-- |
-- A symmetric version of the Kleisli monad transformer arrow.
-- This admits three isomorphic 'MonadBijection' types:
--
-- * @'MonadArrow' ('<->') m a b@
-- * @'Bijection' ('MonadFunction' m) a b@
-- * @m a '<->' m b@
--
-- The Alimarine paper just calls it \"MoT\" for Monad Transformer.
{-# LANGUAGE CPP, TupleSections, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeOperators #-}
#if !(defined(VERSION_semigroupoids) && MIN_VERSION_semigroupoids(5,2,2))
{-# LANGUAGE Safe #-}
#endif
module Control.Invertible.MonadArrow
  ( MonadArrow(..)
  , MonadFunction
  , MonadBijection
  , MonadBijection'
  , MonadBijection''
  , monadBijection
  , monadBijection'
  ) where

import Prelude hiding (id, (.))

import Control.Category
import Control.Arrow
import Control.Monad (MonadPlus(..))
#ifdef VERSION_semigroupoids
import Data.Semigroupoid (Semigroupoid(..))
import Data.Groupoid (Groupoid(..))
#endif

import Data.Invertible.Bijection
import Data.Invertible.TH
import Control.Invertible.BiArrow

-- |Bidirectional 'Control.Arrow.Kleisli'-like monad arrow transformer.
newtype MonadArrow a m b c = MonadArrow { forall (a :: * -> * -> *) (m :: * -> *) b c.
MonadArrow a m b c -> a (m b) (m c)
runMonadArrow :: a (m b) (m c) }

-- |Specialization of 'MonadArrow' to function arrows.
type MonadFunction = MonadArrow (->)

type MonadBijection m = MonadArrow (<->) m
type MonadBijection' m = Bijection (MonadFunction m)
type MonadBijection'' m a b = m a <-> m b

-- |Convert between isomorphic representations of 'MonadBijection's.
monadBijection :: MonadBijection' m a b <-> MonadBijection m a b
monadBijection :: forall (m :: * -> *) a b.
MonadBijection' m a b <-> MonadBijection m a b
monadBijection = [biCase|MonadArrow f :<->: MonadArrow g <-> (MonadArrow (f :<->: g))|]

-- |Convert between isomorphic representations of 'MonadBijection's.
monadBijection' :: MonadBijection'' m a b <-> MonadBijection' m a b
monadBijection' :: forall (m :: * -> *) a b.
MonadBijection'' m a b <-> MonadBijection' m a b
monadBijection' = [biCase|f :<->: g <-> MonadArrow f :<->: MonadArrow g|]

instance Category a => Category (MonadArrow a m) where
  id :: forall a. MonadArrow a m a a
id = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  MonadArrow a (m b) (m c)
f . :: forall b c a.
MonadArrow a m b c -> MonadArrow a m a b -> MonadArrow a m a c
. MonadArrow a (m a) (m b)
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (a (m b) (m c)
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a (m a) (m b)
g)

instance Monad m => Arrow (MonadArrow (->) m) where
  arr :: forall b c. (b -> c) -> MonadArrow (->) m b c
arr = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  first :: forall b c d.
MonadArrow (->) m b c -> MonadArrow (->) m (b, d) (c, d)
first  (MonadArrow m b -> m c
f) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ~(b
a,d
c) -> ( ,d
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b -> m c
f (forall (m :: * -> *) a. Monad m => a -> m a
return b
a))
  second :: forall b c d.
MonadArrow (->) m b c -> MonadArrow (->) m (d, b) (d, c)
second (MonadArrow m b -> m c
f) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ~(d
a,b
b) -> (d
a, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b -> m c
f (forall (m :: * -> *) a. Monad m => a -> m a
return b
b))
  MonadArrow m b -> m c
f *** :: forall b c b' c'.
MonadArrow (->) m b c
-> MonadArrow (->) m b' c' -> MonadArrow (->) m (b, b') (c, c')
*** MonadArrow m b' -> m c'
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow
    (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ~(b
a,b'
b) -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b -> m c
f (forall (m :: * -> *) a. Monad m => a -> m a
return b
a) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m b' -> m c'
g (forall (m :: * -> *) a. Monad m => a -> m a
return b'
b))
  MonadArrow m b -> m c
f &&& :: forall b c c'.
MonadArrow (->) m b c
-> MonadArrow (->) m b c' -> MonadArrow (->) m b (c, c')
&&& MonadArrow m b -> m c'
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow
    (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ b
a -> let ma :: m b
ma = forall (m :: * -> *) a. Monad m => a -> m a
return b
a in (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b -> m c
f m b
ma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m b -> m c'
g m b
ma)

instance Monad m => ArrowChoice (MonadArrow (->) m) where
  left :: forall b c d.
MonadArrow (->) m b c
-> MonadArrow (->) m (Either b d) (Either c d)
left  (MonadArrow m b -> m c
f) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m b -> m c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return) (forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. b -> Either a b
Right))
  right :: forall b c d.
MonadArrow (->) m b c
-> MonadArrow (->) m (Either d b) (Either d c)
right (MonadArrow m b -> m c
f) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m b -> m c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return))
  MonadArrow m b -> m c
f +++ :: forall b c b' c'.
MonadArrow (->) m b c
-> MonadArrow (->) m b' c'
-> MonadArrow (->) m (Either b b') (Either c c')
+++ MonadArrow m b' -> m c'
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow
    (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m b -> m c
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m b' -> m c'
g forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return))
  MonadArrow m b -> m d
f ||| :: forall b d c.
MonadArrow (->) m b d
-> MonadArrow (->) m c d -> MonadArrow (->) m (Either b c) d
||| MonadArrow m c -> m d
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow
    (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m b -> m d
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return) (m c -> m d
g forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return))

instance MonadPlus m => ArrowZero (MonadArrow (->) m) where
  zeroArrow :: forall b c. MonadArrow (->) m b c
zeroArrow = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero)

instance MonadPlus m => ArrowPlus (MonadArrow (->) m) where
  MonadArrow m b -> m c
f <+> :: forall b c.
MonadArrow (->) m b c
-> MonadArrow (->) m b c -> MonadArrow (->) m b c
<+> MonadArrow m b -> m c
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
x -> let mx :: m b
mx = forall (m :: * -> *) a. Monad m => a -> m a
return b
x in m b -> m c
f m b
mx forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` m b -> m c
g m b
mx)

liftMoA :: (MonadArrow (->) m a b -> MonadArrow (->) m c d) -> (m a -> m b) -> (m c -> m d)
liftMoA :: forall (m :: * -> *) a b c d.
(MonadArrow (->) m a b -> MonadArrow (->) m c d)
-> (m a -> m b) -> m c -> m d
liftMoA MonadArrow (->) m a b -> MonadArrow (->) m c d
t = forall (a :: * -> * -> *) (m :: * -> *) b c.
MonadArrow a m b c -> a (m b) (m c)
runMonadArrow forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MonadArrow (->) m a b -> MonadArrow (->) m c d
t forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow

liftMoA2 :: (MonadArrow (->) m a b -> MonadArrow (->) m c d -> MonadArrow (->) m e f) -> (m a -> m b) -> (m c -> m d) -> (m e -> m f)
liftMoA2 :: forall (m :: * -> *) a b c d e f.
(MonadArrow (->) m a b
 -> MonadArrow (->) m c d -> MonadArrow (->) m e f)
-> (m a -> m b) -> (m c -> m d) -> m e -> m f
liftMoA2 MonadArrow (->) m a b
-> MonadArrow (->) m c d -> MonadArrow (->) m e f
t m a -> m b
f m c -> m d
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
MonadArrow a m b c -> a (m b) (m c)
runMonadArrow (forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow m a -> m b
f MonadArrow (->) m a b
-> MonadArrow (->) m c d -> MonadArrow (->) m e f
`t` forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow m c -> m d
g)

instance Monad m => Arrow (MonadArrow (<->) m) where
  arr :: forall b c. (b -> c) -> MonadArrow (<->) m b c
arr = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  first :: forall b c d.
MonadArrow (<->) m b c -> MonadArrow (<->) m (b, d) (c, d)
first (MonadArrow (m b -> m c
f :<->: m c -> m b
g)) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall {a} {b} {d}. (m a -> m b) -> m (a, d) -> m (b, d)
bik m b -> m c
f forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {a} {b} {d}. (m a -> m b) -> m (a, d) -> m (b, d)
bik m c -> m b
g
    where bik :: (m a -> m b) -> m (a, d) -> m (b, d)
bik = forall (m :: * -> *) a b c d.
(MonadArrow (->) m a b -> MonadArrow (->) m c d)
-> (m a -> m b) -> m c -> m d
liftMoA forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
  second :: forall b c d.
MonadArrow (<->) m b c -> MonadArrow (<->) m (d, b) (d, c)
second (MonadArrow (m b -> m c
f :<->: m c -> m b
g)) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall {a} {b} {d}. (m a -> m b) -> m (d, a) -> m (d, b)
bik m b -> m c
f forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {a} {b} {d}. (m a -> m b) -> m (d, a) -> m (d, b)
bik m c -> m b
g
    where bik :: (m a -> m b) -> m (d, a) -> m (d, b)
bik = forall (m :: * -> *) a b c d.
(MonadArrow (->) m a b -> MonadArrow (->) m c d)
-> (m a -> m b) -> m c -> m d
liftMoA forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
  MonadArrow (m b -> m c
f :<->: m c -> m b
g) *** :: forall b c b' c'.
MonadArrow (<->) m b c
-> MonadArrow (<->) m b' c' -> MonadArrow (<->) m (b, b') (c, c')
*** MonadArrow (m b' -> m c'
f' :<->: m c' -> m b'
g') =
    forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall {a} {b} {c} {d}.
(m a -> m b) -> (m c -> m d) -> m (a, c) -> m (b, d)
bik m b -> m c
f m b' -> m c'
f' forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {a} {b} {c} {d}.
(m a -> m b) -> (m c -> m d) -> m (a, c) -> m (b, d)
bik m c -> m b
g m c' -> m b'
g'
    where bik :: (m a -> m b) -> (m c -> m d) -> m (a, c) -> m (b, d)
bik = forall (m :: * -> *) a b c d e f.
(MonadArrow (->) m a b
 -> MonadArrow (->) m c d -> MonadArrow (->) m e f)
-> (m a -> m b) -> (m c -> m d) -> m e -> m f
liftMoA2 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***)
  MonadArrow (m b -> m c
f :<->: m c -> m b
g) &&& :: forall b c c'.
MonadArrow (<->) m b c
-> MonadArrow (<->) m b c' -> MonadArrow (<->) m b (c, c')
&&& MonadArrow (m b -> m c'
f' :<->: m c' -> m b
_) =
    forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c d e f.
(MonadArrow (->) m a b
 -> MonadArrow (->) m c d -> MonadArrow (->) m e f)
-> (m a -> m b) -> (m c -> m d) -> m e -> m f
liftMoA2 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) m b -> m c
f m b -> m c'
f' forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: (m c -> m b
g forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst)) -- (g' . arr snd)

instance Monad m => ArrowChoice (MonadArrow (<->) m) where
  left :: forall b c d.
MonadArrow (<->) m b c
-> MonadArrow (<->) m (Either b d) (Either c d)
left  (MonadArrow (m b -> m c
f :<->: m c -> m b
g)) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall {a} {b} {d}.
(m a -> m b) -> m (Either a d) -> m (Either b d)
bik m b -> m c
f forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {a} {b} {d}.
(m a -> m b) -> m (Either a d) -> m (Either b d)
bik m c -> m b
g
    where bik :: (m a -> m b) -> m (Either a d) -> m (Either b d)
bik = forall (m :: * -> *) a b c d.
(MonadArrow (->) m a b -> MonadArrow (->) m c d)
-> (m a -> m b) -> m c -> m d
liftMoA forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left
  right :: forall b c d.
MonadArrow (<->) m b c
-> MonadArrow (<->) m (Either d b) (Either d c)
right (MonadArrow (m b -> m c
f :<->: m c -> m b
g)) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall {a} {b} {d}.
(m a -> m b) -> m (Either d a) -> m (Either d b)
bik m b -> m c
f forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {a} {b} {d}.
(m a -> m b) -> m (Either d a) -> m (Either d b)
bik m c -> m b
g
    where bik :: (m a -> m b) -> m (Either d a) -> m (Either d b)
bik = forall (m :: * -> *) a b c d.
(MonadArrow (->) m a b -> MonadArrow (->) m c d)
-> (m a -> m b) -> m c -> m d
liftMoA forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right
  MonadArrow (m b -> m c
f :<->: m c -> m b
g) +++ :: forall b c b' c'.
MonadArrow (<->) m b c
-> MonadArrow (<->) m b' c'
-> MonadArrow (<->) m (Either b b') (Either c c')
+++ MonadArrow (m b' -> m c'
f' :<->: m c' -> m b'
g') =
    forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall {a} {b} {c} {d}.
(m a -> m b) -> (m c -> m d) -> m (Either a c) -> m (Either b d)
bik m b -> m c
f m b' -> m c'
f' forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {a} {b} {c} {d}.
(m a -> m b) -> (m c -> m d) -> m (Either a c) -> m (Either b d)
bik m c -> m b
g m c' -> m b'
g'
    where bik :: (m a -> m b) -> (m c -> m d) -> m (Either a c) -> m (Either b d)
bik = forall (m :: * -> *) a b c d e f.
(MonadArrow (->) m a b
 -> MonadArrow (->) m c d -> MonadArrow (->) m e f)
-> (m a -> m b) -> (m c -> m d) -> m e -> m f
liftMoA2 forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
(+++)
  MonadArrow (m b -> m d
f :<->: m d -> m b
g) ||| :: forall b d c.
MonadArrow (<->) m b d
-> MonadArrow (<->) m c d -> MonadArrow (<->) m (Either b c) d
||| MonadArrow (m c -> m d
f' :<->: m d -> m c
_) =
    forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c d e f.
(MonadArrow (->) m a b
 -> MonadArrow (->) m c d -> MonadArrow (->) m e f)
-> (m a -> m b) -> (m c -> m d) -> m e -> m f
liftMoA2 forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
(|||) m b -> m d
f m c -> m d
f' forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m d -> m b
g) -- (arr (fmap Right) . g)

instance MonadPlus m => ArrowZero (MonadArrow (<->) m) where
  zeroArrow :: forall b c. MonadArrow (<->) m b c
zeroArrow = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero)

instance MonadPlus m => ArrowPlus (MonadArrow (<->) m) where
  MonadArrow (m b -> m c
f1 :<->: m c -> m b
g1) <+> :: forall b c.
MonadArrow (<->) m b c
-> MonadArrow (<->) m b c -> MonadArrow (<->) m b c
<+> MonadArrow (m b -> m c
f2 :<->: m c -> m b
g2) =
    forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow forall a b. (a -> b) -> a -> b
$ forall {e} {f}. (m e -> m f) -> (m e -> m f) -> m e -> m f
bik m b -> m c
f1 m b -> m c
f2 forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {e} {f}. (m e -> m f) -> (m e -> m f) -> m e -> m f
bik m c -> m b
g1 m c -> m b
g2
    where bik :: (m e -> m f) -> (m e -> m f) -> m e -> m f
bik = forall (m :: * -> *) a b c d e f.
(MonadArrow (->) m a b
 -> MonadArrow (->) m c d -> MonadArrow (->) m e f)
-> (m a -> m b) -> (m c -> m d) -> m e -> m f
liftMoA2 forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
(<+>)

instance (BiArrow a, Monad m) => BiArrow (MonadArrow a m) where
  b -> c
f <-> :: forall b c. (b -> c) -> (c -> b) -> MonadArrow a m b c
<-> c -> b
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f) forall (a :: * -> * -> *) b c.
BiArrow a =>
(b -> c) -> (c -> b) -> a b c
<-> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> b
g))
  invert :: forall b c. MonadArrow a m b c -> MonadArrow a m c b
invert (MonadArrow a (m b) (m c)
f) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall (a :: * -> * -> *) b c. BiArrow a => a b c -> a c b
invert a (m b) (m c)
f)

instance Monad m => BiArrow' (MonadArrow (<->) m)

#ifdef VERSION_semigroupoids
instance Semigroupoid a => Semigroupoid (MonadArrow a m) where
  MonadArrow a (m j) (m k1)
f o :: forall j k1 i.
MonadArrow a m j k1 -> MonadArrow a m i j -> MonadArrow a m i k1
`o` MonadArrow a (m i) (m j)
g = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (a (m j) (m k1)
f forall {k} (c :: k -> k -> *) (j :: k) (k1 :: k) (i :: k).
Semigroupoid c =>
c j k1 -> c i j -> c i k1
`o` a (m i) (m j)
g)

instance Groupoid a => Groupoid (MonadArrow a m) where
  inv :: forall a b. MonadArrow a m a b -> MonadArrow a m b a
inv (MonadArrow a (m a) (m b)
f) = forall (a :: * -> * -> *) (m :: * -> *) b c.
a (m b) (m c) -> MonadArrow a m b c
MonadArrow (forall {k} (k1 :: k -> k -> *) (a :: k) (b :: k).
Groupoid k1 =>
k1 a b -> k1 b a
inv a (m a) (m b)
f)
#endif