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

ArrowZero and ArrowChoice instances

Browse Source
This commit is contained in:
Marcin Szamotulski 2018-10-24 00:02:32 +02:00
parent 93eafd738f
commit 794e7397cb
No known key found for this signature in database
GPG Key ID: 788D56E52D63FAA4
1 changed files with 16 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -32,7 +32,7 @@ import Control.Algebra.Free2
, joinFree2
, bindFree2
)
import Control.Arrow (Arrow (..))
import Control.Arrow (Arrow (..), ArrowZero (..), ArrowChoice (..))
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
@ -68,6 +68,15 @@ instance Arrow f => Arrow (Cat f) where
(fxb :.: cax) *** Id = (fxb *** arr id) :.: (cax *** Id)
(fxb :.: cax) *** (fyb :.: cay) = (fxb *** fyb) :.: (cax *** cay)
instance ArrowZero f => ArrowZero (Cat f) where
zeroArrow = zeroArrow :.: Id
instance ArrowChoice f => ArrowChoice (Cat f) where
Id +++ Id = Id
Id +++ (fxb :.: cax) = (arr id +++ fxb) :.: (Id +++ cax)
(fxb :.: cax) +++ Id = (fxb +++ arr id) :.: (cax +++ Id)
(fxb :.: cax) +++ (fyb :.: cay) = (fxb +++ fyb) :.: (cax +++ cay)
instance Semigroup (Cat f o o) where
f <> g = g . f
@ -145,6 +154,12 @@ instance Arrow f => Arrow (C f) where
arr ab = C $ \k -> k (arr ab)
C c1 *** C c2 = C $ \k -> k (c1 id *** c2 id)
instance ArrowZero f => ArrowZero (C f) where
zeroArrow = C $ \k -> k zeroArrow
instance ArrowChoice f => ArrowChoice (C f) where
C c1 +++ C c2 = C $ \k -> k (c1 id +++ c2 id)
instance Semigroup (C f o o) where
f <> g = f . g