+module Data.HList.Prelude
+ ( HList
+ , HNil(..)
+ , hNil
+ , (:*:)(..)
+ , (.*.)
+
+ , HExtendable(..)
+ , HAppendable(..)
+
+ , Applyable(..)
+ , Applyable2(..)
+
+ , Id(..)
+ , ApplyHAppend(..)
+
+ , HFoldrable(..)
+ , HConcatable(..)
+ , HMappable(..)
+ )
+ 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