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 Nil         = True
  60 type instance IsExprSet (Cons e es) = IsExpr e :&&: IsExprSet es
  61
  62 type family   IsCommonExprSet es
  63 type instance IsCommonExprSet Nil         = True
  64 type instance IsCommonExprSet (Cons e es) = IsCommonExpr e :&&: IsCommonExprSet es
  65
  66 type family   IsIterativeExprSet es
  67 type instance IsIterativeExprSet Nil         = True
  68 type instance IsIterativeExprSet (Cons 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 = Nil
  79
  80 {- This is what we want to do but GHC can't handle this for now.
  81 class ( (Length str :<=: D19) ~ True
  82       , HString str
  83       )
  84     => IsVarName str
  85 -}
  86 type family   IsVarName str
  87 type instance IsVarName str = ( (Length str :>: D0)
  88                                 :&&:
  89                                 (Length str :<=: D19)
  90                                 :&&:
  91                                 (All IsGoodLetterForVarNameA str)
  92                               )
  93
  94 type family   IsGoodLetterForVarName c
  95 type instance IsGoodLetterForVarName c = ( ((c :>=: D65) :&&: (c :<=:  D90)) -- A-Z
  96                                            :||:
  97                                            ((c :>=: D97) :&&: (c :<=: D122)) -- a-z
  98                                            :||:
  99                                            (c :==: D45) -- '-'
 100                                            :||:
 101                                            (c :==: D95) -- '_'
 102                                          )
 103
 104 data IsGoodLetterForVarNameA
 105 instance ApplyT IsGoodLetterForVarNameA c where
 106     type Apply IsGoodLetterForVarNameA c = IsGoodLetterForVarName c
 107
 108 -- Variable
 109 data Variable vn = Var !vn
 110                    deriving (Show, Eq, Ord)
 111
 112 type instance IsExpr          (Variable vn) = True
 113 type instance IsCommonExpr    (Variable vn) = True
 114 type instance IsIterativeExpr (Variable vn) = True
 115 type instance MentionedVars   (Variable vn) = vn :&: Nil
 116
 117 type family   IsVariableSet vs
 118 type instance IsVariableSet Nil         = True
 119 type instance IsVariableSet (Cons v vs) = IsVarName v :&&: IsVariableSet vs
 120
 121 -- Common operators
 122 data CommonUnaryOp a
 123     = IsUnknown  !a
 124     | IsInfinity !a
 125     | Sin        !a
 126     | Cos        !a
 127     | Log        !a
 128     | Exp        !a
 129     | Sqrt       !a
 130     | Atan       !a
 131     | Floor      !a
 132     | Ceil       !a
 133     | Deg2Rad    !a
 134     | Rad2Deg    !a
 135     | Abs        !a
 136     deriving (Show, Eq, Ord)
 137
 138 type instance IsExpr          (CommonUnaryOp a) = IsExpr a
 139 type instance IsCommonExpr    (CommonUnaryOp a) = IsCommonExpr a
 140 type instance IsIterativeExpr (CommonUnaryOp a) = IsIterativeExpr a
 141 type instance MentionedVars   (CommonUnaryOp a) = MentionedVars a
 142
 143 data CommonBinaryOp a b
 144     = !a :<:  !b
 145     | !a :<=: !b
 146     | !a :>:  !b
 147     | !a :>=: !b
 148     | !a :==: !b
 149     | !a :/=: !b
 150     | Min !a !b
 151     | Max !a !b
 152     | !a :+: !b
 153     | !a :-: !b
 154     | !a :*: !b
 155     | !a :/: !b
 156     | !a :%: !b
 157     | AddNaN !a !b
 158     | AtanXY !a !b
 159     deriving (Show, Eq, Ord)
 160
 161 type instance IsExpr (CommonBinaryOp a b)
 162     = IsExpr a :&&: IsExpr b
 163
 164 type instance IsCommonExpr (CommonBinaryOp a b)
 165     = IsCommonExpr a :&&: IsCommonExpr b
 166
 167 type instance IsIterativeExpr (CommonBinaryOp a b)
 168     = IsIterativeExpr a :&&: IsIterativeExpr b
 169
 170 type instance MentionedVars (CommonBinaryOp a b)
 171     = MentionedVars a :++: MentionedVars b
 172
 173
 174 data CommonTrinaryOp a b c
 175     = If !a !b !c
 176     | Limit !a !b !c
 177     deriving (Show, Eq, Ord)
 178
 179 type instance IsExpr (CommonTrinaryOp a b c)
 180     = IsExpr a :&&: IsExpr b :&&: IsExpr c
 181
 182 type instance IsCommonExpr (CommonTrinaryOp a b c)
 183     = IsCommonExpr a :&&: IsCommonExpr b :&&: IsCommonExpr c
 184
 185 type instance IsIterativeExpr (CommonTrinaryOp a b c)
 186     = IsIterativeExpr a :&&:
 187       IsIterativeExpr b :&&:
 188       IsIterativeExpr c
 189
 190 type instance MentionedVars (CommonTrinaryOp a b c)
 191     = MentionedVars a :++: MentionedVars b :++: MentionedVars c
 192
 193 -- SORT and REV can't be expressed in this way as they push possibly
 194 -- multiple values onto the stack...
 195
 196 data CommonSetOp es
 197     = AverageOf !es
 198     deriving (Show, Eq, Ord)
 199
 200 type instance IsExpr          (CommonSetOp es) = IsExprSet          es
 201 type instance IsCommonExpr    (CommonSetOp es) = IsCommonExprSet    es
 202 type instance IsIterativeExpr (CommonSetOp es) = IsIterativeExprSet es
 203 type instance MentionedVars   (CommonSetOp es) = Concat (Map MentionedVarsA es)
 204
 205 -- TrendOp
 206 data TrendOp vn e
 207     = Trend      !(Variable vn) !e
 208     | TrendNan   !(Variable vn) !e
 209     deriving (Show, Eq, Ord)
 210
 211 type instance IsExpr          (TrendOp vn e) = IsVarName vn :&&: IsExpr e
 212 type instance IsCommonExpr    (TrendOp vn e) = IsVarName vn :&&: IsCommonExpr e
 213 type instance IsIterativeExpr (TrendOp vn e) = IsVarName vn :&&: IsIterativeExpr e
 214 type instance MentionedVars   (TrendOp vn e) = vn :&: MentionedVars e
 215
 216 -- VariableShiftPredictOp
 217 data VariableShiftPredictOp ss w vn
 218     = VariableShiftPredictAverage !ss !w !(Variable vn)
 219     | VariableShiftPredictSigma   !ss !w !(Variable vn)
 220     deriving (Show, Eq, Ord)
 221
 222 type instance IsExpr (VariableShiftPredictOp ss w vn)
 223     = IsExprSet ss :&&: IsExpr w :&&: IsVarName vn
 224
 225 type instance IsCommonExpr (VariableShiftPredictOp ss w vn)
 226     = IsCommonExprSet ss :&&: IsCommonExpr w :&&: IsVarName vn
 227
 228 type instance IsIterativeExpr (VariableShiftPredictOp ss w vn)
 229     = IsIterativeExprSet ss :&&: IsIterativeExpr w :&&: IsVarName vn
 230
 231 type instance MentionedVars (VariableShiftPredictOp ss w vn)
 232     = vn :&: (MentionedVars ss :++: MentionedVars w)
 233
 234 -- FixedShiftPredictOp
 235 data FixedShiftPredictOp sm w vn
 236     = FixedShiftPredictAverage !sm !w !(Variable vn)
 237     | FixedShiftPredictSigma   !sm !w !(Variable vn)
 238     deriving (Show, Eq, Ord)
 239
 240 type instance IsExpr (FixedShiftPredictOp sm w vn)
 241     = IsExpr sm :&&: IsExpr w :&&: IsVarName vn
 242
 243 type instance IsCommonExpr (FixedShiftPredictOp sm w vn)
 244     = IsCommonExpr sm :&&: IsCommonExpr w :&&: IsVarName vn
 245
 246 type instance IsIterativeExpr (FixedShiftPredictOp sm w vn)
 247     = IsIterativeExpr sm :&&: IsIterativeExpr w :&&: IsVarName vn
 248
 249 type instance MentionedVars (FixedShiftPredictOp sm w vn)
 250     = vn :&: (MentionedVars sm :++: MentionedVars w)
 251
 252 -- Common special values
 253 data CommonValue
 254     = Unknown
 255     | Infinity
 256     | NegativeInfinity
 257     | Now
 258     deriving (Show, Eq, Ord)
 259
 260 type instance IsExpr          CommonValue = True
 261 type instance IsCommonExpr    CommonValue = True
 262 type instance IsIterativeExpr CommonValue = True
 263 type instance MentionedVars   CommonValue = Nil
 264
 265 -- Iterative special values
 266 data IterativeValue
 267     = Previous
 268     | Count
 269     | TakenTime
 270     | TakenLocalTime
 271     deriving (Show, Eq, Ord)
 272
 273 type instance IsExpr          IterativeValue = True
 274 type instance IsCommonExpr    IterativeValue = False
 275 type instance IsIterativeExpr IterativeValue = True
 276 type instance MentionedVars   IterativeValue = Nil
 277
 278 -- Iterative special values of something
 279 data IterativeValueOf vn
 280     = PreviousOf !(Variable vn)
 281     deriving (Show, Eq, Ord)
 282
 283 type instance IsExpr          (IterativeValueOf vn) = IsVarName vn
 284 type instance IsCommonExpr    (IterativeValueOf vn) = False
 285 type instance IsIterativeExpr (IterativeValueOf vn) = IsVarName vn
 286 type instance MentionedVars   (IterativeValueOf vn) = vn :&: Nil
 287
 288 -- Aggregative operators (fairly restricted due to rrdtool's
 289 -- restriction)
 290 data AggregativeUnaryOp vn
 291     = Maximum    !(Variable vn)
 292     | Minimum    !(Variable vn)
 293     | Average    !(Variable vn)
 294     | StandardDeviation !(Variable vn)
 295     | First      !(Variable vn)
 296     | Last       !(Variable vn)
 297     | Total      !(Variable vn)
 298     | Percent    !(Variable vn) !Constant
 299     | PercentNan !(Variable vn) !Constant
 300     | LSLSlope   !(Variable vn)
 301     | LSLInt     !(Variable vn)
 302     | LSLCorrel  !(Variable vn)
 303     deriving (Show, Eq, Ord)
 304
 305 type instance MentionedVars (AggregativeUnaryOp vn) = vn :&: Nil