+{-# LANGUAGE
+ EmptyDataDecls,
+ FlexibleInstances,
+ TypeFamilies,
+ TypeOperators,
+ MultiParamTypeClasses,
+ UndecidableInstances
+ #-}
module Database.RRDtool.Expression
( MentionedVars
, MentionedVarsA(..)
, IsExpr
, IsCommonExpr
, IsIterativeExpr
- , IsAggregativeExpr
-
- , IsExprSet
- , IsCommonExprSet
, IsVarName
+ , hString
, Constant(..)
, Variable(..)
- , IsVariableSet
, CommonUnaryOp(..)
, CommonBinaryOp(..)
, CommonTrinaryOp(..)
where
import Data.HList
+import Data.HList.String
import Types.Data.Bool
import Types.Data.Num hiding ((:*:))
import Types.Data.Ord
type family IsExpr e
type family IsCommonExpr e
type family IsIterativeExpr e
-type family IsAggregativeExpr e
type family IsExprSet es
-type instance IsExprSet HNil = True
-type instance IsExprSet (HCons e es) = IsExpr e :&&: IsExprSet es
+type instance IsExprSet Nil = True
+type instance IsExprSet (Cons e es) = IsExpr e :&&: IsExprSet es
type family IsCommonExprSet es
-type instance IsCommonExprSet HNil = True
-type instance IsCommonExprSet (HCons e es) = IsCommonExpr e :&&: IsCommonExprSet es
+type instance IsCommonExprSet Nil = True
+type instance IsCommonExprSet (Cons e es) = IsCommonExpr e :&&: IsCommonExprSet es
+
+type family IsIterativeExprSet es
+type instance IsIterativeExprSet Nil = True
+type instance IsIterativeExprSet (Cons e es) = IsIterativeExpr e :&&: IsIterativeExprSet es
-- Constants and variable names
data Constant
= Const !Double
deriving (Show, Eq, Ord)
-type instance IsExpr Constant = True
-type instance IsCommonExpr Constant = True
-type instance MentionedVars Constant = HNil
+type instance IsExpr Constant = True
+type instance IsCommonExpr Constant = True
+type instance IsIterativeExpr Constant = True
+type instance MentionedVars Constant = Nil
{- This is what we want to do but GHC can't handle this for now.
-class ( (HLengthOf str :<=: D255) ~ True
+class ( (Length str :<=: D19) ~ True
, HString str
)
=> IsVarName str
-}
type family IsVarName str
-type instance IsVarName str = ( (HLength str :<=: D255)
+type instance IsVarName str = ( (Length str :>: D0)
:&&:
- (HAll IsGoodLetterForVarNameA str)
+ (Length str :<=: D19)
+ :&&:
+ (All IsGoodLetterForVarNameA str)
)
type family IsGoodLetterForVarName c
type instance IsGoodLetterForVarName c = ( ((c :>=: D65) :&&: (c :<=: D90)) -- A-Z
:||:
- ((c :>=: D99) :&&: (c :<=: D122)) -- a-z
+ ((c :>=: D97) :&&: (c :<=: D122)) -- a-z
:||:
(c :==: D45) -- '-'
:||:
type Apply IsGoodLetterForVarNameA c = IsGoodLetterForVarName c
-- Variable
-data Variable vn
- = Variable !vn
- deriving (Show, Eq, Ord)
+data Variable vn = Var !vn
+ deriving (Show, Eq, Ord)
-type instance IsExpr (Variable vn) = True
-type instance IsCommonExpr (Variable vn) = True
-type instance MentionedVars (Variable vn) = vn :*: HNil
+type instance IsExpr (Variable vn) = True
+type instance IsCommonExpr (Variable vn) = True
+type instance IsIterativeExpr (Variable vn) = True
+type instance MentionedVars (Variable vn) = vn :&: Nil
type family IsVariableSet vs
-type instance IsVariableSet HNil = True
-type instance IsVariableSet (HCons v vs) = IsVarName v :&&: IsVariableSet vs
+type instance IsVariableSet Nil = True
+type instance IsVariableSet (Cons v vs) = IsVarName v :&&: IsVariableSet vs
-- Common operators
data CommonUnaryOp a
| Abs !a
deriving (Show, Eq, Ord)
-type instance IsExpr (CommonUnaryOp a) = IsExpr a
-type instance IsCommonExpr (CommonUnaryOp a) = IsExpr a
-type instance MentionedVars (CommonUnaryOp a) = MentionedVars a
+type instance IsExpr (CommonUnaryOp a) = IsExpr a
+type instance IsCommonExpr (CommonUnaryOp a) = IsCommonExpr a
+type instance IsIterativeExpr (CommonUnaryOp a) = IsIterativeExpr a
+type instance MentionedVars (CommonUnaryOp a) = MentionedVars a
data CommonBinaryOp a b
= !a :<: !b
type instance IsCommonExpr (CommonBinaryOp a b)
= IsCommonExpr a :&&: IsCommonExpr b
+type instance IsIterativeExpr (CommonBinaryOp a b)
+ = IsIterativeExpr a :&&: IsIterativeExpr b
+
type instance MentionedVars (CommonBinaryOp a b)
= MentionedVars a :++: MentionedVars b
type instance IsCommonExpr (CommonTrinaryOp a b c)
= IsCommonExpr a :&&: IsCommonExpr b :&&: IsCommonExpr c
+type instance IsIterativeExpr (CommonTrinaryOp a b c)
+ = IsIterativeExpr a :&&:
+ IsIterativeExpr b :&&:
+ IsIterativeExpr c
+
type instance MentionedVars (CommonTrinaryOp a b c)
= MentionedVars a :++: MentionedVars b :++: MentionedVars c
= AverageOf !es
deriving (Show, Eq, Ord)
-type instance IsExpr (CommonSetOp es) = IsExprSet es
-type instance IsCommonExpr (CommonSetOp es) = IsCommonExprSet es
-type instance MentionedVars (CommonSetOp es) = HConcat (HMap MentionedVarsA es)
+type instance IsExpr (CommonSetOp es) = IsExprSet es
+type instance IsCommonExpr (CommonSetOp es) = IsCommonExprSet es
+type instance IsIterativeExpr (CommonSetOp es) = IsIterativeExprSet es
+type instance MentionedVars (CommonSetOp es) = Concat (Map MentionedVarsA es)
-- TrendOp
data TrendOp vn e
| TrendNan !(Variable vn) !e
deriving (Show, Eq, Ord)
-type instance IsExpr (TrendOp vn e) = IsVarName vn :&&: IsExpr e
-type instance IsCommonExpr (TrendOp vn e) = IsVarName vn :&&: IsCommonExpr e
-type instance MentionedVars (TrendOp vn e) = vn :*: MentionedVars e
+type instance IsExpr (TrendOp vn e) = IsVarName vn :&&: IsExpr e
+type instance IsCommonExpr (TrendOp vn e) = IsVarName vn :&&: IsCommonExpr e
+type instance IsIterativeExpr (TrendOp vn e) = IsVarName vn :&&: IsIterativeExpr e
+type instance MentionedVars (TrendOp vn e) = vn :&: MentionedVars e
-- VariableShiftPredictOp
data VariableShiftPredictOp ss w vn
type instance IsCommonExpr (VariableShiftPredictOp ss w vn)
= IsCommonExprSet ss :&&: IsCommonExpr w :&&: IsVarName vn
+type instance IsIterativeExpr (VariableShiftPredictOp ss w vn)
+ = IsIterativeExprSet ss :&&: IsIterativeExpr w :&&: IsVarName vn
+
type instance MentionedVars (VariableShiftPredictOp ss w vn)
- = vn :*: (MentionedVars ss :++: MentionedVars w)
+ = vn :&: (MentionedVars ss :++: MentionedVars w)
-- FixedShiftPredictOp
data FixedShiftPredictOp sm w vn
type instance IsCommonExpr (FixedShiftPredictOp sm w vn)
= IsCommonExpr sm :&&: IsCommonExpr w :&&: IsVarName vn
+type instance IsIterativeExpr (FixedShiftPredictOp sm w vn)
+ = IsIterativeExpr sm :&&: IsIterativeExpr w :&&: IsVarName vn
+
type instance MentionedVars (FixedShiftPredictOp sm w vn)
- = vn :*: (MentionedVars sm :++: MentionedVars w)
+ = vn :&: (MentionedVars sm :++: MentionedVars w)
-- Common special values
data CommonValue
| Now
deriving (Show, Eq, Ord)
-type instance IsExpr CommonValue = True
-type instance IsCommonExpr CommonValue = True
-type instance MentionedVars CommonValue = HNil
+type instance IsExpr CommonValue = True
+type instance IsCommonExpr CommonValue = True
+type instance IsIterativeExpr CommonValue = True
+type instance MentionedVars CommonValue = Nil
-- Iterative special values
data IterativeValue
| TakenLocalTime
deriving (Show, Eq, Ord)
-type instance IsExpr IterativeValue = True
-type instance IsCommonExpr IterativeValue = True
-type instance MentionedVars IterativeValue = HNil
+type instance IsExpr IterativeValue = True
+type instance IsCommonExpr IterativeValue = False
+type instance IsIterativeExpr IterativeValue = True
+type instance MentionedVars IterativeValue = Nil
-- Iterative special values of something
data IterativeValueOf vn
deriving (Show, Eq, Ord)
type instance IsExpr (IterativeValueOf vn) = IsVarName vn
+type instance IsCommonExpr (IterativeValueOf vn) = False
type instance IsIterativeExpr (IterativeValueOf vn) = IsVarName vn
-type instance MentionedVars (IterativeValueOf vn) = vn :*: HNil
+type instance MentionedVars (IterativeValueOf vn) = vn :&: Nil
-- Aggregative operators (fairly restricted due to rrdtool's
-- restriction)
| LSLCorrel !(Variable vn)
deriving (Show, Eq, Ord)
-type instance IsAggregativeExpr (AggregativeUnaryOp vn) = IsVarName vn
-type instance MentionedVars (AggregativeUnaryOp vn) = vn :*: HNil
+type instance MentionedVars (AggregativeUnaryOp vn) = vn :&: Nil