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