mirror of
https://github.com/coot/free-category.git
synced 2024-09-11 14:17:30 +03:00
Added foldrL, foldrL and zipWithL
This matches the api of Queue.
This commit is contained in:
parent
ddd4701811
commit
ce0510c372
@ -26,3 +26,5 @@
|
|||||||
- `liftCat` to `liftEffect`
|
- `liftCat` to `liftEffect`
|
||||||
- `foldNatLift` to `foldNatEffCat`
|
- `foldNatLift` to `foldNatEffCat`
|
||||||
- Show instance of 'Cat' and 'C' via 'ListTr' (GHC >= 806)
|
- Show instance of 'Cat' and 'C' via 'ListTr' (GHC >= 806)
|
||||||
|
- Export ListTr from Control.Category.Free
|
||||||
|
- foldrL, foldlL and zipWithL
|
||||||
|
@ -35,11 +35,15 @@ module Control.Category.Free
|
|||||||
, foldNatQ
|
, foldNatQ
|
||||||
, foldrQ
|
, foldrQ
|
||||||
, foldlQ
|
, foldlQ
|
||||||
|
, zipWithQ
|
||||||
|
|
||||||
-- * Type alligned list
|
-- * Type alligned list
|
||||||
, ListTr (..)
|
, ListTr (..)
|
||||||
, liftL
|
, liftL
|
||||||
, foldNatL
|
, foldNatL
|
||||||
|
, foldlL
|
||||||
|
, foldrL
|
||||||
|
, zipWithL
|
||||||
|
|
||||||
-- * Free Category based on Queue
|
-- * Free Category based on Queue
|
||||||
, Cat (Id)
|
, Cat (Id)
|
||||||
|
@ -33,6 +33,9 @@ module Control.Category.Free.Internal
|
|||||||
, liftL
|
, liftL
|
||||||
, foldNatL
|
, foldNatL
|
||||||
, lengthListTr
|
, lengthListTr
|
||||||
|
, foldrL
|
||||||
|
, foldlL
|
||||||
|
, zipWithL
|
||||||
, Queue (NilQ, ConsQ)
|
, Queue (NilQ, ConsQ)
|
||||||
, liftQ
|
, liftQ
|
||||||
, nilQ
|
, 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
|
#if __GLASGOW_HASKELL__ >= 806
|
||||||
instance (forall (x :: k) (y :: k). Show (f x y)) => Show (ListTr f a b) where
|
instance (forall (x :: k) (y :: k). Show (f x y)) => Show (ListTr f a b) where
|
||||||
show NilTr = "NilTr"
|
show NilTr = "NilTr"
|
||||||
|
Loading…
Reference in New Issue
Block a user