]> gitweb @ CieloNegro.org - hs-rrdtool.git/blob - Database/RRDtool/Expression.hs
DSList
[hs-rrdtool.git] / Database / RRDtool / Expression.hs
1 {-# LANGUAGE
2   EmptyDataDecls,
3   FlexibleInstances,
4   TypeFamilies,
5   TypeOperators,
6   MultiParamTypeClasses,
7   UndecidableInstances
8   #-}
9 module Database.RRDtool.Expression
10     ( MentionedVars
11     , MentionedVarsA(..)
12
13     , IsExpr
14     , IsCommonExpr
15     , IsIterativeExpr
16
17     , IsVarName
18     , hString
19
20     , Constant(..)
21     , Variable(..)
22     , CommonUnaryOp(..)
23     , CommonBinaryOp(..)
24     , CommonTrinaryOp(..)
25     , CommonSetOp(..)
26     , TrendOp(..)
27     , VariableShiftPredictOp(..)
28     , FixedShiftPredictOp(..)
29     , CommonValue(..)
30     , IterativeValue(..)
31     , IterativeValueOf(..)
32     , AggregativeUnaryOp(..)
33     )
34     where
35
36 import Data.HList
37 import Data.HList.String
38 import Types.Data.Bool
39 import Types.Data.Num hiding ((:*:))
40 import Types.Data.Ord
41
42
43 -- MentionedVars
44 type family MentionedVars a
45
46 -- MentionedVarsA
47 data MentionedVarsA = MentionedVarsA
48
49 instance ApplyT MentionedVarsA a where
50     type Apply MentionedVarsA a = MentionedVars a
51
52 -- IsExpr
53 --class (Show e, Eq e) => IsExpr e
54 type family IsExpr e
55 type family IsCommonExpr e
56 type family IsIterativeExpr e
57
58 type family   IsExprSet es
59 type instance IsExprSet HNil         = True
60 type instance IsExprSet (HCons e es) = IsExpr e :&&: IsExprSet es
61
62 type family   IsCommonExprSet es
63 type instance IsCommonExprSet HNil         = True
64 type instance IsCommonExprSet (HCons e es) = IsCommonExpr e :&&: IsCommonExprSet es
65
66 type family   IsIterativeExprSet es
67 type instance IsIterativeExprSet HNil         = True
68 type instance IsIterativeExprSet (HCons e es) = IsIterativeExpr e :&&: IsIterativeExprSet es
69
70 -- Constants and variable names
71 data Constant
72     = Const !Double
73     deriving (Show, Eq, Ord)
74
75 type instance IsExpr          Constant = True
76 type instance IsCommonExpr    Constant = True
77 type instance IsIterativeExpr Constant = True
78 type instance MentionedVars   Constant = HNil
79
80 {- This is what we want to do but GHC can't handle this for now. 
81 class ( (HLengthOf str :<=: D19) ~ True
82       , HString str
83       )
84     => IsVarName str
85 -}
86 type family   IsVarName str
87 type instance IsVarName str = ( (HLength str :<=: D19)
88                                 :&&:
89                                 (HAll IsGoodLetterForVarNameA str)
90                               )
91
92 type family   IsGoodLetterForVarName c
93 type instance IsGoodLetterForVarName c = ( ((c :>=: D65) :&&: (c :<=:  D90)) -- A-Z
94                                            :||:
95                                            ((c :>=: D99) :&&: (c :<=: D122)) -- a-z
96                                            :||:
97                                            (c :==: D45) -- '-'
98                                            :||:
99                                            (c :==: D95) -- '_'
100                                          )
101
102 data IsGoodLetterForVarNameA
103 instance ApplyT IsGoodLetterForVarNameA c where
104     type Apply IsGoodLetterForVarNameA c = IsGoodLetterForVarName c
105
106 -- Variable
107 data Variable vn
108     = Variable !vn
109     deriving (Show, Eq, Ord)
110
111 type instance IsExpr          (Variable vn) = True
112 type instance IsCommonExpr    (Variable vn) = True
113 type instance IsIterativeExpr (Variable vn) = True
114 type instance MentionedVars   (Variable vn) = vn :&: HNil
115
116 type family   IsVariableSet vs
117 type instance IsVariableSet HNil         = True
118 type instance IsVariableSet (HCons v vs) = IsVarName v :&&: IsVariableSet vs
119
120 -- Common operators
121 data CommonUnaryOp a
122     = IsUnknown  !a
123     | IsInfinity !a
124     | Sin        !a
125     | Cos        !a
126     | Log        !a
127     | Exp        !a
128     | Sqrt       !a
129     | Atan       !a
130     | Floor      !a
131     | Ceil       !a
132     | Deg2Rad    !a
133     | Rad2Deg    !a
134     | Abs        !a
135     deriving (Show, Eq, Ord)
136
137 type instance IsExpr          (CommonUnaryOp a) = IsExpr a
138 type instance IsCommonExpr    (CommonUnaryOp a) = IsCommonExpr a
139 type instance IsIterativeExpr (CommonUnaryOp a) = IsIterativeExpr a
140 type instance MentionedVars   (CommonUnaryOp a) = MentionedVars a
141
142 data CommonBinaryOp a b
143     = !a :<:  !b
144     | !a :<=: !b
145     | !a :>:  !b
146     | !a :>=: !b
147     | !a :==: !b
148     | !a :/=: !b
149     | Min !a !b
150     | Max !a !b
151     | !a :+: !b
152     | !a :-: !b
153     | !a :*: !b
154     | !a :/: !b
155     | !a :%: !b
156     | AddNaN !a !b
157     | AtanXY !a !b
158     deriving (Show, Eq, Ord)
159
160 type instance IsExpr (CommonBinaryOp a b)
161     = IsExpr a :&&: IsExpr b
162
163 type instance IsCommonExpr (CommonBinaryOp a b)
164     = IsCommonExpr a :&&: IsCommonExpr b
165
166 type instance IsIterativeExpr (CommonBinaryOp a b)
167     = IsIterativeExpr a :&&: IsIterativeExpr b
168
169 type instance MentionedVars (CommonBinaryOp a b)
170     = MentionedVars a :++: MentionedVars b
171         
172
173 data CommonTrinaryOp a b c
174     = If !a !b !c
175     | Limit !a !b !c
176     deriving (Show, Eq, Ord)
177
178 type instance IsExpr (CommonTrinaryOp a b c)
179     = IsExpr a :&&: IsExpr b :&&: IsExpr c
180
181 type instance IsCommonExpr (CommonTrinaryOp a b c)
182     = IsCommonExpr a :&&: IsCommonExpr b :&&: IsCommonExpr c
183
184 type instance IsIterativeExpr (CommonTrinaryOp a b c)
185     = IsIterativeExpr a :&&:
186       IsIterativeExpr b :&&:
187       IsIterativeExpr c
188
189 type instance MentionedVars (CommonTrinaryOp a b c)
190     = MentionedVars a :++: MentionedVars b :++: MentionedVars c
191
192 -- SORT and REV can't be expressed in this way as they push possibly
193 -- multiple values onto the stack...
194
195 data CommonSetOp es
196     = AverageOf !es
197     deriving (Show, Eq, Ord)
198
199 type instance IsExpr          (CommonSetOp es) = IsExprSet          es
200 type instance IsCommonExpr    (CommonSetOp es) = IsCommonExprSet    es
201 type instance IsIterativeExpr (CommonSetOp es) = IsIterativeExprSet es
202 type instance MentionedVars   (CommonSetOp es) = HConcat (HMap MentionedVarsA es)
203
204 -- TrendOp
205 data TrendOp vn e
206     = Trend      !(Variable vn) !e
207     | TrendNan   !(Variable vn) !e
208     deriving (Show, Eq, Ord)
209
210 type instance IsExpr          (TrendOp vn e) = IsVarName vn :&&: IsExpr e
211 type instance IsCommonExpr    (TrendOp vn e) = IsVarName vn :&&: IsCommonExpr e
212 type instance IsIterativeExpr (TrendOp vn e) = IsVarName vn :&&: IsIterativeExpr e
213 type instance MentionedVars   (TrendOp vn e) = vn :&: MentionedVars e
214
215 -- VariableShiftPredictOp
216 data VariableShiftPredictOp ss w vn
217     = VariableShiftPredictAverage !ss !w !(Variable vn)
218     | VariableShiftPredictSigma   !ss !w !(Variable vn)
219     deriving (Show, Eq, Ord)
220
221 type instance IsExpr (VariableShiftPredictOp ss w vn)
222     = IsExprSet ss :&&: IsExpr w :&&: IsVarName vn
223
224 type instance IsCommonExpr (VariableShiftPredictOp ss w vn)
225     = IsCommonExprSet ss :&&: IsCommonExpr w :&&: IsVarName vn
226
227 type instance IsIterativeExpr (VariableShiftPredictOp ss w vn)
228     = IsIterativeExprSet ss :&&: IsIterativeExpr w :&&: IsVarName vn
229
230 type instance MentionedVars (VariableShiftPredictOp ss w vn)
231     = vn :&: (MentionedVars ss :++: MentionedVars w)
232
233 -- FixedShiftPredictOp
234 data FixedShiftPredictOp sm w vn
235     = FixedShiftPredictAverage !sm !w !(Variable vn)
236     | FixedShiftPredictSigma   !sm !w !(Variable vn)
237     deriving (Show, Eq, Ord)
238
239 type instance IsExpr (FixedShiftPredictOp sm w vn)
240     = IsExpr sm :&&: IsExpr w :&&: IsVarName vn
241
242 type instance IsCommonExpr (FixedShiftPredictOp sm w vn)
243     = IsCommonExpr sm :&&: IsCommonExpr w :&&: IsVarName vn
244
245 type instance IsIterativeExpr (FixedShiftPredictOp sm w vn)
246     = IsIterativeExpr sm :&&: IsIterativeExpr w :&&: IsVarName vn
247
248 type instance MentionedVars (FixedShiftPredictOp sm w vn)
249     = vn :&: (MentionedVars sm :++: MentionedVars w)
250
251 -- Common special values
252 data CommonValue
253     = Unknown
254     | Infinity
255     | NegativeInfinity
256     | Now
257     deriving (Show, Eq, Ord)
258
259 type instance IsExpr          CommonValue = True
260 type instance IsCommonExpr    CommonValue = True
261 type instance IsIterativeExpr CommonValue = True
262 type instance MentionedVars   CommonValue = HNil
263
264 -- Iterative special values
265 data IterativeValue
266     = Previous
267     | Count
268     | TakenTime
269     | TakenLocalTime
270     deriving (Show, Eq, Ord)
271
272 type instance IsExpr          IterativeValue = True
273 type instance IsCommonExpr    IterativeValue = False
274 type instance IsIterativeExpr IterativeValue = True
275 type instance MentionedVars   IterativeValue = HNil
276
277 -- Iterative special values of something
278 data IterativeValueOf vn
279     = PreviousOf !(Variable vn)
280     deriving (Show, Eq, Ord)
281
282 type instance IsExpr          (IterativeValueOf vn) = IsVarName vn
283 type instance IsCommonExpr    (IterativeValueOf vn) = False
284 type instance IsIterativeExpr (IterativeValueOf vn) = IsVarName vn
285 type instance MentionedVars   (IterativeValueOf vn) = vn :&: HNil
286
287 -- Aggregative operators (fairly restricted due to rrdtool's
288 -- restriction)
289 data AggregativeUnaryOp vn
290     = Maximum    !(Variable vn)
291     | Minimum    !(Variable vn)
292     | Average    !(Variable vn)
293     | StandardDeviation !(Variable vn)
294     | First      !(Variable vn)
295     | Last       !(Variable vn)
296     | Total      !(Variable vn)
297     | Percent    !(Variable vn) !Constant
298     | PercentNan !(Variable vn) !Constant
299     | LSLSlope   !(Variable vn)
300     | LSLInt     !(Variable vn)
301     | LSLCorrel  !(Variable vn)
302     deriving (Show, Eq, Ord)
303
304 type instance MentionedVars (AggregativeUnaryOp vn) = vn :&: HNil