Create default stack.yaml with documentation comments and commented o…

…ut options

Fixes #226

ChangeLog.md

@@ -26,6 +26,7 @@ Other enhancements:
 * Added `--file-watch-poll` flag for polling instead of using filesystem events (useful for running tests in a Docker container while modifying code in the host environment. When code is injected into the container via a volume, the container won't propagate filesystem events).
 * Give a preemptive error message when `-prof` is given as a GHC option [#1015](https://github.com/commercialhaskell/stack/issues/1015)
 * Locking is now optional, and will be turned on by setting the `STACK_LOCK` environment variable to `true` [#950](https://github.com/commercialhaskell/stack/issues/950)
+* Create default stack.yaml with documentation comments and commented out options [#226](https://github.com/commercialhaskell/stack/issues/226)
 
 Bug fixes:
 

src/Stack/Init.hs

@@ -19,7 +19,11 @@ import           Control.Monad.IO.Class
 import           Control.Monad.Logger
 import           Control.Monad.Reader            (MonadReader, asks)
 import           Control.Monad.Trans.Control     (MonadBaseControl)
+import qualified Data.ByteString.Builder         as B
+import qualified Data.ByteString.Lazy            as L
+import qualified Data.HashMap.Strict             as HM
 import qualified Data.IntMap                     as IntMap
+import qualified Data.Foldable                   as F
 import           Data.List                       (isSuffixOf,sort)
 import           Data.List.Extra                 (nubOrd)
 import           Data.Map                        (Map)
@@ -102,9 +106,55 @@ initProject currDir initOpts = do
             , peSubdirs = []
             }
     $logInfo $ "Selected resolver: " <> resolverName r
-    liftIO $ Yaml.encodeFile dest' p
+    liftIO $ L.writeFile dest' $ B.toLazyByteString $ renderStackYaml p
     $logInfo $ "Wrote project config to: " <> T.pack dest'
 
+-- | Render a stack.yaml file with comments, see:
+-- https://github.com/commercialhaskell/stack/issues/226
+renderStackYaml :: Project -> B.Builder
+renderStackYaml p =
+    case Yaml.toJSON p of
+        Yaml.Object o -> renderObject o
+        _ -> assert False $ B.byteString $ Yaml.encode p
+  where
+    renderObject o =
+        B.byteString "# For more information, see: https://github.com/commercialhaskell/stack/wiki/stack.yaml\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: >= 0.1.4.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"
+
+    comments =
+        [ ("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")
+        ]
+
+    goComment o (name, comment) =
+        case HM.lookup name o of
+            Nothing -> assert False mempty
+            Just v ->
+                B.byteString "# " <>
+                B.byteString comment <>
+                B.byteString "\n" <>
+                B.byteString (Yaml.encode $ Yaml.object [(name, v)]) <>
+                B.byteString "\n"
+
+    goOthers o
+        | HM.null o = mempty
+        | otherwise = assert False $ B.byteString $ Yaml.encode o
+
 getSnapshots' :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, MonadLogger m, MonadBaseControl IO m)
               => m (Maybe Snapshots)
 getSnapshots' =