Settings.hs 11 KB
Newer Older
1
module Settings (
Andrey Mokhov's avatar
Andrey Mokhov committed
2
    getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
3
    findPackageByName, unsafeFindPackageByName, unsafeFindPackageByPath,
4
    isLibrary, stagePackages, getIntegerPackage, completeSetting
5 6
    ) where

7
import CommandLine
Andrey Mokhov's avatar
Andrey Mokhov committed
8
import Expression
Andrey Mokhov's avatar
Andrey Mokhov committed
9
import Flavour
10
import Packages
11
import Settings.Parser
12
import UserSettings (userFlavours, userPackages, userDefaultFlavour)
13

Andrey Mokhov's avatar
Andrey Mokhov committed
14
import {-# SOURCE #-} Settings.Default
15
import Settings.Flavours.Benchmark
Andrey Mokhov's avatar
Andrey Mokhov committed
16
import Settings.Flavours.Development
Alec Theriault's avatar
Alec Theriault committed
17
import Settings.Flavours.Llvm
Andrey Mokhov's avatar
Andrey Mokhov committed
18 19
import Settings.Flavours.Performance
import Settings.Flavours.Profiled
Andrey Mokhov's avatar
Andrey Mokhov committed
20 21
import Settings.Flavours.Quick
import Settings.Flavours.Quickest
22
import Settings.Flavours.QuickCross
23
import Settings.Flavours.GhcInGhci
24
import Settings.Flavours.Validate
Andrey Mokhov's avatar
Andrey Mokhov committed
25

26 27 28
import Control.Monad.Except
import Data.Either

Andrey Mokhov's avatar
Andrey Mokhov committed
29
getArgs :: Args
30
getArgs = expr flavour >>= args
Andrey Mokhov's avatar
Andrey Mokhov committed
31

Andrey Mokhov's avatar
Andrey Mokhov committed
32
getLibraryWays :: Ways
33
getLibraryWays = expr flavour >>= libraryWays
Andrey Mokhov's avatar
Andrey Mokhov committed
34

Andrey Mokhov's avatar
Andrey Mokhov committed
35
getRtsWays :: Ways
36
getRtsWays = expr flavour >>= rtsWays
Andrey Mokhov's avatar
Andrey Mokhov committed
37

38
stagePackages :: Stage -> Action [Package]
Andrey Mokhov's avatar
Andrey Mokhov committed
39 40 41
stagePackages stage = do
    f <- flavour
    packages f stage
42

Andrey Mokhov's avatar
Andrey Mokhov committed
43
hadrianFlavours :: [Flavour]
Andrey Mokhov's avatar
Andrey Mokhov committed
44
hadrianFlavours =
45 46 47
    [ benchmarkFlavour, defaultFlavour, developmentFlavour Stage1
    , developmentFlavour Stage2, performanceFlavour, profiledFlavour
    , quickFlavour, quickestFlavour, quickCrossFlavour, benchmarkLlvmFlavour
48
    , performanceLlvmFlavour, profiledLlvmFlavour, quickLlvmFlavour
49
    , ghcInGhciFlavour, validateFlavour, slowValidateFlavour ]
Andrey Mokhov's avatar
Andrey Mokhov committed
50

51 52 53 54 55 56
-- | This action looks up a flavour with the name given on the
--   command line with @--flavour@, defaulting to 'userDefaultFlavour'
--   when no explicit @--flavour@ is passed. It then applies any
--   potential setting update specified on the command line or in a
--   <build root>/hadrian.settings file, using @k = v@ or @k += v@ style
--   syntax. See Note [Hadrian settings] at the bottom of this file.
57 58
flavour :: Action Flavour
flavour = do
59
    flavourName <- fromMaybe userDefaultFlavour <$> cmdFlavour
60
    kvs <- userSetting ([] :: [KeyVal])
61
    let flavours = hadrianFlavours ++ userFlavours
62 63
        (_settingErrs, tweak) = applySettings kvs

64 65 66 67 68
    return $
      case filter (\fl -> name fl == flavourName) flavours of
        []  -> error $ "Unknown build flavour: " ++ flavourName
        [f] -> tweak f
        _   -> error $ "Multiple build flavours named " ++ flavourName
69

70 71
getIntegerPackage :: Expr Package
getIntegerPackage = expr (integerLibrary =<< flavour)
72

Andrey Mokhov's avatar
Andrey Mokhov committed
73 74 75
-- TODO: switch to Set Package as the order of packages should not matter?
-- Otherwise we have to keep remembering to sort packages from time to time.
knownPackages :: [Package]
76
knownPackages = sort $ ghcPackages ++ userPackages
Andrey Mokhov's avatar
Andrey Mokhov committed
77

Andrey Mokhov's avatar
Andrey Mokhov committed
78
-- TODO: Speed up? Switch to Set?
Andrey Mokhov's avatar
Andrey Mokhov committed
79
-- Note: this is slow but we keep it simple as there are just ~50 packages
80 81
findPackageByName :: PackageName -> Maybe Package
findPackageByName name = find (\pkg -> pkgName pkg == name) knownPackages
82 83 84 85 86 87 88 89 90 91

unsafeFindPackageByName :: PackageName -> Package
unsafeFindPackageByName name = fromMaybe (error msg) $ findPackageByName name
  where
    msg = "unsafeFindPackageByName: No package with name " ++ name

unsafeFindPackageByPath :: FilePath -> Package
unsafeFindPackageByPath path = err $ find (\pkg -> pkgPath pkg == path) knownPackages
  where
    err = fromMaybe $ error ("findPackageByPath: No package for path " ++ path)
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107

-- * CLI and <root>/hadrian.settings options

{-
Note [Hadrian settings]
~~~~~~~~~~~~~~~~~~~~~~~

Hadrian lets one customize GHC builds through the UserSettings module,
where Hadrian users can override existing 'Flavour's or create entirely
new ones, overriding/extending the options passed to some builder
building the RTS in more ways and much more.

It now also offers a more "old-school" interface, in the form of
@foo.bar.baz = v@ or @foo.bar.baz += v@ expressions, that one can
pass on the command line that invokes hadrian:

108
> $ hadrian/build --flavour=quickest -j "stage1.ghc-bin.ghc.link.opts += -v3"
109 110 111 112 113 114 115 116 117 118 119

or in a file at <build root>/hadrian.settings, where <build root>
is the build root to be used for the build, which is _build by default.
For example, you could create a file at _build/hadrian.settings with the
following contents:

> stage1.ghc-bin.ghc.link.opts += -v3
> stage1.base.ghc.hs.opts += -ddump-timings

and issue:

120
> $ hadrian/build
121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228

Hadrian would pick up the settings given in _build/hadrian.settings (as well as
any settings that you may additionally be passing on the command line) and
update the relevant flavour accordingly, to issue the additional arguments
specified by the user.

The supported settings are described by 'builderSetting' below, using
operations from Applicative + two new primitives, 'matchString' and
'matchOneOf', that come as members of the 'Match' class. This gives us
a simple but powerful vocabulary to describe settings and parse them
into values that we can use to compute interesting things, like a 'Predicate'
that we can use to emit additional arguments, or a list of possible completions.

> fmap, (<$>) :: Functor f => (a -> b) -> f a -> f b
> pure :: Applicative f => a -> f a
> (<*>) :: Applicative f => f (a -> b) -> f a -> f b
> (*>) :: Applicative f => f a -> f b -> f b
> (<*) :: Applicative f => f a -> f b -> f a
> (<$) :: Functor f => a -> f b -> f a
>
> str :: Match f => String -> f ()
> val :: Match f => String -> a -> f a
> oneOf :: Match f => [f a] -> f a
> choose :: Match f => [(String, a)] -> f a
> wild :: Match f => [(String, a)] -> f (Wildcard a)

For instance, to describe possible settings:
  foo.bar.{x, y}
  foo.baz.{a, b}.c

we could write:

> str "foo" *> oneOf [ str "bar" *> choose [ ("x", "x"), ("y", "y") ]
>                    , str "baz" *> choose [ ("a", "ac"), ("b", "bc") <* str "c" ]
>                    ]

'builderSetting' uses these combinators to describe the setting keys that
Hadrian supports. A user-oriented description of this mechanism is available
in hadrian/doc/user-settings.md.

-}

-- | Try to interpret all the 'KeyVal' as flavour updates, keeping
--   a list of errors for the ones which don't match known
--   settings.
applySettings :: [KeyVal] -> ([SettingError], Flavour -> Flavour)
applySettings kvs = case partitionEithers (map applySetting kvs) of
  (errs, fs) -> (errs, foldr (flip (.)) id fs)
  -- we need to compose the reverse way to have the following settings
  --     x  = -b
  --     x += -c
  -- produce the final x = "-b -c" value. With just (.) we would apply
  -- the x = -b assignment last, which would silently drop the -c adddition.
  --
  --     foldr (.) id [f, g, h] = f . g . h
  --        -- first function (f) is applied last, we're applying them in
  --        -- the wrong order!
  --
  --     foldr (flip (.)) id [f, g, h] = h . g . f
  --        -- last function (f) is applied last, as desired


-- | Try to interpret the given 'KeyVal' as a flavour update
--   function, returning an error if it doesn't match a known
--   setting.
applySetting :: KeyVal -> Either SettingError (Flavour -> Flavour)
applySetting (KeyVal ks op v) = case runSettingsM ks builderPredicate of
  Left err -> throwError $
      "error while setting " ++ show ks ++ ": " ++ err
  Right pred -> Right $ \flav -> flav
    { args = update (args flav) pred }

  where override arguments predicate = do
          holds <- predicate
          if holds then pure (words v) else arguments

        augment arguments predicate =
          mconcat [arguments, predicate ? pure (words v)]

        update
          | op == Equal = override
          | otherwise   = augment

-- | Try to auto-complete the given @Key@ using
--   all known settings, as described by 'builderSetting'.
--
-- > completeSetting ["stage1","base", "ghc"]
-- >   -- returns [ ["stage1","base","ghc","c","opts"]
-- >   --         , ["stage1","base","ghc","hs","opts"]
-- >   --         , ["stage1","base","ghc","link","opts"]
-- >   --         , ["stage1","base","ghc","deps","opts"]
-- >   --         , ["stage1","base","ghc","toolargs","opts"]
-- >   --         ]
completeSetting :: Key -> [Key]
completeSetting ks = map snd (complete ks builderSetting)

-- | Interpret a 'builderSetting' as a 'Predicate' that
--   potentially constrains on the stage, package or
--   (ghc or cc) builder mode.
--
--   For example, @stage1.base.ghc.link.opts@ gets mapped to
--   a predicate that applies @'stage' 'Stage1'@,
--   @'package' 'base'@ and @'builder' ('Ghc' 'LinkHs')@.
builderPredicate :: SettingsM Predicate
builderPredicate = builderSetting <&> (\(wstg, wpkg, builderMode) ->
  wildcard (pure True) stage wstg <&&>
  wildcard (pure True) package wpkg <&&>
  (case builderMode of
229 230 231 232
     BM_Ghc ghcMode -> wildcard (builder Ghc) (builder . Ghc) ghcMode
     BM_Cc  ccMode  -> wildcard (builder Cc) (builder . Cc) ccMode
     BM_CabalConfigure -> builder (Cabal Setup) )
  )
233 234 235

  where (<&&>) = liftA2 (&&)

236 237 238 239 240
-- | Which builder a setting should apply to
data BuilderMode = BM_Ghc (Wildcard GhcMode)
                 | BM_Cc  (Wildcard CcMode)
                 | BM_CabalConfigure

241 242 243 244 245 246 247
-- | Interpretation-agnostic description of the builder settings
--   supported by Hadrian.
--
--   Supported settings (to be kept in sync with the code):
--
--   > (<stage> or *).(<package name> or *).ghc.(<ghc mode> or *).opts
--   > (<stage> or *).(<package name> or *).cc.(<cc mode> or *).opts
248
--   > (<stage> or *).(<package name> or *).cabal.configure.opts
249 250 251 252 253 254 255 256
--
--   where:
--     - @<stage>@ is one of @stage0@, @stage1@, @stage2@ or @stage3@;
--     - @<package name>@ is the (Cabal) name of a package (@base@,
--       @template-haskell@, ...);
--     - @<ghc mode>@ is one of @c@ (building C files), @hs@ (building Haskell
--       modules), @link@ (linking object files), @deps@ (finding Haskell
--       dependencies with @ghc -M@) or @toolargs@ (getting necessary flags to
257
--       make hadrian/ghci work;
258 259 260 261 262 263 264 265
--     - @<cc mode>@ is one of @c@ (building C files) or @deps@ (finding C
--       dependencies);
--     - locations that support a wildcard (@*@) entry are here to avoid
--       repetition, a wildcard entry being equivalent to writing all the
--       settings that the wildcard matches over; in our case, we can
--       apply GHC or C compiler options uniformly over all stages, packages
--       and compiler modes, if we so desire, by using a wildcard in the
--       appropriate spot.
266 267
builderSetting :: Match f
               => f (Wildcard Stage, Wildcard Package, BuilderMode)
268 269 270 271
builderSetting = (,,)
             <$> wild stages
             <*> wild pkgs
             <*> matchOneOf
272 273 274
                   [ str "ghc" *> fmap BM_Ghc (wild ghcBuilder) <* str "opts"
                   , str "cc" *> fmap BM_Cc (wild ccBuilder) <* str "opts"
                   , BM_CabalConfigure <$ str "cabal" <* str "configure" <* str "opts"
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292
                   ]

  where ghcBuilder =
          [ ("c", CompileCWithGhc)
          , ("deps", FindHsDependencies)
          , ("hs", CompileHs)
          , ("link", LinkHs)
          , ("toolargs", ToolArgs)
          ]

        ccBuilder =
          [ ("c", CompileC)
          , ("deps", FindCDependencies)
          ]

        stages = map (\stg -> (stageString stg, stg)) [minBound..maxBound]

        pkgs = map (\pkg -> (pkgName pkg, pkg)) knownPackages