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

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Arrow.Transformer.Static
-- 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 adding static information.

module Control.Arrow.Transformer.Static(
    StaticArrow(StaticArrow), StaticMonadArrow, StaticArrowArrow,
    wrap, unwrap, wrapA, unwrapA, wrapM, unwrapM,
    ) where

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

import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Monad
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 the underlying arrow with static information.

newtype StaticArrow f a b c = StaticArrow (f (a b c))

instance (Arrow a, Applicative f) => ArrowTransformer (StaticArrow f) a where
    lift :: a b c -> StaticArrow f a b c
lift a b c
f = f (a b c) -> StaticArrow f a b c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a b c -> f (a b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a b c
f)

instance (Category a, Applicative f) => Category (StaticArrow f a) where
    id :: StaticArrow f a a a
id = f (a a a) -> StaticArrow f a a a
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a a a -> f (a a a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
    StaticArrow f (a b c)
f . :: StaticArrow f a b c -> StaticArrow f a a b -> StaticArrow f a a c
. StaticArrow f (a a b)
g = f (a a c) -> StaticArrow f a a c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (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 b c -> a a b -> a a c) -> f (a b c) -> f (a a b -> a a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a b c)
f f (a a b -> a a c) -> f (a a b) -> f (a a c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a a b)
g)

instance (Arrow a, Applicative f) => Arrow (StaticArrow f a) where
    arr :: (b -> c) -> StaticArrow f a b c
arr b -> c
f = f (a b c) -> StaticArrow f a b c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a b c -> f (a b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f))
    first :: StaticArrow f a b c -> StaticArrow f a (b, d) (c, d)
first (StaticArrow f (a b c)
f) = f (a (b, d) (c, d)) -> StaticArrow f a (b, d) (c, d)
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (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 -> a (b, d) (c, d)) -> f (a b c) -> f (a (b, d) (c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a b c)
f)

-- The following promotions follow directly from the arrow transformer.

instance (ArrowZero a, Applicative f) => ArrowZero (StaticArrow f a) where
    zeroArrow :: StaticArrow f a b c
zeroArrow = a b c -> StaticArrow f 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 (ArrowCircuit a, Applicative f) => ArrowCircuit (StaticArrow f a) where
    delay :: b -> StaticArrow f a b b
delay b
x = a b b -> StaticArrow f 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, Applicative f) => ArrowError ex (StaticArrow f a) where
    raise :: StaticArrow f a ex b
raise = a ex b -> StaticArrow f 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 :: StaticArrow f a e b
-> StaticArrow f a (e, ex) b -> StaticArrow f a e b
handle (StaticArrow f (a e b)
f) (StaticArrow f (a (e, ex) b)
h) =
        f (a e b) -> StaticArrow f a e b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a e b -> a (e, ex) b -> a e b
forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a (e, ex) b -> a e b
handle (a e b -> a (e, ex) b -> a e b)
-> f (a e b) -> f (a (e, ex) b -> a e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a e b)
f f (a (e, ex) b -> a e b) -> f (a (e, ex) b) -> f (a e b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a (e, ex) b)
h)
    tryInUnless :: StaticArrow f a e b
-> StaticArrow f a (e, b) c
-> StaticArrow f a (e, ex) c
-> StaticArrow f a e c
tryInUnless (StaticArrow f (a e b)
f) (StaticArrow f (a (e, b) c)
s) (StaticArrow f (a (e, ex) c)
h) =
        f (a e c) -> StaticArrow f a e c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a e b -> a (e, b) c -> a (e, ex) c -> a e 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 b -> a (e, b) c -> a (e, ex) c -> a e c)
-> f (a e b) -> f (a (e, b) c -> a (e, ex) c -> a e c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a e b)
f f (a (e, b) c -> a (e, ex) c -> a e c)
-> f (a (e, b) c) -> f (a (e, ex) c -> a e c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a (e, b) c)
s f (a (e, ex) c -> a e c) -> f (a (e, ex) c) -> f (a e c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a (e, ex) c)
h)

instance (ArrowReader r a, Applicative f) => ArrowReader r (StaticArrow f a) where
    readState :: StaticArrow f a b r
readState = a b r -> StaticArrow f 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 :: StaticArrow f a e b -> StaticArrow f a (e, r) b
newReader (StaticArrow f (a e b)
f) = f (a (e, r) b) -> StaticArrow f a (e, r) b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a e b -> a (e, r) b
forall r (a :: * -> * -> *) e b.
ArrowReader r a =>
a e b -> a (e, r) b
newReader (a e b -> a (e, r) b) -> f (a e b) -> f (a (e, r) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a e b)
f)

instance (ArrowState s a, Applicative f) => ArrowState s (StaticArrow f a) where
    fetch :: StaticArrow f a e s
fetch = a e s -> StaticArrow f 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 :: StaticArrow f a s ()
store = a s () -> StaticArrow f 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, Applicative f) => ArrowWriter w (StaticArrow f a) where
    write :: StaticArrow f a w ()
write = a w () -> StaticArrow f 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 :: StaticArrow f a e b -> StaticArrow f a e (b, w)
newWriter (StaticArrow f (a e b)
f) = f (a e (b, w)) -> StaticArrow f a e (b, w)
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a e b -> a e (b, w)
forall w (a :: * -> * -> *) e b.
ArrowWriter w a =>
a e b -> a e (b, w)
newWriter (a e b -> a e (b, w)) -> f (a e b) -> f (a e (b, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a e b)
f)

-- Classes that are preserved.

instance (ArrowChoice a, Applicative f) => ArrowChoice (StaticArrow f a) where
    left :: StaticArrow f a b c -> StaticArrow f a (Either b d) (Either c d)
left (StaticArrow f (a b c)
f) = f (a (Either b d) (Either c d))
-> StaticArrow f a (Either b d) (Either c d)
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (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 -> a (Either b d) (Either c d))
-> f (a b c) -> f (a (Either b d) (Either c d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a b c)
f)

-- ArrowApply is generally not preserved.

instance (ArrowLoop a, Applicative f) => ArrowLoop (StaticArrow f a) where
    loop :: StaticArrow f a (b, d) (c, d) -> StaticArrow f a b c
loop (StaticArrow f (a (b, d) (c, d))
f) = f (a b c) -> StaticArrow f a b c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a (b, d) (c, d) -> a b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (a (b, d) (c, d) -> a b c) -> f (a (b, d) (c, d)) -> f (a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a (b, d) (c, d))
f)

instance (ArrowPlus a, Applicative f) => ArrowPlus (StaticArrow f a) where
    StaticArrow f (a b c)
f <+> :: StaticArrow f a b c -> StaticArrow f a b c -> StaticArrow f a b c
<+> StaticArrow f (a b c)
g = f (a b c) -> StaticArrow f a b c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (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 b c -> a b c -> a b c) -> f (a b c) -> f (a b c -> a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a b c)
f f (a b c -> a b c) -> f (a b c) -> f (a b c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a b c)
g)

-- Other instances

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

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

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

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

-- promotions

instance (ArrowAddStream a a', Applicative f) =>
        ArrowAddStream (StaticArrow f a) (StaticArrow f a') where
    liftStream :: StaticArrow f a' e b -> StaticArrow f a e b
liftStream (StaticArrow f (a' e b)
f) = f (a e b) -> StaticArrow f a e b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a' e b -> a e b
forall (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddStream a a' =>
a' e b -> a e b
liftStream (a' e b -> a e b) -> f (a' e b) -> f (a e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a' e b)
f)
    elimStream :: StaticArrow f a (e, b) c
-> StaticArrow f a' (e, Stream b) (Stream c)
elimStream (StaticArrow f (a (e, b) c)
f) = f (a' (e, Stream b) (Stream c))
-> StaticArrow f a' (e, Stream b) (Stream c)
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a (e, b) c -> a' (e, Stream b) (Stream c)
forall (a :: * -> * -> *) (a' :: * -> * -> *) e b c.
ArrowAddStream a a' =>
a (e, b) c -> a' (e, Stream b) (Stream c)
elimStream (a (e, b) c -> a' (e, Stream b) (Stream c))
-> f (a (e, b) c) -> f (a' (e, Stream b) (Stream c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a (e, b) c)
f)

instance (ArrowAddState s a a', Applicative f) =>
        ArrowAddState s (StaticArrow f a) (StaticArrow f a') where
    liftState :: StaticArrow f a' e b -> StaticArrow f a e b
liftState (StaticArrow f (a' e b)
f) = f (a e b) -> StaticArrow f a e b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a' e b -> a e b
forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a' e b -> a e b
liftState (a' e b -> a e b) -> f (a' e b) -> f (a e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a' e b)
f)
    elimState :: StaticArrow f a e b -> StaticArrow f a' (e, s) (b, s)
elimState (StaticArrow f (a e b)
f) = f (a' (e, s) (b, s)) -> StaticArrow f a' (e, s) (b, s)
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a e b -> a' (e, s) (b, s)
forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a e b -> a' (e, s) (b, s)
elimState (a e b -> a' (e, s) (b, s)) -> f (a e b) -> f (a' (e, s) (b, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a e b)
f)

instance (ArrowAddReader r a a', Applicative f) =>
        ArrowAddReader r (StaticArrow f a) (StaticArrow f a') where
    liftReader :: StaticArrow f a' e b -> StaticArrow f a e b
liftReader (StaticArrow f (a' e b)
f) = f (a e b) -> StaticArrow f a e b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a' e b -> a e b
forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a' e b -> a e b
liftReader (a' e b -> a e b) -> f (a' e b) -> f (a e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a' e b)
f)
    elimReader :: StaticArrow f a e b -> StaticArrow f a' (e, r) b
elimReader (StaticArrow f (a e b)
f) = f (a' (e, r) b) -> StaticArrow f a' (e, r) b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a e b -> a' (e, r) b
forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a e b -> a' (e, r) b
elimReader (a e b -> a' (e, r) b) -> f (a e b) -> f (a' (e, r) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a e b)
f)

instance (ArrowAddWriter w a a', Applicative f) =>
        ArrowAddWriter w (StaticArrow f a) (StaticArrow f a') where
    liftWriter :: StaticArrow f a' e b -> StaticArrow f a e b
liftWriter (StaticArrow f (a' e b)
f) = f (a e b) -> StaticArrow f a e b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a' e b -> a e b
forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a' e b -> a e b
liftWriter (a' e b -> a e b) -> f (a' e b) -> f (a e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a' e b)
f)
    elimWriter :: StaticArrow f a e b -> StaticArrow f a' e (b, w)
elimWriter (StaticArrow f (a e b)
f) = f (a' e (b, w)) -> StaticArrow f a' e (b, w)
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a e b -> a' e (b, w)
forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a e b -> a' e (b, w)
elimWriter (a e b -> a' e (b, w)) -> f (a e b) -> f (a' e (b, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a e b)
f)

instance (ArrowAddError ex a a', Applicative f) =>
        ArrowAddError ex (StaticArrow f a) (StaticArrow f a') where
    liftError :: StaticArrow f a' e b -> StaticArrow f a e b
liftError (StaticArrow f (a' e b)
f) = f (a e b) -> StaticArrow f a e b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a' e b -> a e b
forall ex (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddError ex a a' =>
a' e b -> a e b
liftError (a' e b -> a e b) -> f (a' e b) -> f (a e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a' e b)
f)
    elimError :: StaticArrow f a e b
-> StaticArrow f a' (e, ex) b -> StaticArrow f a' e b
elimError (StaticArrow f (a e b)
f) (StaticArrow f (a' (e, ex) b)
h) =
        f (a' e b) -> StaticArrow f a' e b
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a e b -> a' (e, ex) b -> a' e b
forall ex (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddError ex a a' =>
a e b -> a' (e, ex) b -> a' e b
elimError (a e b -> a' (e, ex) b -> a' e b)
-> f (a e b) -> f (a' (e, ex) b -> a' e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a e b)
f f (a' (e, ex) b -> a' e b) -> f (a' (e, ex) b) -> f (a' e b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (a' (e, ex) b)
h)

wrap :: (Applicative f, Arrow a) => f (a b c) -> StaticArrow f a b c
wrap :: f (a b c) -> StaticArrow f a b c
wrap = f (a b c) -> StaticArrow f a b c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow

unwrap :: (Applicative f, Arrow a) => StaticArrow f a b c -> f (a b c)
unwrap :: StaticArrow f a b c -> f (a b c)
unwrap (StaticArrow f (a b c)
f) = f (a b c)
f

-- | A special case.

type StaticArrowArrow a s = StaticArrow (WrappedArrow a s)

wrapA :: (Arrow a, Arrow a') => a s (a' b c) -> StaticArrowArrow a s a' b c
wrapA :: a s (a' b c) -> StaticArrowArrow a s a' b c
wrapA a s (a' b c)
x = WrappedArrow a s (a' b c) -> StaticArrowArrow a s a' b c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (a s (a' b c) -> WrappedArrow a s (a' b c)
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow a s (a' b c)
x)

unwrapA :: (Arrow a, Arrow a') => StaticArrowArrow a s a' b c -> a s (a' b c)
unwrapA :: StaticArrowArrow a s a' b c -> a s (a' b c)
unwrapA (StaticArrow (WrapArrow a s (a' b c)
x)) = a s (a' b c)
x

-- | A special case is monads applied to the whole arrow, in contrast to
-- 'Kleisli' arrows, in which the monad is applied to the output.

type StaticMonadArrow m = StaticArrow (WrappedMonad m)

wrapM :: (Monad m, Arrow a) => m (a b c) -> StaticMonadArrow m a b c
wrapM :: m (a b c) -> StaticMonadArrow m a b c
wrapM m (a b c)
x = WrappedMonad m (a b c) -> StaticMonadArrow m a b c
forall (f :: * -> *) (a :: * -> * -> *) b c.
f (a b c) -> StaticArrow f a b c
StaticArrow (m (a b c) -> WrappedMonad m (a b c)
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad m (a b c)
x)

unwrapM :: (Monad m, Arrow a) => StaticMonadArrow m a b c -> m (a b c)
unwrapM :: StaticMonadArrow m a b c -> m (a b c)
unwrapM (StaticArrow (WrapMonad m (a b c)
x)) = m (a b c)
x