Database/RRDtool/Expression.hs

   1 module Database.RRDtool.Expression
   2     ( MentionedVars(..)
   3     , ApplyMentionedVarsOf(..)
   4
   5     , IsExpr
   6     , IsCommonExpr
   7     , IterativeExpr
   8     , IsAggregativeExpr
   9
  10     , IsExprSet
  11     , IsCommonExprSet
  12
  13     , IsVarName
  14     , IsShortEnoughForVarName
  15     , IsGoodLetterForVarName
  16
  17     , Constant(..)
  18     , Variable(..)
  19     , IsVariableSet
  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 Data.HList.String
  36 import Types.Data.Bool
  37 import Types.Data.Num hiding ((:*:))
  38 import Types.Data.Ord
  39
  40
  41 -- MentionedVars
  42 class IsVariableSet (MentionedVarsOf a) => MentionedVars a where
  43     type MentionedVarsOf a
  44
  45 -- ApplyMentionedVarsOf
  46 data ApplyMentionedVarsOf = ApplyMentionedVarsOf
  47
  48 instance Applyable ApplyMentionedVarsOf a where
  49     type Apply ApplyMentionedVarsOf a = MentionedVarsOf a
  50     apply = undefined
  51
  52 -- IsExpr
  53 class (Show e, Eq e) => IsExpr e
  54 class IsExpr e => IsCommonExpr e
  55 class IsExpr e => IterativeExpr e
  56 class IsExpr e => IsAggregativeExpr e
  57
  58 class (Show es, Eq es, HList es) => IsExprSet es
  59 instance IsExprSet HNil
  60 instance (IsExpr e, IsExprSet es) => IsExprSet (HCons e es)
  61
  62 class (Show es, Eq es, HList es) => IsCommonExprSet es
  63 instance IsCommonExprSet HNil
  64 instance (IsCommonExpr e, IsCommonExprSet es) => IsCommonExprSet (HCons e es)
  65
  66
  67 -- Constants and variable names
  68 data Constant
  69     = Const !Double
  70     deriving (Show, Eq, Ord)
  71 instance IsExpr Constant
  72 instance IsCommonExpr Constant
  73 instance MentionedVars Constant where
  74     type MentionedVarsOf Constant = HNil
  75
  76 {- This is what we want to do but GHC can't handle this for now.
  77 class ( (HLengthOf str :<=: D255) ~ True
  78       , HString str
  79       )
  80     => IsVarName str
  81 -}
  82 class ( IsShortEnoughForVarName str
  83       , HString str
  84       )
  85     => IsVarName str
  86
  87 class HString str => IsShortEnoughForVarName str
  88 instance ( HString str
  89          , (HLength str :<=: D255) ~ True
  90          )
  91     => IsShortEnoughForVarName str
  92
  93 class IntegerT c => GoodLetterForVarName c where
  94     type IsGoodLetterForVarName c
  95
  96 instance IntegerT c => GoodLetterForVarName c where
  97     type IsGoodLetterForVarName c = ( (c :>=: D65) :&&: (c :<=:  D90) ) -- A-Z
  98                                     :||:
  99                                     ( (c :>=: D99) :&&: (c :<=: D122) ) -- a-z
 100                                     :||:
 101                                     ( c :==: D45 ) -- '-'
 102                                     :||:
 103                                     ( c :==: D95 ) -- '_'
 104
 105 --instance (a :>=: D65) ~ True => IsGoodLetterForVarName a
 106
 107 -- Variable
 108 data Variable vn
 109     = Variable !vn
 110     deriving (Show, Eq, Ord)
 111
 112 instance IsVarName vn => IsExpr (Variable vn)
 113 instance IsVarName vn => IsCommonExpr (Variable vn)
 114 instance IsVarName vn => MentionedVars (Variable vn) where
 115     type MentionedVarsOf (Variable vn) = vn :*: HNil
 116
 117 class HList vs => IsVariableSet vs
 118 instance IsVariableSet HNil
 119 instance (IsVarName v, IsVariableSet vs) => IsVariableSet (HCons v 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 instance IsExpr a => IsExpr (CommonUnaryOp a)
 138 instance IsCommonExpr a => IsCommonExpr (CommonUnaryOp a)
 139 instance IsVariableSet (MentionedVarsOf a) => MentionedVars (CommonUnaryOp a) where
 140     type MentionedVarsOf (CommonUnaryOp a) = MentionedVarsOf 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 instance (IsExpr a, IsExpr b) =>
 161     IsExpr (CommonBinaryOp a b)
 162
 163 instance (IsCommonExpr a, IsCommonExpr b) =>
 164     IsCommonExpr (CommonBinaryOp a b)
 165
 166 instance IsVariableSet (MentionedVarsOf a :++: MentionedVarsOf b) =>
 167     MentionedVars (CommonBinaryOp a b) where
 168         type MentionedVarsOf (CommonBinaryOp a b)
 169             = MentionedVarsOf a :++: MentionedVarsOf b
 170
 171
 172 data CommonTrinaryOp a b c
 173     = If !a !b !c
 174     | Limit !a !b !c
 175     deriving (Show, Eq, Ord)
 176
 177 instance (IsExpr a, IsExpr b, IsExpr c)
 178     => IsExpr (CommonTrinaryOp a b c)
 179
 180 instance (IsCommonExpr a, IsCommonExpr b, IsCommonExpr c)
 181     => IsCommonExpr (CommonTrinaryOp a b c)
 182
 183 instance IsVariableSet (MentionedVarsOf a :++:
 184                         MentionedVarsOf b :++:
 185                         MentionedVarsOf c) =>
 186     MentionedVars (CommonTrinaryOp a b c) where
 187         type MentionedVarsOf (CommonTrinaryOp a b c)
 188             = MentionedVarsOf a :++:
 189               MentionedVarsOf b :++:
 190               MentionedVarsOf c
 191
 192 -- SORT and REV can't be expressed in this way as they pushes possibly
 193 -- multiple values onto the stack...
 194
 195 data CommonSetOp es
 196     = AverageOf !es
 197     deriving (Show, Eq, Ord)
 198
 199 instance IsExprSet es => IsExpr (CommonSetOp es)
 200 instance (IsExprSet es, IsCommonExprSet es) => IsCommonExpr (CommonSetOp es)
 201 instance IsVariableSet (HConcat (HMap ApplyMentionedVarsOf es)) =>
 202     MentionedVars (CommonSetOp es) where
 203         type MentionedVarsOf (CommonSetOp es)
 204             = HConcat (HMap ApplyMentionedVarsOf es)
 205
 206 data TrendOp vn a
 207     = Trend      !(Variable vn) !a
 208     | TrendNan   !(Variable vn) !a
 209     deriving (Show, Eq, Ord)
 210 instance (IsVarName vn, IsExpr a) => IsExpr (TrendOp vn a)
 211 instance (IsVarName vn, IsCommonExpr a) => IsCommonExpr (TrendOp vn a)
 212
 213 instance ( IsVariableSet (vn :*: MentionedVarsOf a)
 214          ) => MentionedVars (TrendOp vn a) where
 215     type MentionedVarsOf (TrendOp vn a) = vn :*: MentionedVarsOf a
 216
 217 data VariableShiftPredictOp ss w vn
 218     = VariableShiftPredictAverage !ss !w !(Variable vn)
 219     | VariableShiftPredictSigma   !ss !w !(Variable vn)
 220     deriving (Show, Eq, Ord)
 221 instance (IsExprSet ss, IsExpr w, IsVarName vn)
 222     => IsExpr (VariableShiftPredictOp ss w vn)
 223 instance (IsExprSet ss, IsCommonExprSet ss, IsCommonExpr w, IsVarName vn)
 224     => IsCommonExpr (VariableShiftPredictOp ss w vn)
 225 instance ( IsVariableSet (vn :*: (MentionedVarsOf ss :++: MentionedVarsOf w))
 226          ) => MentionedVars (VariableShiftPredictOp ss w vn) where
 227     type MentionedVarsOf (VariableShiftPredictOp ss w vn)
 228         = vn :*: (MentionedVarsOf ss :++: MentionedVarsOf 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 instance (IsExpr sm, IsExpr w, IsVarName vn)
 237     => IsExpr (FixedShiftPredictOp sm w vn)
 238
 239 instance (IsCommonExpr sm, IsCommonExpr w, IsVarName vn)
 240     => IsCommonExpr (FixedShiftPredictOp sm w vn)
 241
 242 instance ( IsVariableSet (vn :*: (MentionedVarsOf sm :++: MentionedVarsOf w))
 243          ) => MentionedVars (FixedShiftPredictOp sm w vn) where
 244     type MentionedVarsOf (FixedShiftPredictOp sm w vn)
 245         = vn :*: (MentionedVarsOf sm :++: MentionedVarsOf w)
 246
 247 -- Common special values
 248 data CommonValue
 249     = Unknown
 250     | Infinity
 251     | NegativeInfinity
 252     | Now
 253     deriving (Show, Eq, Ord)
 254
 255 instance IsExpr CommonValue
 256
 257 instance IsCommonExpr CommonValue
 258
 259 instance MentionedVars CommonValue where
 260     type MentionedVarsOf CommonValue = HNil
 261
 262 -- Iterative special values
 263 data IterativeValue
 264     = Previous
 265     | Count
 266     | TakenTime
 267     | TakenLocalTime
 268     deriving (Show, Eq, Ord)
 269
 270 instance IsExpr IterativeValue
 271
 272 instance IterativeExpr IterativeValue
 273
 274 instance MentionedVars IterativeValue where
 275     type MentionedVarsOf IterativeValue = HNil
 276
 277 -- Iterative special values of something
 278 data IterativeValueOf vn
 279     = PreviousOf !(Variable vn)
 280     deriving (Show, Eq, Ord)
 281
 282 instance IsVarName vn => IsExpr (IterativeValueOf vn)
 283
 284 instance IsVarName vn => IterativeExpr (IterativeValueOf vn)
 285
 286 instance IsVarName vn => MentionedVars (IterativeValueOf vn) where
 287     type MentionedVarsOf (IterativeValueOf vn) = vn :*: HNil
 288
 289 -- Aggregative operators (fairly restricted due to rrdtool's
 290 -- restriction)
 291 data AggregativeUnaryOp vn
 292     = Maximum    !(Variable vn)
 293     | Minimum    !(Variable vn)
 294     | Average    !(Variable vn)
 295     | StandardDeviation !(Variable vn)
 296     | First      !(Variable vn)
 297     | Last       !(Variable vn)
 298     | Total      !(Variable vn)
 299     | Percent    !(Variable vn) !Constant
 300     | PercentNan !(Variable vn) !Constant
 301     | LSLSlope   !(Variable vn)
 302     | LSLInt     !(Variable vn)
 303     | LSLCorrel  !(Variable vn)
 304     deriving (Show, Eq, Ord)
 305
 306 instance IsVarName vn => IsExpr (AggregativeUnaryOp vn)
 307
 308 instance IsVarName vn => IsAggregativeExpr (AggregativeUnaryOp vn)
 309
 310 instance IsVarName vn => MentionedVars (AggregativeUnaryOp vn) where
 311     type MentionedVarsOf (AggregativeUnaryOp vn) = vn :*: HNil