coot/free-category
1
1
Fork 0
mirror of https://github.com/coot/free-category.git synced 2024-11-23 09:55:43 +03:00
Code Issues Projects Releases Wiki Activity

arrCat and mapCat

Browse Source 
Renamed arrow to arrCat, since 'arrCat' is very like 'arr' for 'Arrows'.
'mapCat' is a smart constructor.
This commit is contained in:
Marcin Szamotulski 2019-08-31 10:59:16 +02:00
parent ed310d4af7
commit fd9dba5509
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Control/Category/Free.hs
View File

@ -22,7 +22,8 @@
module Control.Category.Free module Control.Category.Free
( -- * Free category ( -- * Free category
Cat (Id) Cat (Id)
, arrow , arrCat
, mapCat
, foldCat , foldCat
-- * Free category (CPS style) -- * Free category (CPS style)
, C (..) , C (..)
@ -78,12 +79,20 @@ data Cat (f :: k -> k -> *) a b where
-> Cat f a c -> Cat f a c
-- | Smart constructor for embeding spanning transitions into 'Cat', the same -- | Smart constructor for embeding spanning transitions into 'Cat', the same
-- as @'liftFree2' \@'Cat'@. -- as @'liftFree2' \@'Cat'@. It is like 'arr' for 'Arrows'.
-- --
arrow :: forall (f :: k -> k -> *) a b. arrCat :: forall (f :: k -> k -> *) a b.
f a b f a b
-> Cat f a b -> Cat f a b
arrow fab = Cat fab emptyQ arrCat fab = Cat fab emptyQ
-- | Smart constructor 'mapCat' for morphisms of @'Cat' f@ category.
--
mapCat :: forall (f :: k -> k -> *) a b c.
f b c
-> Cat f a b
-> Cat f a c
mapCat fbc cab = arrCat fbc . cab
-- | Right fold of 'Cat' into a category, the same as @'foldNatFree2' \@'Cat'@. -- | Right fold of 'Cat' into a category, the same as @'foldNatFree2' \@'Cat'@.
-- --
@ -118,7 +127,7 @@ type instance AlgebraType Cat c = Category c
-- transitions embeded in 'Cat'. -- transitions embeded in 'Cat'.
-- --
instance FreeAlgebra2 Cat where instance FreeAlgebra2 Cat where
liftFree2 = arrow liftFree2 = arrCat
{-# INLINE liftFree2 #-} {-# INLINE liftFree2 #-}
foldNatFree2 = foldCat foldNatFree2 = foldCat
@ -128,14 +137,14 @@ instance FreeAlgebra2 Cat where
forget2 = proof forget2 = proof
instance Arrow f => Arrow (Cat f) where instance Arrow f => Arrow (Cat f) where
arr = arrow . arr arr = arrCat . arr
Cat tr queue *** Cat tr' queue' = Cat (tr *** tr') (zipWithQ (***) queue queue') Cat tr queue *** Cat tr' queue' = Cat (tr *** tr') (zipWithQ (***) queue queue')
Cat tr queue *** Id = Cat (tr *** arr id) (zipWithQ (***) queue NilQ) Cat tr queue *** Id = Cat (tr *** arr id) (zipWithQ (***) queue NilQ)
Id *** Cat tr' queue' = Cat (arr id *** tr') (zipWithQ (***) NilQ queue') Id *** Cat tr' queue' = Cat (arr id *** tr') (zipWithQ (***) NilQ queue')
Id *** Id = Cat (arr id *** arr id) NilQ Id *** Id = Cat (arr id *** arr id) NilQ
instance ArrowZero f => ArrowZero (Cat f) where instance ArrowZero f => ArrowZero (Cat f) where
zeroArrow = arrow zeroArrow zeroArrow = arrCat zeroArrow
instance ArrowChoice f => ArrowChoice (Cat f) where instance ArrowChoice f => ArrowChoice (Cat f) where
Cat fxb cax +++ Cat fyb cay Cat fxb cax +++ Cat fyb cay