/
Semigroupoid.hs
75 lines (60 loc) · 2.14 KB
/
Semigroupoid.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
#if __GLASGOW_HASKELL__ >= 707 && (MIN_VERSION_comonad(3,0,3))
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
#endif
-----------------------------------------------------------------------------
-- |
-- Module : Data.Semigroupoid
-- Copyright : (C) 2007-2011 Edward Kmett
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : provisional
-- Portability : portable
--
-- A semigroupoid satisfies all of the requirements to be a Category except
-- for the existence of identity arrows.
----------------------------------------------------------------------------
module Data.Semigroupoid
( Semigroupoid(..)
, WrappedCategory(..)
, Semi(..)
) where
import Control.Arrow
import Data.Functor.Bind
import Data.Functor.Extend
import Data.Functor.Contravariant
import Control.Comonad
import Data.Semigroup
import Control.Category
import Prelude hiding (id, (.))
-- | 'Control.Category.Category' sans 'Control.Category.id'
class Semigroupoid c where
o :: c j k -> c i j -> c i k
instance Semigroupoid (->) where
o = (.)
-- | <http://en.wikipedia.org/wiki/Band_(mathematics)#Rectangular_bands>
instance Semigroupoid (,) where
o (_,k) (i,_) = (i,k)
instance Bind m => Semigroupoid (Kleisli m) where
Kleisli g `o` Kleisli f = Kleisli $ \a -> f a >>- g
instance Extend w => Semigroupoid (Cokleisli w) where
Cokleisli f `o` Cokleisli g = Cokleisli $ f . extended g
instance Semigroupoid Op where
Op f `o` Op g = Op (g `o` f)
newtype WrappedCategory k a b = WrapCategory { unwrapCategory :: k a b }
instance Category k => Semigroupoid (WrappedCategory k) where
WrapCategory f `o` WrapCategory g = WrapCategory (f . g)
instance Category k => Category (WrappedCategory k) where
id = WrapCategory id
WrapCategory f . WrapCategory g = WrapCategory (f . g)
newtype Semi m a b = Semi { getSemi :: m }
instance Semigroup m => Semigroupoid (Semi m) where
Semi m `o` Semi n = Semi (m <> n)
instance Monoid m => Category (Semi m) where
id = Semi mempty
Semi m . Semi n = Semi (m `mappend` n)