fix: a docker section in global/user config caused 'stack new' to try to start a container

borsboom · borsboom · commit 6a9261fccd7f · 2015-10-12T16:26:15.000-07:00
diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs
@@ -268,7 +268,13 @@ loadConfig :: (MonadLogger m,MonadIO m,MonadCatch m,MonadThrow m,MonadBaseContro
 loadConfig configArgs mstackYaml = do
     stackRoot <- determineStackRoot
     userConfigPath <- getDefaultUserConfigPath stackRoot
-    extraConfigs <- getExtraConfigs userConfigPath >>= mapM loadYaml
+    extraConfigs0 <- getExtraConfigs userConfigPath >>= mapM loadYaml
+    let extraConfigs =
+            -- non-project config files' existence of a docker section should never default docker
+            -- to enabled, so make it look like they didn't exist
+            map (\c -> c {configMonoidDockerOpts =
+                              (configMonoidDockerOpts c) {dockerMonoidDefaultEnable = False}})
+                extraConfigs0
     mproject <- loadProjectConfig mstackYaml
     config <- configFromConfigMonoid stackRoot userConfigPath (fmap (\(proj, _, _) -> proj) mproject) $ mconcat $
         case mproject of
diff --git a/src/Stack/Config/Docker.hs b/src/Stack/Config/Docker.hs
@@ -19,7 +19,7 @@ dockerOptsFromMonoid
     => Maybe Project -> Path Abs Dir -> DockerOptsMonoid -> m DockerOpts
 dockerOptsFromMonoid mproject stackRoot DockerOptsMonoid{..} = do
     let dockerEnable =
-            fromMaybe (fromMaybe False dockerMonoidExists) dockerMonoidEnable
+            fromMaybe dockerMonoidDefaultEnable dockerMonoidEnable
         dockerImage =
             let defaultTag =
                     case mproject of
diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs
@@ -293,7 +293,7 @@ configOptsParser docker =
 dockerOptsParser :: Bool -> Parser DockerOptsMonoid
 dockerOptsParser showOptions =
     DockerOptsMonoid
-    <$> pure Nothing
+    <$> pure False
     <*> maybeBoolFlags dockerCmdName
                        "using a Docker container"
                        hide
diff --git a/src/Stack/Types/Docker.hs b/src/Stack/Types/Docker.hs
@@ -52,8 +52,8 @@ data DockerOpts = DockerOpts
 -- | An uninterpreted representation of docker options.
 -- Configurations may be "cascaded" using mappend (left-biased).
 data DockerOptsMonoid = DockerOptsMonoid
-  {dockerMonoidExists :: !(Maybe Bool)
-    -- ^ Does a @docker:@ section exist in the top-level (usually project) config?
+  {dockerMonoidDefaultEnable :: !Bool
+    -- ^ Should Docker be defaulted to enabled (does @docker:@ section exist in the config)?
   ,dockerMonoidEnable :: !(Maybe Bool)
     -- ^ Is using Docker enabled?
   ,dockerMonoidRepoOrImage :: !(Maybe DockerMonoidRepoOrImage)
@@ -92,7 +92,7 @@ data DockerOptsMonoid = DockerOptsMonoid
 -- | Decode uninterpreted docker options from JSON/YAML.
 instance FromJSON (DockerOptsMonoid, [JSONWarning]) where
   parseJSON = withObjectWarnings "DockerOptsMonoid"
-    (\o -> do dockerMonoidExists           <- pure (Just True)
+    (\o -> do dockerMonoidDefaultEnable    <- pure True
               dockerMonoidEnable           <- o ..:? dockerEnableArgName
               dockerMonoidRepoOrImage      <- ((Just . DockerMonoidImage) <$> o ..: dockerImageArgName) <|>
                                               ((Just . DockerMonoidRepo) <$> o ..: dockerRepoArgName) <|>
@@ -115,7 +115,7 @@ instance FromJSON (DockerOptsMonoid, [JSONWarning]) where
 -- | Left-biased combine Docker options
 instance Monoid DockerOptsMonoid where
   mempty = DockerOptsMonoid
-    {dockerMonoidExists           = Just False
+    {dockerMonoidDefaultEnable    = False
     ,dockerMonoidEnable           = Nothing
     ,dockerMonoidRepoOrImage      = Nothing
     ,dockerMonoidRegistryLogin    = Nothing
@@ -133,7 +133,7 @@ instance Monoid DockerOptsMonoid where
     ,dockerMonoidSetUser          = Nothing
     }
   mappend l r = DockerOptsMonoid
-    {dockerMonoidExists           = dockerMonoidExists l <|> dockerMonoidExists r
+    {dockerMonoidDefaultEnable    = dockerMonoidDefaultEnable l || dockerMonoidDefaultEnable r
     ,dockerMonoidEnable           = dockerMonoidEnable l <|> dockerMonoidEnable r
     ,dockerMonoidRepoOrImage      = dockerMonoidRepoOrImage l <|> dockerMonoidRepoOrImage r
     ,dockerMonoidRegistryLogin    = dockerMonoidRegistryLogin l <|> dockerMonoidRegistryLogin r
