From: PHO 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