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

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Arrow.Transformer.Error
    -- 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)
    --
    -- An arrow transformer that adds error handling.
    --
    -- /TODO:/ the operations here are inconsistent with other arrow transformers.

    module Control.Arrow.Transformer.Error(
        ErrorArrow(ErrorArrow),
        runError,
        ArrowAddError(..),
        ) 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 that augments an existing arrow with possible errors.
    -- The 'ArrowError' class contains methods for raising and handling
    -- these errors.

    newtype ErrorArrow ex a b c = ErrorArrow (a b (Either ex c))

    rstrength :: (Either ex a, b) -> Either ex (a, b)
    rstrength :: (Either ex a, b) -> Either ex (a, b)
    rstrength (Left ex :: ex
    ex, _) = ex -> Either ex (a, b)
    forall a b. a -> Either a b
    Left ex
    ex
    rstrength (Right a :: a
    a, b :: b
    b) = (a, b) -> Either ex (a, b)
    forall a b. b -> Either a b
    Right (a
    a, b
    b)

    -- | Encapsulate an error-raising computation,
    -- by completely handling any errors.
    --
    -- Typical usage in arrow notation:
    --
    -- >    proc p -> ...
    -- >        body `runError` \ex -> handler

    runError :: ArrowChoice a =>
        ErrorArrow ex a e b  -- ^ computation that may raise errors
        -> a (e,ex) b        -- ^ computation to handle errors
        -> a e b
    runError :: ErrorArrow ex a e b -> a (e, ex) b -> a e b
    runError (ErrorArrow f :: a e (Either ex b)
    f) h :: a (e, ex) b
    h =
        (e -> e) -> a e e
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr e -> e
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id a e e -> a e (Either ex b) -> a e (e, Either ex b)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& a e (Either ex b)
    f a e (e, Either ex b) -> a (e, Either ex b) b -> a e b
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ((e, Either ex b) -> Either (e, ex) b)
    -> a (e, Either ex b) (Either (e, ex) b)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (e, Either ex b) -> Either (e, ex) b
    forall a b b. (a, Either b b) -> Either (a, b) b
    strength a (e, Either ex b) (Either (e, ex) b)
    -> a (Either (e, ex) b) b -> a (e, Either ex 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 (e, ex) b
    h a (e, ex) b -> a b b -> a (Either (e, ex) b) b
    forall (a :: * -> * -> *) b d c.
    ArrowChoice a =>
    a b d -> a c d -> a (Either b c) d
    ||| (b -> b) -> a b b
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr b -> b
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id
          where
            strength :: (a, Either b b) -> Either (a, b) b
    strength (x :: a
    x, Left y :: b
    y) = (a, b) -> Either (a, b) b
    forall a b. a -> Either a b
    Left (a
    x, b
    y)
            strength (_, Right z :: b
    z) = b -> Either (a, b) b
    forall a b. b -> Either a b
    Right b
    z

    -- transformer

    instance ArrowChoice a => ArrowTransformer (ErrorArrow ex) a where
        lift :: a b c -> ErrorArrow ex a b c
    lift f :: a b c
    f = a b (Either ex c) -> ErrorArrow ex a b c
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a b c
    f a b c -> a c (Either ex c) -> a b (Either ex 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 ex c) -> a c (Either ex c)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr c -> Either ex c
    forall a b. b -> Either a b
    Right)

    -- liftings of standard classes

    instance ArrowChoice a => Category (ErrorArrow ex a) where
        id :: ErrorArrow ex a a a
    id = a a (Either ex a) -> ErrorArrow ex a a a
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow ((a -> Either ex a) -> a a (Either ex a)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr a -> Either ex a
    forall a b. b -> Either a b
    Right)
        ErrorArrow f :: a b (Either ex c)
    f . :: ErrorArrow ex a b c -> ErrorArrow ex a a b -> ErrorArrow ex a a c
    . ErrorArrow g :: a a (Either ex b)
    g =
            a a (Either ex c) -> ErrorArrow ex a a c
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow ((Either ex (Either ex c) -> Either ex c)
    -> a (Either ex (Either ex c)) (Either ex c)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((ex -> Either ex c)
    -> (Either ex c -> Either ex c)
    -> Either ex (Either ex c)
    -> Either ex c
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ex -> Either ex c
    forall a b. a -> Either a b
    Left Either ex c -> Either ex c
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id) a (Either ex (Either ex c)) (Either ex c)
    -> a a (Either ex (Either ex c)) -> a a (Either ex c)
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . a b (Either ex c) -> a (Either ex b) (Either ex (Either ex c))
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either d b) (Either d c)
    right a b (Either ex c)
    f a (Either ex b) (Either ex (Either ex c))
    -> a a (Either ex b) -> a a (Either ex (Either ex 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 (Either ex b)
    g)

    instance ArrowChoice a => Arrow (ErrorArrow ex a) where
        arr :: (b -> c) -> ErrorArrow ex a b c
    arr f :: b -> c
    f = a b (Either ex c) -> ErrorArrow ex a b c
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow ((b -> Either ex c) -> a b (Either ex c)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (c -> Either ex c
    forall a b. b -> Either a b
    Right (c -> Either ex c) -> (b -> c) -> b -> Either ex 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 :: ErrorArrow ex a b c -> ErrorArrow ex a (b, d) (c, d)
    first (ErrorArrow f :: a b (Either ex c)
    f) = a (b, d) (Either ex (c, d)) -> ErrorArrow ex a (b, d) (c, d)
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a b (Either ex c) -> a (b, d) (Either ex c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first a b (Either ex c)
    f a (b, d) (Either ex c, d)
    -> a (Either ex c, d) (Either ex (c, d))
    -> a (b, d) (Either ex (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 ex c, d) -> Either ex (c, d))
    -> a (Either ex c, d) (Either ex (c, d))
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (Either ex c, d) -> Either ex (c, d)
    forall ex a b. (Either ex a, b) -> Either ex (a, b)
    rstrength)

    instance ArrowChoice a => ArrowChoice (ErrorArrow ex a) where
        left :: ErrorArrow ex a b c -> ErrorArrow ex a (Either b d) (Either c d)
    left (ErrorArrow f :: a b (Either ex c)
    f) = a (Either b d) (Either ex (Either c d))
    -> ErrorArrow ex a (Either b d) (Either c d)
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a b (Either ex c) -> a (Either b d) (Either (Either ex c) d)
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left a b (Either ex c)
    f a (Either b d) (Either (Either ex c) d)
    -> a (Either (Either ex c) d) (Either ex (Either c d))
    -> a (Either b d) (Either ex (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
    >>> (Either (Either ex c) d -> Either ex (Either c d))
    -> a (Either (Either ex c) d) (Either ex (Either c d))
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr Either (Either ex c) d -> Either ex (Either c d)
    forall a b c. Either (Either a b) c -> Either a (Either b c)
    assocsum)

    assocsum :: Either (Either a b) c -> Either a (Either b c)
    assocsum :: Either (Either a b) c -> Either a (Either b c)
    assocsum (Left (Left a :: a
    a)) = a -> Either a (Either b c)
    forall a b. a -> Either a b
    Left a
    a
    assocsum (Left (Right b :: b
    b)) = Either b c -> Either a (Either b c)
    forall a b. b -> Either a b
    Right (b -> Either b c
    forall a b. a -> Either a b
    Left b
    b)
    assocsum (Right c :: c
    c) = Either b c -> Either a (Either b c)
    forall a b. b -> Either a b
    Right (c -> Either b c
    forall a b. b -> Either a b
    Right c
    c)

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

    -- this instance has the right type, but it doesn't satisfy right
    -- tightening, or sliding of non-strict functions.

    instance (ArrowChoice a, ArrowLoop a) => ArrowLoop (ErrorArrow ex a) where
        loop :: ErrorArrow ex a (b, d) (c, d) -> ErrorArrow ex a b c
    loop (ErrorArrow f :: a (b, d) (Either ex (c, d))
    f) = a b (Either ex c) -> ErrorArrow ex a b c
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a (b, d) (Either ex c, d) -> a b (Either ex c)
    forall (a :: * -> * -> *) b d c.
    ArrowLoop a =>
    a (b, d) (c, d) -> a b c
    loop (a (b, d) (Either ex (c, d))
    f a (b, d) (Either ex (c, d))
    -> a (Either ex (c, d)) (Either ex c, d)
    -> a (b, d) (Either ex 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 ex (c, d) -> (Either ex c, d))
    -> a (Either ex (c, d)) (Either ex c, d)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr Either ex (c, d) -> (Either ex c, d)
    forall a a b. Either a (a, b) -> (Either a a, b)
    dist))
          where
            dist :: Either a (a, b) -> (Either a a, b)
    dist x :: Either a (a, b)
    x = (Either a (a, b) -> Either a a
    forall a b b. Either a (b, b) -> Either a b
    fstRight Either a (a, b)
    x, (a, b) -> b
    forall a b. (a, b) -> b
    snd ((a, b) -> b) -> (a, b) -> b
    forall a b. (a -> b) -> a -> b
    $ Either a (a, b) -> (a, b)
    forall a p. Either a p -> p
    fromRight Either a (a, b)
    x)
            fstRight :: Either a (b, b) -> Either a b
    fstRight (Left x :: a
    x) = a -> Either a b
    forall a b. a -> Either a b
    Left a
    x
            fstRight (Right (x :: b
    x,_)) = b -> Either a b
    forall a b. b -> Either a b
    Right b
    x
            fromRight :: Either a p -> p
    fromRight (Left _) = [Char] -> p
    forall a. HasCallStack => [Char] -> a
    error "fromRight"
            fromRight (Right y :: p
    y) = p
    y

    -- Other instances

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

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

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

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

    -- fresh instances

    instance ArrowChoice a => ArrowError ex (ErrorArrow ex a) where
        raise :: ErrorArrow ex a ex b
    raise = a ex (Either ex b) -> ErrorArrow ex a ex b
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow ((ex -> Either ex b) -> a ex (Either ex b)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ex -> Either ex b
    forall a b. a -> Either a b
    Left)
        handle :: ErrorArrow ex a e b
    -> ErrorArrow ex a (e, ex) b -> ErrorArrow ex a e b
    handle (ErrorArrow f :: a e (Either ex b)
    f) (ErrorArrow h :: a (e, ex) (Either ex b)
    h) =
            a e (Either ex b) -> ErrorArrow ex a e b
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow ((e -> e) -> a e e
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr e -> e
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id a e e -> a e (Either ex b) -> a e (e, Either ex b)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& a e (Either ex b)
    f a e (e, Either ex b)
    -> a (e, Either ex b) (Either ex b) -> a e (Either ex b)
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ((e, Either ex b) -> Either (e, ex) b)
    -> a (e, Either ex b) (Either (e, ex) b)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (e, Either ex b) -> Either (e, ex) b
    forall a b b. (a, Either b b) -> Either (a, b) b
    strength a (e, Either ex b) (Either (e, ex) b)
    -> a (Either (e, ex) b) (Either ex b)
    -> a (e, Either ex b) (Either 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) (Either ex b)
    h a (e, ex) (Either ex b)
    -> a b (Either ex b) -> a (Either (e, ex) b) (Either ex b)
    forall (a :: * -> * -> *) b d c.
    ArrowChoice a =>
    a b d -> a c d -> a (Either b c) d
    ||| (b -> Either ex b) -> a b (Either ex b)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr b -> Either ex b
    forall a b. b -> Either a b
    Right)
          where
            strength :: (a, Either b b) -> Either (a, b) b
    strength (x :: a
    x, Left y :: b
    y) = (a, b) -> Either (a, b) b
    forall a b. a -> Either a b
    Left (a
    x, b
    y)
            strength (_, Right z :: b
    z) = b -> Either (a, b) b
    forall a b. b -> Either a b
    Right b
    z
        tryInUnless :: ErrorArrow ex a e b
    -> ErrorArrow ex a (e, b) c
    -> ErrorArrow ex a (e, ex) c
    -> ErrorArrow ex a e c
    tryInUnless (ErrorArrow f :: a e (Either ex b)
    f) (ErrorArrow s :: a (e, b) (Either ex c)
    s) (ErrorArrow h :: a (e, ex) (Either ex c)
    h) =
            a e (Either ex c) -> ErrorArrow ex a e c
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow ((e -> e) -> a e e
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr e -> e
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id a e e -> a e (Either ex b) -> a e (e, Either ex b)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& a e (Either ex b)
    f a e (e, Either ex b)
    -> a (e, Either ex b) (Either ex c) -> a e (Either ex c)
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ((e, Either ex b) -> Either (e, ex) (e, b))
    -> a (e, Either ex b) (Either (e, ex) (e, b))
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (e, Either ex b) -> Either (e, ex) (e, b)
    forall a b b. (a, Either b b) -> Either (a, b) (a, b)
    distr a (e, Either ex b) (Either (e, ex) (e, b))
    -> a (Either (e, ex) (e, b)) (Either ex c)
    -> a (e, Either ex b) (Either 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) (Either ex c)
    h a (e, ex) (Either ex c)
    -> a (e, b) (Either ex c)
    -> a (Either (e, ex) (e, b)) (Either ex c)
    forall (a :: * -> * -> *) b d c.
    ArrowChoice a =>
    a b d -> a c d -> a (Either b c) d
    ||| a (e, b) (Either ex c)
    s)
          where
            distr :: (a, Either b b) -> Either (a, b) (a, b)
    distr (b :: a
    b, Left ex :: b
    ex) = (a, b) -> Either (a, b) (a, b)
    forall a b. a -> Either a b
    Left (a
    b, b
    ex)
            distr (b :: a
    b, Right c :: b
    c) = (a, b) -> Either (a, b) (a, b)
    forall a b. b -> Either a b
    Right (a
    b, b
    c)

    instance ArrowChoice a => ArrowAddError ex (ErrorArrow ex a) a where
        liftError :: a e b -> ErrorArrow ex a e b
    liftError = a e b -> ErrorArrow ex a e b
    forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
    ArrowTransformer f a =>
    a b c -> f a b c
    lift
        elimError :: ErrorArrow ex a e b -> a (e, ex) b -> a e b
    elimError = ErrorArrow ex a e b -> a (e, ex) b -> a e b
    forall (a :: * -> * -> *) ex e b.
    ArrowChoice a =>
    ErrorArrow ex a e b -> a (e, ex) b -> a e b
    runError

    instance (Monoid ex, ArrowChoice a) => ArrowZero (ErrorArrow ex a) where
        zeroArrow :: ErrorArrow ex a b c
    zeroArrow = a b (Either ex c) -> ErrorArrow ex a b c
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow ((b -> Either ex c) -> a b (Either ex c)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (Either ex c -> b -> Either ex c
    forall a b. a -> b -> a
    const (ex -> Either ex c
    forall a b. a -> Either a b
    Left ex
    forall a. Monoid a => a
    mempty)))

    instance (Monoid ex, ArrowChoice a) => ArrowPlus (ErrorArrow ex a) where
        f :: ErrorArrow ex a b c
    f <+> :: ErrorArrow ex a b c -> ErrorArrow ex a b c -> ErrorArrow ex a b c
    <+> g :: ErrorArrow ex a b c
    g = ErrorArrow ex a b c
    -> ErrorArrow ex a (b, ex) c -> ErrorArrow ex a b c
    forall ex (a :: * -> * -> *) e b.
    ArrowError ex a =>
    a e b -> a (e, ex) b -> a e b
    handle ErrorArrow ex a b c
    f (ErrorArrow ex a (b, ex) c -> ErrorArrow ex a b c)
    -> ErrorArrow ex a (b, ex) c -> ErrorArrow ex a b c
    forall a b. (a -> b) -> a -> b
    $ ErrorArrow ex a (b, ex) c
    -> ErrorArrow ex a ((b, ex), ex) c -> ErrorArrow ex a (b, ex) c
    forall ex (a :: * -> * -> *) e b.
    ArrowError ex a =>
    a e b -> a (e, ex) b -> a e b
    handle (((b, ex) -> b) -> ErrorArrow ex a (b, ex) b
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (b, ex) -> b
    forall a b. (a, b) -> a
    fst ErrorArrow ex a (b, ex) b
    -> ErrorArrow ex a b c -> ErrorArrow ex a (b, ex) c
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ErrorArrow ex a b c
    g) (ErrorArrow ex a ((b, ex), ex) c -> ErrorArrow ex a (b, ex) c)
    -> ErrorArrow ex a ((b, ex), ex) c -> ErrorArrow ex a (b, ex) c
    forall a b. (a -> b) -> a -> b
    $
            a ((b, ex), ex) (Either ex c) -> ErrorArrow ex a ((b, ex), ex) c
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow ((((b, ex), ex) -> Either ex c) -> a ((b, ex), ex) (Either ex c)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (\((_,ex1 :: ex
    ex1), ex2 :: ex
    ex2) -> ex -> Either ex c
    forall a b. a -> Either a b
    Left (ex
    ex1 ex -> ex -> ex
    forall a. Monoid a => a -> a -> a
    `mappend` ex
    ex2)))

    -- liftings of other arrow classes

    -- specializations of general promotions

    instance (ArrowReader r a, ArrowChoice a) =>
            ArrowReader r (ErrorArrow ex a) where
        readState :: ErrorArrow ex a b r
    readState = a b r -> ErrorArrow ex 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 :: ErrorArrow ex a e b -> ErrorArrow ex a (e, r) b
    newReader (ErrorArrow f :: a e (Either ex b)
    f) = a (e, r) (Either ex b) -> ErrorArrow ex a (e, r) b
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a e (Either ex b) -> a (e, r) (Either ex b)
    forall r (a :: * -> * -> *) e b.
    ArrowReader r a =>
    a e b -> a (e, r) b
    newReader a e (Either ex b)
    f)

    instance (ArrowState s a, ArrowChoice a) =>
            ArrowState s (ErrorArrow ex a) where
        fetch :: ErrorArrow ex a e s
    fetch = a e s -> ErrorArrow ex 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 :: ErrorArrow ex a s ()
    store = a s () -> ErrorArrow ex 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 w a, ArrowChoice a) =>
            ArrowWriter w (ErrorArrow ex a) where
        write :: ErrorArrow ex a w ()
    write = a w () -> ErrorArrow ex a w ()
    forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
    ArrowTransformer f a =>
    a b c -> f a b c
    lift a w ()
    forall w (a :: * -> * -> *). ArrowWriter w a => a w ()
    write
        newWriter :: ErrorArrow ex a e b -> ErrorArrow ex a e (b, w)
    newWriter (ErrorArrow f :: a e (Either ex b)
    f) = a e (Either ex (b, w)) -> ErrorArrow ex a e (b, w)
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a e (Either ex b) -> a e (Either ex b, w)
    forall w (a :: * -> * -> *) e b.
    ArrowWriter w a =>
    a e b -> a e (b, w)
    newWriter a e (Either ex b)
    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 ex a b. (Either ex a, b) -> Either ex (a, b)
    rstrength)

    -- promotions

    instance (ArrowAddReader r a a', ArrowChoice a, ArrowChoice a') =>
            ArrowAddReader r (ErrorArrow ex a) (ErrorArrow ex a') where
        liftReader :: ErrorArrow ex a' e b -> ErrorArrow ex a e b
    liftReader (ErrorArrow f :: a' e (Either ex b)
    f) = a e (Either ex b) -> ErrorArrow ex a e b
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a' e (Either ex b) -> a e (Either ex b)
    forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
    ArrowAddReader r a a' =>
    a' e b -> a e b
    liftReader a' e (Either ex b)
    f)
        elimReader :: ErrorArrow ex a e b -> ErrorArrow ex a' (e, r) b
    elimReader (ErrorArrow f :: a e (Either ex b)
    f) = a' (e, r) (Either ex b) -> ErrorArrow ex a' (e, r) b
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a e (Either ex b) -> a' (e, r) (Either ex b)
    forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
    ArrowAddReader r a a' =>
    a e b -> a' (e, r) b
    elimReader a e (Either ex b)
    f)

    instance (ArrowAddState s a a', ArrowChoice a, ArrowChoice a') =>
            ArrowAddState s (ErrorArrow ex a) (ErrorArrow ex a') where
        liftState :: ErrorArrow ex a' e b -> ErrorArrow ex a e b
    liftState (ErrorArrow f :: a' e (Either ex b)
    f) = a e (Either ex b) -> ErrorArrow ex a e b
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a' e (Either ex b) -> a e (Either ex b)
    forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
    ArrowAddState s a a' =>
    a' e b -> a e b
    liftState a' e (Either ex b)
    f)
        elimState :: ErrorArrow ex a e b -> ErrorArrow ex a' (e, s) (b, s)
    elimState (ErrorArrow f :: a e (Either ex b)
    f) = a' (e, s) (Either ex (b, s)) -> ErrorArrow ex a' (e, s) (b, s)
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a e (Either ex b) -> a' (e, s) (Either ex b, s)
    forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
    ArrowAddState s a a' =>
    a e b -> a' (e, s) (b, s)
    elimState a e (Either ex b)
    f a' (e, s) (Either ex b, s)
    -> a' (Either ex b, s) (Either ex (b, s))
    -> a' (e, s) (Either ex (b, s))
    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, s) -> Either ex (b, s))
    -> a' (Either ex b, s) (Either ex (b, s))
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (Either ex b, s) -> Either ex (b, s)
    forall ex a b. (Either ex a, b) -> Either ex (a, b)
    rstrength)

    instance (ArrowAddWriter w a a', ArrowChoice a, ArrowChoice a') =>
            ArrowAddWriter w (ErrorArrow ex a) (ErrorArrow ex a') where
        liftWriter :: ErrorArrow ex a' e b -> ErrorArrow ex a e b
    liftWriter (ErrorArrow f :: a' e (Either ex b)
    f) = a e (Either ex b) -> ErrorArrow ex a e b
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a' e (Either ex b) -> a e (Either ex b)
    forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
    ArrowAddWriter w a a' =>
    a' e b -> a e b
    liftWriter a' e (Either ex b)
    f)
        elimWriter :: ErrorArrow ex a e b -> ErrorArrow ex a' e (b, w)
    elimWriter (ErrorArrow f :: a e (Either ex b)
    f) = a' e (Either ex (b, w)) -> ErrorArrow ex a' e (b, w)
    forall ex (a :: * -> * -> *) b c.
    a b (Either ex c) -> ErrorArrow ex a b c
    ErrorArrow (a e (Either ex b) -> a' e (Either ex b, w)
    forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
    ArrowAddWriter w a a' =>
    a e b -> a' e (b, w)
    elimWriter a e (Either ex b)
    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 ex a b. (Either ex a, b) -> Either ex (a, b)
    rstrength)