Base.hs 5.69 KB
Newer Older
Andrey Mokhov's avatar
Andrey Mokhov committed
1
2
{-# LANGUAGE FlexibleInstances #-}

3
module Expression.Base (
Andrey Mokhov's avatar
Andrey Mokhov committed
4
5
6
7
    module Expression.Build,
    module Expression.Predicate,
    (?), (??), whenExists,
    Args (..), -- hide?
Andrey Mokhov's avatar
Andrey Mokhov committed
8
    Settings,
9
10
    Packages,
    FilePaths,
Andrey Mokhov's avatar
Andrey Mokhov committed
11
    Ways,
12
13
14
15
16
17
18
19
    project,
    arg, args, argsOrdered, argBuildPath, argBuildDir,
    argInput, argOutput,
    argConfig, argConfigStaged, argBuilderPath, argStagedBuilderPath,
    argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
    argIncludeDirs, argDepIncludeDirs,
    argConcat, argConcatPath, argPairs, argPrefix,
    argBootPkgConstraints,
Andrey Mokhov's avatar
Andrey Mokhov committed
20
21
    setPackage, setBuilder, setBuilderFamily, setStage, setWay,
    setFile, setConfig
Andrey Mokhov's avatar
Andrey Mokhov committed
22
23
    ) where

Andrey Mokhov's avatar
Andrey Mokhov committed
24
import Base hiding (arg, args, Args)
Andrey Mokhov's avatar
Andrey Mokhov committed
25
import Ways
26
import Package (Package)
Andrey Mokhov's avatar
Andrey Mokhov committed
27
28
29
import Oracles.Builder
import Expression.PG
import Expression.Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
30
import Expression.Build
31

Andrey Mokhov's avatar
Andrey Mokhov committed
32
33
-- Settings can be built out of the following primitive elements
data Args
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
    = Plain String           -- a plain old string argument: e.g., "-O2"
    | BuildPath              -- evaluates to build path: "libraries/base"
    | BuildDir               -- evaluates to build directory: "dist-install"
    | Input                  -- evaluates to input file(s): "src.c"
    | Output                 -- evaluates to output file(s): "src.o"
    | Config String          -- evaluates to the value of a given config key
    | ConfigStaged String    -- as above, but stage is appended to the key
    | BuilderPath Builder    -- evaluates to the path to a given builder
    | PackageData String     -- looks up value a given key in package-data.mk
    | BootPkgConstraints     -- evaluates to boot package constraints
    | Pair Combine Args Args -- combine two Args using a given append method
    | Fold Combine Settings  -- fold settings using a given combine method

-- Assume original settings structure: (a `op1` b `op2` c ...)
data Combine = Concat        -- Concatenate all: a ++ b ++ c ...
             | ConcatPath    -- </>-concatenate all: a </> b </> c ...

type Ways      = BuildExpression Way
type Settings  = BuildExpression Args
type Packages  = BuildExpression Package
type FilePaths = BuildExpression FilePath
Andrey Mokhov's avatar
Andrey Mokhov committed
55

Andrey Mokhov's avatar
Andrey Mokhov committed
56
57
-- A single argument
arg :: String -> Settings
58
arg = return . Plain
Andrey Mokhov's avatar
Andrey Mokhov committed
59

Andrey Mokhov's avatar
Andrey Mokhov committed
60
61
-- A set of arguments (unordered)
args :: [String] -> Settings
62
args = msum . map arg
Andrey Mokhov's avatar
Andrey Mokhov committed
63

Andrey Mokhov's avatar
Andrey Mokhov committed
64
65
-- An (ordered) list of arguments
argsOrdered :: [String] -> Settings
66
argsOrdered = mproduct . map arg
Andrey Mokhov's avatar
Andrey Mokhov committed
67

68
69
argBuildPath :: Settings
argBuildPath = return BuildPath
Andrey Mokhov's avatar
Andrey Mokhov committed
70

71
72
argBuildDir :: Settings
argBuildDir = return BuildDir
Andrey Mokhov's avatar
Andrey Mokhov committed
73

74
75
76
77
78
argInput :: Settings
argInput = return Input

argOutput :: Settings
argOutput = return Output
Andrey Mokhov's avatar
Andrey Mokhov committed
79

Andrey Mokhov's avatar
Andrey Mokhov committed
80
argConfig :: String -> Settings
81
82
83
84
argConfig = return . Config

argConfigStaged :: String -> Settings
argConfigStaged = return . ConfigStaged
Andrey Mokhov's avatar
Andrey Mokhov committed
85

Andrey Mokhov's avatar
Andrey Mokhov committed
86
argBuilderPath :: Builder -> Settings
87
argBuilderPath = return . BuilderPath
Andrey Mokhov's avatar
Andrey Mokhov committed
88

Andrey Mokhov's avatar
Andrey Mokhov committed
89
90
91
-- evaluates to the path to a given builder, taking current stage into account
argStagedBuilderPath :: (Stage -> Builder) -> Settings
argStagedBuilderPath f =
92
93
94
95
96
97
98
99
    msum $ map (\s -> stage s ? argBuilderPath (f s)) [Stage0 ..]

-- Accessing key value pairs from package-data.mk files
argPackageKey :: Settings
argPackageKey = return $ PackageData "PACKAGE_KEY"

argPackageDeps :: Settings
argPackageDeps = return $ PackageData "DEPS"
Andrey Mokhov's avatar
Andrey Mokhov committed
100

101
102
argPackageDepKeys :: Settings
argPackageDepKeys = return $ PackageData "DEP_KEYS"
Andrey Mokhov's avatar
Andrey Mokhov committed
103

104
105
argSrcDirs :: Settings
argSrcDirs = return $ PackageData "HS_SRC_DIRS"
Andrey Mokhov's avatar
Andrey Mokhov committed
106

107
108
109
110
111
argIncludeDirs :: Settings
argIncludeDirs = return $ PackageData "INCLUDE_DIRS"

argDepIncludeDirs :: Settings
argDepIncludeDirs = return $ PackageData "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
Andrey Mokhov's avatar
Andrey Mokhov committed
112

Andrey Mokhov's avatar
Andrey Mokhov committed
113
argBootPkgConstraints :: Settings
114
115
116
117
118
119
120
121
122
argBootPkgConstraints = return BootPkgConstraints

-- A concatenation of arguments: arg1 ++ arg2 ++ ...
argConcat :: Settings -> Settings
argConcat = return . Fold Concat

-- A </>-concatenation of arguments: arg1 </> arg2 </> ...
argConcatPath :: Settings -> Settings
argConcatPath = return . Fold ConcatPath
Andrey Mokhov's avatar
Andrey Mokhov committed
123

124
125
126
-- An ordered list of pairs of arguments: prefix |> arg1, prefix |> arg2, ...
argPairs :: String -> Settings -> Settings
argPairs prefix settings = settings >>= (arg prefix |>) . return
Andrey Mokhov's avatar
Andrey Mokhov committed
127

128
129
130
131
132
133
134
-- An ordered list of prefixed arguments: prefix ++ arg1, prefix ++ arg2, ...
argPrefix :: String -> Settings -> Settings
argPrefix prefix = fmap (Pair Concat $ Plain prefix)

-- An ordered list of prefixed arguments: prefix </> arg1, prefix </> arg2, ...
argPaths :: String -> Settings -> Settings
argPaths prefix = fmap (Pair ConcatPath $ Plain prefix)
Andrey Mokhov's avatar
Andrey Mokhov committed
135

Andrey Mokhov's avatar
Andrey Mokhov committed
136
137
138
-- Partially evaluate Settings using a truth-teller (compute a 'projection')
project :: (BuildVariable -> Maybe Bool) -> Settings -> Settings
project _ Epsilon = Epsilon
139
project t (Vertex v) = Vertex v -- TODO: go deeper
Andrey Mokhov's avatar
Andrey Mokhov committed
140
141
142
project t (Overlay   l r) = Overlay   (project  t l) (project t r)
project t (Sequence  l r) = Sequence  (project  t l) (project t r)
project t (Condition l r) = Condition (evaluate t l) (project t r)
Andrey Mokhov's avatar
Andrey Mokhov committed
143
144
145
146
147
148
149
150
151

-- Partial evaluation of settings

setPackage :: Package -> Settings -> Settings
setPackage = project . matchPackage

setBuilder :: Builder -> Settings -> Settings
setBuilder = project . matchBuilder

152
setBuilderFamily :: (Stage -> Builder) -> Settings -> Settings
Andrey Mokhov's avatar
Andrey Mokhov committed
153
setBuilderFamily = project . matchBuilderFamily
154

Andrey Mokhov's avatar
Andrey Mokhov committed
155
156
157
158
159
160
161
162
163
setStage :: Stage -> Settings -> Settings
setStage = project . matchStage

setWay :: Way -> Settings -> Settings
setWay = project . matchWay

setFile :: FilePath -> Settings -> Settings
setFile = project . matchFile

Andrey Mokhov's avatar
Andrey Mokhov committed
164
165
setConfig :: String -> String -> Settings -> Settings
setConfig key = project . matchConfig key
166

Andrey Mokhov's avatar
Andrey Mokhov committed
167
--type ArgsTeller = Args -> Maybe [String]
168

Andrey Mokhov's avatar
Andrey Mokhov committed
169
170
171
--fromPlain :: ArgsTeller
--fromPlain (Plain list) = Just list
--fromPlain _            = Nothing
172

Andrey Mokhov's avatar
Andrey Mokhov committed
173
174
175
176
--tellArgs :: ArgsTeller -> Args -> Args
--tellArgs t a = case t a of
--    Just list -> Plain list
--    Nothing   -> a