From 135df1a5d8a159db412614bcfc25634bee201f94 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Fri, 23 Apr 2010 12:29:48 +0900
Subject: [PATCH] cleanup

---
 Data/HList.hs                  |  7 +++-
 Data/HList/Prelude.hs          | 66 +++++++++++++++++-----------------
 Data/HList/String.hs           |  2 ++
 Database/RRDtool/Expression.hs | 16 ++++-----
 4 files changed, 50 insertions(+), 41 deletions(-)

diff --git a/Data/HList.hs b/Data/HList.hs
index 56f961d..e1e7769 100644
--- a/Data/HList.hs
+++ b/Data/HList.hs
@@ -1,9 +1,14 @@
 module Data.HList
     ( -- Data.HList.Prelude
       HList
+
     , HNil(..)
     , hNil
-    , (:*:)(..)
+
+    , HCons(..)
+    , hCons
+
+    , (:*:)
     , (.*.)
 
     , (:++:)
diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs
index b3e6b95..b3a88fd 100644
--- a/Data/HList/Prelude.hs
+++ b/Data/HList/Prelude.hs
@@ -1,9 +1,11 @@
 module Data.HList.Prelude
     ( HList
+
     , HNil(..)
     , hNil
-    , (:*:)(..)
-    , (.*.)
+
+    , HCons(..)
+    , hCons
 
     , HExtendable(..)
     , HAppendable(..)
@@ -36,31 +38,31 @@ instance HList HNil
 hNil :: HNil
 hNil = HNil
 
--- :*:
-infixr 2 :*:
-infixr 2 .*.
-
-data e :*: l
-    = e :*: l
+-- HCons
+data HCons e l
+    = HCons e l
       deriving (Show, Eq, Ord, Read, Typeable)
 
-instance HList l => HList (e :*: l)
+instance HList l => HList (HCons e l)
 
-(.*.) :: HList l => e -> l -> e :*: l
-(.*.) = (:*:)
+hCons :: HList l => e -> l -> HCons e l
+hCons = HCons
 
 -- HExtendable
+infixr 2 :*:
+infixr 2 .*.
+
 class HExtendable e l where
-    type HExtend e l
-    hExtend :: e -> l -> HExtend e l
+    type e :*: l
+    (.*.) :: e -> l -> e :*: l
 
 instance HExtendable e HNil where
-    type HExtend e HNil = e :*: HNil
-    hExtend e nil = e .*. nil
+    type e :*: HNil = HCons e HNil
+    e .*. nil = hCons e nil
 
-instance HList l => HExtendable e (e' :*: l) where
-    type HExtend e (e' :*: l) = e :*: e' :*: l
-    hExtend e (e' :*: l) = e .*. e' .*. l
+instance HList l => HExtendable e (HCons e' l) where
+    type e :*: HCons e' l = HCons e (HCons e' l)
+    e .*. HCons e' l = hCons e (hCons e' l)
 
 -- HAppendable
 infixr 1 :++:
@@ -74,11 +76,11 @@ instance HList l => HAppendable HNil l where
     type HNil :++: l = l
     _ .++. l = l
 
-instance ( HAppendable l l'
-         , HList (l :++: l')
-         ) => HAppendable (e :*: l) l' where
-    type (e :*: l) :++: l' = e :*: (l :++: l')
-    (e :*: l) .++. l' = e .*. (l .++. l')
+instance ( HList (l :++: l')
+         , HAppendable l l'
+         ) => HAppendable (HCons e l) l' where
+    type HCons e l :++: l' = HCons e (l :++: l')
+    (HCons e l) .++. l' = hCons e (l .++. l')
 
 -- Applyable
 class Applyable f a where
@@ -115,9 +117,9 @@ instance HFoldrable f v HNil where
 
 instance ( HFoldrable f v l
          , Applyable2 f e (HFoldr f v l)
-         ) => HFoldrable f v (e :*: l) where
-    type HFoldr f v (e :*: l) = Apply2 f e (HFoldr f v l)
-    hFoldr f v (e :*: l) = apply2 f e (hFoldr f v l)
+         ) => HFoldrable f v (HCons e l) where
+    type HFoldr f v (HCons e l) = Apply2 f e (HFoldr f v l)
+    hFoldr f v (HCons e l) = apply2 f e (hFoldr f v l)
 
 -- HConcatable
 class HConcatable ls where
@@ -135,11 +137,11 @@ class HMappable f l where
 
 instance HMappable f HNil where
     type HMap f HNil = HNil
-    hMap _ _ = HNil
+    hMap _ _ = hNil
 
-instance ( HList (HMap f xs)
-         , Applyable f x
+instance ( Applyable f x
          , HMappable f xs
-         ) => HMappable f (x :*: xs) where
-    type HMap f (x :*: xs) = Apply f x :*: HMap f xs
-    hMap f (x :*: xs) = apply f x .*. hMap f xs
+         , HList (HMap f xs)
+         ) => HMappable f (HCons x xs) where
+    type HMap f (HCons x xs) = HCons (Apply f x) (HMap f xs)
+    hMap f (HCons x xs) = hCons (apply f x) (hMap f xs)
diff --git a/Data/HList/String.hs b/Data/HList/String.hs
index ecb93ed..a51457e 100644
--- a/Data/HList/String.hs
+++ b/Data/HList/String.hs
@@ -2,3 +2,5 @@ module Data.HList.String
     (
     )
     where
+
+--import Data.HList.Prelude
diff --git a/Database/RRDtool/Expression.hs b/Database/RRDtool/Expression.hs
index 3a06167..669acbc 100644
--- a/Database/RRDtool/Expression.hs
+++ b/Database/RRDtool/Expression.hs
@@ -50,11 +50,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
@@ -80,7 +80,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 +173,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 +186,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 +203,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)
-- 
2.40.0