Database/RRDtool/Expression.hs

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