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

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Arrow.Transformer.Automaton
-- 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)
--
-- Simple Mealy-style automata.

module Control.Arrow.Transformer.Automaton(
    Automaton(Automaton), runAutomaton,
    ) 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 Data.Stream

import Prelude hiding (id,(.))

-- | An arrow type comprising Mealy-style automata, each step of which is
-- is a computation in the original arrow type.

newtype Automaton a b c = Automaton (a b (c, Automaton a b c))

instance Arrow a => ArrowTransformer Automaton a where
    lift :: forall b c. a b c -> Automaton a b c
lift a b c
f = Automaton a b c
c
      where
        c :: Automaton a b c
c = forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a b c
f forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. a -> b -> a
const Automaton a b c
c))

instance Arrow a => Category (Automaton a) where
    id :: forall a. Automaton a a a
id = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    Automaton a b (c, Automaton a b c)
f . :: forall b c a. Automaton a b c -> Automaton a a b -> Automaton a a c
. Automaton a a (b, Automaton a a b)
g =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((c
z, Automaton a b c
cf), Automaton a a b
cg) -> (c
z, Automaton a b c
cf forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Automaton a a b
cg)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b (c, Automaton a b c)
f 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, Automaton a a b)
g)

instance Arrow a => Arrow (Automaton a) where
    arr :: forall b c. (b -> c) -> Automaton a b c
arr b -> c
f = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f)
    first :: forall b c d. Automaton a b c -> Automaton a (b, d) (c, d)
first (Automaton a b (c, Automaton a b c)
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b (c, Automaton a b c)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((c
x', Automaton a b c
c), d
y) -> ((c
x', d
y), forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Automaton a b c
c)))
    second :: forall b c d. Automaton a b c -> Automaton a (d, b) (d, c)
second (Automaton a b (c, Automaton a b c)
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a b (c, Automaton a b c)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(d
x, (c
y', Automaton a b c
c)) -> ((d
x, c
y'), forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Automaton a b c
c)))
    Automaton a b (c, Automaton a b c)
f1 *** :: forall b c b' c'.
Automaton a b c -> Automaton a b' c' -> Automaton a (b, b') (c, c')
*** Automaton a b' (c', Automaton a b' c')
f2 =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((a b (c, Automaton a b c)
f1 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** a b' (c', Automaton a b' c')
f2) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((c
x', Automaton a b c
c1), (c'
y', Automaton a b' c'
c2)) -> ((c
x', c'
y'), Automaton a b c
c1 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Automaton a b' c'
c2)))
    Automaton a b (c, Automaton a b c)
f1 &&& :: forall b c c'.
Automaton a b c -> Automaton a b c' -> Automaton a b (c, c')
&&& Automaton a b (c', Automaton a b c')
f2 =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((a b (c, Automaton a b c)
f1 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a b (c', Automaton a b c')
f2) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((c
x1, Automaton a b c
c1), (c'
x2, Automaton a b c'
c2)) -> ((c
x1, c'
x2), Automaton a b c
c1 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Automaton a b c'
c2)))

instance ArrowChoice a => ArrowChoice (Automaton a) where
    left :: forall b c d.
Automaton a b c -> Automaton a (Either b d) (Either c d)
left (Automaton a b (c, Automaton a b c)
f) = forall {b}. Automaton a (Either b b) (Either c b)
left_f
      where
        left_f :: Automaton a (Either b b) (Either c b)
left_f = forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left a b (c, Automaton a b c)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Either (c, Automaton a b c) b
-> (Either c b, Automaton a (Either b b) (Either c b))
combine)
        combine :: Either (c, Automaton a b c) b
-> (Either c b, Automaton a (Either b b) (Either c b))
combine (Left (c
y, Automaton a b c
cf)) = (forall a b. a -> Either a b
Left c
y, forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Automaton a b c
cf)
        combine (Right b
z) = (forall a b. b -> Either a b
Right b
z, Automaton a (Either b b) (Either c b)
left_f)
    right :: forall b c d.
Automaton a b c -> Automaton a (Either d b) (Either d c)
right (Automaton a b (c, Automaton a b c)
f) = forall {a}. Automaton a (Either a b) (Either a c)
right_f
      where
        right_f :: Automaton a (Either a b) (Either a c)
right_f = forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right a b (c, Automaton a b c)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Either a (c, Automaton a b c)
-> (Either a c, Automaton a (Either a b) (Either a c))
combine)
        combine :: Either a (c, Automaton a b c)
-> (Either a c, Automaton a (Either a b) (Either a c))
combine (Left a
z) = (forall a b. a -> Either a b
Left a
z, Automaton a (Either a b) (Either a c)
right_f)
        combine (Right (c
y, Automaton a b c
cf)) = (forall a b. b -> Either a b
Right c
y, forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right Automaton a b c
cf)
    Automaton a b (c, Automaton a b c)
f1 +++ :: forall b c b' c'.
Automaton a b c
-> Automaton a b' c' -> Automaton a (Either b b') (Either c c')
+++ Automaton a b' (c', Automaton a b' c')
f2 =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((a b (c, Automaton a b c)
f1 forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ a b' (c', Automaton a b' c')
f2) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {a} {b}.
Either (a, Automaton a b c) (b, Automaton a b' c')
-> (Either a b, Automaton a (Either b b') (Either c c'))
combine)
      where
        combine :: Either (a, Automaton a b c) (b, Automaton a b' c')
-> (Either a b, Automaton a (Either b b') (Either c c'))
combine (Left  (a
x, Automaton a b c
c)) = (forall a b. a -> Either a b
Left a
x,  Automaton a b c
c forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton a b' (c', Automaton a b' c')
f2)
        combine (Right (b
x, Automaton a b' c'
c)) = (forall a b. b -> Either a b
Right b
x, forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton a b (c, Automaton a b c)
f1 forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ Automaton a b' c'
c)
    Automaton a b (d, Automaton a b d)
f1 ||| :: forall b d c.
Automaton a b d -> Automaton a c d -> Automaton a (Either b c) d
||| Automaton a c (d, Automaton a c d)
f2 =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((a b (d, Automaton a b d)
f1 forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ a c (d, Automaton a c d)
f2) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {a}.
Either (a, Automaton a b d) (a, Automaton a c d)
-> (a, Automaton a (Either b c) d)
combine)
      where
        combine :: Either (a, Automaton a b d) (a, Automaton a c d)
-> (a, Automaton a (Either b c) d)
combine (Left  (a
x, Automaton a b d
c)) = (a
x, Automaton a b d
c forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton a c (d, Automaton a c d)
f2)
        combine (Right (a
x, Automaton a c d
c)) = (a
x, forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton a b (d, Automaton a b d)
f1 forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Automaton a c d
c)

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

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

-- Circuit combinators

instance ArrowLoop a => ArrowLoop (Automaton a) where
    loop :: forall b d c. Automaton a (b, d) (c, d) -> Automaton a b c
loop (Automaton a (b, d) ((c, d), Automaton a (b, d) (c, d))
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (a (b, d) ((c, d), Automaton a (b, d) (c, d))
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((c
x, d
y), Automaton a (b, d) (c, d)
cf) -> ((c
x, forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop Automaton a (b, d) (c, d)
cf), d
y))))

instance ArrowLoop a => ArrowCircuit (Automaton a) where
    delay :: forall b. b -> Automaton a b b
delay b
x = forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\b
x' -> (b
x, forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay b
x')))

-- Other instances

instance Arrow a => Functor (Automaton a b) where
    fmap :: forall a b. (a -> b) -> Automaton a b a -> Automaton a b b
fmap a -> b
f Automaton a b a
g = Automaton a b a
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f

instance Arrow a => Applicative (Automaton a b) where
    pure :: forall a. a -> Automaton a b a
pure a
x = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. a -> b -> a
const a
x)
    Automaton a b (a -> b)
f <*> :: forall a b.
Automaton a b (a -> b) -> Automaton a b a -> Automaton a b b
<*> Automaton a b a
g = Automaton a b (a -> b)
f forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Automaton a b a
g forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)

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

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

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

--    runAutomaton (Automaton f) = proc (e, Cons x xs) -> do
--        (y, c) <- f <- (e, x)
--        ys <- runAutomaton c -<< (e, xs)
--        returnA -< Cons y ys

-- | Encapsulating an automaton by running it on a stream of inputs,
-- obtaining a stream of outputs.
--
-- Typical usage in arrow notation:
--
-- >    proc p -> do
-- >        ...
-- >        ys <- (|runAutomaton (\x -> ...)|) xs
--
-- Here @xs@ refers to the input stream and @x@ to individual
-- elements of that stream.  @ys@ is bound to the output stream.

runAutomaton :: (ArrowLoop a, ArrowApply a) =>
    Automaton a (e,b) c -> a (e,Stream b) (Stream c)
runAutomaton :: forall (a :: * -> * -> *) e b c.
(ArrowLoop a, ArrowApply a) =>
Automaton a (e, b) c -> a (e, Stream b) (Stream c)
runAutomaton (Automaton a (e, b) (c, Automaton a (e, b) c)
f) =
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(e
e, Cons b
x Stream b
xs) -> ((e
e, b
x), (e
e, Stream b
xs))) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a (e, b) (c, Automaton a (e, b) c)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((c
y, Automaton a (e, b) c
c), (e
e, Stream b
xs)) -> (c
y, (forall (a :: * -> * -> *) e b c.
(ArrowLoop a, ArrowApply a) =>
Automaton a (e, b) c -> a (e, Stream b) (Stream c)
runAutomaton Automaton a (e, b) c
c, (e
e, Stream b
xs)))) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Stream a -> Stream a
Cons)

instance (ArrowLoop a, ArrowApply a) => ArrowAddStream (Automaton a) a where
    liftStream :: forall e b. a e b -> Automaton a e b
liftStream = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift
    elimStream :: forall e b c. Automaton a (e, b) c -> a (e, Stream b) (Stream c)
elimStream = forall (a :: * -> * -> *) e b c.
(ArrowLoop a, ArrowApply a) =>
Automaton a (e, b) c -> a (e, Stream b) (Stream c)
runAutomaton

-- other promotions

instance ArrowWriter w a => ArrowWriter w (Automaton a) where
    write :: Automaton a w ()
write = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall w (a :: * -> * -> *). ArrowWriter w a => a w ()
write
    newWriter :: forall e b. Automaton a e b -> Automaton a e (b, w)
newWriter (Automaton a e (b, Automaton a e b)
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall w (a :: * -> * -> *) e b.
ArrowWriter w a =>
a e b -> a e (b, w)
newWriter a e (b, Automaton a e b)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((b
c, Automaton a e b
f'), w
w) -> ((b
c, w
w), forall w (a :: * -> * -> *) e b.
ArrowWriter w a =>
a e b -> a e (b, w)
newWriter Automaton a e b
f')))

instance ArrowError r a => ArrowError r (Automaton a) where
    raise :: forall b. Automaton a r b
raise = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall ex (a :: * -> * -> *) b. ArrowError ex a => a ex b
raise
    tryInUnless :: forall e b c.
Automaton a e b
-> Automaton a (e, b) c -> Automaton a (e, r) c -> Automaton a e c
tryInUnless f0 :: Automaton a e b
f0@(Automaton a e (b, Automaton a e b)
f) s0 :: Automaton a (e, b) c
s0@(Automaton a (e, b) (c, Automaton a (e, b) c)
s) h0 :: Automaton a (e, r) c
h0@(Automaton a (e, r) (c, Automaton a (e, r) c)
h) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (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, Automaton a e b)
f a (e, (b, Automaton a e b)) (c, Automaton a e c)
sA a (e, r) (c, Automaton a e c)
hA)
      where
        sA :: a (e, (b, Automaton a e b)) (c, Automaton a e c)
sA = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(e
b,(b
c,Automaton a e b
f')) -> ((e
b,b
c),Automaton a e b
f')) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a (e, b) (c, Automaton a (e, b) c)
s forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((c
d,Automaton a (e, b) c
s'),Automaton a e b
f') -> (c
d, forall ex (a :: * -> * -> *) e b c.
ArrowError ex a =>
a e b -> a (e, b) c -> a (e, ex) c -> a e c
tryInUnless Automaton a e b
f' Automaton a (e, b) c
s' Automaton a (e, r) c
h0))
        hA :: a (e, r) (c, Automaton a e c)
hA = a (e, r) (c, Automaton a (e, r) c)
h forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(c
d,Automaton a (e, r) c
h') -> (c
d, forall ex (a :: * -> * -> *) e b c.
ArrowError ex a =>
a e b -> a (e, b) c -> a (e, ex) c -> a e c
tryInUnless Automaton a e b
f0 Automaton a (e, b) c
s0 Automaton a (e, r) c
h'))
    newError :: forall e b. Automaton a e b -> Automaton a e (Either r b)
newError (Automaton a e (b, Automaton a e b)
f) = forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a e (Either ex b)
newError a e (b, Automaton a e b)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {ex} {a} {b}.
ArrowError ex a =>
Either a (b, Automaton a e b)
-> (Either a b, Automaton a e (Either ex b))
h)
      where
        h :: Either a (b, Automaton a e b)
-> (Either a b, Automaton a e (Either ex b))
h (Left a
ex) = (forall a b. a -> Either a b
Left a
ex, forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a e (Either ex b)
newError (forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton a e (b, Automaton a e b)
f))
        h (Right (b
c, Automaton a e b
f')) = (forall a b. b -> Either a b
Right b
c, forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a e (Either ex b)
newError Automaton a e b
f')

instance ArrowReader r a => ArrowReader r (Automaton a) where
    readState :: forall b. Automaton a b r
readState = forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift forall r (a :: * -> * -> *) b. ArrowReader r a => a b r
readState
    newReader :: forall e b. Automaton a e b -> Automaton a (e, r) b
newReader (Automaton a e (b, Automaton a e b)
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall r (a :: * -> * -> *) e b.
ArrowReader r a =>
a e b -> a (e, r) b
newReader a e (b, Automaton a e b)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall r (a :: * -> * -> *) e b.
ArrowReader r a =>
a e b -> a (e, r) b
newReader))

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

-- encapsulations

instance ArrowAddWriter w a a' =>
        ArrowAddWriter w (Automaton a) (Automaton a') where
    liftWriter :: forall e b. Automaton a' e b -> Automaton a e b
liftWriter (Automaton a' e (b, Automaton a' e b)
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a' e b -> a e b
liftWriter a' e (b, Automaton a' e b)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(b
c, Automaton a' e b
f') -> (b
c, forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a' e b -> a e b
liftWriter Automaton a' e b
f')))
    elimWriter :: forall e b. Automaton a e b -> Automaton a' e (b, w)
elimWriter (Automaton a e (b, Automaton a e b)
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a e b -> a' e (b, w)
elimWriter a e (b, Automaton a e b)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((b
c, Automaton a e b
f'), w
w) -> ((b
c, w
w), forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a e b -> a' e (b, w)
elimWriter Automaton a e b
f')))

instance ArrowAddReader r a a' =>
        ArrowAddReader r (Automaton a) (Automaton a') where
    liftReader :: forall e b. Automaton a' e b -> Automaton a e b
liftReader (Automaton a' e (b, Automaton a' e b)
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a' e b -> a e b
liftReader a' e (b, Automaton a' e b)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(b
c, Automaton a' e b
f') -> (b
c, forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a' e b -> a e b
liftReader Automaton a' e b
f')))
    elimReader :: forall e b. Automaton a e b -> Automaton a' (e, r) b
elimReader (Automaton a e (b, Automaton a e b)
f) =
        forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a e b -> a' (e, r) b
elimReader a e (b, Automaton a e b)
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a e b -> a' (e, r) b
elimReader))


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