module splitting

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

diff --git a/Data/HList.hs b/Data/HList.hs
index 05dd901214532b337bca9155508373b9dd09eb2a..56f961d832640e2f68822984d2f5d783b5a7a0e6 100644 (file)
--- a/Data/HList.hs
+++ b/Data/HList.hs
@@ -1,144 +1,19 @@
 module Data.HList
-    ( HList
+    ( -- Data.HList.Prelude
+      HList
     , HNil(..)
     , hNil
     , (:*:)(..)
     , (.*.)
 
-    , HExtendable(..)
-    , HAppendable(..)
+    , (:++:)
+    , (.++.)
 
     , Applyable(..)
-    , Applyable2(..)
 
-    , Id(..)
-    , ApplyHAppend(..)
-
-    , HFoldrable(..)
-    , HConcatable(..)
-    , HMappable(..)
+    , HConcat
+    , HMap
     )
     where
 
-import Data.Typeable
-
--- HList
-class HList l
-
--- HNil
-data HNil
-    = HNil
-      deriving (Show, Eq, Ord, Read, Typeable)
-
-instance HList HNil
-
-hNil :: HNil
-hNil = HNil
-
--- :*:
-infixr 2 :*:
-infixr 2 .*.
-
-data e :*: l
-    = e :*: l
-      deriving (Show, Eq, Ord, Read, Typeable)
-
-instance HList l => HList (e :*: l)
-
-(.*.) :: HList l => e -> l -> e :*: l
-(.*.) = (:*:)
-
--- HExtendable
-class HExtendable e l where
-    type HExtend e l
-    hExtend :: e -> l -> HExtend e l
-
-instance HExtendable e HNil where
-    type HExtend e HNil = e :*: HNil
-    hExtend e nil = 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
-
--- HAppendable
-infixr 1 :++:
-infixr 1 .++.
-
-class HAppendable l l' where
-    type l :++: l'
-    (.++.) :: l -> l' -> l :++: l'
-
-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')
-
--- Applyable
-class Applyable f a where
-    type Apply f a
-    apply :: f -> a -> Apply f a
-
--- Applyable2
-class Applyable2 f a b where
-    type Apply2 f a b
-    apply2 :: f -> a -> b -> Apply2 f a b
-
--- Id
-data Id = Id
-
-instance Applyable Id a where
-    type Apply Id a = a
-    apply _ a = a
-
--- ApplyHAppend
-data ApplyHAppend = ApplyHAppend
-
-instance HAppendable a b => Applyable2 ApplyHAppend a b where
-    type Apply2 ApplyHAppend a b = a :++: b
-    apply2 _ a b = a .++. b
-
--- HFoldrable
-class HFoldrable f v l where
-    type HFoldr f v l
-    hFoldr :: f -> v -> l -> HFoldr f v l
-
-instance HFoldrable 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 (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)
-
--- HConcatable
-class HConcatable 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
-
--- HMappable
-class HMappable f l where
-    type HMap f l
-    hMap :: f -> l -> HMap f l
-
-instance HMappable f HNil where
-    type HMap f HNil = HNil
-    hMap _ _ = HNil
-
-instance ( HList (HMap f xs)
-         , 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
+import Data.HList.Prelude