Implement all HList functions in terms of single fold
This commit is contained in:
parent
784e6f2fb2
commit
8e6179f103
@ -42,6 +42,7 @@ module Pre (
|
|||||||
adjacentPairs,
|
adjacentPairs,
|
||||||
sortPair,
|
sortPair,
|
||||||
HListF (..),
|
HListF (..),
|
||||||
|
foldHListF,
|
||||||
mapHListF,
|
mapHListF,
|
||||||
fromHListF,
|
fromHListF,
|
||||||
unHListF,
|
unHListF,
|
||||||
@ -149,20 +150,19 @@ data HListF (f :: Type -> Type) (as :: List Type) :: Type where
|
|||||||
HListF f as ->
|
HListF f as ->
|
||||||
HListF f (a ': as)
|
HListF f (a ': as)
|
||||||
|
|
||||||
|
foldHListF :: (forall x xs. f x -> r xs -> r (x ': xs)) -> r '[] -> HListF f as -> r as
|
||||||
|
foldHListF f e = \case
|
||||||
|
HNilF -> e
|
||||||
|
HConsF x xs -> f x $ foldHListF f e xs
|
||||||
|
|
||||||
mapHListF :: (forall a. f a -> g a) -> HListF f as -> HListF g as
|
mapHListF :: (forall a. f a -> g a) -> HListF f as -> HListF g as
|
||||||
mapHListF t = \case
|
mapHListF t = foldHListF (\x r -> HConsF (t x) $ r) HNilF
|
||||||
HNilF -> HNilF
|
|
||||||
HConsF x xs -> HConsF (t x) $ mapHListF t xs
|
|
||||||
|
|
||||||
fromHListF :: HListF Identity as -> HList as
|
fromHListF :: HListF Identity as -> HList as
|
||||||
fromHListF = \case
|
fromHListF = foldHListF (\(Identity x) r -> HCons x r) HNil
|
||||||
HNilF -> HNil
|
|
||||||
HConsF (Identity x) xs -> HCons x $ fromHListF xs
|
|
||||||
|
|
||||||
unHListF :: HListF (Const b) as -> List b
|
unHListF :: HListF (Const b) as -> List b
|
||||||
unHListF = \case
|
unHListF = getConst . foldHListF (\(Const x) (Const r) -> Const $ x : r) (Const [])
|
||||||
HNilF -> []
|
|
||||||
HConsF (Const x) xs -> x : unHListF xs
|
|
||||||
|
|
||||||
instance Semigroup (TestDefM a b ()) where
|
instance Semigroup (TestDefM a b ()) where
|
||||||
(<>) = (>>)
|
(<>) = (>>)
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user