Experiment with parameterised graphs.
[hadrian.git] / src / Settings.hs
1 {-# LANGUAGE FlexibleInstances #-}
2
3 module Settings (
4 IntegerLibrary (..), integerLibrary, integerLibraryName,
5 buildHaddock
6 ) where
7
8 import Base
9 import Ways
10
11 data IntegerLibrary = IntegerGmp | IntegerGmp2 | IntegerSimple
12
13 integerLibrary :: IntegerLibrary
14 integerLibrary = IntegerGmp2
15
16 integerLibraryName :: String
17 integerLibraryName = case integerLibrary of
18 IntegerGmp -> "integer-gmp"
19 IntegerGmp2 -> "integer-gmp2"
20 IntegerSimple -> "integer-simple"
21
22 buildHaddock :: Bool
23 buildHaddock = True
24
25 -- A Parameterised Graph datatype for storing argument lists with conditions
26 data PG a b = Epsilon
27 | Vertex a
28 | Overlay (PG a b) (PG a b)
29 | Sequence (PG a b) (PG a b)
30 | Condition b (PG a b)
31
32 instance Monoid (PG a b) where
33 mempty = Epsilon
34 mappend = Overlay
35
36 type ArgsExpression = PG String Predicate
37 type WaysExpression = PG Way Predicate
38
39 data Match = MatchPackage FilePath -- Match a Package name
40 | MatchFile FilePath -- Match a file
41 | MatchStage Stage -- Match a Stage
42 | MatchWay Way -- Match a Way
43 | MatchKeyValue String String -- Match a key with a value (config)
44
45 -- A Matcher takes a Match description and attempts to evaluate it.
46 -- Returns Nothing if the attempt fails.
47 type Matcher = Match -> Maybe Bool
48
49 -- A Monoid instance for matchers (returns first successful match)
50 instance Monoid Matcher where
51 mempty = const Nothing
52 p `mappend` q = \m -> getFirst $ First (p m) <> First (q m)
53
54 data Predicate = Evaluated Bool -- Evaluated predicate
55 | If Match -- Perform a match to evaluate
56 | Not Predicate -- Negate predicate
57 | And Predicate Predicate -- Conjunction of two predicates
58 | Or Predicate Predicate -- Disjunction of two predicates
59
60 match :: Predicate -> Matcher -> Predicate
61 match p @ (Evaluated _) _ = p
62 match p @ (If match ) m = case m match of
63 Just bool -> Evaluated bool
64 Nothing -> p
65 match (Not p ) m = match p m
66 match (And p q) m = And (match p m) (match q m)
67 match (Or p q) m = Or (match p m) (match q m)
68
69 -- returns Nothing if the given predicate cannot be uniquely evaluated
70 evalPredicate :: Predicate -> Maybe Bool
71 evalPredicate (Evaluated bool) = Just bool
72 evalPredicate (Not p) = not <$> evalPredicate p
73 evalPredicate (And p q)
74 | p' == Just False || q' == Just False = Just False
75 | p' == Just True && q' == Just True = Just True
76 | otherwise = Nothing
77 where
78 p' = evalPredicate p
79 q' = evalPredicate q
80 evalPredicate (Or p q)
81 | p' == Just True || q' == Just True = Just True
82 | p' == Just False && q' == Just False = Just False
83 | otherwise = Nothing
84 where
85 p' = evalPredicate p
86 q' = evalPredicate q
87 evalPredicate (If _) = Nothing
88
89 -- returns Nothing if the given expression cannot be uniquely evaluated
90 evalPG :: PG a Predicate -> Maybe [a]
91 evalPG Epsilon = Just []
92 evalPG (Vertex v) = Just [v]
93 evalPG (Overlay p q) = (++) <$> evalPG p <*> evalPG q
94 evalPG (Sequence p q) = (++) <$> evalPG p <*> evalPG q
95 evalPG (Condition x p) = case evalPredicate x of
96 Just True -> evalPG p
97 Just False -> Just []
98 Nothing -> Nothing