Part 1 of the Great Refactoring of the Expression

See #347

hadrian.cabal

@@ -111,7 +111,8 @@ executable hadrian
 
     default-language:    Haskell2010
     default-extensions:  RecordWildCards
-    other-extensions:    DeriveGeneric
+    other-extensions:    DeriveFunctor
+                       , DeriveGeneric
                        , FlexibleInstances
                        , GeneralizedNewtypeDeriving
                        , LambdaCase

src/Base.hs

@@ -7,7 +7,6 @@ module Base (
     module Data.List.Extra,
     module Data.Maybe,
     module Data.Monoid,
-    MonadTrans(lift),
 
     -- * Shake
     module Development.Shake,

src/Expression.hs

-{-# LANGUAGE FlexibleInstances, LambdaCase #-}
+{-# LANGUAGE DeriveFunctor, FlexibleInstances, LambdaCase #-}
 module Expression (
     -- * Expressions
-    Expr, DiffExpr, fromDiffExpr,
+    Expr, expr, exprIO,
     -- ** Operators
-    apply, append, arg, remove,
-    appendSub, appendSubD, filterSub, removeSub,
+    append, arg, remove,
     -- ** Evaluation
-    interpret, interpretInContext, interpretDiff,
+    interpret, interpretInContext,
     -- ** Predicates
     Predicate, (?), applyPredicate,
     -- ** Common expressions
@@ -16,10 +15,10 @@ module Expression (
 
     -- * Convenient accessors
     getContext, getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
-    getInput, getOutput, getSingleton,
+    getInput, getOutput, getSingleton, getSetting, getSettingList, getFlag,
+    getTopDirectory,
 
     -- * Re-exports
-    module Control.Monad.Trans.Reader,
     module Data.Monoid,
     module Builder,
     module Package,
@@ -28,6 +27,7 @@ module Expression (
     ) where
 
 import Control.Monad.Trans.Reader
+import Control.Monad.Trans
 import Data.Monoid
 
 import Base
@@ -38,53 +38,58 @@ import Stage
 import Target
 import Way
 
+import Oracles.Config.Flag
+import Oracles.Config.Setting
+import Oracles.Path
+
 -- | @Expr a@ is a computation that produces a value of type @Action a@ and can
 -- read parameters of the current build 'Target'.
-type Expr a = ReaderT Target Action a
+newtype Expr a = Expr (ReaderT Target Action a) deriving Functor
+
+expr :: Action a -> Expr a
+expr = Expr . lift
+
+exprIO :: IO a -> Expr a
+exprIO = Expr . liftIO
 
--- | @Diff a@ is a /difference list/ containing values of type @a@. A difference
--- list is a list with efficient concatenation, encoded as a value @a -> a@. We
--- could use @Dual (Endo a)@ instead of @Diff a@, but the former may look scary.
-newtype Diff a = Diff { fromDiff :: a -> a }
+instance Monoid a => Monoid (Expr a) where
+    mempty                    = Expr $ return mempty
+    mappend (Expr x) (Expr y) = Expr $ (<>) <$> x <*> y
 
--- | @DiffExpr a@ is a computation that builds a difference list (i.e., a
--- function of type @'Action' (a -> a)@) and can read parameters of the current
--- build 'Target'.
-type DiffExpr a = Expr (Diff a)
+instance Applicative Expr where
+    pure  = Expr . pure
+    (<*>) = ap
 
--- Note the reverse order of function composition (y . x), which ensures that
--- when two DiffExpr computations c1 and c2 are combined (c1 <> c2), then c1 is
--- applied first, and c2 is applied second.
-instance Monoid (Diff a) where
-    mempty = Diff id
-    Diff x `mappend` Diff y = Diff $ y . x
+instance Monad Expr where
+    return       = pure
+    Expr e >>= f = Expr $ do
+        re <- e
+        let Expr rf = f re
+        rf
 
 -- | The following expressions are used throughout the build system for
 -- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways'
 -- and 'Packages'.
 type Predicate = Expr Bool
-type Args      = DiffExpr [String]
-type Packages  = DiffExpr [Package]
-type Ways      = DiffExpr [Way]
+type Args      = Expr [String]
+type Packages  = Expr [Package]
+type Ways      = Expr [Way]
 
 -- Basic operations on expressions:
--- | Transform an expression by applying a given function.
-apply :: (a -> a) -> DiffExpr a
-apply = return . Diff
 
 -- | Append something to an expression.
-append :: Monoid a => a -> DiffExpr a
-append x = apply (<> x)
+append :: Monoid a => a -> Expr a
+append = Expr . return
 
 -- | Remove given elements from a list expression.
-remove :: Eq a => [a] -> DiffExpr [a]
-remove xs = apply $ filter (`notElem` xs)
+remove :: Eq a => [a] -> Expr [a] -> Expr [a]
+remove xs e = filter (`notElem` xs) <$> e
 
 -- | Apply a predicate to an expression.
 applyPredicate :: Monoid a => Predicate -> Expr a -> Expr a
 applyPredicate predicate expr = do
     bool <- predicate
-    if bool then expr else return mempty
+    if bool then expr else mempty
 
 -- | Add a single argument to 'Args'.
 arg :: String -> Args
@@ -100,104 +105,73 @@ instance PredicateLike Predicate where
     (?) = applyPredicate
 
 instance PredicateLike Bool where
-    (?) = applyPredicate . return
+    (?) = applyPredicate . Expr . return
 
 instance PredicateLike (Action Bool) where
-    (?) = applyPredicate . lift
-
--- | @appendSub@ appends a list of sub-arguments to all arguments starting with a
--- given prefix. If there is no argument with such prefix then a new argument
--- of the form @prefix=listOfSubarguments@ is appended to the expression.
--- Note: nothing is done if the list of sub-arguments is empty.
-appendSub :: String -> [String] -> Args
-appendSub prefix xs
-    | xs' == [] = mempty
-    | otherwise = apply . go $ False
-  where
-    xs' = filter (/= "") xs
-    go True  []     = []
-    go False []     = [prefix ++ "=" ++ unwords xs']
-    go found (y:ys) = if prefix `isPrefixOf` y
-                      then unwords (y : xs') : go True ys
-                      else y : go found ys
-
--- | @appendSubD@ is similar to 'appendSub' but it extracts the list of sub-arguments
--- from the given 'DiffExpr'.
-appendSubD :: String -> Args -> Args
-appendSubD prefix diffExpr = fromDiffExpr diffExpr >>= appendSub prefix
-
-filterSub :: String -> (String -> Bool) -> Args
-filterSub prefix p = apply $ map filterSubstr
-  where
-    filterSubstr s
-        | prefix `isPrefixOf` s = unwords . filter p . words $ s
-        | otherwise             = s
-
--- | Remove given elements from a list of sub-arguments with a given prefix
--- Example: removeSub "--configure-option=CFLAGS" ["-Werror"].
-removeSub :: String -> [String] -> Args
-removeSub prefix xs = filterSub prefix (`notElem` xs)
+    (?) = applyPredicate . expr
 
 -- | Interpret a given expression according to the given 'Target'.
 interpret :: Target -> Expr a -> Action a
-interpret = flip runReaderT
+interpret target (Expr e) = runReaderT e target
 
 -- | Interpret a given expression by looking only at the given 'Context'.
 interpretInContext :: Context -> Expr a -> Action a
 interpretInContext = interpret . dummyTarget
 
--- | Extract an expression from a difference expression.
-fromDiffExpr :: Monoid a => DiffExpr a -> Expr a
-fromDiffExpr = fmap (($ mempty) . fromDiff)
-
--- | Interpret a given difference expression in a given environment.
-interpretDiff :: Monoid a => Target -> DiffExpr a -> Action a
-interpretDiff target = interpret target . fromDiffExpr
-
 -- | Get the current build 'Context'.
 getContext :: Expr Context
-getContext = asks context
+getContext = Expr $ asks context
 
 -- | Get the 'Stage' of the current 'Context'.
 getStage :: Expr Stage
-getStage = stage <$> asks context
+getStage = Expr $ stage <$> asks context
 
 -- | Get the 'Package' of the current 'Context'.
 getPackage :: Expr Package
-getPackage = package <$> asks context
+getPackage = Expr $ package <$> asks context
 
 -- | Get the 'Way' of the current 'Context'.
 getWay :: Expr Way
-getWay = way <$> asks context
+getWay = Expr $ way <$> asks context
 
 -- | Get the 'Builder' for the current 'Target'.
 getBuilder :: Expr Builder
-getBuilder = asks builder
+getBuilder = Expr $ asks builder
 
 -- | Get the input files of the current 'Target'.
 getInputs :: Expr [FilePath]
-getInputs = asks inputs
+getInputs = Expr $ asks inputs
 
 -- | Run 'getInputs' and check that the result contains one input file only.
 getInput :: Expr FilePath
-getInput = do
+getInput = Expr $ do
     target <- ask
-    getSingleton ("Exactly one input file expected in " ++ show target)
-        <$> getInputs
+    getSingleton ("Exactly one input file expected in " ++ show target) <$> asks inputs
 
 -- | Get the files produced by the current 'Target'.
 getOutputs :: Expr [FilePath]
-getOutputs = asks outputs
+getOutputs = Expr $ asks outputs
 
 -- | Run 'getOutputs' and check that the result contains one output file only.
 getOutput :: Expr FilePath
-getOutput = do
+getOutput = Expr $ do
     target <- ask
-    getSingleton ("Exactly one output file expected in " ++ show target)
-        <$> getOutputs
+    getSingleton ("Exactly one output file expected in " ++ show target) <$> asks outputs
 
 -- | Extract a value from a singleton list, or raise an error if the list does
 -- not contain exactly one value.
 getSingleton :: String -> [a] -> a
 getSingleton _ [res] = res
 getSingleton msg _   = error msg
+
+getSetting :: Setting -> Expr String
+getSetting = expr . setting
+
+getSettingList :: SettingList -> Expr [String]
+getSettingList = expr . settingList
+
+getFlag :: Flag -> Predicate
+getFlag = expr . flag
+
+getTopDirectory :: Expr FilePath
+getTopDirectory = expr topDirectory

src/Oracles/Config/Flag.hs

 module Oracles.Config.Flag (
-    Flag (..), flag, getFlag, crossCompiling, platformSupportsSharedLibs,
+    Flag (..), flag, crossCompiling, platformSupportsSharedLibs,
     ghcWithSMP, ghcWithNativeCodeGen, supportsSplitObjects
     ) where
 
-import Control.Monad.Trans.Reader
-
 import Base
 import Oracles.Config
 import Oracles.Config.Setting
@@ -44,9 +42,6 @@ flag f = do
         ++ quote (key ++ " = " ++ value) ++ "cannot be parsed."
     return $ value == "YES"
 
-getFlag :: Flag -> ReaderT a Action Bool
-getFlag = lift . flag
-
 crossCompiling :: Action Bool
 crossCompiling = flag CrossCompiling
 

src/Oracles/Config/Setting.hs

 module Oracles.Config.Setting (
-    Setting (..), SettingList (..), setting, settingList, getSetting,
-    getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
+    Setting (..), SettingList (..), setting, settingList,
+    anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
     ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,
     ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost,
     relocatableBuild, installDocDir, installGhcLibDir
     ) where
 
-import Control.Monad.Trans.Reader
-
 import Base
 import Oracles.Config
 import Stage
@@ -130,12 +128,6 @@ settingList key = fmap words $ unsafeAskConfig $ case key of
     ConfLdLinkerArgs  stage -> "conf-ld-linker-args-"  ++ stageString stage
     HsCppArgs               -> "hs-cpp-args"
 
-getSetting :: Setting -> ReaderT a Action String
-getSetting = lift . setting
-
-getSettingList :: SettingList -> ReaderT a Action [String]
-getSettingList = lift . settingList
-
 matchSetting :: Setting -> [String] -> Action Bool
 matchSetting key values = fmap (`elem` values) $ setting key
 

src/Oracles/Path.hs

 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Oracles.Path (
-    topDirectory, getTopDirectory, systemBuilderPath, pathOracle, bashPath,
+    topDirectory, systemBuilderPath, pathOracle, bashPath,
     fixAbsolutePathOnWindows
     ) where
 
-import Control.Monad.Trans.Reader
 import Data.Char
 import System.Directory
 
@@ -18,9 +17,6 @@ import Stage
 topDirectory :: Action FilePath
 topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
 
-getTopDirectory :: ReaderT a Action FilePath
-getTopDirectory = lift topDirectory
-
 -- | Determine the location of a system 'Builder'.
 systemBuilderPath :: Builder -> Action FilePath
 systemBuilderPath builder = case builder of

src/Rules/Generators/Common.hs

@@ -5,12 +5,12 @@ import Expression
 
 -- | Track a given source file when constructing an expression.
 trackSource :: FilePath -> Expr ()
-trackSource file = lift $ need [ sourcePath -/- file ]
+trackSource file = expr $ need [ sourcePath -/- file ]
 
 -- | Turn a 'Bool' computed by an 'Action' into a 'String' expression returning
 -- "YES" (when the Boolean is 'True') or "NO" (when the Boolean is 'False').
 yesNo :: Action Bool -> Expr String
-yesNo = lift . fmap (\x -> if x then "YES" else "NO")
+yesNo = expr . fmap (\x -> if x then "YES" else "NO")
 
 -- | Given a 'String' replace charaters '.' and '-' by underscores ('_') so that
 -- the resulting 'String' becomes a valid C identifier.

src/Rules/Generators/ConfigHs.hs

@@ -31,7 +31,7 @@ generateConfigHs = do
     cGhcEnableTablesNextToCode <- yesNo ghcEnableTablesNextToCode
     cLeadingUnderscore         <- yesNo $ flag LeadingUnderscore
     cGHC_UNLIT_PGM             <- fmap takeFileName $ getBuilderPath Unlit
-    cLibFFI                    <- lift useLibFFIForAdjustors
+    cLibFFI                    <- expr useLibFFIForAdjustors
     rtsWays                    <- getRtsWays
     cGhcRtsWithLibdw           <- getFlag WithLibdw
     let cGhcRTSWays = unwords $ map show rtsWays

src/Rules/Generators/GhcAutoconfH.hs

@@ -19,8 +19,8 @@ undefinePackage s
 generateGhcAutoconfH :: Expr String
 generateGhcAutoconfH = do
     trackSource "Rules/Generators/GhcAutoconfH.hs"
-    configHContents  <- lift $ map undefinePackage <$> readFileLines configH
-    tablesNextToCode <- lift $ ghcEnableTablesNextToCode
+    configHContents  <- expr $ map undefinePackage <$> readFileLines configH
+    tablesNextToCode <- expr ghcEnableTablesNextToCode
     ghcUnreg         <- getFlag GhcUnregisterised
     ccLlvmBackend    <- getSetting CcLlvmBackend
     ccClangBackend   <- getSetting CcClangBackend

src/Rules/Generators/GhcSplit.hs

@@ -17,7 +17,7 @@ generateGhcSplit = do
     targetPlatform <- getSetting TargetPlatform
     ghcEnableTNC   <- yesNo ghcEnableTablesNextToCode
     perlPath       <- getBuilderPath Perl
-    contents       <- lift $ readFileLines ghcSplitSource
+    contents       <- expr $ readFileLines ghcSplitSource
     return . unlines $
         [ "#!" ++ perlPath
         , "my $TARGETPLATFORM = " ++ show targetPlatform ++ ";"

src/Rules/Libffi.hs

@@ -24,10 +24,10 @@ fixLibffiMakefile top =
 -- TODO: check code duplication w.r.t. ConfCcArgs
 configureEnvironment :: Action [CmdOption]
 configureEnvironment = do
-    cFlags  <- interpretInContext libffiContext . fromDiffExpr $ mconcat
+    cFlags  <- interpretInContext libffiContext $ mconcat
                [ cArgs
                , argStagedSettingList ConfCcArgs ]
-    ldFlags <- interpretInContext libffiContext $ fromDiffExpr ldArgs
+    ldFlags <- interpretInContext libffiContext ldArgs
     sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
              , builderEnvironment "CXX" $ Cc CompileC Stage1
              , builderEnvironment "LD" Ld

src/Rules/Wrappers.hs

@@ -8,7 +8,7 @@ import GHC
 import Settings (getPackages, latestBuildStage)
 import Settings.Install (installPackageDbDirectory)
 import Settings.Path (buildPath, inplacePackageDbDirectory)
-import Oracles.Path (getTopDirectory, bashPath)
+import Oracles.Path (bashPath)
 import Oracles.Config.Setting (SettingList(..), settingList)
 
 -- | Wrapper is an expression depending on the 'FilePath' to the
@@ -22,8 +22,8 @@ type Wrapper = WrappedBinary -> Expr String
 
 ghcWrapper :: WrappedBinary -> Expr String
 ghcWrapper WrappedBinary{..} = do
-    lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- lift bashPath
+    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+    bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
         , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
@@ -31,8 +31,8 @@ ghcWrapper WrappedBinary{..} = do
 
 inplaceRunGhcWrapper :: WrappedBinary -> Expr String
 inplaceRunGhcWrapper WrappedBinary{..} = do
-    lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- lift bashPath
+    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+    bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
         , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
@@ -41,8 +41,8 @@ inplaceRunGhcWrapper WrappedBinary{..} = do
 
 installRunGhcWrapper :: WrappedBinary -> Expr String
 installRunGhcWrapper WrappedBinary{..} = do
-    lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- lift bashPath
+    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+    bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
         , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
@@ -51,13 +51,13 @@ installRunGhcWrapper WrappedBinary{..} = do
 
 inplaceGhcPkgWrapper :: WrappedBinary -> Expr String
 inplaceGhcPkgWrapper WrappedBinary{..} = do
-    lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
+    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
     stage <- getStage
     top <- getTopDirectory
     -- Use the package configuration for the next stage in the wrapper.
     -- The wrapper is generated in StageN, but used in StageN+1.
     let packageDb = top -/- inplacePackageDbDirectory (succ stage)
-    bash <- lift bashPath
+    bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
         , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
@@ -65,13 +65,13 @@ inplaceGhcPkgWrapper WrappedBinary{..} = do
 
 installGhcPkgWrapper :: WrappedBinary -> Expr String
 installGhcPkgWrapper WrappedBinary{..} = do
-    lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
+    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
     stage <- getStage
     top <- getTopDirectory
     -- Use the package configuration for the next stage in the wrapper.
     -- The wrapper is generated in StageN, but used in StageN+1.
     let packageDb = installPackageDbDirectory binaryLibPath top (succ stage)
-    bash <- lift bashPath
+    bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
         , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
@@ -79,16 +79,16 @@ installGhcPkgWrapper WrappedBinary{..} = do
 
 hp2psWrapper :: WrappedBinary -> Expr String
 hp2psWrapper WrappedBinary{..} = do
-    lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- lift bashPath
+    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+    bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
         , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
 
 hpcWrapper :: WrappedBinary -> Expr String
 hpcWrapper WrappedBinary{..} = do
-    lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- lift bashPath
+    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+    bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
         , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
@@ -96,14 +96,14 @@ hpcWrapper WrappedBinary{..} = do
 hsc2hsWrapper :: WrappedBinary -> Expr String
 hsc2hsWrapper WrappedBinary{..} = do
     top <- getTopDirectory
-    lift $ need [ sourcePath -/- "Rules/Wrappers.hs" ]
-    contents <- lift $ readFile' $ top -/- "utils/hsc2hs/hsc2hs.wrapper"
+    expr $ need [ sourcePath -/- "Rules/Wrappers.hs" ]
+    contents <- expr $ readFile' $ top -/- "utils/hsc2hs/hsc2hs.wrapper"
     let executableName = binaryLibPath -/- "bin" -/- binaryName
-    confCcArgs <- lift $ settingList (ConfCcArgs Stage1)
-    confGccLinkerArgs <- lift $ settingList (ConfGccLinkerArgs Stage1)
+    confCcArgs <- expr $ settingList (ConfCcArgs Stage1)
+    confGccLinkerArgs <- expr $ settingList (ConfGccLinkerArgs Stage1)
     let hsc2hsExtra = unwords (map ("-cflags=" ++) confCcArgs) ++ " " ++
                       unwords (map ("-lflags=" ++) confGccLinkerArgs)
-    bash <- lift bashPath
+    bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
         , "executablename=\"" ++ executableName ++ "\""
@@ -112,7 +112,7 @@ hsc2hsWrapper WrappedBinary{..} = do
 
 haddockWrapper :: WrappedBinary -> Expr String
 haddockWrapper WrappedBinary{..} = do
-  lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
+  expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
   return $ unlines
     [ "#!/bin/bash"
     , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
@@ -120,13 +120,13 @@ haddockWrapper WrappedBinary{..} = do
 
 iservBinWrapper :: WrappedBinary -> Expr String
 iservBinWrapper WrappedBinary{..} = do
-    lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
+    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
     activePackages <- filter isLibrary <$> getPackages
     -- TODO: Figure our the reason of this hardcoded exclusion
     let pkgs = activePackages \\ [ cabal, process, haskeline
                                  , terminfo, ghcCompact, hpc, compiler ]
     contexts <- catMaybes <$> mapM (\p -> do
-                                        m <- lift $ latestBuildStage p
+                                        m <- expr $ latestBuildStage p
                                         return $ fmap (\s -> vanillaContext s p) m
                                    ) pkgs
     let buildPaths = map buildPath contexts

src/Settings.hs

@@ -24,16 +24,16 @@ import Settings.Path
 import UserSettings
 
 getArgs :: Expr [String]
-getArgs = fromDiffExpr $ args flavour
+getArgs = args flavour
 
 getLibraryWays :: Expr [Way]
-getLibraryWays = fromDiffExpr $ libraryWays flavour
+getLibraryWays = libraryWays flavour
 
 getRtsWays :: Expr [Way]
-getRtsWays = fromDiffExpr $ rtsWays flavour
+getRtsWays = rtsWays flavour
 
 getPackages :: Expr [Package]
-getPackages = fromDiffExpr $ packages flavour
+getPackages = packages flavour
 
 stagePackages :: Stage -> Action [Package]
 stagePackages stage = interpretInContext (stageContext stage) getPackages
@@ -48,10 +48,10 @@ getBuildPath :: Expr FilePath
 getBuildPath = buildPath <$> getContext
 
 getPkgData :: (FilePath -> PackageData) -> Expr String
-getPkgData key = lift . pkgData . key =<< getBuildPath
+getPkgData key = expr . pkgData . key =<< getBuildPath
 
 getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
-getPkgDataList key = lift . pkgDataList . key =<< getBuildPath
+getPkgDataList key = expr . pkgDataList . key =<< getBuildPath
 
 hadrianFlavours :: [Flavour]
 hadrianFlavours =
@@ -92,8 +92,8 @@ builderPath builder = case builderProvenance builder of
         let msg = error $ show builder ++ " is never built by Hadrian."
         return $ fromMaybe msg maybePath
 
-getBuilderPath :: Builder -> ReaderT a Action FilePath
-getBuilderPath = lift . builderPath
+getBuilderPath :: Builder -> Expr FilePath
+getBuilderPath = expr . builderPath
 
 -- | Was the path to a given 'Builder' specified in configuration files?
 isSpecified :: Builder -> Action Bool

src/Settings/Builders/Cc.hs

@@ -7,7 +7,7 @@ ccBuilderArgs = do
   way <- getWay
   builder Cc ? mconcat
     [ append =<< getPkgDataList CcArgs
-    , argSettingList . ConfCcArgs =<< getStage
+    , getSettingList . ConfCcArgs =<< getStage
     , cIncludeArgs
 
     , builder (Cc CompileC) ? mconcat

src/Settings/Builders/Common.hs

@@ -10,8 +10,8 @@ module Settings.Builders.Common (
     module Settings,
     module Settings.Path,
     module UserSettings,
-    cIncludeArgs, ldArgs, cArgs, cWarnings, argSetting, argSettingList,
-    argStagedBuilderPath, argStagedSettingList, bootPackageDatabaseArgs
+    cIncludeArgs, ldArgs, cArgs, cWarnings, argStagedBuilderPath,
+    argStagedSettingList, bootPackageDatabaseArgs
     ) where
 
 import Base
@@ -53,12 +53,6 @@ cWarnings = do
             , gccGe46 ? notM windowsHost ? arg "-Werror=unused-but-set-variable"
             , gccGe46 ? arg "-Wno-error=inline" ]
 
-argM :: Action String -> Args
-argM = (arg =<<) . lift