{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Semigroupoid
( Semigroupoid(..)
, WrappedCategory(..)
, Semi(..)
) where
import Control.Applicative
import Control.Arrow
import Data.Functor.Bind
import Data.Semigroup
import Control.Category
import Prelude hiding (id, (.))
#ifdef MIN_VERSION_contravariant
import Data.Functor.Contravariant
#endif
#ifdef MIN_VERSION_comonad
import Data.Functor.Extend
import Control.Comonad
#endif
#ifdef MIN_VERSION_tagged
import Data.Tagged (Tagged (..))
#endif
#if MIN_VERSION_base(4,7,0)
import qualified Data.Type.Coercion as Co
import qualified Data.Type.Equality as Eq
#endif
class Semigroupoid c where
o :: c j k -> c i j -> c i k
instance Semigroupoid (->) where
o :: (j -> k) -> (i -> j) -> i -> k
o = (j -> k) -> (i -> j) -> i -> k
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)
instance Semigroupoid (,) where
o :: (j, k) -> (i, j) -> (i, k)
o (j
_,k
k) (i
i,j
_) = (i
i,k
k)
instance Bind m => Semigroupoid (Kleisli m) where
Kleisli j -> m k
g o :: Kleisli m j k -> Kleisli m i j -> Kleisli m i k
`o` Kleisli i -> m j
f = (i -> m k) -> Kleisli m i k
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((i -> m k) -> Kleisli m i k) -> (i -> m k) -> Kleisli m i k
forall a b. (a -> b) -> a -> b
$ \i
a -> i -> m j
f i
a m j -> (j -> m k) -> m k
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- j -> m k
g
#ifdef MIN_VERSION_comonad
instance Extend w => Semigroupoid (Cokleisli w) where
Cokleisli w j -> k
f o :: Cokleisli w j k -> Cokleisli w i j -> Cokleisli w i k
`o` Cokleisli w i -> j
g = (w i -> k) -> Cokleisli w i k
forall k (w :: k -> *) (a :: k) b. (w a -> b) -> Cokleisli w a b
Cokleisli ((w i -> k) -> Cokleisli w i k) -> (w i -> k) -> Cokleisli w i k
forall a b. (a -> b) -> a -> b
$ w j -> k
f (w j -> k) -> (w i -> w j) -> w i -> k
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w i -> j) -> w i -> w j
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended w i -> j
g
#endif
#ifdef MIN_VERSION_contravariant
instance Semigroupoid Op where
Op k -> j
f o :: Op j k -> Op i j -> Op i k
`o` Op j -> i
g = (k -> i) -> Op i k
forall a b. (b -> a) -> Op a b
Op (j -> i
g (j -> i) -> (k -> j) -> k -> i
forall k (c :: k -> k -> *) (j :: k) (k :: k) (i :: k).
Semigroupoid c =>
c j k -> c i j -> c i k
`o` k -> j
f)
#endif
newtype WrappedCategory k a b = WrapCategory { WrappedCategory k a b -> k a b
unwrapCategory :: k a b }
instance Category k => Semigroupoid (WrappedCategory k) where
WrapCategory k j k
f o :: WrappedCategory k j k
-> WrappedCategory k i j -> WrappedCategory k i k
`o` WrapCategory k i j
g = k i k -> WrappedCategory k i k
forall k k (k :: k -> k -> *) (a :: k) (b :: k).
k a b -> WrappedCategory k a b
WrapCategory (k j k
f k j k -> k i j -> k i k
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. k i j
g)
instance Category k => Category (WrappedCategory k) where
id :: WrappedCategory k a a
id = k a a -> WrappedCategory k a a
forall k k (k :: k -> k -> *) (a :: k) (b :: k).
k a b -> WrappedCategory k a b
WrapCategory k a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
WrapCategory k b c
f . :: WrappedCategory k b c
-> WrappedCategory k a b -> WrappedCategory k a c
. WrapCategory k a b
g = k a c -> WrappedCategory k a c
forall k k (k :: k -> k -> *) (a :: k) (b :: k).
k a b -> WrappedCategory k a b
WrapCategory (k b c
f k b c -> k a b -> k a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. k a b
g)
newtype Semi m a b = Semi { Semi m a b -> m
getSemi :: m }
instance Semigroup m => Semigroupoid (Semi m) where
Semi m
m o :: Semi m j k -> Semi m i j -> Semi m i k
`o` Semi m
n = m -> Semi m i k
forall k k m (a :: k) (b :: k). m -> Semi m a b
Semi (m
m m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
n)
instance Monoid m => Category (Semi m) where
id :: Semi m a a
id = m -> Semi m a a
forall k k m (a :: k) (b :: k). m -> Semi m a b
Semi m
forall a. Monoid a => a
mempty
Semi m
m . :: Semi m b c -> Semi m a b -> Semi m a c
. Semi m
n = m -> Semi m a c
forall k k m (a :: k) (b :: k). m -> Semi m a b
Semi (m
m m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m
n)
instance Semigroupoid Const where
Const j k
_ o :: Const j k -> Const i j -> Const i k
`o` Const i
a = i -> Const i k
forall k a (b :: k). a -> Const a b
Const i
a
#ifdef MIN_VERSION_tagged
instance Semigroupoid Tagged where
Tagged k
b o :: Tagged j k -> Tagged i j -> Tagged i k
`o` Tagged i j
_ = k -> Tagged i k
forall k (s :: k) b. b -> Tagged s b
Tagged k
b
#endif
#if MIN_VERSION_base(4,7,0)
instance Semigroupoid Co.Coercion where
o :: Coercion j k -> Coercion i j -> Coercion i k
o = (Coercion i j -> Coercion j k -> Coercion i k)
-> Coercion j k -> Coercion i j -> Coercion i k
forall a b c. (a -> b -> c) -> b -> a -> c
flip Coercion i j -> Coercion j k -> Coercion i k
forall k (a :: k) (b :: k) (c :: k).
Coercion a b -> Coercion b c -> Coercion a c
Co.trans
instance Semigroupoid (Eq.:~:) where
o :: (j :~: k) -> (i :~: j) -> i :~: k
o = ((i :~: j) -> (j :~: k) -> i :~: k)
-> (j :~: k) -> (i :~: j) -> i :~: k
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i :~: j) -> (j :~: k) -> i :~: k
forall k (a :: k) (b :: k) (c :: k).
(a :~: b) -> (b :~: c) -> a :~: c
Eq.trans
#endif
#if MIN_VERSION_base(4,10,0)
instance Semigroupoid (Eq.:~~:) where
o :: (j :~~: k) -> (i :~~: j) -> i :~~: k
o j :~~: k
Eq.HRefl i :~~: j
Eq.HRefl = i :~~: k
forall k1 (a :: k1). a :~~: a
Eq.HRefl
#endif