From: PHO <pho@cielonegro.org>
Date: Fri, 23 Apr 2010 13:30:48 +0000 (+0900)
Subject: added missing type instances
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=16e0b5c01dc848105b3673a72ee6e04f8baae9d9;p=hs-rrdtool.git

added missing type instances
---

diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs
index bbcc50c..e8d84ad 100644
--- a/Data/HList/Prelude.hs
+++ b/Data/HList/Prelude.hs
@@ -1,10 +1,11 @@
-{-# LANGUAGE DeriveDataTypeable,
-             FlexibleContexts,
-             FlexibleInstances,
-             MultiParamTypeClasses,
-             TypeFamilies,
-             TypeOperators,
-             UndecidableInstances
+{-# LANGUAGE
+  DeriveDataTypeable,
+  FlexibleContexts,
+  FlexibleInstances,
+  MultiParamTypeClasses,
+  TypeFamilies,
+  TypeOperators,
+  UndecidableInstances
   #-}
 module Data.HList.Prelude
     ( HList
diff --git a/Database/RRDtool/Create.hs b/Database/RRDtool/Create.hs
index 5438e04..a6a67fc 100644
--- a/Database/RRDtool/Create.hs
+++ b/Database/RRDtool/Create.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+  TypeFamilies,
+  UndecidableInstances
+  #-}
 module Database.RRDtool.Create
     ( DataSource
     , ExternalDSType(..)
@@ -159,8 +163,8 @@ instance (IsCommonExpr e ~ True) =>
 
 dsTest = ComputedDataSource {
            cdsName = "foo"
---       , dsExpr = Previous :<: Const 100
---       , dsExpr = Var "foo" :<: Const 100
+--         , cdsExpr = Previous :<: Const 100
+--         , cdsExpr = Var "foo" :<: Const 100
          , cdsExpr = AverageOf (Const 100 .*. Const 200 .*. HNil)
          }
 
diff --git a/Database/RRDtool/Expression.hs b/Database/RRDtool/Expression.hs
index aed9539..f2d2574 100644
--- a/Database/RRDtool/Expression.hs
+++ b/Database/RRDtool/Expression.hs
@@ -1,3 +1,10 @@
+{-# LANGUAGE
+  EmptyDataDecls,
+  FlexibleInstances,
+  TypeFamilies,
+  MultiParamTypeClasses,
+  UndecidableInstances
+  #-}
 module Database.RRDtool.Expression
     ( MentionedVars
     , MentionedVarsA(..)
@@ -5,16 +12,11 @@ module Database.RRDtool.Expression
     , IsExpr
     , IsCommonExpr
     , IsIterativeExpr
-    , IsAggregativeExpr
-
-    , IsExprSet
-    , IsCommonExprSet
 
     , IsVarName
 
     , Constant(..)
     , Variable(..)
-    , IsVariableSet
     , CommonUnaryOp(..)
     , CommonBinaryOp(..)
     , CommonTrinaryOp(..)
@@ -49,7 +51,6 @@ instance ApplyT MentionedVarsA a where
 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
@@ -59,14 +60,19 @@ 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)
 
-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 = HNil
 
 {- This is what we want to do but GHC can't handle this for now. 
 class ( (HLengthOf str :<=: D255) ~ True
@@ -99,9 +105,10 @@ data Variable vn
     = Variable !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 :*: HNil
 
 type family   IsVariableSet vs
 type instance IsVariableSet HNil         = True
@@ -124,9 +131,10 @@ 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
@@ -152,6 +160,9 @@ type instance IsExpr (CommonBinaryOp 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
         
@@ -167,6 +178,11 @@ type instance IsExpr (CommonTrinaryOp a b c)
 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
 
@@ -177,9 +193,10 @@ data CommonSetOp es
     = 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) = HConcat (HMap MentionedVarsA es)
 
 -- TrendOp
 data TrendOp vn e
@@ -187,9 +204,10 @@ 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
@@ -203,6 +221,9 @@ type instance IsExpr (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)
 
@@ -218,6 +239,9 @@ type instance IsExpr (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)
 
@@ -229,9 +253,10 @@ 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 = HNil
 
 -- Iterative special values
 data IterativeValue
@@ -241,9 +266,10 @@ 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 = HNil
 
 -- Iterative special values of something
 data IterativeValueOf vn
@@ -251,6 +277,7 @@ 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
 
@@ -271,5 +298,4 @@ data AggregativeUnaryOp vn
     | 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 :*: HNil