coot/free-category
1
1
Fork 0
mirror of https://github.com/coot/free-category.git synced 2024-10-26 15:15:00 +03:00
Code Issues Projects Releases Wiki Activity

Added semigroup and monoid instances

Browse Source 
Arr anc A are categories, and thus every endo-morphism object is
a monoid.
This commit is contained in:
Marcin Szamotulski 2019-08-31 12:15:09 +02:00
parent 08ee2a979b
commit 1f20714c0a
1 changed files with 25 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/Control/Arrow/Free.hs
View File

@ -1,4 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
@ -30,6 +32,11 @@ module Control.Arrow.Free
import Prelude hiding (id, (.))
import Control.Arrow (Arrow (..))
import Control.Category (Category (..))
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
#endif
import Control.Algebra.Free2
( AlgebraType0
, AlgebraType
@ -76,6 +83,15 @@ instance Category (Arr f) where
(Arr f g) . h = Arr f (g . h)
(Prod f g) . h = Prod (f . h) (g . h)
instance Semigroup (Arr f o o) where
f <> g = f . g
instance Monoid (Arr f o o) where
mempty = Id
#if __GLASGOW_HASKELL__ < 804
mappend = (<>)
#endif
instance Arrow (Arr f) where
arr = arrArr
first bc = Prod (bc . arr fst) (arr snd)
@ -125,6 +141,15 @@ instance Category (A f) where
id = A (const id)
A f . A g = A $ \k -> f k . g k
instance Semigroup (A f o o) where
f <> g = f . g
instance Monoid (A f o o) where
mempty = id
#if __GLASGOW_HASKELL__ < 804
mappend = (<>)
#endif
instance Arrow (A f) where
arr f = A (const (arr f))
A f *** A g = A $ \k -> f k *** g k