Introduces $locals et al ghc-options keys

ChangeLog.md

@@ -59,6 +59,9 @@ Other enhancements:
 * Added `stack ghci --only-main` flag, to skip loading / importing
   all but main modules. See the ghci documentation page
   for further info.
+* Extended the `ghc-options` field to support `$locals`, `$targets`,
+  and `$everything`. See:
+  [#3329](https://github.com/commercialhaskell/stack/issues/3329)
 
 Bug fixes:
 

doc/yaml_configuration.md

@@ -499,21 +499,29 @@ Allows specifying per-package and global GHC options:
 ```yaml
 ghc-options:
     # All packages
-    "*": -Wall
+    "$locals": -Wall
+    "$targets": -Werror
+    "$everything": -O2
     some-package: -DSOME_CPP_FLAG
 ```
 
-Since 0.1.6, setting a GHC options for a specific package will
+Since 1.6.0, setting a GHC options for a specific package will
 automatically promote it to a local package (much like setting a
-custom package flag). However, setting options via `"*"` on all flags
+custom package flag). However, setting options via `$everything` on all flags
 will not do so (see
 [Github discussion](https://github.com/commercialhaskell/stack/issues/849#issuecomment-320892095)
 for reasoning). This can lead to unpredicable behavior by affecting
 your snapshot packages.
 
-By contrast, the `ghc-options` command line flag will only affect the
-packages specified by the
-[`apply-ghc-options` option](yaml_configuration.md#apply-ghc-options).
+The behavior of the `$locals`, `$targets`, and `$everything` special
+keys mirrors the behavior for the
+[`apply-ghc-options` setting](#apply-ghc-options), which affects
+command line parameters.
+
+NOTE: Prior to version 1.6.0, the `$locals`, `$targets`, and
+`$everything` keys were not support. Instead, you could use `"*"` for
+the behavior represented now by `$everything`. It is highly
+recommended to switch to the new, more expressive, keys.
 
 ### apply-ghc-options
 

src/Data/Aeson/Extended.hs

@@ -147,6 +147,8 @@ data WarningParserMonoid = WarningParserMonoid
 instance Monoid WarningParserMonoid where
     mempty = memptydefault
     mappend = mappenddefault
+instance IsString WarningParserMonoid where
+    fromString s = mempty { wpmWarnings = [fromString s] }
 
 -- Parsed JSON value with its warnings
 data WithJSONWarnings a = WithJSONWarnings a [JSONWarning]
@@ -159,8 +161,12 @@ instance Monoid a => Monoid (WithJSONWarnings a) where
 
 -- | Warning output from 'WarningParser'.
 data JSONWarning = JSONUnrecognizedFields String [Text]
+                 | JSONGeneralWarning !Text
 instance Show JSONWarning where
     show (JSONUnrecognizedFields obj [field]) =
         "Unrecognized field in " <> obj <> ": " <> T.unpack field
     show (JSONUnrecognizedFields obj fields) =
         "Unrecognized fields in " <> obj <> ": " <> T.unpack (T.intercalate ", " fields)
+    show (JSONGeneralWarning t) = T.unpack t
+instance IsString JSONWarning where
+  fromString = JSONGeneralWarning . T.pack

src/Stack/Build/Source.hs

@@ -128,7 +128,13 @@ getLocalFlags bconfig boptsCli name = Map.unions
 getGhcOptions :: BuildConfig -> BuildOptsCLI -> PackageName -> Bool -> Bool -> [Text]
 getGhcOptions bconfig boptsCli name isTarget isLocal = concat
     [ Map.findWithDefault [] name (configGhcOptionsByName config)
-    , configGhcOptionsAll config
+    , if isTarget
+        then Map.findWithDefault [] AGOTargets (configGhcOptionsByCat config)
+        else []
+    , if isLocal
+        then Map.findWithDefault [] AGOLocals (configGhcOptionsByCat config)
+        else []
+    , Map.findWithDefault [] AGOEverything (configGhcOptionsByCat config)
     , concat [["-fhpc"] | isLocal && toCoverage (boptsTestOpts bopts)]
     , if boptsLibProfile bopts || boptsExeProfile bopts
          then ["-auto-all","-caf-all"]

src/Stack/Config.hs

@@ -359,7 +359,7 @@ configFromConfigMonoid
      let configTemplateParams = configMonoidTemplateParameters
          configScmInit = getFirst configMonoidScmInit
          configGhcOptionsByName = configMonoidGhcOptionsByName
-         configGhcOptionsAll = configMonoidGhcOptionsAll
+         configGhcOptionsByCat = configMonoidGhcOptionsByCat
          configSetupInfoLocations = configMonoidSetupInfoLocations
          configPvpBounds = fromFirst (PvpBounds PvpBoundsNone False) configMonoidPvpBounds
          configModifyCodePage = fromFirst True configMonoidModifyCodePage

src/Stack/Ghci.hs

@@ -300,8 +300,10 @@ runGhci GhciOpts{..} targets mainIsTargets pkgs extraFiles = do
             | otherwise = bioOneWordOpts bio
         genOpts = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs)
         (omittedOpts, ghcOpts) = partition badForGhci $
-            concatMap (concatMap (bioOpts . snd) . ghciPkgOpts) pkgs ++
-            map T.unpack (configGhcOptionsAll config ++ concatMap (getUserOptions . ghciPkgName) pkgs)
+            concatMap (concatMap (bioOpts . snd) . ghciPkgOpts) pkgs ++ map T.unpack
+              ( fold (configGhcOptionsByCat config) -- include everything, locals, and targets
+             ++ concatMap (getUserOptions . ghciPkgName) pkgs
+              )
         getUserOptions pkg = M.findWithDefault [] pkg (configGhcOptionsByName config)
         badForGhci x =
             isPrefixOf "-O" x || elem x (words "-debug -threaded -ticky -static -Werror")

src/Stack/Types/Config.hs

@@ -167,13 +167,15 @@ module Stack.Types.Config
   ,to
   ) where
 
+import           Control.Monad.Writer (tell)
 import           Stack.Prelude
 import           Data.Aeson.Extended
                  (ToJSON, toJSON, FromJSON, FromJSONKey (..), parseJSON, withText, object,
                   (.=), (..:), (..:?), (..!=), Value(Bool, String),
                   withObjectWarnings, WarningParser, Object, jsonSubWarnings,
                   jsonSubWarningsT, jsonSubWarningsTT, WithJSONWarnings(..), noJSONWarnings,
                   FromJSONKeyFunction (FromJSONKeyTextParser))
+import           Data.Attoparsec.Args (parseArgs, EscapingMode (Escaping))
 import qualified Data.ByteString.Char8 as S8
 import           Data.List (stripPrefix)
 import           Data.List.NonEmpty (NonEmpty)
@@ -313,8 +315,8 @@ data Config =
          -- ^ Initialize SCM (e.g. git) when creating new projects.
          ,configGhcOptionsByName    :: !(Map PackageName [Text])
          -- ^ Additional GHC options to apply to specific packages.
-         ,configGhcOptionsAll       :: ![Text]
-         -- ^ Additional GHC options to apply to all packages
+         ,configGhcOptionsByCat     :: !(Map ApplyGhcOptions [Text])
+         -- ^ Additional GHC options to apply to categories of packages
          ,configSetupInfoLocations  :: ![SetupInfoLocation]
          -- ^ Additional SetupInfo (inline or remote) to use to find tools.
          ,configPvpBounds           :: !PvpBounds
@@ -709,7 +711,7 @@ data ConfigMonoid =
     -- ^ Initialize SCM (e.g. git init) when making new projects?
     ,configMonoidGhcOptionsByName    :: !(Map PackageName [Text])
     -- ^ See 'configGhcOptionsByName'
-    ,configMonoidGhcOptionsAll       :: ![Text]
+    ,configMonoidGhcOptionsByCat     :: !(Map ApplyGhcOptions [Text])
     -- ^ See 'configGhcOptionsAll'
     ,configMonoidExtraPath           :: ![Path Abs Dir]
     -- ^ Additional paths to search for executables in
@@ -794,14 +796,25 @@ parseConfigMonoidObject rootDir obj = do
           return (First scmInit,fromMaybe M.empty params)
     configMonoidCompilerCheck <- First <$> obj ..:? configMonoidCompilerCheckName
 
-    configMonoidGhcOptions <- obj ..:? configMonoidGhcOptionsName ..!= mempty
-    let configMonoidGhcOptionsByName = Map.unions (map
-          (\(mname, opts) ->
-              case mname of
-                GOKAll -> Map.empty
-                GOKPackage name -> Map.singleton name opts)
-          (Map.toList configMonoidGhcOptions))
-        configMonoidGhcOptionsAll = Map.findWithDefault [] GOKAll configMonoidGhcOptions
+    options <- Map.map unGhcOptions <$> obj ..:? configMonoidGhcOptionsName ..!= mempty
+
+    optionsEverything <-
+      case (Map.lookup GOKOldEverything options, Map.lookup GOKEverything options) of
+        (Just _, Just _) -> fail "Cannot specify both `*` and `$everything` GHC options"
+        (Nothing, Just x) -> return x
+        (Just x, Nothing) -> do
+          tell "The `*` ghc-options key is not recommended. Consider using $locals, or if really needed, $everything"
+          return x
+        (Nothing, Nothing) -> return []
+
+    let configMonoidGhcOptionsByCat = Map.fromList
+          [ (AGOEverything, optionsEverything)
+          , (AGOLocals, Map.findWithDefault [] GOKLocals options)
+          , (AGOTargets, Map.findWithDefault [] GOKTargets options)
+          ]
+
+        configMonoidGhcOptionsByName = Map.fromList
+            [(name, opts) | (GOKPackage name, opts) <- Map.toList options]
 
     configMonoidExtraPath <- obj ..:? configMonoidExtraPathName ..!= []
     configMonoidSetupInfoLocations <-
@@ -1721,17 +1734,35 @@ data DockerUser = DockerUser
     , duUmask :: FileMode -- ^ File creation mask }
     } deriving (Read,Show)
 
-data GhcOptionKey = GOKAll | GOKPackage !PackageName
+data GhcOptionKey
+  = GOKOldEverything
+  | GOKEverything
+  | GOKLocals
+  | GOKTargets
+  | GOKPackage !PackageName
   deriving (Eq, Ord)
+
 instance FromJSONKey GhcOptionKey where
   fromJSONKey = FromJSONKeyTextParser $ \t ->
-    if t == "*"
-      then return GOKAll
-      else case parsePackageName t of
-             Left e -> fail $ show e
-             Right x -> return $ GOKPackage x
+    case t of
+      "*" -> return GOKOldEverything
+      "$everything" -> return GOKEverything
+      "$locals" -> return GOKLocals
+      "$targets" -> return GOKTargets
+      _ ->
+        case parsePackageName t of
+          Left e -> fail $ show e
+          Right x -> return $ GOKPackage x
   fromJSONKeyList = FromJSONKeyTextParser $ \_ -> fail "GhcOptionKey.fromJSONKeyList"
 
+newtype GhcOptions = GhcOptions { unGhcOptions :: [Text] }
+
+instance FromJSON GhcOptions where
+  parseJSON = withText "GhcOptions" $ \t ->
+    case parseArgs Escaping t of
+      Left e -> fail e
+      Right opts -> return $ GhcOptions $ map T.pack opts
+
 -----------------------------------
 -- Lens classes
 -----------------------------------