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

    -- ** 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

Ben Gamari's avatar
Ben Gamari committed
15
    -- * Convenient accessors
16 17
    getBuildRoot, getContext, getOutputs, getInputs,
    getInput, getOutput, getPackageData,
Ben Gamari's avatar
Ben Gamari committed
18 19

    -- * Re-exports
20
    module Base,
21 22
    module Builder,
    module Context,
23 24
    ) where

Andrey Mokhov's avatar
Andrey Mokhov committed
25
import Base
26
import {-# SOURCE #-} Builder
27
import Context hiding (stage, package, way)
28 29
import Expression.Type
import Hadrian.Expression hiding (Expr, Predicate, Args)
30 31 32
import Hadrian.Haskell.Cabal.PackageData (PackageData)
import Hadrian.Oracles.TextFile (readPackageDataFile)

33
-- TODO: Get rid of partiality.
34 35 36
-- | Get values from a configured cabal stage.
getPackageData :: (PackageData -> a) -> Expr a
getPackageData key = do
37 38 39
    ctx <- getContext
    Just cabal <- expr (readPackageDataFile ctx)
    return $ key cabal
Andrey Mokhov's avatar
Andrey Mokhov committed
40

41 42 43 44 45 46 47 48
-- | 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

49 50 51 52 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
-- | 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

84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
-- | 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