X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hs-rrdtool.git;a=blobdiff_plain;f=Data%2FHList.hs;fp=Data%2FHList.hs;h=56f961d832640e2f68822984d2f5d783b5a7a0e6;hp=05dd901214532b337bca9155508373b9dd09eb2a;hb=b7e8a37aa24e9bda11995613c45187e6e19e0c01;hpb=5cab7a6846cf5ad61df14def9c0e023840bb756b diff --git a/Data/HList.hs b/Data/HList.hs index 05dd901..56f961d 100644 --- 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