X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hs-rrdtool.git;a=blobdiff_plain;f=Database%2FRRDtool%2FExpression.hs;h=aed95394d557117c5289dded3a221364d7b413f5;hp=499a580753c6a17e4d049a36e9ebbc3828ab93f0;hb=d07e35733d4f0994a12202164c9065aef1fe98f4;hpb=58a14778ab5fc1fe86403595bd5a499f17292a3c

diff --git a/Database/RRDtool/Expression.hs b/Database/RRDtool/Expression.hs
index 499a580..aed9539 100644
--- a/Database/RRDtool/Expression.hs
+++ b/Database/RRDtool/Expression.hs
@@ -1,18 +1,16 @@
 module Database.RRDtool.Expression
-    ( MentionedVars(..)
-    , ApplyMentionedVarsOf(..)
+    ( MentionedVars
+    , MentionedVarsA(..)
 
     , IsExpr
     , IsCommonExpr
-    , IterativeExpr
+    , IsIterativeExpr
     , IsAggregativeExpr
 
     , IsExprSet
     , IsCommonExprSet
 
     , IsVarName
-    , IsShortEnoughForVarName
-    , IsGoodLetterForVarName
 
     , Constant(..)
     , Variable(..)
@@ -32,46 +30,43 @@ module Database.RRDtool.Expression
     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
+type family IsAggregativeExpr e
 
-class (Show es, Eq es, HList es) => IsExprSet es
-instance IsExprSet HNil
-instance (IsExpr e, IsExprSet es) => IsExprSet (HCons e es)
-
-class (Show es, Eq es, HList es) => IsCommonExprSet es
-instance IsCommonExprSet HNil
-instance (IsCommonExpr e, IsCommonExprSet es) => IsCommonExprSet (HCons e es)
+type family   IsExprSet es
+type instance IsExprSet HNil         = True
+type instance IsExprSet (HCons 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
 
 -- 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
+
+type instance IsExpr        Constant = True
+type instance IsCommonExpr  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 :<=: D255) ~ True
@@ -79,44 +74,38 @@ class ( (HLengthOf str :<=: D255) ~ True
       )
     => IsVarName str
 -}
-class ( IsShortEnoughForVarName str
-      , HString str
-      )
-    => IsVarName str
-
-class HString str => IsShortEnoughForVarName str
-instance ( HString str
-         , (HLength str :<=: D255) ~ True
-         )
-    => IsShortEnoughForVarName str
-
-class IntegerT c => GoodLetterForVarName c where
-    type IsGoodLetterForVarName c
-
-instance IntegerT c => GoodLetterForVarName c where
-    type IsGoodLetterForVarName c = ( (c :>=: D65) :&&: (c :<=:  D90) ) -- A-Z
-                                    :||:
-                                    ( (c :>=: D99) :&&: (c :<=: D122) ) -- a-z
-                                    :||:
-                                    ( c :==: D45 ) -- '-'
-                                    :||:
-                                    ( c :==: D95 ) -- '_'
-
---instance (a :>=: D65) ~ True => IsGoodLetterForVarName a
+type family   IsVarName str
+type instance IsVarName str = ( (HLength str :<=: D255)
+                                :&&:
+                                (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 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
@@ -134,10 +123,10 @@ 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) = IsExpr a
+type instance MentionedVars (CommonUnaryOp a) = MentionedVars a
 
 data CommonBinaryOp a b
     = !a :<:  !b
@@ -157,16 +146,14 @@ data CommonBinaryOp 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
 
-instance (IsCommonExpr a, IsCommonExpr b) =>
-    IsCommonExpr (CommonBinaryOp a b)
+type instance IsCommonExpr (CommonBinaryOp a b)
+    = IsCommonExpr a :&&: IsCommonExpr 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
@@ -174,58 +161,50 @@ 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 MentionedVars (CommonTrinaryOp a b c)
+    = MentionedVars a :++: MentionedVars b :++: MentionedVars c
 
--- SORT and REV can't be expressed in this way as they pushes possibly
+-- 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 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 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 MentionedVars (VariableShiftPredictOp ss w vn)
+    = vn :*: (MentionedVars ss :++: MentionedVars w)
 
 -- FixedShiftPredictOp
 data FixedShiftPredictOp sm w vn
@@ -233,16 +212,14 @@ 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
 
-instance (IsCommonExpr sm, IsCommonExpr w, IsVarName vn)
-    => IsCommonExpr (FixedShiftPredictOp sm w vn)
+type instance IsCommonExpr (FixedShiftPredictOp sm w vn)
+    = IsCommonExpr sm :&&: IsCommonExpr 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
@@ -252,12 +229,9 @@ 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 MentionedVars CommonValue = HNil
 
 -- Iterative special values
 data IterativeValue
@@ -267,24 +241,18 @@ 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 = 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 IsIterativeExpr (IterativeValueOf vn) = IsVarName vn
+type instance MentionedVars   (IterativeValueOf vn) = vn :*: HNil
 
 -- Aggregative operators (fairly restricted due to rrdtool's
 -- restriction)
@@ -303,9 +271,5 @@ data AggregativeUnaryOp vn
     | 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 IsAggregativeExpr (AggregativeUnaryOp vn) = IsVarName vn
+type instance MentionedVars     (AggregativeUnaryOp vn) = vn :*: HNil