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