Expression.hs 3.59 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 Data.Semigroup,
Ben Gamari's avatar
Ben Gamari committed
24
25
26
27
    module Builder,
    module Package,
    module Stage,
    module Way
28
29
    ) where

30
import Control.Monad.Extra
Andrey Mokhov's avatar
Andrey Mokhov committed
31
import Data.Semigroup
32

33
34
35
import qualified Hadrian.Expression as H
import Hadrian.Expression hiding (Expr, Predicate, Args)

36
import Builder
37
import Context (Context, vanillaContext, stageContext, getStage, getPackage, getWay)
Andrey Mokhov's avatar
Andrey Mokhov committed
38
import Package
Andrey Mokhov's avatar
Andrey Mokhov committed
39
import Stage
40
import Target hiding (builder, inputs, outputs)
Andrey Mokhov's avatar
Andrey Mokhov committed
41
import Way
42

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

Ben Gamari's avatar
Ben Gamari committed
47
48
49
-- | The following expressions are used throughout the build system for
-- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways'
-- and 'Packages'.
50
51
type Predicate = H.Predicate Context Builder
type Args      = H.Args      Context Builder
52
53
type Packages  = Expr [Package]
type Ways      = Expr [Way]
54

55
56
57
58
59
60
61
62
-- | 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

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
88
89
90
91
92
93
94
95
96
97
-- | 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

98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
-- | 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