+{-# LANGUAGE
+ EmptyDataDecls,
+ FlexibleInstances,
+ TypeFamilies,
+ TypeOperators,
+ MultiParamTypeClasses,
+ UndecidableInstances
+ #-}
module Database.RRDtool.Expression
- ( MentionedVars(..)
- , ApplyMentionedVarsOf(..)
+ ( MentionedVars
+ , MentionedVarsA(..)
, IsExpr
, IsCommonExpr
- , IterativeExpr
- , IsAggregativeExpr
+ , IsIterativeExpr
- , IsExprSet
- , IsCommonExprSet
+ , IsVarName
+ , hString
, Constant(..)
- , IsVarName(..)
, 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
-- MentionedVars
-class IsVariableSet (MentionedVarsOf a) => MentionedVars a where
- type MentionedVarsOf a
+type family MentionedVars a
--- ApplyMentionedVarsOf
-data ApplyMentionedVarsOf = ApplyMentionedVarsOf
+-- MentionedVarsA
+data MentionedVarsA = MentionedVarsA
-instance Applyable ApplyMentionedVarsOf a where
- type Apply ApplyMentionedVarsOf a = MentionedVarsOf a
- apply = undefined
+instance ApplyT MentionedVarsA a where
+ type Apply MentionedVarsA a = MentionedVars a
-- IsExpr
-class (Show e, Eq e) => IsExpr e
-class IsExpr e => IsCommonExpr e
-class IsExpr e => IterativeExpr e
-class IsExpr e => IsAggregativeExpr e
+--class (Show e, Eq e) => IsExpr e
+type family IsExpr e
+type family IsCommonExpr e
+type family IsIterativeExpr e
-class (Show es, Eq es, HList es) => IsExprSet es
-instance IsExprSet HNil
-instance (IsExpr e, IsExprSet es) => IsExprSet (HCons e es)
+type family IsExprSet es
+type instance IsExprSet HNil = True
+type instance IsExprSet (HCons e es) = IsExpr e :&&: IsExprSet es
-class (Show es, Eq es, HList es) => IsCommonExprSet es
-instance IsCommonExprSet HNil
-instance (IsCommonExpr e, IsCommonExprSet es) => IsCommonExprSet (HCons e es)
+type family IsCommonExprSet es
+type instance IsCommonExprSet HNil = True
+type instance IsCommonExprSet (HCons e es) = IsCommonExpr e :&&: IsCommonExprSet es
+type family IsIterativeExprSet es
+type instance IsIterativeExprSet HNil = True
+type instance IsIterativeExprSet (HCons e es) = IsIterativeExpr e :&&: IsIterativeExprSet es
-- Constants and variable names
data Constant
= Const !Double
deriving (Show, Eq, Ord)
-instance IsExpr Constant
-instance IsCommonExpr Constant
-instance MentionedVars Constant where
- type MentionedVarsOf Constant = HNil
-
-class (Show a, Eq a, Ord a) => IsVarName a where
- varName :: a -> String
+type instance IsExpr Constant = True
+type instance IsCommonExpr Constant = True
+type instance IsIterativeExpr Constant = True
+type instance MentionedVars Constant = HNil
+
+{- This is what we want to do but GHC can't handle this for now.
+class ( (HLengthOf str :<=: D19) ~ True
+ , HString str
+ )
+ => IsVarName str
+-}
+type family IsVarName str
+type instance IsVarName str = ( (HLength str :<=: D19)
+ :&&:
+ (HAll IsGoodLetterForVarNameA str)
+ )
+
+type family IsGoodLetterForVarName c
+type instance IsGoodLetterForVarName c = ( ((c :>=: D65) :&&: (c :<=: D90)) -- A-Z
+ :||:
+ ((c :>=: D99) :&&: (c :<=: D122)) -- a-z
+ :||:
+ (c :==: D45) -- '-'
+ :||:
+ (c :==: D95) -- '_'
+ )
+
+data IsGoodLetterForVarNameA
+instance ApplyT IsGoodLetterForVarNameA c where
+ type Apply IsGoodLetterForVarNameA c = IsGoodLetterForVarName c
+
+-- Variable
data Variable vn
= Variable !vn
deriving (Show, Eq, Ord)
-instance IsVarName vn => IsExpr (Variable vn)
-instance IsVarName vn => IsCommonExpr (Variable vn)
-instance IsVarName vn => MentionedVars (Variable vn) where
- type MentionedVarsOf (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 :*: HNil
-class HList vs => IsVariableSet vs
-instance IsVariableSet HNil
-instance (IsVarName v, IsVariableSet vs) => IsVariableSet (HCons v vs)
+type family IsVariableSet vs
+type instance IsVariableSet HNil = True
+type instance IsVariableSet (HCons v vs) = IsVarName v :&&: IsVariableSet vs
-- Common operators
data CommonUnaryOp a
| Rad2Deg !a
| Abs !a
deriving (Show, Eq, Ord)
-instance IsExpr a => IsExpr (CommonUnaryOp a)
-instance IsCommonExpr a => IsCommonExpr (CommonUnaryOp a)
-instance IsVariableSet (MentionedVarsOf a) => MentionedVars (CommonUnaryOp a) where
- type MentionedVarsOf (CommonUnaryOp a) = MentionedVarsOf 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
| AtanXY !a !b
deriving (Show, Eq, Ord)
-instance (IsExpr a, IsExpr b) =>
- IsExpr (CommonBinaryOp a b)
+type instance IsExpr (CommonBinaryOp a b)
+ = IsExpr a :&&: IsExpr b
+
+type instance IsCommonExpr (CommonBinaryOp a b)
+ = IsCommonExpr a :&&: IsCommonExpr b
-instance (IsCommonExpr a, IsCommonExpr b) =>
- IsCommonExpr (CommonBinaryOp a b)
+type instance IsIterativeExpr (CommonBinaryOp a b)
+ = IsIterativeExpr a :&&: IsIterativeExpr b
-instance IsVariableSet (MentionedVarsOf a :++: MentionedVarsOf b) =>
- MentionedVars (CommonBinaryOp a b) where
- type MentionedVarsOf (CommonBinaryOp a b)
- = MentionedVarsOf a :++: MentionedVarsOf b
+type instance MentionedVars (CommonBinaryOp a b)
+ = MentionedVars a :++: MentionedVars b
data CommonTrinaryOp a b c
| Limit !a !b !c
deriving (Show, Eq, Ord)
-instance (IsExpr a, IsExpr b, IsExpr c)
- => IsExpr (CommonTrinaryOp a b c)
+type instance IsExpr (CommonTrinaryOp a b c)
+ = IsExpr a :&&: IsExpr b :&&: IsExpr c
-instance (IsCommonExpr a, IsCommonExpr b, IsCommonExpr c)
- => IsCommonExpr (CommonTrinaryOp a b c)
+type instance IsCommonExpr (CommonTrinaryOp a b c)
+ = IsCommonExpr a :&&: IsCommonExpr b :&&: IsCommonExpr c
-instance IsVariableSet (MentionedVarsOf a :++:
- MentionedVarsOf b :++:
- MentionedVarsOf c) =>
- MentionedVars (CommonTrinaryOp a b c) where
- type MentionedVarsOf (CommonTrinaryOp a b c)
- = MentionedVarsOf a :++:
- MentionedVarsOf b :++:
- MentionedVarsOf c
+type instance IsIterativeExpr (CommonTrinaryOp a b c)
+ = IsIterativeExpr a :&&:
+ IsIterativeExpr b :&&:
+ IsIterativeExpr c
--- SORT and REV can't be expressed in this way as they pushes possibly
+type instance MentionedVars (CommonTrinaryOp a b c)
+ = MentionedVars a :++: MentionedVars b :++: MentionedVars c
+
+-- SORT and REV can't be expressed in this way as they push possibly
-- multiple values onto the stack...
data CommonSetOp es
= AverageOf !es
deriving (Show, Eq, Ord)
-instance IsExprSet es => IsExpr (CommonSetOp es)
-instance (IsExprSet es, IsCommonExprSet es) => IsCommonExpr (CommonSetOp es)
-instance IsVariableSet (HConcat (HMap ApplyMentionedVarsOf es)) =>
- MentionedVars (CommonSetOp es) where
- type MentionedVarsOf (CommonSetOp es)
- = HConcat (HMap ApplyMentionedVarsOf 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) = HConcat (HMap MentionedVarsA es)
-data TrendOp vn a
- = Trend !(Variable vn) !a
- | TrendNan !(Variable vn) !a
+-- TrendOp
+data TrendOp vn e
+ = Trend !(Variable vn) !e
+ | TrendNan !(Variable vn) !e
deriving (Show, Eq, Ord)
-instance (IsVarName vn, IsExpr a) => IsExpr (TrendOp vn a)
-instance (IsVarName vn, IsCommonExpr a) => IsCommonExpr (TrendOp vn a)
-instance ( IsVariableSet (vn :*: MentionedVarsOf a)
- ) => MentionedVars (TrendOp vn a) where
- type MentionedVarsOf (TrendOp vn a) = vn :*: MentionedVarsOf a
+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
= VariableShiftPredictAverage !ss !w !(Variable vn)
| VariableShiftPredictSigma !ss !w !(Variable vn)
deriving (Show, Eq, Ord)
-instance (IsExprSet ss, IsExpr w, IsVarName vn)
- => IsExpr (VariableShiftPredictOp ss w vn)
-instance (IsExprSet ss, IsCommonExprSet ss, IsCommonExpr w, IsVarName vn)
- => IsCommonExpr (VariableShiftPredictOp ss w vn)
-instance ( IsVariableSet (vn :*: (MentionedVarsOf ss :++: MentionedVarsOf w))
- ) => MentionedVars (VariableShiftPredictOp ss w vn) where
- type MentionedVarsOf (VariableShiftPredictOp ss w vn)
- = vn :*: (MentionedVarsOf ss :++: MentionedVarsOf w)
+
+type instance IsExpr (VariableShiftPredictOp ss w vn)
+ = IsExprSet ss :&&: IsExpr w :&&: IsVarName 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)
-- FixedShiftPredictOp
data FixedShiftPredictOp sm w vn
| FixedShiftPredictSigma !sm !w !(Variable vn)
deriving (Show, Eq, Ord)
-instance (IsExpr sm, IsExpr w, IsVarName vn)
- => IsExpr (FixedShiftPredictOp sm w vn)
+type instance IsExpr (FixedShiftPredictOp sm w vn)
+ = IsExpr sm :&&: IsExpr w :&&: IsVarName vn
+
+type instance IsCommonExpr (FixedShiftPredictOp sm w vn)
+ = IsCommonExpr sm :&&: IsCommonExpr w :&&: IsVarName vn
-instance (IsCommonExpr sm, IsCommonExpr w, IsVarName vn)
- => IsCommonExpr (FixedShiftPredictOp sm w vn)
+type instance IsIterativeExpr (FixedShiftPredictOp sm w vn)
+ = IsIterativeExpr sm :&&: IsIterativeExpr w :&&: IsVarName vn
-instance ( IsVariableSet (vn :*: (MentionedVarsOf sm :++: MentionedVarsOf w))
- ) => MentionedVars (FixedShiftPredictOp sm w vn) where
- type MentionedVarsOf (FixedShiftPredictOp sm w vn)
- = vn :*: (MentionedVarsOf sm :++: MentionedVarsOf w)
+type instance MentionedVars (FixedShiftPredictOp sm w vn)
+ = vn :*: (MentionedVars sm :++: MentionedVars w)
-- Common special values
data CommonValue
| Now
deriving (Show, Eq, Ord)
-instance IsExpr CommonValue
-
-instance IsCommonExpr CommonValue
-
-instance MentionedVars CommonValue where
- type MentionedVarsOf CommonValue = HNil
+type instance IsExpr CommonValue = True
+type instance IsCommonExpr CommonValue = True
+type instance IsIterativeExpr CommonValue = True
+type instance MentionedVars CommonValue = HNil
-- Iterative special values
data IterativeValue
| TakenLocalTime
deriving (Show, Eq, Ord)
-instance IsExpr IterativeValue
-
-instance IterativeExpr IterativeValue
-
-instance MentionedVars IterativeValue where
- type MentionedVarsOf IterativeValue = HNil
+type instance IsExpr IterativeValue = True
+type instance IsCommonExpr IterativeValue = False
+type instance IsIterativeExpr IterativeValue = True
+type instance MentionedVars IterativeValue = HNil
-- Iterative special values of something
data IterativeValueOf vn
= PreviousOf !(Variable vn)
deriving (Show, Eq, Ord)
-instance IsVarName vn => IsExpr (IterativeValueOf vn)
-
-instance IsVarName vn => IterativeExpr (IterativeValueOf vn)
-
-instance IsVarName vn => MentionedVars (IterativeValueOf vn) where
- type MentionedVarsOf (IterativeValueOf vn) = vn :*: HNil
+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
-- Aggregative operators (fairly restricted due to rrdtool's
-- restriction)
| LSLCorrel !(Variable vn)
deriving (Show, Eq, Ord)
-instance IsVarName vn => IsExpr (AggregativeUnaryOp vn)
-
-instance IsVarName vn => IsAggregativeExpr (AggregativeUnaryOp vn)
-
-instance IsVarName vn => MentionedVars (AggregativeUnaryOp vn) where
- type MentionedVarsOf (AggregativeUnaryOp vn) = vn :*: HNil
+type instance MentionedVars (AggregativeUnaryOp vn) = vn :*: HNil
projects / hs-rrdtool.git / blobdiff