    {-# LANGUAGE CPP #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Arrow.Transformer.CoState
    -- 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)
    --
    -- Transformation of state readers.
    --
    -- /TODO:/ define operations for this arrow.

    module Control.Arrow.Transformer.CoState(
        CoStateArrow(CoStateArrow),
        ) where

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

    import Prelude hiding (id,(.))

    newtype CoStateArrow s a b c = CoStateArrow (a (s -> b) (s -> c))

    instance Category a => Category (CoStateArrow s a) where
        id :: forall a. CoStateArrow s a a a
    id = a (s -> a) (s -> a) -> CoStateArrow s a a a
    forall s (a :: * -> * -> *) b c.
    a (s -> b) (s -> c) -> CoStateArrow s a b c
    CoStateArrow a (s -> a) (s -> a)
    forall a. a a a
    forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id
        CoStateArrow a (s -> b) (s -> c)
    f . :: forall b c a.
    CoStateArrow s a b c
    -> CoStateArrow s a a b -> CoStateArrow s a a c
    . CoStateArrow a (s -> a) (s -> b)
    g = a (s -> a) (s -> c) -> CoStateArrow s a a c
    forall s (a :: * -> * -> *) b c.
    a (s -> b) (s -> c) -> CoStateArrow s a b c
    CoStateArrow (a (s -> b) (s -> c)
    f a (s -> b) (s -> c) -> a (s -> a) (s -> b) -> a (s -> a) (s -> c)
    forall b c a. a b c -> a a b -> a 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 (s -> a) (s -> b)
    g)

    instance Arrow a => Arrow (CoStateArrow s a) where
        arr :: forall b c. (b -> c) -> CoStateArrow s a b c
    arr b -> c
    f = a (s -> b) (s -> c) -> CoStateArrow s a b c
    forall s (a :: * -> * -> *) b c.
    a (s -> b) (s -> c) -> CoStateArrow s a b c
    CoStateArrow (((s -> b) -> s -> c) -> a (s -> b) (s -> c)
    forall b c. (b -> c) -> a b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (b -> c
    f (b -> c) -> (s -> b) -> s -> 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
    .))
        first :: forall b c d.
    CoStateArrow s a b c -> CoStateArrow s a (b, d) (c, d)
    first (CoStateArrow a (s -> b) (s -> c)
    f) =
            a (s -> (b, d)) (s -> (c, d)) -> CoStateArrow s a (b, d) (c, d)
    forall s (a :: * -> * -> *) b c.
    a (s -> b) (s -> c) -> CoStateArrow s a b c
    CoStateArrow (((s -> (b, d)) -> (s -> b, s -> d))
    -> a (s -> (b, d)) (s -> b, s -> d)
    forall b c. (b -> c) -> a b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (s -> (b, d)) -> (s -> b, s -> d)
    forall s a b. (s -> (a, b)) -> (s -> a, s -> b)
    unzipMap a (s -> (b, d)) (s -> b, s -> d)
    -> a (s -> b, s -> d) (s -> (c, d))
    -> a (s -> (b, d)) (s -> (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 (s -> b) (s -> c) -> a (s -> b, s -> d) (s -> c, s -> d)
    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 (s -> b) (s -> c)
    f a (s -> b, s -> d) (s -> c, s -> d)
    -> a (s -> c, s -> d) (s -> (c, d))
    -> a (s -> b, s -> d) (s -> (c, d))
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ((s -> c, s -> d) -> s -> (c, d))
    -> a (s -> c, s -> d) (s -> (c, d))
    forall b c. (b -> c) -> a b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (s -> c, s -> d) -> s -> (c, d)
    forall s a b. (s -> a, s -> b) -> s -> (a, b)
    zipMap)

    zipMap :: (s -> a, s -> b) -> (s -> (a,b))
    zipMap :: forall s a b. (s -> a, s -> b) -> s -> (a, b)
    zipMap (s -> a, s -> b)
    h s
    s = ((s -> a, s -> b) -> s -> a
    forall a b. (a, b) -> a
    fst (s -> a, s -> b)
    h s
    s, (s -> a, s -> b) -> s -> b
    forall a b. (a, b) -> b
    snd (s -> a, s -> b)
    h s
    s)

    unzipMap :: (s -> (a,b)) -> (s -> a, s -> b)
    unzipMap :: forall s a b. (s -> (a, b)) -> (s -> a, s -> b)
    unzipMap s -> (a, b)
    h = ((a, b) -> a
    forall a b. (a, b) -> a
    fst ((a, b) -> a) -> (s -> (a, b)) -> s -> 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
    . s -> (a, b)
    h, (a, b) -> b
    forall a b. (a, b) -> b
    snd ((a, b) -> b) -> (s -> (a, b)) -> s -> b
    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
    . s -> (a, b)
    h)

    -- there is no transformer

    -- promotions of standard classes

    instance ArrowLoop a => ArrowLoop (CoStateArrow s a) where
        loop :: forall b d c.
    CoStateArrow s a (b, d) (c, d) -> CoStateArrow s a b c
    loop (CoStateArrow a (s -> (b, d)) (s -> (c, d))
    f) =
            a (s -> b) (s -> c) -> CoStateArrow s a b c
    forall s (a :: * -> * -> *) b c.
    a (s -> b) (s -> c) -> CoStateArrow s a b c
    CoStateArrow (a (s -> b, s -> d) (s -> c, s -> d) -> a (s -> b) (s -> c)
    forall b d c. a (b, d) (c, d) -> a b c
    forall (a :: * -> * -> *) b d c.
    ArrowLoop a =>
    a (b, d) (c, d) -> a b c
    loop (((s -> b, s -> d) -> s -> (b, d))
    -> a (s -> b, s -> d) (s -> (b, d))
    forall b c. (b -> c) -> a b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (s -> b, s -> d) -> s -> (b, d)
    forall s a b. (s -> a, s -> b) -> s -> (a, b)
    zipMap a (s -> b, s -> d) (s -> (b, d))
    -> a (s -> (b, d)) (s -> c, s -> d)
    -> a (s -> b, s -> d) (s -> c, s -> d)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> a (s -> (b, d)) (s -> (c, d))
    f a (s -> (b, d)) (s -> (c, d))
    -> a (s -> (c, d)) (s -> c, s -> d)
    -> a (s -> (b, d)) (s -> c, s -> d)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ((s -> (c, d)) -> (s -> c, s -> d))
    -> a (s -> (c, d)) (s -> c, s -> d)
    forall b c. (b -> c) -> a b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (s -> (c, d)) -> (s -> c, s -> d)
    forall s a b. (s -> (a, b)) -> (s -> a, s -> b)
    unzipMap))

    instance ArrowZero a => ArrowZero (CoStateArrow s a) where
        zeroArrow :: forall b c. CoStateArrow s a b c
    zeroArrow = a (s -> b) (s -> c) -> CoStateArrow s a b c
    forall s (a :: * -> * -> *) b c.
    a (s -> b) (s -> c) -> CoStateArrow s a b c
    CoStateArrow a (s -> b) (s -> c)
    forall b c. a b c
    forall (a :: * -> * -> *) b c. ArrowZero a => a b c
    zeroArrow

    instance ArrowPlus a => ArrowPlus (CoStateArrow s a) where
        CoStateArrow a (s -> b) (s -> c)
    f <+> :: forall b c.
    CoStateArrow s a b c
    -> CoStateArrow s a b c -> CoStateArrow s a b c
    <+> CoStateArrow a (s -> b) (s -> c)
    g = a (s -> b) (s -> c) -> CoStateArrow s a b c
    forall s (a :: * -> * -> *) b c.
    a (s -> b) (s -> c) -> CoStateArrow s a b c
    CoStateArrow (a (s -> b) (s -> c)
    f a (s -> b) (s -> c) -> a (s -> b) (s -> c) -> a (s -> b) (s -> c)
    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 (s -> b) (s -> c)
    g)

    -- Other instances

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

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

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

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