Implement all HList functions in terms of single fold

This commit is contained in:
George Thomas 2026-01-04 02:39:33 +00:00
parent 784e6f2fb2
commit 8e6179f103

View File

@ -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
(<>) = (>>) (<>) = (>>)