revised HLength

[hs-rrdtool.git] / Database / RRDtool / Expression.hs

diff --git a/Database/RRDtool/Expression.hs b/Database/RRDtool/Expression.hs
index 3a061676198ef76af9761365709456caa0de7eb5..ec5b23adc20b6fab4c1f280edfa02dd828219957 100644 (file)
--- a/Database/RRDtool/Expression.hs
+++ b/Database/RRDtool/Expression.hs
@@ -11,7 +11,7 @@ module Database.RRDtool.Expression
     , IsCommonExprSet
 
     , Constant(..)
-    , IsVarName(..)
+    , IsVarName
     , Variable(..)
     , IsVariableSet
     , CommonUnaryOp(..)
@@ -29,6 +29,7 @@ module Database.RRDtool.Expression
     where
 
 import Data.HList
+import Data.HList.String
 
 
 -- MentionedVars
@@ -50,11 +51,11 @@ class IsExpr e => IsAggregativeExpr e
 
 class (Show es, Eq es, HList es) => IsExprSet es
 instance IsExprSet HNil
-instance (IsExpr e, IsExprSet es) => IsExprSet (e :*: es)
+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 (e :*: es)
+instance (IsCommonExpr e, IsCommonExprSet es) => IsCommonExprSet (HCons e es)
 
 
 -- Constants and variable names
@@ -66,8 +67,13 @@ instance IsCommonExpr Constant
 instance MentionedVars Constant where
     type MentionedVarsOf Constant = HNil
 
-class (Show a, Eq a, Ord a) => IsVarName a where
-    varName :: a -> String
+{- This is what we want to do but GHC can't handle this for now. 
+class ( (HLengthOf a :<=: D255) ~ True
+      , HString a
+      )
+    => IsVarName a
+-}
+class HString a => IsVarName a
 
 data Variable vn
     = Variable !vn
@@ -80,7 +86,7 @@ instance IsVarName vn => MentionedVars (Variable vn) where
 
 class HList vs => IsVariableSet vs
 instance IsVariableSet HNil
-instance (IsVarName v, IsVariableSet vs) => IsVariableSet (v :*: vs)
+instance (IsVarName v, IsVariableSet vs) => IsVariableSet (HCons v vs)
 
 -- Common operators
 data CommonUnaryOp a
@@ -173,7 +179,9 @@ data TrendOp vn a
     deriving (Show, Eq, Ord)
 instance (IsVarName vn, IsExpr a) => IsExpr (TrendOp vn a)
 instance (IsVarName vn, IsCommonExpr a) => IsCommonExpr (TrendOp vn a)
-instance (IsVarName vn, MentionedVars a) => MentionedVars (TrendOp vn a) where
+
+instance ( IsVariableSet (vn :*: MentionedVarsOf a)
+         ) => MentionedVars (TrendOp vn a) where
     type MentionedVarsOf (TrendOp vn a) = vn :*: MentionedVarsOf a
 
 data VariableShiftPredictOp ss w vn
@@ -184,8 +192,7 @@ 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 ( IsVarName vn
-         , IsVariableSet (MentionedVarsOf ss :++: MentionedVarsOf w)
+instance ( IsVariableSet (vn :*: (MentionedVarsOf ss :++: MentionedVarsOf w))
          ) => MentionedVars (VariableShiftPredictOp ss w vn) where
     type MentionedVarsOf (VariableShiftPredictOp ss w vn)
         = vn :*: (MentionedVarsOf ss :++: MentionedVarsOf w)
@@ -202,8 +209,7 @@ instance (IsExpr sm, IsExpr w, IsVarName vn)
 instance (IsCommonExpr sm, IsCommonExpr w, IsVarName vn)
     => IsCommonExpr (FixedShiftPredictOp sm w vn)
 
-instance ( IsVarName vn
-         , IsVariableSet (MentionedVarsOf sm :++: MentionedVarsOf w)
+instance ( IsVariableSet (vn :*: (MentionedVarsOf sm :++: MentionedVarsOf w))
          ) => MentionedVars (FixedShiftPredictOp sm w vn) where
     type MentionedVarsOf (FixedShiftPredictOp sm w vn)
         = vn :*: (MentionedVarsOf sm :++: MentionedVarsOf w)