Merge pull request commercialhaskell#4300 from commercialhaskell/appl…

…y-cli-flag

ApplyCLIFlag

src/Stack/Build/Source.hs

@@ -116,8 +116,8 @@ getLocalFlags
     -> PackageName
     -> Map FlagName Bool
 getLocalFlags bconfig boptsCli name = Map.unions
-    [ Map.findWithDefault Map.empty (Just name) cliFlags
-    , Map.findWithDefault Map.empty Nothing cliFlags
+    [ Map.findWithDefault Map.empty (ACFByName name) cliFlags
+    , Map.findWithDefault Map.empty ACFAllProjectPackages cliFlags
     , Map.findWithDefault Map.empty name (bcFlags bconfig)
     ]
   where
@@ -325,7 +325,7 @@ checkFlagsUsed boptsCli lps extraDeps snapshot = do
 
         -- Check if flags specified in stack.yaml and the command line are
         -- used, see https://github.com/commercialhaskell/stack/issues/617
-    let flags = map (, FSCommandLine) [(k, v) | (Just k, v) <- Map.toList $ boptsCLIFlags boptsCli]
+    let flags = map (, FSCommandLine) [(k, v) | (ACFByName k, v) <- Map.toList $ boptsCLIFlags boptsCli]
              ++ map (, FSStackYaml) (Map.toList $ bcFlags bconfig)
 
         localNameMap = Map.fromList $ map (packageName . lpPackage &&& lpPackage) lps

src/Stack/Build/Target.hs

@@ -487,10 +487,8 @@ parseTargets needTargets boptscli = do
       | otherwise -> throwIO $ TargetParseException
           ["The specified targets matched no packages"]
 
-  let dropMaybeKey (Nothing, _) = Map.empty
-      dropMaybeKey (Just key, value) = Map.singleton key value
-      flags = Map.unionWith Map.union
-        (Map.unions (map dropMaybeKey (Map.toList (boptsCLIFlags boptscli))))
+  let flags = Map.unionWith Map.union
+        (boptsCLIFlagsByName boptscli)
         (bcFlags bconfig)
       hides = Map.empty -- not supported to add hidden packages
 

src/Stack/Dot.hs

@@ -50,7 +50,7 @@ data DotOpts = DotOpts
     -- ^ Package names to prune from the graph
     , dotTargets :: [Text]
     -- ^ stack TARGETs to trace dependencies for
-    , dotFlags :: !(Map (Maybe PackageName) (Map FlagName Bool))
+    , dotFlags :: !(Map ApplyCLIFlag (Map FlagName Bool))
     -- ^ Flags to apply when calculating dependencies
     , dotTestTargets :: Bool
     -- ^ Like the "--test" flag for build, affects the meaning of 'dotTargets'.

src/Stack/Ghci.hs

@@ -55,7 +55,7 @@ data GhciOpts = GhciOpts
     { ghciTargets            :: ![Text]
     , ghciArgs               :: ![String]
     , ghciGhcOptions         :: ![Text]
-    , ghciFlags              :: !(Map (Maybe PackageName) (Map FlagName Bool))
+    , ghciFlags              :: !(Map ApplyCLIFlag (Map FlagName Bool))
     , ghciGhcCommand         :: !(Maybe FilePath)
     , ghciNoLoadModules      :: !Bool
     , ghciAdditionalPackages :: ![String]

src/Stack/Options/BuildParser.hs

@@ -92,7 +92,7 @@ targetsParser =
                     versionString stackMinorVersion <>
                     "/build_command/#target-syntax for details.")))
 
-flagsParser :: Parser (Map.Map (Maybe PackageName) (Map.Map FlagName Bool))
+flagsParser :: Parser (Map.Map ApplyCLIFlag (Map.Map FlagName Bool))
 flagsParser =
      Map.unionsWith Map.union <$>
      many

src/Stack/Options/PackageParser.hs

@@ -5,19 +5,20 @@ import qualified Data.Map                          as Map
 import           Options.Applicative
 import           Options.Applicative.Types         (readerAsk)
 import           Stack.Prelude
+import           Stack.Types.Config.Build (ApplyCLIFlag (..))
 
 -- | Parser for package:[-]flag
-readFlag :: ReadM (Map (Maybe PackageName) (Map FlagName Bool))
+readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool))
 readFlag = do
     s <- readerAsk
     case break (== ':') s of
         (pn, ':':mflag) -> do
             pn' <-
                 case parsePackageName pn of
                     Nothing
-                        | pn == "*" -> return Nothing
+                        | pn == "*" -> return ACFAllProjectPackages
                         | otherwise -> readerError $ "Invalid package name: " ++ pn
-                    Just x -> return $ Just x
+                    Just x -> return $ ACFByName x
             let (b, flagS) =
                     case mflag of
                         '-':x -> (False, x)

src/Stack/Types/Config/Build.hs

@@ -25,6 +25,8 @@ module Stack.Types.Config.Build
     , BenchmarkOptsMonoid(..)
     , FileWatchOpts(..)
     , BuildSubset(..)
+    , ApplyCLIFlag (..)
+    , boptsCLIFlagsByName
     )
     where
 
@@ -137,12 +139,31 @@ defaultBuildOptsCLI = BuildOptsCLI
     , boptsCLIInitialBuildSteps = False
     }
 
+-- | How to apply a CLI flag
+data ApplyCLIFlag
+  = ACFAllProjectPackages
+  -- ^ Apply to all project packages which have such a flag name available.
+  | ACFByName !PackageName
+  -- ^ Apply to the specified package only.
+  deriving (Show, Eq, Ord)
+
+-- | Only flags set via 'ACFByName'
+boptsCLIFlagsByName :: BuildOptsCLI -> Map PackageName (Map FlagName Bool)
+boptsCLIFlagsByName =
+  Map.fromList .
+  mapMaybe go .
+  Map.toList .
+  boptsCLIFlags
+  where
+    go (ACFAllProjectPackages, _) = Nothing
+    go (ACFByName name, flags) = Just (name, flags)
+
 -- | Build options that may only be specified from the CLI
 data BuildOptsCLI = BuildOptsCLI
     { boptsCLITargets :: ![Text]
     , boptsCLIDryrun :: !Bool
     , boptsCLIGhcOptions :: ![Text]
-    , boptsCLIFlags :: !(Map (Maybe PackageName) (Map FlagName Bool))
+    , boptsCLIFlags :: !(Map ApplyCLIFlag (Map FlagName Bool))
     , boptsCLIBuildSubset :: !BuildSubset
     , boptsCLIFileWatch :: !FileWatchOpts
     , boptsCLIExec :: ![(String, [String])]