( HList
, HNil(..)
, hNil
- , HCons(..)
- , hCons
+ , (:*:)(..)
+ , (.*.)
, HExtendable(..)
, HAppendable(..)
- , (:*:)
- , (.*.)
+ , Applyable(..)
+ , Applyable2(..)
+
+ , Id(..)
+ , ApplyHAppend(..)
+
+ , HFoldrable(..)
+ , HConcatable(..)
+ , HMappable(..)
)
where
hNil :: HNil
hNil = HNil
--- HCons
-data HCons e l
- = HCons e l
+-- :*:
+infixr 2 :*:
+infixr 2 .*.
+
+data e :*: l
+ = e :*: l
deriving (Show, Eq, Ord, Read, Typeable)
-instance HList l => HList (HCons e l)
+instance HList l => HList (e :*: l)
-hCons :: HList l => e -> l -> HCons e l
-hCons = HCons
+(.*.) :: HList l => e -> l -> e :*: l
+(.*.) = (:*:)
-- HExtendable
class HExtendable e l where
hExtend :: e -> l -> HExtend e l
instance HExtendable e HNil where
- type HExtend e HNil = HCons e HNil
- hExtend e nil = hCons e nil
+ type HExtend e HNil = e :*: HNil
+ hExtend e nil = e .*. nil
-instance HList l => HExtendable e (HCons e' l) where
- type HExtend e (HCons e' l) = HCons e (HCons e' l)
- hExtend e (HCons e' l) = hCons e (hCons e' l)
+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 HAppend l l'
- hAppend :: l -> l' -> HAppend l l'
+ type l :++: l'
+ (.++.) :: l -> l' -> l :++: l'
instance HList l => HAppendable HNil l where
- type HAppend HNil l = l
- hAppend _ l = l
-
-instance (HAppendable l l',
- HList (HAppend l l')) => HAppendable (HCons e l) l' where
- type HAppend (HCons e l) l' = HCons e (HAppend l l')
- hAppend (HCons e l) l' = hCons e (hAppend l l')
-
--- :*:
-infixr 2 :*:
-infixr 2 .*.
-
-type e :*: l = HCons e l
-
-(.*.) :: HExtendable e l => e -> l -> HExtend e l
-e .*. l = hExtend e l
+ 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