1
1
mirror of https://github.com/coot/free-category.git synced 2024-08-16 09:30:46 +03:00

Added foldrL, foldrL and zipWithL

This matches the api of Queue.
This commit is contained in:
Marcin Szamotulski 2019-10-06 23:16:40 +01:00
parent ddd4701811
commit ce0510c372
3 changed files with 45 additions and 0 deletions

View File

@ -26,3 +26,5 @@
- `liftCat` to `liftEffect`
- `foldNatLift` to `foldNatEffCat`
- Show instance of 'Cat' and 'C' via 'ListTr' (GHC >= 806)
- Export ListTr from Control.Category.Free
- foldrL, foldlL and zipWithL

View File

@ -35,11 +35,15 @@ module Control.Category.Free
, foldNatQ
, foldrQ
, foldlQ
, zipWithQ
-- * Type alligned list
, ListTr (..)
, liftL
, foldNatL
, foldlL
, foldrL
, zipWithL
-- * Free Category based on Queue
, Cat (Id)

View File

@ -33,6 +33,9 @@ module Control.Category.Free.Internal
, liftL
, foldNatL
, lengthListTr
, foldrL
, foldlL
, zipWithL
, Queue (NilQ, ConsQ)
, liftQ
, nilQ
@ -165,6 +168,42 @@ foldNatL fun (ConsTr bc ab) = fun bc . foldNatFree2 fun ab
#-}
-- | 'foldr' of a 'ListTr'
--
foldrL :: forall (f :: k -> k -> *) c a b d.
(forall x y z. f y z -> c x y -> c x z)
-> c a b
-> ListTr f b d
-> c a d
foldrL _nat ab NilTr = ab
foldrL nat ab (ConsTr xd bx) = nat xd (foldrL nat ab bx)
{-# INLINE [1] foldrL #-}
-- | 'foldl' of a 'ListTr'
--
-- TODO: make it strict, like 'foldl''.
--
foldlL :: forall (f :: k -> k -> *) c a b d.
(forall x y z. c y z -> f x y -> c x z)
-> c b d
-> ListTr f a b
-> c a d
foldlL _nat bd NilTr = bd
foldlL nat bd (ConsTr xb ax) = foldlL nat (nat bd xb) ax
zipWithL :: forall f g a b a' b'.
Category f
=> (forall x y x' y'. f x y -> f x' y' -> f (g x x') (g y y'))
-> ListTr f a b
-> ListTr f a' b'
-> ListTr f (g a a') (g b b')
zipWithL fn queueA queueB = case (queueA, queueB) of
(NilTr, NilTr) -> NilTr
(NilTr, ConsTr trB' queueB') -> ConsTr (id `fn` trB') (zipWithL fn NilTr queueB')
(ConsTr trA' queueA', NilTr) -> ConsTr (trA' `fn` id) (zipWithL fn queueA' NilTr)
(ConsTr trA' queueA', ConsTr trB' queueB')
-> ConsTr (trA' `fn` trB') (zipWithL fn queueA' queueB')
#if __GLASGOW_HASKELL__ >= 806
instance (forall (x :: k) (y :: k). Show (f x y)) => Show (ListTr f a b) where
show NilTr = "NilTr"