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

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Arrow.Transformer.Writer
-- 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 accumulation of output.

module Control.Arrow.Transformer.Writer(
    WriterArrow(WriterArrow),
    runWriter,
    ArrowAddWriter(..),
    ) 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 accumulating
-- output.  The 'ArrowWriter' class contains the relevant operations.

newtype WriterArrow w a b c = WriterArrow (a b (c, w))

-- | Encapsulation of a writer computation, providing the accumulated output.
--
-- Typical usage in arrow notation:
--
-- >    proc p -> do
-- >        ...
-- >        (result, output) <- (|runWriter cmd|)

runWriter :: (Arrow a, Monoid w) => WriterArrow w a e b -> a e (b,w)
runWriter :: WriterArrow w a e b -> a e (b, w)
runWriter (WriterArrow a e (b, w)
f) = a e (b, w)
f

rstrength :: ((a, w), b) -> ((a, b), w)
rstrength :: ((a, w), b) -> ((a, b), w)
rstrength ((a
a, w
w), b
b) = ((a
a, b
b), w
w)

unit :: Monoid w => a -> (a, w)
unit :: a -> (a, w)
unit a
a = (a
a, w
forall a. Monoid a => a
mempty)

join :: Monoid w => ((a, w), w) -> (a, w)
join :: ((a, w), w) -> (a, w)
join ((a
a, w
w2), w
w1) = (a
a, w
w1 w -> w -> w
forall a. Monoid a => a -> a -> a
`mappend` w
w2)

-- arrow transformer

instance (Arrow a, Monoid w) => ArrowTransformer (WriterArrow w) a where
    lift :: a b c -> WriterArrow w a b c
lift a b c
f = a b (c, w) -> WriterArrow w a b c
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a b c
f a b c -> a c (c, w) -> a b (c, w)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (c -> (c, w)) -> a c (c, w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr c -> (c, w)
forall w a. Monoid w => a -> (a, w)
unit)

-- liftings of standard classes

instance (Arrow a, Monoid w) => Category (WriterArrow w a) where
    id :: WriterArrow w a a a
id = a a (a, w) -> WriterArrow w a a a
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow ((a -> (a, w)) -> a a (a, w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> (a, w)
forall w a. Monoid w => a -> (a, w)
unit)
    WriterArrow a b (c, w)
f . :: WriterArrow w a b c -> WriterArrow w a a b -> WriterArrow w a a c
. WriterArrow a a (b, w)
g =
        a a (c, w) -> WriterArrow w a a c
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow ((((c, w), w) -> (c, w)) -> a ((c, w), w) (c, w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((c, w), w) -> (c, w)
forall w a. Monoid w => ((a, w), w) -> (a, w)
join a ((c, w), w) (c, w) -> a a ((c, w), w) -> a a (c, w)
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, w) -> a (b, w) ((c, w), w)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b (c, w)
f a (b, w) ((c, w), w) -> a a (b, w) -> a a ((c, w), w)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a a (b, w)
g)

instance (Arrow a, Monoid w) => Arrow (WriterArrow w a) where
    arr :: (b -> c) -> WriterArrow w a b c
arr b -> c
f = a b (c, w) -> WriterArrow w a b c
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow ((b -> (c, w)) -> a b (c, w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (c -> (c, w)
forall w a. Monoid w => a -> (a, w)
unit (c -> (c, w)) -> (b -> c) -> b -> (c, w)
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 :: WriterArrow w a b c -> WriterArrow w a (b, d) (c, d)
first (WriterArrow a b (c, w)
f) = a (b, d) ((c, d), w) -> WriterArrow w a (b, d) (c, d)
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a b (c, w) -> a (b, d) ((c, w), d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b (c, w)
f a (b, d) ((c, w), d)
-> a ((c, w), d) ((c, d), w) -> a (b, d) ((c, d), w)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (((c, w), d) -> ((c, d), w)) -> a ((c, w), d) ((c, d), w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((c, w), d) -> ((c, d), w)
forall a w b. ((a, w), b) -> ((a, b), w)
rstrength)

instance (ArrowChoice a, Monoid w) => ArrowChoice (WriterArrow w a) where
    left :: WriterArrow w a b c -> WriterArrow w a (Either b d) (Either c d)
left (WriterArrow a b (c, w)
f) = a (Either b d) (Either c d, w)
-> WriterArrow w a (Either b d) (Either c d)
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a b (c, w) -> a (Either b d) (Either (c, w) d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left a b (c, w)
f a (Either b d) (Either (c, w) d)
-> a (Either (c, w) d) (Either c d, w)
-> a (Either b d) (Either c d, w)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either (c, w) d -> (Either c d, w))
-> a (Either (c, w) d) (Either c d, w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Either (c, w) d -> (Either c d, w)
forall b a b. Monoid b => Either (a, b) b -> (Either a b, b)
lift_monoid)
      where
        lift_monoid :: Either (a, b) b -> (Either a b, b)
lift_monoid (Left (a
x, b
w)) = (a -> Either a b
forall a b. a -> Either a b
Left a
x, b
w)
        lift_monoid (Right b
y) = Either a b -> (Either a b, b)
forall w a. Monoid w => a -> (a, w)
unit (b -> Either a b
forall a b. b -> Either a b
Right b
y)

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

instance (ArrowZero a, Monoid w) => ArrowZero (WriterArrow w a) where
    zeroArrow :: WriterArrow w a b c
zeroArrow = a b (c, w) -> WriterArrow w a b c
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow a b (c, w)
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow

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

instance (ArrowLoop a, Monoid w) => ArrowLoop (WriterArrow w a) where
    loop :: WriterArrow w a (b, d) (c, d) -> WriterArrow w a b c
loop (WriterArrow a (b, d) ((c, d), w)
f) = a b (c, w) -> WriterArrow w a b c
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a (b, d) ((c, w), d) -> a b (c, w)
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (a (b, d) ((c, d), w)
f a (b, d) ((c, d), w)
-> a ((c, d), w) ((c, w), d) -> a (b, d) ((c, w), 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), w) -> ((c, w), d)) -> a ((c, d), w) ((c, w), d)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((c, d), w) -> ((c, w), d)
forall a w b. ((a, w), b) -> ((a, b), w)
swapenv))
      where
        swapenv :: ((a, b), b) -> ((a, b), b)
swapenv ~(~(a
x, b
y), b
w) = ((a
x, b
w), b
y)

-- Other instances

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

instance (Arrow a, Monoid w) => Applicative (WriterArrow w a b) where
    pure :: a -> WriterArrow w a b a
pure a
x = (b -> a) -> WriterArrow w 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)
    WriterArrow w a b (a -> b)
f <*> :: WriterArrow w a b (a -> b)
-> WriterArrow w a b a -> WriterArrow w a b b
<*> WriterArrow w a b a
g = WriterArrow w a b (a -> b)
f WriterArrow w a b (a -> b)
-> WriterArrow w a b a -> WriterArrow w a b (a -> b, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WriterArrow w a b a
g WriterArrow w a b (a -> b, a)
-> WriterArrow w a (a -> b, a) b -> WriterArrow w 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) -> WriterArrow w 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, Monoid w) => Alternative (WriterArrow w a b) where
    empty :: WriterArrow w a b a
empty = WriterArrow w a b a
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
    WriterArrow w a b a
f <|> :: WriterArrow w a b a -> WriterArrow w a b a -> WriterArrow w a b a
<|> WriterArrow w a b a
g = WriterArrow w a b a
f WriterArrow w a b a -> WriterArrow w a b a -> WriterArrow w a b a
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> WriterArrow w a b a
g

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

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

-- new instances

instance (Arrow a, Monoid w) => ArrowWriter w (WriterArrow w a) where
    write :: WriterArrow w a w ()
write = a w ((), w) -> WriterArrow w a w ()
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow ((w -> ((), w)) -> a w ((), w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\w
x -> ((), w
x)))
    newWriter :: WriterArrow w a e b -> WriterArrow w a e (b, w)
newWriter (WriterArrow a e (b, w)
f) =
        a e ((b, w), w) -> WriterArrow w a e (b, w)
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a e (b, w)
f a e (b, w) -> a (b, w) ((b, w), w) -> a e ((b, w), w)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((b, w) -> ((b, w), w)) -> a (b, w) ((b, w), w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(b
x, w
w) -> ((b
x, w
w), w
w)))

instance (Arrow a, Monoid w) => ArrowAddWriter w (WriterArrow w a) a where
    liftWriter :: a e b -> WriterArrow w a e b
liftWriter = a e b -> WriterArrow w a e b
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift
    elimWriter :: WriterArrow w a e b -> a e (b, w)
elimWriter = WriterArrow w a e b -> a e (b, w)
forall (a :: * -> * -> *) w e b.
(Arrow a, Monoid w) =>
WriterArrow w a e b -> a e (b, w)
runWriter

-- liftings of other classes

instance (ArrowCircuit a, Monoid w) => ArrowCircuit (WriterArrow w a) where
    delay :: b -> WriterArrow w a b b
delay b
x = a b b -> WriterArrow w 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, Monoid w) => ArrowError ex (WriterArrow w a) where
    raise :: WriterArrow w a ex b
raise = a ex b -> WriterArrow w 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 :: WriterArrow w a e b
-> WriterArrow w a (e, ex) b -> WriterArrow w a e b
handle (WriterArrow a e (b, w)
f) (WriterArrow a (e, ex) (b, w)
h) = a e (b, w) -> WriterArrow w a e b
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a e (b, w) -> a (e, ex) (b, w) -> a e (b, w)
forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a (e, ex) b -> a e b
handle a e (b, w)
f a (e, ex) (b, w)
h)
    tryInUnless :: WriterArrow w a e b
-> WriterArrow w a (e, b) c
-> WriterArrow w a (e, ex) c
-> WriterArrow w a e c
tryInUnless (WriterArrow a e (b, w)
f) (WriterArrow a (e, b) (c, w)
s) (WriterArrow a (e, ex) (c, w)
h) =
        a e (c, w) -> WriterArrow w a e c
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a e (b, w)
-> a (e, (b, w)) (c, w) -> a (e, ex) (c, w) -> a e (c, w)
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 (b, w)
f a (e, (b, w)) (c, w)
s' a (e, ex) (c, w)
h)
      where
        s' :: a (e, (b, w)) (c, w)
s' = ((e, (b, w)) -> ((e, b), w)) -> a (e, (b, w)) ((e, b), w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (e, (b, w)) -> ((e, b), w)
forall a b b. (a, (b, b)) -> ((a, b), b)
lstrength a (e, (b, w)) ((e, b), w)
-> a ((e, b), w) (c, w) -> a (e, (b, w)) (c, w)
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) (c, w) -> a ((e, b), w) ((c, w), w)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a (e, b) (c, w)
s a ((e, b), w) ((c, w), w)
-> a ((c, w), w) (c, w) -> a ((e, b), w) (c, w)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (((c, w), w) -> (c, w)) -> a ((c, w), w) (c, w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((c, w), w) -> (c, w)
forall w a. Monoid w => ((a, w), w) -> (a, w)
join
        lstrength :: (a, (b, b)) -> ((a, b), b)
lstrength (a
x, (b
y, b
w)) = ((a
x, b
y), b
w)
    newError :: WriterArrow w a e b -> WriterArrow w a e (Either ex b)
newError (WriterArrow a e (b, w)
f) = a e (Either ex b, w) -> WriterArrow w a e (Either ex b)
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a e (b, w) -> a e (Either ex (b, w))
forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a e (Either ex b)
newError a e (b, w)
f a e (Either ex (b, w))
-> a (Either ex (b, w)) (Either ex b, w) -> a e (Either ex b, w)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either ex (b, w) -> (Either ex b, w))
-> a (Either ex (b, w)) (Either ex b, w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Either ex (b, w) -> (Either ex b, w)
forall w a b. Monoid w => Either a (b, w) -> (Either a b, w)
h)
      where
        h :: Either a (b, w) -> (Either a b, w)
h (Left a
ex) = Either a b -> (Either a b, w)
forall w a. Monoid w => a -> (a, w)
unit (a -> Either a b
forall a b. a -> Either a b
Left a
ex)
        h (Right (b
c, w
w)) = (b -> Either a b
forall a b. b -> Either a b
Right b
c, w
w)

instance (ArrowReader r a, Monoid w) => ArrowReader r (WriterArrow w a) where
    readState :: WriterArrow w a b r
readState = a b r -> WriterArrow w a b r
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift a b r
forall r (a :: * -> * -> *) b. ArrowReader r a => a b r
readState
    newReader :: WriterArrow w a e b -> WriterArrow w a (e, r) b
newReader (WriterArrow a e (b, w)
f) = a (e, r) (b, w) -> WriterArrow w a (e, r) b
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a e (b, w) -> a (e, r) (b, w)
forall r (a :: * -> * -> *) e b.
ArrowReader r a =>
a e b -> a (e, r) b
newReader a e (b, w)
f)

instance (ArrowState s a, Monoid w) => ArrowState s (WriterArrow w a) where
    fetch :: WriterArrow w a e s
fetch = a e s -> WriterArrow w 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 :: WriterArrow w a s ()
store = a s () -> WriterArrow w 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

-- promotions of encapsulation operators

instance (ArrowAddError ex a a', Monoid w) =>
        ArrowAddError ex (WriterArrow w a) (WriterArrow w a') where
    liftError :: WriterArrow w a' e b -> WriterArrow w a e b
liftError (WriterArrow a' e (b, w)
f) = a e (b, w) -> WriterArrow w a e b
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a' e (b, w) -> a e (b, w)
forall ex (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddError ex a a' =>
a' e b -> a e b
liftError a' e (b, w)
f)
    elimError :: WriterArrow w a e b
-> WriterArrow w a' (e, ex) b -> WriterArrow w a' e b
elimError (WriterArrow a e (b, w)
f) (WriterArrow a' (e, ex) (b, w)
h) = a' e (b, w) -> WriterArrow w a' e b
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a e (b, w) -> a' (e, ex) (b, w) -> a' e (b, w)
forall ex (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddError ex a a' =>
a e b -> a' (e, ex) b -> a' e b
elimError a e (b, w)
f a' (e, ex) (b, w)
h)

instance (ArrowAddReader r a a', Monoid w) =>
        ArrowAddReader r (WriterArrow w a) (WriterArrow w a') where
    liftReader :: WriterArrow w a' e b -> WriterArrow w a e b
liftReader (WriterArrow a' e (b, w)
f) = a e (b, w) -> WriterArrow w a e b
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a' e (b, w) -> a e (b, w)
forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a' e b -> a e b
liftReader a' e (b, w)
f)
    elimReader :: WriterArrow w a e b -> WriterArrow w a' (e, r) b
elimReader (WriterArrow a e (b, w)
f) = a' (e, r) (b, w) -> WriterArrow w a' (e, r) b
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a e (b, w) -> a' (e, r) (b, w)
forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a e b -> a' (e, r) b
elimReader a e (b, w)
f)

instance (ArrowAddState s a a', Monoid w) =>
        ArrowAddState s (WriterArrow w a) (WriterArrow w a') where
    liftState :: WriterArrow w a' e b -> WriterArrow w a e b
liftState (WriterArrow a' e (b, w)
f) = a e (b, w) -> WriterArrow w a e b
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a' e (b, w) -> a e (b, w)
forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a' e b -> a e b
liftState a' e (b, w)
f)
    elimState :: WriterArrow w a e b -> WriterArrow w a' (e, s) (b, s)
elimState (WriterArrow a e (b, w)
f) = a' (e, s) ((b, s), w) -> WriterArrow w a' (e, s) (b, s)
forall w (a :: * -> * -> *) b c. a b (c, w) -> WriterArrow w a b c
WriterArrow (a e (b, w) -> a' (e, s) ((b, w), s)
forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a e b -> a' (e, s) (b, s)
elimState a e (b, w)
f a' (e, s) ((b, w), s)
-> a' ((b, w), s) ((b, s), w) -> a' (e, s) ((b, s), w)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (((b, w), s) -> ((b, s), w)) -> a' ((b, w), s) ((b, s), w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((b, w), s) -> ((b, s), w)
forall a w b. ((a, w), b) -> ((a, b), w)
rstrength)