Skip to content

Commit

Permalink
Merge pull request commercialhaskell#1850 from commercialhaskell/stac…
Browse files Browse the repository at this point in the history 
…k-yaml

Improve the generated stack.yaml
  • Loading branch information
@mgsloan
mgsloan committed Mar 1, 2016
2 parents 8616bf3 + 6e58c52 commit 6af4831
Showing 1 changed file with 112 additions and 44 deletions.
156 changes: 112 additions & 44 deletions src/Stack/Init.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,8 @@ import qualified Data.Foldable as F
import Data.Function (on)
import qualified Data.HashMap.Strict as HM
import qualified Data.IntMap as IntMap
import Data.List (intersect, maximumBy)
import Data.List ( intercalate, intersect
, maximumBy)
import Data.List.Extra (nubOrd)
import Data.Map (Map)
import qualified Data.Map as Map
Expand All @@ -31,9 +32,12 @@ import Data.Monoid
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import qualified Distribution.PackageDescription as C
import qualified Distribution.Text as C
import qualified Distribution.Version as C
import Network.HTTP.Client.Conduit (HasHttpManager)
import Path
import Path.IO
import qualified Paths_stack as Meta
import Stack.BuildPlan
import Stack.Config (getSnapshots,
makeConcreteResolver)
Expand Down Expand Up @@ -176,65 +180,129 @@ renderStackYaml p ignoredPackages dupPackages =
_ -> assert False $ B.byteString $ Yaml.encode p
where
renderObject o =
B.byteString "# This file was automatically generated by stack init\n" <>
B.byteString "# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/\n\n" <>
F.foldMap (goComment o) comments <>
goOthers (o `HM.difference` HM.fromList comments) <>
B.byteString
"# Control whether we use the GHC we find on the path\n\
\# system-ghc: true\n\n\
\# Require a specific version of stack, using version ranges\n\
\# require-stack-version: -any # Default\n\
\# require-stack-version: >= 1.0.0\n\n\
\# Override the architecture used by stack, especially useful on Windows\n\
\# arch: i386\n\
\# arch: x86_64\n\n\
\# Extra directories used by stack for building\n\
\# extra-include-dirs: [/path/to/dir]\n\
\# extra-lib-dirs: [/path/to/dir]\n\n\
\# Allow a newer minor version of GHC than the snapshot specifies\n\
\# compiler-check: newer-minor\n"
B.byteString headerHelp
<> B.byteString "\n\n"
<> F.foldMap (goComment o) comments
<> goOthers (o `HM.difference` HM.fromList comments)
<> B.byteString footerHelp

comments =
[ ("user-message", "A message to be displayed to the user. Used when autogenerated config ignored some packages or added extra deps.")
, ("resolver", "Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)")
, ("packages", "Local packages, usually specified by relative directory name")
, ("extra-deps", "Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)")
, ("flags", "Override default flag values for local packages and extra-deps")
, ("extra-package-dbs", "Extra package databases containing global packages")
]
goComment o (name, comment) =
case HM.lookup name o of
Nothing -> assert (name == "user-message") mempty
Just v ->
B.byteString comment <>
B.byteString "\n" <>
B.byteString (Yaml.encode $ Yaml.object [(name, v)]) <>
if (name == "packages") then commentedPackages else "" <>
B.byteString "\n"

commentHelp = BC.pack . intercalate "\n" . map ("# " ++)
commentedPackages =
let ignoredComment = "# The following packages have been ignored \
\due to incompatibility with the resolver compiler or \
\dependency conflicts with other packages"
dupComment = "# The following packages have been ignored due \
\to package name conflict with other packages"
let ignoredComment = commentHelp
[ "The following packages have been ignored due to incompatibility with the"
, "resolver compiler, dependency conflicts with other packages"
, "or unsatisfied dependencies."
]
dupComment = commentHelp
[ "The following packages have been ignored due to package name conflict "
, "with other packages."
]
in commentPackages ignoredComment ignoredPackages
<> commentPackages dupComment dupPackages

commentPackages comment pkgs
| pkgs /= [] =
B.byteString (BC.pack $ comment ++ "\n")
B.byteString comment
<> B.byteString "\n"
<> (B.byteString $ BC.pack $ concat
$ (map (\x -> "#- " ++ x ++ "\n") pkgs) ++ ["\n"])
| otherwise = ""

goComment o (name, comment) =
case HM.lookup name o of
Nothing -> assert (name == "user-message") mempty
Just v ->
B.byteString "# " <>
B.byteString comment <>
B.byteString "\n" <>
B.byteString (Yaml.encode $ Yaml.object [(name, v)]) <>
if (name == "packages") then commentedPackages else "" <>
B.byteString "\n"

goOthers o
| HM.null o = mempty
| otherwise = assert False $ B.byteString $ Yaml.encode o

-- Per Section Help
comments =
[ ("user-message" , userMsgHelp)
, ("resolver" , resolverHelp)
, ("packages" , packageHelp)
, ("extra-deps" , "# Dependency packages to be pulled from upstream that are not in the resolver\n# (e.g., acme-missiles-0.3)")
, ("flags" , "# Override default flag values for local packages and extra-deps")
, ("extra-package-dbs", "# Extra package databases containing global packages")
]

-- Help strings
headerHelp = commentHelp
[ "This file was automatically generated by 'stack init'"
, ""
, "Some commonly used options have been documented as comments in this file."
, "For advanced use and comprehensive documentation of the format, please see:"
, "http://docs.haskellstack.org/en/stable/yaml_configuration/"
]

resolverHelp = commentHelp
[ "Resolver to choose a 'specific' stackage snapshot or a compiler version."
, "A snapshot resolver dictates the compiler version and the set of packages"
, "to be used for project dependencies. For example:"
, ""
, "resolver: lts-3.5"
, "resolver: nightly-2015-09-21"
, "resolver: ghc-7.10.2"
, "resolver: ghcjs-0.1.0_ghc-7.10.2"
, "resolver:"
, " name: custom-snapshot"
, " location: \"./custom-snapshot.yaml\""
]

userMsgHelp = commentHelp
[ "A warning or info to be displayed to the user on config load." ]

packageHelp = commentHelp
[ "User packages to be built."
, "Various formats can be used as shown in the example below."
, ""
, "packages:"
, "- some-directory"
, "- https://example.com/foo/bar/baz-0.0.2.tar.gz"
, "- location:"
, " git: https://github.com/commercialhaskell/stack.git"
, " commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a"
, "- location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a"
, " extra-dep: true"
, " subdirs:"
, " - auto-update"
, " - wai"
, ""
, "A package marked 'extra-dep: true' will only be built if demanded by a"
, "non-dependency (i.e. a user package), and its test suites and benchmarks"
, "will not be run. This is useful for tweaking upstream packages."
]

footerHelp =
let major = toCabalVersion
$ toMajorVersion $ fromCabalVersion Meta.version
in commentHelp
[ "Control whether we use the GHC we find on the path"
, "system-ghc: true"
, ""
, "Require a specific version of stack, using version ranges"
, "require-stack-version: -any # Default"
, "require-stack-version: \""
++ C.display (C.orLaterVersion major) ++ "\""
, ""
, "Override the architecture used by stack, especially useful on Windows"
, "arch: i386"
, "arch: x86_64"
, ""
, "Extra directories used by stack for building"
, "extra-include-dirs: [/path/to/dir]"
, "extra-lib-dirs: [/path/to/dir]"
, ""
, "Allow a newer minor version of GHC than the snapshot specifies"
, "compiler-check: newer-minor"
]

getSnapshots' :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, MonadLogger m, MonadBaseControl IO m)
=> m Snapshots
getSnapshots' =
Expand Down

0 comments on commit 6af4831

Please sign in to comment.