X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hs-rrdtool.git;a=blobdiff_plain;f=Data%2FHList%2FPrelude.hs;h=bbcc50c60194078a17e10f6af8c150f6315825d3;hp=d9ee19a89211b532ff20f01e6a0409e7e8eef94a;hb=d07e35733d4f0994a12202164c9065aef1fe98f4;hpb=58a14778ab5fc1fe86403595bd5a499f17292a3c diff --git a/Data/HList/Prelude.hs b/Data/HList/Prelude.hs index d9ee19a..bbcc50c 100644 --- 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