(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}

module Control.Arrow (

[Arrow](Control.Arrow.html#Arrow)(..), [Kleisli](Control.Arrow.html#Kleisli)(..),

[returnA](Control.Arrow.html#returnA),
[(^>>)](Control.Arrow.html#%5E%3E%3E), [(>>^)](Control.Arrow.html#%3E%3E%5E),
[(>>>)](Control.Category.html#%3E%3E%3E), [(<<<)](Control.Category.html#%3C%3C%3C), 

[(<<^)](Control.Arrow.html#%3C%3C%5E), [(^<<)](Control.Arrow.html#%5E%3C%3C),

[ArrowZero](Control.Arrow.html#ArrowZero)(..), [ArrowPlus](Control.Arrow.html#ArrowPlus)(..),

[ArrowChoice](Control.Arrow.html#ArrowChoice)(..),

[ArrowApply](Control.Arrow.html#ArrowApply)(..), [ArrowMonad](Control.Arrow.html#ArrowMonad)(..), [leftApp](Control.Arrow.html#leftApp),

[ArrowLoop](Control.Arrow.html#ArrowLoop)(..)
) where

import Data.Tuple ( fst, snd, uncurry ) import Data.Either import Control.Monad.Fix import Control.Category import GHC.Base hiding ( (.), id ) import GHC.Generics (Generic, Generic1)

infixr 5 <+> infixr 3 *** infixr 3 &&& infixr 2 +++ infixr 2 ||| infixr 1 ^>>, >>^ infixr 1 ^<<, <<^

class Category a => Arrow a where {-# MINIMAL arr, (first | (***)) #-}

[arr](Control.Arrow.html#arr) :: ([b](#local-6989586621679657681) -> [c](#local-6989586621679657682)) -> [a](#local-6989586621679657650) [b](#local-6989586621679657681) [c](#local-6989586621679657682)


[first](Control.Arrow.html#first) :: [a](#local-6989586621679657650) [b](#local-6989586621679657653) [c](#local-6989586621679657654) -> [a](#local-6989586621679657650) ([b](#local-6989586621679657653),[d](#local-6989586621679657655)) ([c](#local-6989586621679657654),[d](#local-6989586621679657655))
[first](Control.Arrow.html#first) = (a b c -> a d d -> a (b, d) (c, d)

forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c') forall (a :: * -> * -> *) b c b' c'. Arrow a => a b c -> a b' c' -> a (b, b') (c, c') *** a d d forall a. a a a forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a id)

[second](Control.Arrow.html#second) :: [a](#local-6989586621679657650) [b](#local-6989586621679657666) [c](#local-6989586621679657667) -> [a](#local-6989586621679657650) ([d](#local-6989586621679657668),[b](#local-6989586621679657666)) ([d](#local-6989586621679657668),[c](#local-6989586621679657667))
[second](Control.Arrow.html#second) = (a d d

forall a. a a a forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a id a d d -> a b c -> a (d, b) (d, c) forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c') forall (a :: * -> * -> *) b c b' c'. Arrow a => a b c -> a b' c' -> a (b, b') (c, c') ***)

[(***)](Control.Arrow.html#%2A%2A%2A) :: [a](#local-6989586621679657650) [b](#local-6989586621679657659) [c](#local-6989586621679657660) -> [a](#local-6989586621679657650) [b'](#local-6989586621679657661) [c'](#local-6989586621679657662) -> [a](#local-6989586621679657650) ([b](#local-6989586621679657659),[b'](#local-6989586621679657661)) ([c](#local-6989586621679657660),[c'](#local-6989586621679657662))
a b c

f *** a b' c' g = a b c -> a (b, b') (c, b') forall b c d. a b c -> a (b, d) (c, d) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first a b c f a (b, b') (c, b') -> a (c, b') (c, c') -> a (b, b') (c, c') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> ((c, b') -> (b', c)) -> a (c, b') (b', c) forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (c, b') -> (b', c) forall {b} {a}. (b, a) -> (a, b) swap a (c, b') (b', c) -> a (b', c) (c, c') -> a (c, b') (c, c') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a b' c' -> a (b', c) (c', c) forall b c d. a b c -> a (b, d) (c, d) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first a b' c' g a (b', c) (c', c) -> a (c', c) (c, c') -> a (b', c) (c, c') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> ((c', c) -> (c, c')) -> a (c', c) (c, c') forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (c', c) -> (c, c') forall {b} {a}. (b, a) -> (a, b) swap where swap :: (b, a) -> (a, b) swap ~(b x,a y) = (a y,b x)

[(&&&)](Control.Arrow.html#%26%26%26) :: [a](#local-6989586621679657650) [b](#local-6989586621679657685) [c](#local-6989586621679657686) -> [a](#local-6989586621679657650) [b](#local-6989586621679657685) [c'](#local-6989586621679657687) -> [a](#local-6989586621679657650) [b](#local-6989586621679657685) ([c](#local-6989586621679657686),[c'](#local-6989586621679657687))
a b c

f &&& a b c' g = (b -> (b, b)) -> a b (b, b) forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (\b b -> (b b,b b)) a b (b, b) -> a (b, b) (c, c') -> a b (c, c') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a b c f a b c -> a b c' -> a (b, b) (c, c') forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c') forall (a :: * -> * -> *) b c b' c'. Arrow a => a b c -> a b' c' -> a (b, b') (c, c') *** a b c' g

{-# RULES "compose/arr" forall f g . (arr f) . (arr g) = arr (f . g) "first/arr" forall f . first (arr f) = arr (first f) "second/arr" forall f . second (arr f) = arr (second f) "product/arr" forall f g . arr f *** arr g = arr (f *** g) "fanout/arr" forall f g . arr f &&& arr g = arr (f &&& g) "compose/first" forall f g . (first f) . (first g) = first (f . g) "compose/second" forall f g . (second f) . (second g) = second (f . g) #-}

instance Arrow (->) where arr :: forall b c. (b -> c) -> b -> c arr b -> c f = b -> c f

*** :: forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')

(***) b -> c f b' -> c' g ~(b x,b' y) = (b -> c f b x, b' -> c' g b' y)

newtype Kleisli m a b = Kleisli { forall (m :: * -> *) a b. Kleisli m a b -> a -> m b runKleisli :: a -> m b }

deriving instance Generic (Kleisli m a b)

deriving instance Generic1 (Kleisli m a)

deriving instance Functor m => Functor (Kleisli m a)

instance Applicative m => Applicative (Kleisli m a) where pure :: forall a. a -> Kleisli m a a pure = (a -> m a) -> Kleisli m a a forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m a) -> Kleisli m a a) -> (a -> a -> m a) -> a -> Kleisli m a a forall b c a. (b -> c) -> (a -> b) -> a -> c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . m a -> a -> m a forall a b. a -> b -> a const (m a -> a -> m a) -> (a -> m a) -> a -> a -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c 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 forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure {-# INLINE pure #-} Kleisli a -> m (a -> b) f <*> :: forall a b. Kleisli m a (a -> b) -> Kleisli m a a -> Kleisli m a b <*> Kleisli a -> m a g = (a -> m b) -> Kleisli m a b forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m b) -> Kleisli m a b) -> (a -> m b) -> Kleisli m a b forall a b. (a -> b) -> a -> b $ \a x -> a -> m (a -> b) f a x m (a -> b) -> m a -> m b forall a b. m (a -> b) -> m a -> m b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> a -> m a g a x {-# INLINE (<*>) #-} Kleisli a -> m a f *> :: forall a b. Kleisli m a a -> Kleisli m a b -> Kleisli m a b *> Kleisli a -> m b g = (a -> m b) -> Kleisli m a b forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m b) -> Kleisli m a b) -> (a -> m b) -> Kleisli m a b forall a b. (a -> b) -> a -> b $ \a x -> a -> m a f a x m a -> m b -> m b forall a b. m a -> m b -> m b forall (f :: * -> ) a b. Applicative f => f a -> f b -> f b *> a -> m b g a x {-# INLINE (>) #-} Kleisli a -> m a f <* :: forall a b. Kleisli m a a -> Kleisli m a b -> Kleisli m a a <* Kleisli a -> m b g = (a -> m a) -> Kleisli m a a forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m a) -> Kleisli m a a) -> (a -> m a) -> Kleisli m a a forall a b. (a -> b) -> a -> b $ \a x -> a -> m a f a x m a -> m b -> m a forall a b. m a -> m b -> m a forall (f :: * -> ) a b. Applicative f => f a -> f b -> f a <* a -> m b g a x {-# INLINE (<) #-}

instance Alternative m => Alternative (Kleisli m a) where empty :: forall a. Kleisli m a a empty = (a -> m a) -> Kleisli m a a forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m a) -> Kleisli m a a) -> (a -> m a) -> Kleisli m a a forall a b. (a -> b) -> a -> b $ m a -> a -> m a forall a b. a -> b -> a const m a forall a. m a forall (f :: * -> *) a. Alternative f => f a empty {-# INLINE empty #-} Kleisli a -> m a f <|> :: forall a. Kleisli m a a -> Kleisli m a a -> Kleisli m a a <|> Kleisli a -> m a g = (a -> m a) -> Kleisli m a a forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m a) -> Kleisli m a a) -> (a -> m a) -> Kleisli m a a forall a b. (a -> b) -> a -> b $ \a x -> a -> m a f a x m a -> m a -> m a forall a. m a -> m a -> m a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> a -> m a g a x {-# INLINE (<|>) #-}

instance Monad m => Monad (Kleisli m a) where Kleisli a -> m a f >>= :: forall a b. Kleisli m a a -> (a -> Kleisli m a b) -> Kleisli m a b >>= a -> Kleisli m a b k = (a -> m b) -> Kleisli m a b forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m b) -> Kleisli m a b) -> (a -> m b) -> Kleisli m a b forall a b. (a -> b) -> a -> b $ \a x -> a -> m a f a x m a -> (a -> m b) -> m b forall a b. m a -> (a -> m b) -> m b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \a a -> Kleisli m a b -> a -> m b forall (m :: * -> *) a b. Kleisli m a b -> a -> m b runKleisli (a -> Kleisli m a b k a a) a x {-# INLINE (>>=) #-}

instance MonadPlus m => MonadPlus (Kleisli m a) where mzero :: forall a. Kleisli m a a mzero = (a -> m a) -> Kleisli m a a forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m a) -> Kleisli m a a) -> (a -> m a) -> Kleisli m a a forall a b. (a -> b) -> a -> b $ m a -> a -> m a forall a b. a -> b -> a const m a forall a. m a forall (m :: * -> *) a. MonadPlus m => m a mzero {-# INLINE mzero #-} Kleisli a -> m a f mplus :: forall a. Kleisli m a a -> Kleisli m a a -> Kleisli m a a mplus Kleisli a -> m a g = (a -> m a) -> Kleisli m a a forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((a -> m a) -> Kleisli m a a) -> (a -> m a) -> Kleisli m a a forall a b. (a -> b) -> a -> b $ \a x -> a -> m a f a x m a -> m a -> m a forall a. m a -> m a -> m a forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a mplus a -> m a g a x {-# INLINE mplus #-}

instance Monad m => Category (Kleisli m) where id :: forall a. Kleisli m a a id = (a -> m a) -> Kleisli m a a forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli a -> m a forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (Kleisli b -> m c f) . :: forall b c a. Kleisli m b c -> Kleisli m a b -> Kleisli m a c . (Kleisli a -> m b g) = (a -> m c) -> Kleisli m a c forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli (\a b -> a -> m b g a b m b -> (b -> m c) -> m c forall a b. m a -> (a -> m b) -> m b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= b -> m c f)

instance Monad m => Arrow (Kleisli m) where arr :: forall b c. (b -> c) -> Kleisli m b c arr b -> c f = (b -> m c) -> Kleisli m b c forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli (c -> m c forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (c -> m c) -> (b -> c) -> b -> m c forall b c a. (b -> c) -> (a -> b) -> a -> c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . b -> c f) first :: forall b c d. Kleisli m b c -> Kleisli m (b, d) (c, d) first (Kleisli b -> m c f) = ((b, d) -> m (c, d)) -> Kleisli m (b, d) (c, d) forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli (\ ~(b b,d d) -> b -> m c f b b m c -> (c -> m (c, d)) -> m (c, d) forall a b. m a -> (a -> m b) -> m b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \c c -> (c, d) -> m (c, d) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (c c,d d)) second :: forall b c d. Kleisli m b c -> Kleisli m (d, b) (d, c) second (Kleisli b -> m c f) = ((d, b) -> m (d, c)) -> Kleisli m (d, b) (d, c) forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli (\ ~(d d,b b) -> b -> m c f b b m c -> (c -> m (d, c)) -> m (d, c) forall a b. m a -> (a -> m b) -> m b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \c c -> (d, c) -> m (d, c) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (d d,c c))

returnA :: Arrow a => a b b returnA :: forall (a :: * -> * -> *) b. Arrow a => a b b returnA = a b b forall a. a a a forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a id

(^>>) :: Arrow a => (b -> c) -> a c d -> a b d b -> c f ^>> :: forall (a :: * -> * -> *) b c d. Arrow a => (b -> c) -> a c d -> a b d ^>> a c d a = (b -> c) -> a b c forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr b -> c f a b c -> a c d -> a b d forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a c d a

(>>^) :: Arrow a => a b c -> (c -> d) -> a b d a b c a >>^ :: forall (a :: * -> * -> *) b c d. Arrow a => a b c -> (c -> d) -> a b d >>^ c -> d f = a b c a a b c -> a c d -> a b d forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (c -> d) -> a c d forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr c -> d f

(<<^) :: Arrow a => a c d -> (b -> c) -> a b d a c d a <<^ :: forall (a :: * -> * -> *) c d b. Arrow a => a c d -> (b -> c) -> a b d <<^ b -> c f = a c d a a c d -> a b c -> a b d forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c <<< (b -> c) -> a b c forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr b -> c f

(^<<) :: Arrow a => (c -> d) -> a b c -> a b d c -> d f ^<< :: forall (a :: * -> * -> *) c d b. Arrow a => (c -> d) -> a b c -> a b d ^<< a b c a = (c -> d) -> a c d forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr c -> d f a c d -> a b c -> a b d forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c <<< a b c a

class Arrow a => ArrowZero a where zeroArrow :: a b c

instance MonadPlus m => ArrowZero (Kleisli m) where zeroArrow :: forall b c. Kleisli m b c zeroArrow = (b -> m c) -> Kleisli m b c forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli (\b _ -> m c forall a. m a forall (m :: * -> *) a. MonadPlus m => m a mzero)

class ArrowZero a => ArrowPlus a where

[(<+>)](Control.Arrow.html#%3C%2B%3E) :: [a](#local-6989586621679657859) [b](#local-6989586621679657862) [c](#local-6989586621679657863) -> [a](#local-6989586621679657859) [b](#local-6989586621679657862) [c](#local-6989586621679657863) -> [a](#local-6989586621679657859) [b](#local-6989586621679657862) [c](#local-6989586621679657863)

instance MonadPlus m => ArrowPlus (Kleisli m) where Kleisli b -> m c f <+> :: forall b c. Kleisli m b c -> Kleisli m b c -> Kleisli m b c <+> Kleisli b -> m c g = (b -> m c) -> Kleisli m b c forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli (\b x -> b -> m c f b x m c -> m c -> m c forall a. m a -> m a -> m a forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a mplus b -> m c g b x)

class Arrow a => ArrowChoice a where {-# MINIMAL (left | (+++)) #-}

[left](Control.Arrow.html#left) :: [a](#local-6989586621679657867) [b](#local-6989586621679657869) [c](#local-6989586621679657870) -> [a](#local-6989586621679657867) ([Either](Data.Either.html#Either) [b](#local-6989586621679657869) [d](#local-6989586621679657871)) ([Either](Data.Either.html#Either) [c](#local-6989586621679657870) [d](#local-6989586621679657871))
[left](Control.Arrow.html#left) = (a b c -> a d d -> a (Either b d) (Either c d)

forall b c b' c'. a b c -> a b' c' -> a (Either b b') (Either c c') forall (a :: * -> * -> *) b c b' c'. ArrowChoice a => a b c -> a b' c' -> a (Either b b') (Either c c') +++ a d d forall a. a a a forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a id)

[right](Control.Arrow.html#right) :: [a](#local-6989586621679657867) [b](#local-6989586621679657879) [c](#local-6989586621679657880) -> [a](#local-6989586621679657867) ([Either](Data.Either.html#Either) [d](#local-6989586621679657881) [b](#local-6989586621679657879)) ([Either](Data.Either.html#Either) [d](#local-6989586621679657881) [c](#local-6989586621679657880))
[right](Control.Arrow.html#right) = (a d d

forall a. a a a forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a id a d d -> a b c -> a (Either d b) (Either d c) forall b c b' c'. a b c -> a b' c' -> a (Either b b') (Either c c') forall (a :: * -> * -> *) b c b' c'. ArrowChoice a => a b c -> a b' c' -> a (Either b b') (Either c c') +++)

[(+++)](Control.Arrow.html#%2B%2B%2B) :: [a](#local-6989586621679657867) [b](#local-6989586621679657875) [c](#local-6989586621679657876) -> [a](#local-6989586621679657867) [b'](#local-6989586621679657877) [c'](#local-6989586621679657878) -> [a](#local-6989586621679657867) ([Either](Data.Either.html#Either) [b](#local-6989586621679657875) [b'](#local-6989586621679657877)) ([Either](Data.Either.html#Either) [c](#local-6989586621679657876) [c'](#local-6989586621679657878))
a b c

f +++ a b' c' g = a b c -> a (Either b b') (Either c b') forall b c d. a b c -> a (Either b d) (Either c d) forall (a :: * -> * -> *) b c d. ArrowChoice a => a b c -> a (Either b d) (Either c d) left a b c f a (Either b b') (Either c b') -> a (Either c b') (Either c c') -> a (Either b b') (Either c c') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Either c b' -> Either b' c) -> a (Either c b') (Either b' c) forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr Either c b' -> Either b' c forall x y. Either x y -> Either y x mirror a (Either c b') (Either b' c) -> a (Either b' c) (Either c c') -> a (Either c b') (Either c c') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a b' c' -> a (Either b' c) (Either c' c) forall b c d. a b c -> a (Either b d) (Either c d) forall (a :: * -> * -> *) b c d. ArrowChoice a => a b c -> a (Either b d) (Either c d) left a b' c' g a (Either b' c) (Either c' c) -> a (Either c' c) (Either c c') -> a (Either b' c) (Either c c') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Either c' c -> Either c c') -> a (Either c' c) (Either c c') forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr Either c' c -> Either c c' forall x y. Either x y -> Either y x mirror where mirror :: Either x y -> Either y x mirror :: forall x y. Either x y -> Either y x mirror (Left x x) = x -> Either y x forall a b. b -> Either a b Right x x mirror (Right y y) = y -> Either y x forall a b. a -> Either a b Left y y

[(|||)](Control.Arrow.html#%7C%7C%7C) :: [a](#local-6989586621679657867) [b](#local-6989586621679657895) [d](#local-6989586621679657896) -> [a](#local-6989586621679657867) [c](#local-6989586621679657897) [d](#local-6989586621679657896) -> [a](#local-6989586621679657867) ([Either](Data.Either.html#Either) [b](#local-6989586621679657895) [c](#local-6989586621679657897)) [d](#local-6989586621679657896)
a b d

f ||| a c d g = a b d f a b d -> a c d -> a (Either b c) (Either d d) forall b c b' c'. a b c -> a b' c' -> a (Either b b') (Either c c') forall (a :: * -> * -> *) b c b' c'. ArrowChoice a => a b c -> a b' c' -> a (Either b b') (Either c c') +++ a c d g a (Either b c) (Either d d) -> a (Either d d) d -> a (Either b c) d forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Either d d -> d) -> a (Either d d) d forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr Either d d -> d forall {a}. Either a a -> a untag where untag :: Either a a -> a untag (Left a x) = a x untag (Right a y) = a y

{-# RULES "left/arr" forall f . left (arr f) = arr (left f) "right/arr" forall f . right (arr f) = arr (right f) "sum/arr" forall f g . arr f +++ arr g = arr (f +++ g) "fanin/arr" forall f g . arr f ||| arr g = arr (f ||| g) "compose/left" forall f g . left f . left g = left (f . g) "compose/right" forall f g . right f . right g = right (f . g) #-}

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

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

class Arrow a => ArrowApply a where app :: a (a b c, b) c

instance ArrowApply (->) where app :: forall b c. (b -> c, b) -> c app (b -> c f,b x) = b -> c f b x

instance Monad m => ArrowApply (Kleisli m) where app :: forall b c. Kleisli m (Kleisli m b c, b) c app = ((Kleisli m b c, b) -> m c) -> Kleisli m (Kleisli m b c, b) c forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli ((Kleisli b -> m c f, b x) -> b -> m c f b x)

newtype ArrowMonad a b = ArrowMonad (a () b)

instance Arrow a => Functor (ArrowMonad a) where fmap :: forall a b. (a -> b) -> ArrowMonad a a -> ArrowMonad a b fmap a -> b f (ArrowMonad a () a m) = a () b -> ArrowMonad a b forall (a :: * -> * -> *) b. a () b -> ArrowMonad a b ArrowMonad (a () b -> ArrowMonad a b) -> a () b -> ArrowMonad a b forall a b. (a -> b) -> a -> b $ a () a m a () a -> a a b -> a () b forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (a -> b) -> a a b forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr a -> b f

instance Arrow a => Applicative (ArrowMonad a) where pure :: forall a. a -> ArrowMonad a a pure a x = a () a -> ArrowMonad a a forall (a :: * -> * -> *) b. a () b -> ArrowMonad a b ArrowMonad ((() -> a) -> a () a forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (a -> () -> a forall a b. a -> b -> a const a x)) ArrowMonad a () (a -> b) f <*> :: forall a b. ArrowMonad a (a -> b) -> ArrowMonad a a -> ArrowMonad a b <*> ArrowMonad a () a x = a () b -> ArrowMonad a b forall (a :: * -> * -> *) b. a () b -> ArrowMonad a b ArrowMonad (a () (a -> b) f a () (a -> b) -> a () a -> a () (a -> b, a) forall b c c'. a b c -> a b c' -> a b (c, c') forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& a () a x a () (a -> b, a) -> a (a -> b, a) b -> a () b forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> ((a -> b, a) -> b) -> a (a -> b, a) b forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (((a -> b) -> a -> b) -> (a -> b, a) -> b forall a b c. (a -> b -> c) -> (a, b) -> c uncurry (a -> b) -> a -> b forall a. a -> a forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a id))

instance ArrowApply a => Monad (ArrowMonad a) where ArrowMonad a () a m >>= :: forall a b. ArrowMonad a a -> (a -> ArrowMonad a b) -> ArrowMonad a b >>= a -> ArrowMonad a b f = a () b -> ArrowMonad a b forall (a :: * -> * -> *) b. a () b -> ArrowMonad a b ArrowMonad (a () b -> ArrowMonad a b) -> a () b -> ArrowMonad a b forall a b. (a -> b) -> a -> b $ a () a m a () a -> a a b -> a () b forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (a -> (a () b, ())) -> a a (a () b, ()) forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (\a x -> let ArrowMonad a () b h = a -> ArrowMonad a b f a x in (a () b h, ())) a a (a () b, ()) -> a (a () b, ()) b -> a a b forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a (a () b, ()) b forall b c. a (a b c, b) c forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c app

instance ArrowPlus a => Alternative (ArrowMonad a) where empty :: forall a. ArrowMonad a a empty = a () a -> ArrowMonad a a forall (a :: * -> * -> *) b. a () b -> ArrowMonad a b ArrowMonad a () a forall b c. a b c forall (a :: * -> * -> *) b c. ArrowZero a => a b c zeroArrow ArrowMonad a () a x <|> :: forall a. ArrowMonad a a -> ArrowMonad a a -> ArrowMonad a a <|> ArrowMonad a () a y = a () a -> ArrowMonad a a forall (a :: * -> * -> *) b. a () b -> ArrowMonad a b ArrowMonad (a () a x a () a -> a () a -> a () a forall b c. a b c -> a b c -> a b c forall (a :: * -> * -> *) b c. ArrowPlus a => a b c -> a b c -> a b c <+> a () a y)

instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a)

leftApp :: ArrowApply a => a b c -> a (Either b d) (Either c d) leftApp :: forall (a :: * -> * -> *) b c d. ArrowApply a => a b c -> a (Either b d) (Either c d) leftApp a b c f = (Either b d -> (a () (Either c d), ())) -> a (Either b d) (a () (Either c d), ()) forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr ((\b b -> ((() -> b) -> a () b forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (() -> b b) a () b -> a b (Either c d) -> a () (Either c d) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a b c f a b c -> a c (Either c d) -> a b (Either c d) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (c -> Either c d) -> a c (Either c d) forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr c -> Either c d forall a b. a -> Either a b Left, ())) (b -> (a () (Either c d), ())) -> (d -> (a () (Either c d), ())) -> Either b d -> (a () (Either c d), ()) forall b d c. (b -> d) -> (c -> d) -> Either b c -> d forall (a :: * -> * -> *) b d c. ArrowChoice a => a b d -> a c d -> a (Either b c) d ||| (\d d -> ((() -> d) -> a () d forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (() -> d d) a () d -> a d (Either c d) -> a () (Either c d) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (d -> Either c d) -> a d (Either c d) forall b c. (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr d -> Either c d forall a b. b -> Either a b Right, ()))) a (Either b d) (a () (Either c d), ()) -> a (a () (Either c d), ()) (Either c d) -> a (Either b d) (Either c d) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a (a () (Either c d), ()) (Either c d) forall b c. a (a b c, b) c forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c app

class Arrow a => ArrowLoop a where loop :: a (b,d) (c,d) -> a b c

instance ArrowLoop (->) where loop :: forall b d c. ((b, d) -> (c, d)) -> b -> c loop (b, d) -> (c, d) f b b = let (c c,d d) = (b, d) -> (c, d) f (b b,d d) in c c

instance MonadFix m => ArrowLoop (Kleisli m) where loop :: forall b d c. Kleisli m (b, d) (c, d) -> Kleisli m b c loop (Kleisli (b, d) -> m (c, d) f) = (b -> m c) -> Kleisli m b c forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b Kleisli (((c, d) -> c) -> m (c, d) -> m c forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM (c, d) -> c forall a b. (a, b) -> a fst (m (c, d) -> m c) -> (b -> m (c, d)) -> b -> m c forall b c a. (b -> c) -> (a -> b) -> a -> c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . ((c, d) -> m (c, d)) -> m (c, d) forall a. (a -> m a) -> m a forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a mfix (((c, d) -> m (c, d)) -> m (c, d)) -> (b -> (c, d) -> m (c, d)) -> b -> m (c, d) forall b c a. (b -> c) -> (a -> b) -> a -> c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . b -> (c, d) -> m (c, d) forall {a}. b -> (a, d) -> m (c, d) f') where f' :: b -> (a, d) -> m (c, d) f' b x (a, d) y = (b, d) -> m (c, d) f (b x, (a, d) -> d forall a b. (a, b) -> b snd (a, d) y)