de982bd02a39c53fca4688fb726df112a1025a7e
[hadrian.git] / src / Expression / Base.hs
1 {-# LANGUAGE FlexibleInstances #-}
2
3 module Expression.Base (
4 module Expression.Build,
5 module Expression.Predicate,
6 (?), (??), whenExists,
7 Args (..), -- hide?
8 Settings,
9 Packages,
10 FilePaths,
11 Ways,
12 project,
13 arg, args, argsOrdered, argBuildPath, argBuildDir,
14 argInput, argOutput,
15 argConfig, argConfigStaged, argBuilderPath, argStagedBuilderPath,
16 argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
17 argIncludeDirs, argDepIncludeDirs,
18 argConcat, argConcatPath, argPairs, argPrefix,
19 argBootPkgConstraints,
20 setPackage, setBuilder, setBuilderFamily, setStage, setWay,
21 setFile, setConfig
22 ) where
23
24 import Base hiding (arg, args, Args)
25 import Ways
26 import Package (Package)
27 import Oracles.Builder
28 import Expression.PG
29 import Expression.Predicate
30 import Expression.Build
31
32 -- Settings can be built out of the following primitive elements
33 data Args
34 = Plain String -- a plain old string argument: e.g., "-O2"
35 | BuildPath -- evaluates to build path: "libraries/base"
36 | BuildDir -- evaluates to build directory: "dist-install"
37 | Input -- evaluates to input file(s): "src.c"
38 | Output -- evaluates to output file(s): "src.o"
39 | Config String -- evaluates to the value of a given config key
40 | ConfigStaged String -- as above, but stage is appended to the key
41 | BuilderPath Builder -- evaluates to the path to a given builder
42 | PackageData String -- looks up value a given key in package-data.mk
43 | BootPkgConstraints -- evaluates to boot package constraints
44 | Pair Combine Args Args -- combine two Args using a given append method
45 | Fold Combine Settings -- fold settings using a given combine method
46
47 -- Assume original settings structure: (a `op1` b `op2` c ...)
48 data Combine = Concat -- Concatenate all: a ++ b ++ c ...
49 | ConcatPath -- </>-concatenate all: a </> b </> c ...
50
51 type Ways = BuildExpression Way
52 type Settings = BuildExpression Args
53 type Packages = BuildExpression Package
54 type FilePaths = BuildExpression FilePath
55
56 -- A single argument
57 arg :: String -> Settings
58 arg = return . Plain
59
60 -- A set of arguments (unordered)
61 args :: [String] -> Settings
62 args = msum . map arg
63
64 -- An (ordered) list of arguments
65 argsOrdered :: [String] -> Settings
66 argsOrdered = mproduct . map arg
67
68 argBuildPath :: Settings
69 argBuildPath = return BuildPath
70
71 argBuildDir :: Settings
72 argBuildDir = return BuildDir
73
74 argInput :: Settings
75 argInput = return Input
76
77 argOutput :: Settings
78 argOutput = return Output
79
80 argConfig :: String -> Settings
81 argConfig = return . Config
82
83 argConfigStaged :: String -> Settings
84 argConfigStaged = return . ConfigStaged
85
86 argBuilderPath :: Builder -> Settings
87 argBuilderPath = return . BuilderPath
88
89 -- evaluates to the path to a given builder, taking current stage into account
90 argStagedBuilderPath :: (Stage -> Builder) -> Settings
91 argStagedBuilderPath f =
92 msum $ map (\s -> stage s ? argBuilderPath (f s)) [Stage0 ..]
93
94 -- Accessing key value pairs from package-data.mk files
95 argPackageKey :: Settings
96 argPackageKey = return $ PackageData "PACKAGE_KEY"
97
98 argPackageDeps :: Settings
99 argPackageDeps = return $ PackageData "DEPS"
100
101 argPackageDepKeys :: Settings
102 argPackageDepKeys = return $ PackageData "DEP_KEYS"
103
104 argSrcDirs :: Settings
105 argSrcDirs = return $ PackageData "HS_SRC_DIRS"
106
107 argIncludeDirs :: Settings
108 argIncludeDirs = return $ PackageData "INCLUDE_DIRS"
109
110 argDepIncludeDirs :: Settings
111 argDepIncludeDirs = return $ PackageData "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
112
113 argBootPkgConstraints :: Settings
114 argBootPkgConstraints = return BootPkgConstraints
115
116 -- A concatenation of arguments: arg1 ++ arg2 ++ ...
117 argConcat :: Settings -> Settings
118 argConcat = return . Fold Concat
119
120 -- A </>-concatenation of arguments: arg1 </> arg2 </> ...
121 argConcatPath :: Settings -> Settings
122 argConcatPath = return . Fold ConcatPath
123
124 -- An ordered list of pairs of arguments: prefix |> arg1, prefix |> arg2, ...
125 argPairs :: String -> Settings -> Settings
126 argPairs prefix settings = settings >>= (arg prefix |>) . return
127
128 -- An ordered list of prefixed arguments: prefix ++ arg1, prefix ++ arg2, ...
129 argPrefix :: String -> Settings -> Settings
130 argPrefix prefix = fmap (Pair Concat $ Plain prefix)
131
132 -- An ordered list of prefixed arguments: prefix </> arg1, prefix </> arg2, ...
133 argPaths :: String -> Settings -> Settings
134 argPaths prefix = fmap (Pair ConcatPath $ Plain prefix)
135
136 -- Partially evaluate Settings using a truth-teller (compute a 'projection')
137 project :: (BuildVariable -> Maybe Bool) -> Settings -> Settings
138 project _ Epsilon = Epsilon
139 project t (Vertex v) = Vertex v -- TODO: go deeper
140 project t (Overlay l r) = Overlay (project t l) (project t r)
141 project t (Sequence l r) = Sequence (project t l) (project t r)
142 project t (Condition l r) = Condition (evaluate t l) (project t r)
143
144 -- Partial evaluation of settings
145
146 setPackage :: Package -> Settings -> Settings
147 setPackage = project . matchPackage
148
149 setBuilder :: Builder -> Settings -> Settings
150 setBuilder = project . matchBuilder
151
152 setBuilderFamily :: (Stage -> Builder) -> Settings -> Settings
153 setBuilderFamily = project . matchBuilderFamily
154
155 setStage :: Stage -> Settings -> Settings
156 setStage = project . matchStage
157
158 setWay :: Way -> Settings -> Settings
159 setWay = project . matchWay
160
161 setFile :: FilePath -> Settings -> Settings
162 setFile = project . matchFile
163
164 setConfig :: String -> String -> Settings -> Settings
165 setConfig key = project . matchConfig key
166
167 --type ArgsTeller = Args -> Maybe [String]
168
169 --fromPlain :: ArgsTeller
170 --fromPlain (Plain list) = Just list
171 --fromPlain _ = Nothing
172
173 --tellArgs :: ArgsTeller -> Args -> Args
174 --tellArgs t a = case t a of
175 -- Just list -> Plain list
176 -- Nothing -> a