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