Skip to content

Commit 073dad9

Browse files
snoybergsnoyberg
committed
Introduces $locals et al ghc-options keys
Closes commercialhaskell#3329. This also fixes a regression I introduced in the previous commit on ghc-options, which mistakenly assumed ghc-options were supposed to be given as a list instead of a single Text value.
1 parent f3ae87f commit 073dad9

7 files changed

Lines changed: 83 additions & 27 deletions

File tree

‎ChangeLog.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,9 @@ Other enhancements:
5959
* Added `stack ghci --only-main` flag, to skip loading / importing
6060
all but main modules. See the ghci documentation page
6161
for further info.
62+
* Extended the `ghc-options` field to support `$locals`, `$targets`,
63+
and `$everything`. See:
64+
[#3329](https://github.com/commercialhaskell/stack/issues/3329)
6265

6366
Bug fixes:
6467

‎doc/yaml_configuration.md‎

Lines changed: 14 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -499,21 +499,29 @@ Allows specifying per-package and global GHC options:
499499
```yaml
500500
ghc-options:
501501
# All packages
502-
"*": -Wall
502+
"$locals": -Wall
503+
"$targets": -Werror
504+
"$everything": -O2
503505
some-package: -DSOME_CPP_FLAG
504506
```
505507

506-
Since 0.1.6, setting a GHC options for a specific package will
508+
Since 1.6.0, setting a GHC options for a specific package will
507509
automatically promote it to a local package (much like setting a
508-
custom package flag). However, setting options via `"*"` on all flags
510+
custom package flag). However, setting options via `$everything` on all flags
509511
will not do so (see
510512
[Github discussion](https://github.com/commercialhaskell/stack/issues/849#issuecomment-320892095)
511513
for reasoning). This can lead to unpredicable behavior by affecting
512514
your snapshot packages.
513515

514-
By contrast, the `ghc-options` command line flag will only affect the
515-
packages specified by the
516-
[`apply-ghc-options` option](yaml_configuration.md#apply-ghc-options).
516+
The behavior of the `$locals`, `$targets`, and `$everything` special
517+
keys mirrors the behavior for the
518+
[`apply-ghc-options` setting](#apply-ghc-options), which affects
519+
command line parameters.
520+
521+
NOTE: Prior to version 1.6.0, the `$locals`, `$targets`, and
522+
`$everything` keys were not support. Instead, you could use `"*"` for
523+
the behavior represented now by `$everything`. It is highly
524+
recommended to switch to the new, more expressive, keys.
517525

518526
### apply-ghc-options
519527

‎src/Data/Aeson/Extended.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -147,6 +147,8 @@ data WarningParserMonoid = WarningParserMonoid
147147
instance Monoid WarningParserMonoid where
148148
mempty = memptydefault
149149
mappend = mappenddefault
150+
instance IsString WarningParserMonoid where
151+
fromString s = mempty { wpmWarnings = [fromString s] }
150152

151153
-- Parsed JSON value with its warnings
152154
data WithJSONWarnings a = WithJSONWarnings a [JSONWarning]
@@ -159,8 +161,12 @@ instance Monoid a => Monoid (WithJSONWarnings a) where
159161

160162
-- | Warning output from 'WarningParser'.
161163
data JSONWarning = JSONUnrecognizedFields String [Text]
164+
| JSONGeneralWarning !Text
162165
instance Show JSONWarning where
163166
show (JSONUnrecognizedFields obj [field]) =
164167
"Unrecognized field in " <> obj <> ": " <> T.unpack field
165168
show (JSONUnrecognizedFields obj fields) =
166169
"Unrecognized fields in " <> obj <> ": " <> T.unpack (T.intercalate ", " fields)
170+
show (JSONGeneralWarning t) = T.unpack t
171+
instance IsString JSONWarning where
172+
fromString = JSONGeneralWarning . T.pack

‎src/Stack/Build/Source.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -128,7 +128,13 @@ getLocalFlags bconfig boptsCli name = Map.unions
128128
getGhcOptions :: BuildConfig -> BuildOptsCLI -> PackageName -> Bool -> Bool -> [Text]
129129
getGhcOptions bconfig boptsCli name isTarget isLocal = concat
130130
[ Map.findWithDefault [] name (configGhcOptionsByName config)
131-
, configGhcOptionsAll config
131+
, if isTarget
132+
then Map.findWithDefault [] AGOTargets (configGhcOptionsByCat config)
133+
else []
134+
, if isLocal
135+
then Map.findWithDefault [] AGOLocals (configGhcOptionsByCat config)
136+
else []
137+
, Map.findWithDefault [] AGOEverything (configGhcOptionsByCat config)
132138
, concat [["-fhpc"] | isLocal && toCoverage (boptsTestOpts bopts)]
133139
, if boptsLibProfile bopts || boptsExeProfile bopts
134140
then ["-auto-all","-caf-all"]

‎src/Stack/Config.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -359,7 +359,7 @@ configFromConfigMonoid
359359
let configTemplateParams = configMonoidTemplateParameters
360360
configScmInit = getFirst configMonoidScmInit
361361
configGhcOptionsByName = configMonoidGhcOptionsByName
362-
configGhcOptionsAll = configMonoidGhcOptionsAll
362+
configGhcOptionsByCat = configMonoidGhcOptionsByCat
363363
configSetupInfoLocations = configMonoidSetupInfoLocations
364364
configPvpBounds = fromFirst (PvpBounds PvpBoundsNone False) configMonoidPvpBounds
365365
configModifyCodePage = fromFirst True configMonoidModifyCodePage

‎src/Stack/Ghci.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -300,8 +300,10 @@ runGhci GhciOpts{..} targets mainIsTargets pkgs extraFiles = do
300300
| otherwise = bioOneWordOpts bio
301301
genOpts = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs)
302302
(omittedOpts, ghcOpts) = partition badForGhci $
303-
concatMap (concatMap (bioOpts . snd) . ghciPkgOpts) pkgs ++
304-
map T.unpack (configGhcOptionsAll config ++ concatMap (getUserOptions . ghciPkgName) pkgs)
303+
concatMap (concatMap (bioOpts . snd) . ghciPkgOpts) pkgs ++ map T.unpack
304+
( fold (configGhcOptionsByCat config) -- include everything, locals, and targets
305+
++ concatMap (getUserOptions . ghciPkgName) pkgs
306+
)
305307
getUserOptions pkg = M.findWithDefault [] pkg (configGhcOptionsByName config)
306308
badForGhci x =
307309
isPrefixOf "-O" x || elem x (words "-debug -threaded -ticky -static -Werror")

‎src/Stack/Types/Config.hs‎

Lines changed: 48 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -167,13 +167,15 @@ module Stack.Types.Config
167167
,to
168168
) where
169169

170+
import Control.Monad.Writer (tell)
170171
import Stack.Prelude
171172
import Data.Aeson.Extended
172173
(ToJSON, toJSON, FromJSON, FromJSONKey (..), parseJSON, withText, object,
173174
(.=), (..:), (..:?), (..!=), Value(Bool, String),
174175
withObjectWarnings, WarningParser, Object, jsonSubWarnings,
175176
jsonSubWarningsT, jsonSubWarningsTT, WithJSONWarnings(..), noJSONWarnings,
176177
FromJSONKeyFunction (FromJSONKeyTextParser))
178+
import Data.Attoparsec.Args (parseArgs, EscapingMode (Escaping))
177179
import qualified Data.ByteString.Char8 as S8
178180
import Data.List (stripPrefix)
179181
import Data.List.NonEmpty (NonEmpty)
@@ -313,8 +315,8 @@ data Config =
313315
-- ^ Initialize SCM (e.g. git) when creating new projects.
314316
,configGhcOptionsByName :: !(Map PackageName [Text])
315317
-- ^ Additional GHC options to apply to specific packages.
316-
,configGhcOptionsAll :: ![Text]
317-
-- ^ Additional GHC options to apply to all packages
318+
,configGhcOptionsByCat :: !(Map ApplyGhcOptions [Text])
319+
-- ^ Additional GHC options to apply to categories of packages
318320
,configSetupInfoLocations :: ![SetupInfoLocation]
319321
-- ^ Additional SetupInfo (inline or remote) to use to find tools.
320322
,configPvpBounds :: !PvpBounds
@@ -709,7 +711,7 @@ data ConfigMonoid =
709711
-- ^ Initialize SCM (e.g. git init) when making new projects?
710712
,configMonoidGhcOptionsByName :: !(Map PackageName [Text])
711713
-- ^ See 'configGhcOptionsByName'
712-
,configMonoidGhcOptionsAll :: ![Text]
714+
,configMonoidGhcOptionsByCat :: !(Map ApplyGhcOptions [Text])
713715
-- ^ See 'configGhcOptionsAll'
714716
,configMonoidExtraPath :: ![Path Abs Dir]
715717
-- ^ Additional paths to search for executables in
@@ -794,14 +796,25 @@ parseConfigMonoidObject rootDir obj = do
794796
return (First scmInit,fromMaybe M.empty params)
795797
configMonoidCompilerCheck <- First <$> obj ..:? configMonoidCompilerCheckName
796798

797-
configMonoidGhcOptions <- obj ..:? configMonoidGhcOptionsName ..!= mempty
798-
let configMonoidGhcOptionsByName = Map.unions (map
799-
(\(mname, opts) ->
800-
case mname of
801-
GOKAll -> Map.empty
802-
GOKPackage name -> Map.singleton name opts)
803-
(Map.toList configMonoidGhcOptions))
804-
configMonoidGhcOptionsAll = Map.findWithDefault [] GOKAll configMonoidGhcOptions
799+
options <- Map.map unGhcOptions <$> obj ..:? configMonoidGhcOptionsName ..!= mempty
800+
801+
optionsEverything <-
802+
case (Map.lookup GOKOldEverything options, Map.lookup GOKEverything options) of
803+
(Just _, Just _) -> fail "Cannot specify both `*` and `$everything` GHC options"
804+
(Nothing, Just x) -> return x
805+
(Just x, Nothing) -> do
806+
tell "The `*` ghc-options key is not recommended. Consider using $locals, or if really needed, $everything"
807+
return x
808+
(Nothing, Nothing) -> return []
809+
810+
let configMonoidGhcOptionsByCat = Map.fromList
811+
[ (AGOEverything, optionsEverything)
812+
, (AGOLocals, Map.findWithDefault [] GOKLocals options)
813+
, (AGOTargets, Map.findWithDefault [] GOKTargets options)
814+
]
815+
816+
configMonoidGhcOptionsByName = Map.fromList
817+
[(name, opts) | (GOKPackage name, opts) <- Map.toList options]
805818

806819
configMonoidExtraPath <- obj ..:? configMonoidExtraPathName ..!= []
807820
configMonoidSetupInfoLocations <-
@@ -1721,17 +1734,35 @@ data DockerUser = DockerUser
17211734
, duUmask :: FileMode -- ^ File creation mask }
17221735
} deriving (Read,Show)
17231736

1724-
data GhcOptionKey = GOKAll | GOKPackage !PackageName
1737+
data GhcOptionKey
1738+
= GOKOldEverything
1739+
| GOKEverything
1740+
| GOKLocals
1741+
| GOKTargets
1742+
| GOKPackage !PackageName
17251743
deriving (Eq, Ord)
1744+
17261745
instance FromJSONKey GhcOptionKey where
17271746
fromJSONKey = FromJSONKeyTextParser $ \t ->
1728-
if t == "*"
1729-
then return GOKAll
1730-
else case parsePackageName t of
1731-
Left e -> fail $ show e
1732-
Right x -> return $ GOKPackage x
1747+
case t of
1748+
"*" -> return GOKOldEverything
1749+
"$everything" -> return GOKEverything
1750+
"$locals" -> return GOKLocals
1751+
"$targets" -> return GOKTargets
1752+
_ ->
1753+
case parsePackageName t of
1754+
Left e -> fail $ show e
1755+
Right x -> return $ GOKPackage x
17331756
fromJSONKeyList = FromJSONKeyTextParser $ \_ -> fail "GhcOptionKey.fromJSONKeyList"
17341757

1758+
newtype GhcOptions = GhcOptions { unGhcOptions :: [Text] }
1759+
1760+
instance FromJSON GhcOptions where
1761+
parseJSON = withText "GhcOptions" $ \t ->
1762+
case parseArgs Escaping t of
1763+
Left e -> fail e
1764+
Right opts -> return $ GhcOptions $ map T.pack opts
1765+
17351766
-----------------------------------
17361767
-- Lens classes
17371768
-----------------------------------

0 commit comments

Comments
 (0)