Expression.hs 3.42 KB
Newer Older
1
module Expression (
Ben Gamari's avatar
Ben Gamari committed
2
    -- * Expressions
3 4 5
    Expr, Predicate, Args, Ways, Packages,

    -- ** Construction and modification
Andrey Mokhov's avatar
Andrey Mokhov committed
6
    expr, exprIO, arg, remove,
7 8 9

    -- ** Predicates
    (?), stage, stage0, stage1, stage2, notStage0, package, notPackage,
10
    libraryPackage, builder, way, input, inputs, output, outputs,
11

Ben Gamari's avatar
Ben Gamari committed
12
    -- ** Evaluation
13
    interpret, interpretInContext,
14

15
    -- ** Context and Target
16
    Context, vanillaContext, stageContext, Target,
Ben Gamari's avatar
Ben Gamari committed
17 18

    -- * Convenient accessors
Andrey Mokhov's avatar
Andrey Mokhov committed
19
    getContext, getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
20
    getInput, getOutput,
Ben Gamari's avatar
Ben Gamari committed
21 22

    -- * Re-exports
Andrey Mokhov's avatar
Andrey Mokhov committed
23
    module Base
24 25
    ) where

26 27 28
import qualified Hadrian.Expression as H
import Hadrian.Expression hiding (Expr, Predicate, Args)

Andrey Mokhov's avatar
Andrey Mokhov committed
29
import Base
30 31
import Context (Context, vanillaContext, stageContext, getStage, getPackage, getWay)
import Target hiding (builder, inputs, outputs)
32

Andrey Mokhov's avatar
Andrey Mokhov committed
33 34
-- | @Expr a@ is a computation that produces a value of type @Action a@ and can
-- read parameters of the current build 'Target'.
35
type Expr a = H.Expr Context Builder a
36

Ben Gamari's avatar
Ben Gamari committed
37 38 39
-- | The following expressions are used throughout the build system for
-- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways'
-- and 'Packages'.
40 41
type Predicate = H.Predicate Context Builder
type Args      = H.Args      Context Builder
42 43
type Packages  = Expr [Package]
type Ways      = Expr [Way]
44

45 46 47 48 49 50 51 52
-- | Is the build currently in the provided stage?
stage :: Stage -> Predicate
stage s = (s ==) <$> getStage

-- | Is a particular package being built?
package :: Package -> Predicate
package p = (p ==) <$> getPackage

53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
-- | This type class allows the user to construct both precise builder
-- predicates, such as @builder (Ghc CompileHs Stage1)@, as well as predicates
-- covering a set of similar builders. For example, @builder (Ghc CompileHs)@
-- matches any stage, and @builder Ghc@ matches any stage and any GHC mode.
class BuilderPredicate a where
    -- | Is a particular builder being used?
    builder :: a -> Predicate

instance BuilderPredicate Builder where
    builder b = (b ==) <$> getBuilder

instance BuilderPredicate a => BuilderPredicate (Stage -> a) where
    builder f = builder . f =<< getStage

instance BuilderPredicate a => BuilderPredicate (CcMode -> a) where
    builder f = do
        b <- getBuilder
        case b of
            Cc  c _ -> builder (f c)
            _       -> return False

instance BuilderPredicate a => BuilderPredicate (GhcMode -> a) where
    builder f = do
        b <- getBuilder
        case b of
            Ghc c _ -> builder (f c)
            _       -> return False

instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where
    builder f = do
        b <- getBuilder
        case b of
            Configure path -> builder (f path)
            _              -> return False

88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
-- | Is the current build 'Way' equal to a certain value?
way :: Way -> Predicate
way w = (w ==) <$> getWay

-- | Is the build currently in stage 0?
stage0 :: Predicate
stage0 = stage Stage0

-- | Is the build currently in stage 1?
stage1 :: Predicate
stage1 = stage Stage1

-- | Is the build currently in stage 2?
stage2 :: Predicate
stage2 = stage Stage2

-- | Is the build /not/ in stage 0 right now?
notStage0 :: Predicate
notStage0 = notM stage0

-- | Is a certain package /not/ built right now?
notPackage :: Package -> Predicate
notPackage = notM . package

-- | Is a library package currently being built?
libraryPackage :: Predicate
libraryPackage = isLibrary <$> getPackage