Database/RRDtool/Expression.hs

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