{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Arrow.Transformer.Reader
-- Copyright   :  (c) Ross Paterson 2003
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  R.Paterson@city.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable (multi-parameter type classes)
--
-- Arrow transformer that adds a read-only state (i.e. an environment).

module Control.Arrow.Transformer.Reader(
    ReaderArrow(ReaderArrow),
    runReader,
    ArrowAddReader(..),
    ) where

import Control.Arrow.Internals
import Control.Arrow.Operations
import Control.Arrow.Transformer

import Control.Applicative
import Control.Arrow
import Control.Category
import Data.Monoid
#if (MIN_VERSION_base(4,9,0)) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif

import Prelude hiding (id,(.))

-- | An arrow type that augments an existing arrow with a read-only state
-- (or environment).  The 'ArrowReader' class contains the operations
-- on this state.

newtype ReaderArrow r a b c = ReaderArrow (a (b, r) c)

-- | Encapsulation of a state-reading computation, taking a value for the
-- state.
--
-- Typical usage in arrow notation:
--
-- >    proc p -> ...
-- >        (|runReader cmd|) env

runReader :: Arrow a => ReaderArrow r a e b -> a (e,r) b
runReader :: ReaderArrow r a e b -> a (e, r) b
runReader (ReaderArrow a (e, r) b
f) = a (e, r) b
f

-- arrow transformer

instance Arrow a => ArrowTransformer (ReaderArrow r) a where
    lift :: a b c -> ReaderArrow r a b c
lift a b c
f = a (b, r) c -> ReaderArrow r a b c
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (((b, r) -> b) -> a (b, r) b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b, r) -> b
forall a b. (a, b) -> a
fst a (b, r) b -> a b c -> a (b, r) 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)

-- liftings of standard classes

instance Arrow a => Category (ReaderArrow r a) where
    id :: ReaderArrow r a a a
id = a (a, r) a -> ReaderArrow r a a a
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (((a, r) -> a) -> a (a, r) a
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a, r) -> a
forall a b. (a, b) -> a
fst)
    ReaderArrow a (b, r) c
f . :: ReaderArrow r a b c -> ReaderArrow r a a b -> ReaderArrow r a a c
. ReaderArrow a (a, r) b
g = a (a, r) c -> ReaderArrow r a a c
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (b, r) c
f a (b, r) c -> a (a, r) (b, r) -> a (a, r) c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a (a, r) b -> a ((a, r), r) (b, r)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a (a, r) b
g a ((a, r), r) (b, r) -> a (a, r) ((a, r), r) -> a (a, r) (b, r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((a, r) -> ((a, r), r)) -> a (a, r) ((a, r), r)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a, r) -> ((a, r), r)
forall a b. (a, b) -> ((a, b), b)
dupenv)
      where
        dupenv :: (a, b) -> ((a, b), b)
dupenv (a
a, b
r) = ((a
a, b
r), b
r)

instance Arrow a => Arrow (ReaderArrow r a) where
    arr :: (b -> c) -> ReaderArrow r a b c
arr b -> c
f = a (b, r) c -> ReaderArrow r a b c
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (((b, r) -> c) -> a (b, r) c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b -> c
f (b -> c) -> ((b, r) -> b) -> (b, r) -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b, r) -> b
forall a b. (a, b) -> a
fst))
    first :: ReaderArrow r a b c -> ReaderArrow r a (b, d) (c, d)
first (ReaderArrow a (b, r) c
f) = a ((b, d), r) (c, d) -> ReaderArrow r a (b, d) (c, d)
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow ((((b, d), r) -> ((b, r), d)) -> a ((b, d), r) ((b, r), d)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((b, d), r) -> ((b, r), d)
forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd a ((b, d), r) ((b, r), d)
-> a ((b, r), d) (c, d) -> a ((b, d), r) (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, r) c -> a ((b, r), d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a (b, r) c
f)

swapsnd :: ((a, r), b) -> ((a, b), r)
swapsnd :: ((a, r), b) -> ((a, b), r)
swapsnd ~(~(a
a, r
r), b
b) = ((a
a, b
b), r
r)

instance ArrowChoice a => ArrowChoice (ReaderArrow r a) where
    left :: ReaderArrow r a b c -> ReaderArrow r a (Either b d) (Either c d)
left (ReaderArrow a (b, r) c
f) = a (Either b d, r) (Either c d)
-> ReaderArrow r a (Either b d) (Either c d)
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (((Either b d, r) -> Either (b, r) d)
-> a (Either b d, r) (Either (b, r) d)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Either b d, r) -> Either (b, r) d
forall b c r. (Either b c, r) -> Either (b, r) c
dist' a (Either b d, r) (Either (b, r) d)
-> a (Either (b, r) d) (Either c d)
-> a (Either b d, r) (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, r) c -> a (Either (b, r) d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left a (b, r) c
f)
      where
        dist' :: (Either b c, r) -> Either (b, r) c
        dist' :: (Either b c, r) -> Either (b, r) c
dist' (Left b
b, r
r) = (b, r) -> Either (b, r) c
forall a b. a -> Either a b
Left (b
b, r
r)
        dist' (Right c
c, r
_) = c -> Either (b, r) c
forall a b. b -> Either a b
Right c
c

instance ArrowApply a => ArrowApply (ReaderArrow r a) where
    app :: ReaderArrow r a (ReaderArrow r a b c, b) c
app = a ((ReaderArrow r a b c, b), r) c
-> ReaderArrow r a (ReaderArrow r a b c, b) c
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow
        ((((ReaderArrow r a b c, b), r) -> (a (b, r) c, (b, r)))
-> a ((ReaderArrow r a b c, b), r) (a (b, r) c, (b, r))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((ReaderArrow a (b, r) c
f, b
a), r
r) -> (a (b, r) c
f, (b
a, r
r))) a ((ReaderArrow r a b c, b), r) (a (b, r) c, (b, r))
-> a (a (b, r) c, (b, r)) c -> a ((ReaderArrow r a b c, b), r) c
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, r) c, (b, r)) c
forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app)

instance ArrowZero a => ArrowZero (ReaderArrow r a) where
    zeroArrow :: ReaderArrow r a b c
zeroArrow = a b c -> ReaderArrow r a b c
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift a b c
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow

instance ArrowPlus a => ArrowPlus (ReaderArrow r a) where
    ReaderArrow a (b, r) c
f <+> :: ReaderArrow r a b c -> ReaderArrow r a b c -> ReaderArrow r a b c
<+> ReaderArrow a (b, r) c
g = a (b, r) c -> ReaderArrow r a b c
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (b, r) c
f a (b, r) c -> a (b, r) c -> a (b, r) c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> a (b, r) c
g)

instance ArrowLoop a => ArrowLoop (ReaderArrow r a) where
    loop :: ReaderArrow r a (b, d) (c, d) -> ReaderArrow r a b c
loop (ReaderArrow a ((b, d), r) (c, d)
f) = a (b, r) c -> ReaderArrow r a b c
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a ((b, r), d) (c, d) -> a (b, r) c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop ((((b, r), d) -> ((b, d), r)) -> a ((b, r), d) ((b, d), r)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((b, r), d) -> ((b, d), r)
forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd a ((b, r), d) ((b, d), r)
-> a ((b, d), r) (c, d) -> a ((b, r), d) (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, d), r) (c, d)
f))

-- new instances

instance Arrow a => ArrowReader r (ReaderArrow r a) where
    readState :: ReaderArrow r a b r
readState = a (b, r) r -> ReaderArrow r a b r
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (((b, r) -> r) -> a (b, r) r
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (b, r) -> r
forall a b. (a, b) -> b
snd)
    newReader :: ReaderArrow r a e b -> ReaderArrow r a (e, r) b
newReader (ReaderArrow a (e, r) b
f) = a ((e, r), r) b -> ReaderArrow r a (e, r) b
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow ((((e, r), r) -> (e, r)) -> a ((e, r), r) (e, r)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((e, r), r) -> (e, r)
forall a b. (a, b) -> a
fst a ((e, r), r) (e, r) -> a (e, r) b -> a ((e, r), r) b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (e, r) b
f)

instance Arrow a => ArrowAddReader r (ReaderArrow r a) a where
    liftReader :: a e b -> ReaderArrow r a e b
liftReader = a e b -> ReaderArrow r a e b
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift
    elimReader :: ReaderArrow r a e b -> a (e, r) b
elimReader = ReaderArrow r a e b -> a (e, r) b
forall (a :: * -> * -> *) r e b.
Arrow a =>
ReaderArrow r a e b -> a (e, r) b
runReader

-- liftings of other classes

instance ArrowCircuit a => ArrowCircuit (ReaderArrow r a) where
    delay :: b -> ReaderArrow r a b b
delay b
x = a b b -> ReaderArrow r a b b
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift (b -> a b b
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay b
x)

instance ArrowError ex a => ArrowError ex (ReaderArrow r a) where
    raise :: ReaderArrow r a ex b
raise = a ex b -> ReaderArrow r a ex b
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift a ex b
forall ex (a :: * -> * -> *) b. ArrowError ex a => a ex b
raise
    handle :: ReaderArrow r a e b
-> ReaderArrow r a (e, ex) b -> ReaderArrow r a e b
handle (ReaderArrow a (e, r) b
f) (ReaderArrow a ((e, ex), r) b
h) =
        a (e, r) b -> ReaderArrow r a e b
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (e, r) b -> a ((e, r), ex) b -> a (e, r) b
forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a (e, ex) b -> a e b
handle a (e, r) b
f ((((e, r), ex) -> ((e, ex), r)) -> a ((e, r), ex) ((e, ex), r)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((e, r), ex) -> ((e, ex), r)
forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd a ((e, r), ex) ((e, ex), r) -> a ((e, ex), r) b -> a ((e, r), ex) b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a ((e, ex), r) b
h))
    tryInUnless :: ReaderArrow r a e b
-> ReaderArrow r a (e, b) c
-> ReaderArrow r a (e, ex) c
-> ReaderArrow r a e c
tryInUnless (ReaderArrow a (e, r) b
f) (ReaderArrow a ((e, b), r) c
s) (ReaderArrow a ((e, ex), r) c
h) =
        a (e, r) c -> ReaderArrow r a e c
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (e, r) b -> a ((e, r), b) c -> a ((e, r), ex) c -> a (e, r) c
forall ex (a :: * -> * -> *) e b c.
ArrowError ex a =>
a e b -> a (e, b) c -> a (e, ex) c -> a e c
tryInUnless a (e, r) b
f ((((e, r), b) -> ((e, b), r)) -> a ((e, r), b) ((e, b), r)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((e, r), b) -> ((e, b), r)
forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd a ((e, r), b) ((e, b), r) -> a ((e, b), r) c -> a ((e, r), b) c
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a ((e, b), r) c
s) ((((e, r), ex) -> ((e, ex), r)) -> a ((e, r), ex) ((e, ex), r)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((e, r), ex) -> ((e, ex), r)
forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd a ((e, r), ex) ((e, ex), r) -> a ((e, ex), r) c -> a ((e, r), ex) c
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a ((e, ex), r) c
h))
    newError :: ReaderArrow r a e b -> ReaderArrow r a e (Either ex b)
newError (ReaderArrow a (e, r) b
f) = a (e, r) (Either ex b) -> ReaderArrow r a e (Either ex b)
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (e, r) b -> a (e, r) (Either ex b)
forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a e (Either ex b)
newError a (e, r) b
f)

instance ArrowState s a => ArrowState s (ReaderArrow r a) where
    fetch :: ReaderArrow r a e s
fetch = a e s -> ReaderArrow r a e s
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift a e s
forall s (a :: * -> * -> *) e. ArrowState s a => a e s
fetch
    store :: ReaderArrow r a s ()
store = a s () -> ReaderArrow r a s ()
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift a s ()
forall s (a :: * -> * -> *). ArrowState s a => a s ()
store

instance ArrowWriter s a => ArrowWriter s (ReaderArrow r a) where
    write :: ReaderArrow r a s ()
write = a s () -> ReaderArrow r a s ()
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift a s ()
forall w (a :: * -> * -> *). ArrowWriter w a => a w ()
write
    newWriter :: ReaderArrow r a e b -> ReaderArrow r a e (b, s)
newWriter (ReaderArrow a (e, r) b
f) = a (e, r) (b, s) -> ReaderArrow r a e (b, s)
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (e, r) b -> a (e, r) (b, s)
forall w (a :: * -> * -> *) e b.
ArrowWriter w a =>
a e b -> a e (b, w)
newWriter a (e, r) b
f)

-- Promotions of encapsulation operators.

instance ArrowAddError ex a a' =>
        ArrowAddError ex (ReaderArrow r a) (ReaderArrow r a') where
    liftError :: ReaderArrow r a' e b -> ReaderArrow r a e b
liftError (ReaderArrow a' (e, r) b
f) = a (e, r) b -> ReaderArrow r a e b
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a' (e, r) b -> a (e, r) b
forall ex (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddError ex a a' =>
a' e b -> a e b
liftError a' (e, r) b
f)
    elimError :: ReaderArrow r a e b
-> ReaderArrow r a' (e, ex) b -> ReaderArrow r a' e b
elimError (ReaderArrow a (e, r) b
f) (ReaderArrow a' ((e, ex), r) b
h) =
        a' (e, r) b -> ReaderArrow r a' e b
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (e, r) b -> a' ((e, r), ex) b -> a' (e, r) b
forall ex (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddError ex a a' =>
a e b -> a' (e, ex) b -> a' e b
elimError a (e, r) b
f ((((e, r), ex) -> ((e, ex), r)) -> a' ((e, r), ex) ((e, ex), r)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((e, r), ex) -> ((e, ex), r)
forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd a' ((e, r), ex) ((e, ex), r)
-> a' ((e, ex), r) b -> a' ((e, r), ex) b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a' ((e, ex), r) b
h))

instance ArrowAddState s a a' =>
        ArrowAddState s (ReaderArrow r a) (ReaderArrow r a') where
    liftState :: ReaderArrow r a' e b -> ReaderArrow r a e b
liftState (ReaderArrow a' (e, r) b
f) = a (e, r) b -> ReaderArrow r a e b
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a' (e, r) b -> a (e, r) b
forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a' e b -> a e b
liftState a' (e, r) b
f)
    elimState :: ReaderArrow r a e b -> ReaderArrow r a' (e, s) (b, s)
elimState (ReaderArrow a (e, r) b
f) = a' ((e, s), r) (b, s) -> ReaderArrow r a' (e, s) (b, s)
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow ((((e, s), r) -> ((e, r), s)) -> a' ((e, s), r) ((e, r), s)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((e, s), r) -> ((e, r), s)
forall a r b. ((a, r), b) -> ((a, b), r)
swapsnd a' ((e, s), r) ((e, r), s)
-> a' ((e, r), s) (b, s) -> a' ((e, s), r) (b, s)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (e, r) b -> a' ((e, r), s) (b, s)
forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a e b -> a' (e, s) (b, s)
elimState a (e, r) b
f)

-- instance ArrowAddReader r a a' =>
--         ArrowAddReader r (ReaderArrow r a) (ReaderArrow r a') where
--     elimReader (ReaderArrow f) = ReaderArrow (arr swapsnd >>> elimReader f)

instance ArrowAddWriter s a a' =>
        ArrowAddWriter s (ReaderArrow r a) (ReaderArrow r a') where
    liftWriter :: ReaderArrow r a' e b -> ReaderArrow r a e b
liftWriter (ReaderArrow a' (e, r) b
f) = a (e, r) b -> ReaderArrow r a e b
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a' (e, r) b -> a (e, r) b
forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a' e b -> a e b
liftWriter a' (e, r) b
f)
    elimWriter :: ReaderArrow r a e b -> ReaderArrow r a' e (b, s)
elimWriter (ReaderArrow a (e, r) b
f) = a' (e, r) (b, s) -> ReaderArrow r a' e (b, s)
forall r (a :: * -> * -> *) b c. a (b, r) c -> ReaderArrow r a b c
ReaderArrow (a (e, r) b -> a' (e, r) (b, s)
forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a e b -> a' e (b, w)
elimWriter a (e, r) b
f)

-- Other instances

instance Arrow a => Functor (ReaderArrow r a b) where
    fmap :: (a -> b) -> ReaderArrow r a b a -> ReaderArrow r a b b
fmap a -> b
f ReaderArrow r a b a
g = ReaderArrow r a b a
g ReaderArrow r a b a -> ReaderArrow r a a b -> ReaderArrow r a b 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) -> ReaderArrow r a a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f

instance Arrow a => Applicative (ReaderArrow r a b) where
    pure :: a -> ReaderArrow r a b a
pure a
x = (b -> a) -> ReaderArrow r a b a
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a -> b -> a
forall a b. a -> b -> a
const a
x)
    ReaderArrow r a b (a -> b)
f <*> :: ReaderArrow r a b (a -> b)
-> ReaderArrow r a b a -> ReaderArrow r a b b
<*> ReaderArrow r a b a
g = ReaderArrow r a b (a -> b)
f ReaderArrow r a b (a -> b)
-> ReaderArrow r a b a -> ReaderArrow r a b (a -> b, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ReaderArrow r a b a
g ReaderArrow r a b (a -> b, a)
-> ReaderArrow r a (a -> b, a) b -> ReaderArrow r a b 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) -> ReaderArrow r a (a -> b, a) b
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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)

instance ArrowPlus a => Alternative (ReaderArrow r a b) where
    empty :: ReaderArrow r a b a
empty = ReaderArrow r a b a
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
    ReaderArrow r a b a
f <|> :: ReaderArrow r a b a -> ReaderArrow r a b a -> ReaderArrow r a b a
<|> ReaderArrow r a b a
g = ReaderArrow r a b a
f ReaderArrow r a b a -> ReaderArrow r a b a -> ReaderArrow r a b a
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> ReaderArrow r a b a
g

#if MIN_VERSION_base(4,9,0)
instance ArrowPlus a => Semigroup (ReaderArrow r a b c) where
    <> :: ReaderArrow r a b c -> ReaderArrow r a b c -> ReaderArrow r a b c
(<>) = ReaderArrow r a b c -> ReaderArrow r a b c -> ReaderArrow r a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
(<+>)
#endif

instance ArrowPlus a => Monoid (ReaderArrow r a b c) where
    mempty :: ReaderArrow r a b c
mempty = ReaderArrow r a b c
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<+>)
#endif