major rewrite

[hs-rrdtool.git] / Data / HList / Prelude.hs

diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs
index d9ee19a89211b532ff20f01e6a0409e7e8eef94a..bbcc50c60194078a17e10f6af8c150f6315825d3 100644 (file)
--- a/Data/HList/Prelude.hs
+++ b/Data/HList/Prelude.hs
@@ -15,20 +15,20 @@ module Data.HList.Prelude
     , HCons(..)
     , hCons
 
-    , HExtendable(..)
-    , HAppendable(..)
+    , HExtendT(..)
+    , HAppendT(..)
 
-    , Applyable(..)
-    , Applyable2(..)
+    , ApplyT(..)
+    , Apply2T(..)
 
     , Id(..)
-    , ApplyHAppend(..)
+    , HAppendA(..)
 
-    , HFoldrable(..)
-    , HConcatable(..)
-    , HMappable(..)
-    , HAllable(..)
+    , HFoldrT(..)
+    , HConcatT(..)
+    , HMapT(..)
 
+    , HAll
     , HLength
     )
     where
@@ -61,123 +61,110 @@ instance HList l => HList (HCons e l)
 hCons :: HList l => e -> l -> HCons e l
 hCons = HCons
 
--- HExtendable
+-- HExtendT
 infixr 2 :*:
 infixr 2 .*.
 
-class HExtendable e l where
+class HExtendT e l where
     type e :*: l
     (.*.) :: e -> l -> e :*: l
 
-instance HExtendable e HNil where
+instance HExtendT e HNil where
     type e :*: HNil = HCons e HNil
     e .*. nil = hCons e nil
 
-instance HList l => HExtendable e (HCons e' l) where
+instance HList l => HExtendT 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
+-- HAppendT
 infixr 1 :++:
 infixr 1 .++.
 
-class HAppendable l l' where
+class HAppendT l l' where
     type l :++: l'
     (.++.) :: l -> l' -> l :++: l'
 
-instance HList l => HAppendable HNil l where
+instance HList l => HAppendT HNil l where
     type HNil :++: l = l
     _ .++. l = l
 
 instance ( HList (l :++: l')
-         , HAppendable l l'
-         ) => HAppendable (HCons e l) l' where
+         , HAppendT l l'
+         ) => HAppendT (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
+-- ApplyT
+class ApplyT f a where
     type Apply f a
     apply :: f -> a -> Apply f a
+    apply _ _ = undefined
 
--- Applyable2
-class Applyable2 f a b where
+-- Apply2T
+class Apply2T f a b where
     type Apply2 f a b
     apply2 :: f -> a -> b -> Apply2 f a b
+    apply2 _ _ _ = undefined
 
 -- Id
 data Id = Id
 
-instance Applyable Id a where
+instance ApplyT Id a where
     type Apply Id a = a
     apply _ a = a
 
--- ApplyHAppend
-data ApplyHAppend = ApplyHAppend
+-- HAppendA
+data HAppendA = HAppendA
 
-instance HAppendable a b => Applyable2 ApplyHAppend a b where
-    type Apply2 ApplyHAppend a b = a :++: b
+instance HAppendT a b => Apply2T HAppendA a b where
+    type Apply2 HAppendA a b = a :++: b
     apply2 _ a b = a .++. b
 
--- HFoldrable
-class HFoldrable f v l where
+-- HFoldrT
+class HFoldrT f v l where
     type HFoldr f v l
     hFoldr :: f -> v -> l -> HFoldr f v l
 
-instance HFoldrable f v HNil where
+instance HFoldrT f v HNil where
     type HFoldr f v HNil = v
     hFoldr _ v _ = v
 
-instance ( HFoldrable f v l
-         , Applyable2 f e (HFoldr f v l)
-         ) => HFoldrable f v (HCons e l) where
+instance ( HFoldrT f v l
+         , Apply2T f e (HFoldr f v l)
+         ) => HFoldrT 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
+-- HConcatT
+class HConcatT ls where
     type HConcat ls
     hConcat :: ls -> HConcat ls
 
-instance HFoldrable ApplyHAppend HNil ls => HConcatable ls where
-    type HConcat ls = HFoldr ApplyHAppend HNil ls
-    hConcat ls = hFoldr ApplyHAppend hNil ls
+instance HFoldrT HAppendA HNil ls => HConcatT ls where
+    type HConcat ls = HFoldr HAppendA HNil ls
+    hConcat ls = hFoldr HAppendA hNil ls
 
--- HMappable
-class HMappable f l where
+-- HMapT
+class HMapT f l where
     type HMap f l
     hMap :: f -> l -> HMap f l
 
-instance HMappable f HNil where
+instance HMapT f HNil where
     type HMap f HNil = HNil
     hMap _ _ = hNil
 
-instance ( Applyable f x
-         , HMappable f xs
+instance ( ApplyT f x
+         , HMapT f xs
          , HList (HMap f xs)
-         ) => HMappable f (HCons x xs) where
+         ) => HMapT 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)
 
--- HAllable
-class HAllable f l where
-    type HAll f l
-    hAll :: f -> l -> HAll f l
-
-instance HAllable f HNil where
-    type HAll f HNil = True
-    hAll _ _ = undefined :: True
-
-instance ( IfT (Apply f x) (HAll f xs) False
-         , Applyable f x
-         , HAllable f xs
-         ) => HAllable f (HCons x xs) where
-    type HAll f (HCons x xs) = If (Apply f x)
-                                 (HAll f xs)
-                                 False
-    hAll f (HCons x xs) = ifT (apply f x)
-                                 (hAll f xs)
-                                 (undefined :: False)
+-- HAll
+type family HAll f l
+type instance HAll f HNil         = True
+type instance HAll f (HCons x xs) = If (Apply f x) (HAll f xs) False
 
 -- HLength
 type family HLength l