{-# 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 :: a b c -> Automaton a b c
lift a b c
f = Automaton a b c
c
      where
        c :: Automaton a b c
c = a b (c, Automaton a b c) -> Automaton a b c
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a b c
f a b c -> a b (Automaton a b c) -> a b (c, Automaton a b c)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (b -> Automaton a b c) -> a b (Automaton a b c)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Automaton a b c -> b -> Automaton a b c
forall a b. a -> b -> a
const Automaton a b c
c))

instance Arrow a => Category (Automaton a) where
    id :: Automaton a a a
id = a a a -> Automaton a a a
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift a a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    Automaton a b (c, Automaton a b c)
f . :: Automaton a b c -> Automaton a a b -> Automaton a a c
. Automaton a a (b, Automaton a a b)
g =
        a a (c, Automaton a a c) -> Automaton a a c
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((((c, Automaton a b c), Automaton a a b) -> (c, Automaton a a c))
-> a ((c, Automaton a b c), Automaton a a b) (c, Automaton a a c)
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 Automaton a b c -> Automaton a a b -> Automaton 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
. Automaton a a b
cg)) a ((c, Automaton a b c), Automaton a a b) (c, Automaton a a c)
-> a a ((c, Automaton a b c), Automaton a a b)
-> a a (c, Automaton 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, Automaton a b c)
-> a (b, Automaton a a b) ((c, Automaton a b c), Automaton a a b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b (c, Automaton a b c)
f a (b, Automaton a a b) ((c, Automaton a b c), Automaton a a b)
-> a a (b, Automaton a a b)
-> a a ((c, Automaton a b c), Automaton a a b)
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 :: (b -> c) -> Automaton a b c
arr b -> c
f = a b c -> Automaton a b c
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift ((b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f)
    first :: Automaton a b c -> Automaton a (b, d) (c, d)
first (Automaton a b (c, Automaton a b c)
f) =
        a (b, d) ((c, d), Automaton a (b, d) (c, d))
-> Automaton a (b, d) (c, d)
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a b (c, Automaton a b c) -> a (b, d) ((c, Automaton a b c), d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b (c, Automaton a b c)
f a (b, d) ((c, Automaton a b c), d)
-> a ((c, Automaton a b c), d) ((c, d), Automaton a (b, d) (c, d))
-> a (b, d) ((c, d), Automaton a (b, d) (c, d))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (((c, Automaton a b c), d) -> ((c, d), Automaton a (b, d) (c, d)))
-> a ((c, Automaton a b c), d) ((c, d), Automaton a (b, d) (c, d))
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), Automaton a b c -> Automaton a (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Automaton a b c
c)))
    second :: Automaton a b c -> Automaton a (d, b) (d, c)
second (Automaton a b (c, Automaton a b c)
f) =
        a (d, b) ((d, c), Automaton a (d, b) (d, c))
-> Automaton a (d, b) (d, c)
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a b (c, Automaton a b c) -> a (d, b) (d, (c, Automaton a b c))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a b (c, Automaton a b c)
f a (d, b) (d, (c, Automaton a b c))
-> a (d, (c, Automaton a b c)) ((d, c), Automaton a (d, b) (d, c))
-> a (d, b) ((d, c), Automaton a (d, b) (d, c))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            ((d, (c, Automaton a b c)) -> ((d, c), Automaton a (d, b) (d, c)))
-> a (d, (c, Automaton a b c)) ((d, c), Automaton a (d, b) (d, 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'), Automaton a b c -> Automaton a (d, b) (d, c)
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 *** :: Automaton a b c -> Automaton a b' c' -> Automaton a (b, b') (c, c')
*** Automaton a b' (c', Automaton a b' c')
f2 =
        a (b, b') ((c, c'), Automaton a (b, b') (c, c'))
-> Automaton a (b, b') (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)
f1 a b (c, Automaton a b c)
-> a b' (c', Automaton a b' c')
-> a (b, b') ((c, Automaton a b c), (c', Automaton a b' c'))
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) a (b, b') ((c, Automaton a b c), (c', Automaton a b' c'))
-> a ((c, Automaton a b c), (c', Automaton a b' c'))
     ((c, c'), Automaton a (b, b') (c, c'))
-> a (b, b') ((c, c'), Automaton a (b, b') (c, c'))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (((c, Automaton a b c), (c', Automaton a b' c'))
 -> ((c, c'), Automaton a (b, b') (c, c')))
-> a ((c, Automaton a b c), (c', Automaton a b' c'))
     ((c, c'), Automaton a (b, b') (c, 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 Automaton a b c -> Automaton a b' c' -> Automaton a (b, b') (c, c')
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 &&& :: Automaton a b c -> Automaton a b c' -> Automaton a b (c, c')
&&& Automaton a b (c', Automaton a b c')
f2 =
        a b ((c, c'), Automaton a b (c, 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, Automaton a b c)
f1 a b (c, Automaton a b c)
-> a b (c', Automaton a b c')
-> a b ((c, Automaton a b c), (c', Automaton a b c'))
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) a b ((c, Automaton a b c), (c', Automaton a b c'))
-> a ((c, Automaton a b c), (c', Automaton a b c'))
     ((c, c'), Automaton a b (c, c'))
-> a b ((c, c'), Automaton a b (c, c'))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (((c, Automaton a b c), (c', Automaton a b c'))
 -> ((c, c'), Automaton a b (c, c')))
-> a ((c, Automaton a b c), (c', Automaton a b c'))
     ((c, c'), Automaton a b (c, 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 Automaton a b c -> Automaton a b c' -> Automaton a b (c, c')
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 :: Automaton a b c -> Automaton a (Either b d) (Either c d)
left (Automaton a b (c, Automaton a b c)
f) = Automaton a (Either b d) (Either c d)
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 = a (Either b b) (Either c b, Automaton a (Either b b) (Either c b))
-> Automaton a (Either b b) (Either c b)
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a b (c, Automaton a b c)
-> a (Either b b) (Either (c, Automaton a b c) b)
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 a (Either b b) (Either (c, Automaton a b c) b)
-> a (Either (c, Automaton a b c) b)
     (Either c b, Automaton a (Either b b) (Either c b))
-> a (Either b b)
     (Either c b, Automaton a (Either b b) (Either c b))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either (c, Automaton a b c) b
 -> (Either c b, Automaton a (Either b b) (Either c b)))
-> a (Either (c, Automaton a b c) b)
     (Either c b, Automaton a (Either b b) (Either c b))
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)) = (c -> Either c b
forall a b. a -> Either a b
Left c
y, Automaton a b c -> Automaton a (Either b b) (Either c b)
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) = (b -> Either c b
forall a b. b -> Either a b
Right b
z, Automaton a (Either b b) (Either c b)
left_f)
    right :: Automaton a b c -> Automaton a (Either d b) (Either d c)
right (Automaton a b (c, Automaton a b c)
f) = Automaton a (Either d b) (Either d c)
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 = a (Either a b) (Either a c, Automaton a (Either a b) (Either a c))
-> Automaton a (Either a b) (Either a c)
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a b (c, Automaton a b c)
-> a (Either a b) (Either a (c, Automaton a b c))
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 a (Either a b) (Either a (c, Automaton a b c))
-> a (Either a (c, Automaton a b c))
     (Either a c, Automaton a (Either a b) (Either a c))
-> a (Either a b)
     (Either a c, Automaton a (Either a b) (Either a c))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either a (c, Automaton a b c)
 -> (Either a c, Automaton a (Either a b) (Either a c)))
-> a (Either a (c, Automaton a b c))
     (Either a c, Automaton a (Either a b) (Either 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) = (a -> Either a c
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)) = (c -> Either a c
forall a b. b -> Either a b
Right c
y, Automaton a b c -> Automaton a (Either a b) (Either a c)
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 +++ :: 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 =
        a (Either b b')
  (Either c c', Automaton a (Either b b') (Either c c'))
-> Automaton 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)
f1 a b (c, Automaton a b c)
-> a b' (c', Automaton a b' c')
-> a (Either b b')
     (Either (c, Automaton a b c) (c', Automaton a b' c'))
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) a (Either b b')
  (Either (c, Automaton a b c) (c', Automaton a b' c'))
-> a (Either (c, Automaton a b c) (c', Automaton a b' c'))
     (Either c c', Automaton a (Either b b') (Either c c'))
-> a (Either b b')
     (Either c c', Automaton a (Either b b') (Either c c'))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either (c, Automaton a b c) (c', Automaton a b' c')
 -> (Either c c', Automaton a (Either b b') (Either c c')))
-> a (Either (c, Automaton a b c) (c', Automaton a b' c'))
     (Either c c', Automaton a (Either b b') (Either c c'))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Either (c, Automaton a b c) (c', Automaton a b' c')
-> (Either c c', Automaton a (Either b b') (Either c c'))
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)) = (a -> Either a b
forall a b. a -> Either a b
Left a
x,  Automaton a b c
c Automaton a b c
-> Automaton a b' c' -> Automaton a (Either b b') (Either c c')
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') -> Automaton a b' 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)) = (b -> Either a b
forall a b. b -> Either a b
Right b
x, a b (c, Automaton a b c) -> Automaton a b c
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton a b (c, Automaton a b c)
f1 Automaton a b c
-> Automaton a b' c' -> Automaton a (Either b b') (Either c c')
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 ||| :: Automaton a b d -> Automaton a c d -> Automaton a (Either b c) d
||| Automaton a c (d, Automaton a c d)
f2 =
        a (Either b c) (d, Automaton a (Either b c) d)
-> Automaton a (Either b c) d
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((a b (d, Automaton a b d)
f1 a b (d, Automaton a b d)
-> a c (d, Automaton a c d)
-> a (Either b c)
     (Either (d, Automaton a b d) (d, Automaton a c d))
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) a (Either b c) (Either (d, Automaton a b d) (d, Automaton a c d))
-> a (Either (d, Automaton a b d) (d, Automaton a c d))
     (d, Automaton a (Either b c) d)
-> a (Either b c) (d, Automaton a (Either b 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 (d, Automaton a b d) (d, Automaton a c d)
 -> (d, Automaton a (Either b c) d))
-> a (Either (d, Automaton a b d) (d, Automaton a c d))
     (d, Automaton a (Either b c) d)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Either (d, Automaton a b d) (d, Automaton a c d)
-> (d, Automaton a (Either b c) d)
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 Automaton a b d -> Automaton a c d -> Automaton a (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| a c (d, Automaton a c d) -> Automaton a 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, a b (d, Automaton a b d) -> Automaton a b d
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton a b (d, Automaton a b d)
f1 Automaton a b d -> Automaton a c d -> Automaton a (Either b c) d
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 :: Automaton a b c
zeroArrow = a b (c, Automaton a b c) -> Automaton a b c
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton a b (c, Automaton a b c)
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 <+> :: Automaton a b c -> Automaton a b c -> Automaton a b c
<+> Automaton a b (c, Automaton a b c)
g = a b (c, Automaton a b c) -> Automaton a b c
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a b (c, Automaton a b c)
f a b (c, Automaton a b c)
-> a b (c, Automaton a b c) -> a b (c, Automaton a b c)
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 :: Automaton a (b, d) (c, d) -> Automaton a b c
loop (Automaton a (b, d) ((c, d), Automaton a (b, d) (c, d))
f) =
        a b (c, Automaton a b c) -> Automaton a b c
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a (b, d) ((c, Automaton a b c), d) -> a b (c, Automaton a b c)
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 a (b, d) ((c, d), Automaton a (b, d) (c, d))
-> a ((c, d), Automaton a (b, d) (c, d)) ((c, Automaton a b c), d)
-> a (b, d) ((c, Automaton a b c), 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), Automaton a (b, d) (c, d)) -> ((c, Automaton a b c), d))
-> a ((c, d), Automaton a (b, d) (c, d)) ((c, Automaton a b c), d)
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, Automaton a (b, d) (c, d) -> Automaton a b c
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 :: b -> Automaton a b b
delay b
x = a b (b, Automaton a b b) -> Automaton a b b
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton ((b -> (b, Automaton a b b)) -> a b (b, Automaton a b b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\b
x' -> (b
x, b -> Automaton a b b
forall (a :: * -> * -> *) b. ArrowCircuit a => b -> a b b
delay b
x')))

-- Other instances

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

instance Arrow a => Applicative (Automaton a b) where
    pure :: a -> Automaton a b a
pure a
x = (b -> a) -> Automaton 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)
    Automaton a b (a -> b)
f <*> :: Automaton a b (a -> b) -> Automaton a b a -> Automaton a b b
<*> Automaton a b a
g = Automaton a b (a -> b)
f Automaton a b (a -> b)
-> Automaton a b a -> Automaton a b (a -> b, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Automaton a b a
g Automaton a b (a -> b, a)
-> Automaton a (a -> b, a) b -> Automaton 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) -> Automaton 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 => Alternative (Automaton a b) where
    empty :: Automaton a b a
empty = Automaton a b a
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
    Automaton a b a
f <|> :: Automaton a b a -> Automaton a b a -> Automaton a b a
<|> Automaton a b a
g = Automaton a b a
f Automaton a b a -> Automaton a b a -> Automaton a b a
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
(<>) = 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 = Automaton a b c
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 :: Automaton a (e, b) c -> a (e, Stream b) (Stream c)
runAutomaton (Automaton a (e, b) (c, Automaton a (e, b) c)
f) =
    ((e, Stream b) -> ((e, b), (e, Stream b)))
-> a (e, Stream b) ((e, b), (e, Stream b))
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))) a (e, Stream b) ((e, b), (e, Stream b))
-> a ((e, b), (e, Stream b)) (Stream c)
-> a (e, Stream b) (Stream 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, b) (c, Automaton a (e, b) c)
-> a ((e, b), (e, Stream b))
     ((c, Automaton a (e, b) c), (e, Stream b))
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 a ((e, b), (e, Stream b))
  ((c, Automaton a (e, b) c), (e, Stream b))
-> a ((c, Automaton a (e, b) c), (e, Stream b)) (Stream c)
-> a ((e, b), (e, Stream b)) (Stream c)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    (((c, Automaton a (e, b) c), (e, Stream b))
 -> (c, (a (e, Stream b) (Stream c), (e, Stream b))))
-> a ((c, Automaton a (e, b) c), (e, Stream b))
     (c, (a (e, Stream b) (Stream c), (e, Stream b)))
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, (Automaton a (e, b) c -> a (e, Stream b) (Stream c)
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)))) a ((c, Automaton a (e, b) c), (e, Stream b))
  (c, (a (e, Stream b) (Stream c), (e, Stream b)))
-> a (c, (a (e, Stream b) (Stream c), (e, Stream b))) (Stream c)
-> a ((c, Automaton a (e, b) c), (e, Stream b)) (Stream 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 (e, Stream b) (Stream c), (e, Stream b)) (Stream c)
-> a (c, (a (e, Stream b) (Stream c), (e, Stream b))) (c, Stream c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a (a (e, Stream b) (Stream c), (e, Stream b)) (Stream c)
forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app a (c, (a (e, Stream b) (Stream c), (e, Stream b))) (c, Stream c)
-> a (c, Stream c) (Stream c)
-> a (c, (a (e, Stream b) (Stream c), (e, Stream b))) (Stream c)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    ((c, Stream c) -> Stream c) -> a (c, Stream c) (Stream c)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((c -> Stream c -> Stream c) -> (c, Stream c) -> Stream c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry c -> Stream c -> Stream c
forall a. a -> Stream a -> Stream a
Cons)

instance (ArrowLoop a, ArrowApply a) => ArrowAddStream (Automaton a) a where
    liftStream :: a e b -> Automaton a e b
liftStream = a e b -> Automaton a e b
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift
    elimStream :: Automaton a (e, b) c -> a (e, Stream b) (Stream c)
elimStream = Automaton a (e, b) c -> a (e, Stream b) (Stream c)
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 = a w () -> Automaton 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 :: Automaton a e b -> Automaton a e (b, w)
newWriter (Automaton a e (b, Automaton a e b)
f) =
        a e ((b, w), Automaton a e (b, w)) -> Automaton a e (b, w)
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a e (b, Automaton a e b) -> a e ((b, Automaton a e b), w)
forall w (a :: * -> * -> *) e b.
ArrowWriter w a =>
a e b -> a e (b, w)
newWriter a e (b, Automaton a e b)
f a e ((b, Automaton a e b), w)
-> a ((b, Automaton a e b), w) ((b, w), Automaton a e (b, w))
-> a e ((b, w), Automaton a e (b, w))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (((b, Automaton a e b), w) -> ((b, w), Automaton a e (b, w)))
-> a ((b, Automaton a e b), w) ((b, w), Automaton a e (b, w))
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), Automaton a e b -> Automaton a e (b, 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 :: Automaton a r b
raise = a r b -> Automaton a r b
forall (f :: (* -> * -> *) -> * -> * -> *) (a :: * -> * -> *) b c.
ArrowTransformer f a =>
a b c -> f a b c
lift a r b
forall ex (a :: * -> * -> *) b. ArrowError ex a => a ex b
raise
    tryInUnless :: 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) =
        a e (c, Automaton a e c) -> Automaton a e c
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a e (b, Automaton a e b)
-> a (e, (b, Automaton a e b)) (c, Automaton a e c)
-> a (e, r) (c, Automaton a e c)
-> a e (c, Automaton 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, 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 = ((e, (b, Automaton a e b)) -> ((e, b), Automaton a e b))
-> a (e, (b, Automaton a e b)) ((e, b), Automaton a e b)
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')) a (e, (b, Automaton a e b)) ((e, b), Automaton a e b)
-> a ((e, b), Automaton a e b) (c, Automaton a e c)
-> a (e, (b, Automaton a e b)) (c, Automaton a e 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, b) (c, Automaton a (e, b) c)
-> a ((e, b), Automaton a e b)
     ((c, Automaton a (e, b) c), Automaton a e b)
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 a ((e, b), Automaton a e b)
  ((c, Automaton a (e, b) c), Automaton a e b)
-> a ((c, Automaton a (e, b) c), Automaton a e b)
     (c, Automaton a e c)
-> a ((e, b), Automaton a e b) (c, Automaton a e c)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (((c, Automaton a (e, b) c), Automaton a e b)
 -> (c, Automaton a e c))
-> a ((c, Automaton a (e, b) c), Automaton a e b)
     (c, Automaton a e 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, Automaton a e b
-> Automaton a (e, b) c -> Automaton a (e, r) c -> Automaton 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 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 a (e, r) (c, Automaton a (e, r) c)
-> a (c, Automaton a (e, r) c) (c, Automaton a e c)
-> a (e, r) (c, Automaton a e c)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((c, Automaton a (e, r) c) -> (c, Automaton a e c))
-> a (c, Automaton a (e, r) c) (c, Automaton a e c)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(c
d,Automaton a (e, r) c
h') -> (c
d, Automaton a e b
-> Automaton a (e, b) c -> Automaton a (e, r) c -> Automaton 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 Automaton a e b
f0 Automaton a (e, b) c
s0 Automaton a (e, r) c
h'))
    newError :: Automaton a e b -> Automaton a e (Either r b)
newError (Automaton a e (b, Automaton a e b)
f) = a e (Either r b, Automaton a e (Either r b))
-> Automaton a e (Either r b)
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a e (b, Automaton a e b) -> a e (Either r (b, Automaton a e b))
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 a e (Either r (b, Automaton a e b))
-> a (Either r (b, Automaton a e b))
     (Either r b, Automaton a e (Either r b))
-> a e (Either r b, Automaton a e (Either r b))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either r (b, Automaton a e b)
 -> (Either r b, Automaton a e (Either r b)))
-> a (Either r (b, Automaton a e b))
     (Either r b, Automaton a e (Either r b))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Either r (b, Automaton a e b)
-> (Either r b, Automaton a e (Either r b))
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) = (a -> Either a b
forall a b. a -> Either a b
Left a
ex, Automaton a e b -> Automaton a e (Either ex b)
forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a e (Either ex b)
newError (a e (b, Automaton a e b) -> Automaton a e b
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')) = (b -> Either a b
forall a b. b -> Either a b
Right b
c, Automaton a e b -> Automaton a e (Either ex b)
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 :: Automaton a b r
readState = a b r -> Automaton 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 :: Automaton a e b -> Automaton a (e, r) b
newReader (Automaton a e (b, Automaton a e b)
f) =
        a (e, r) (b, Automaton a (e, r) b) -> Automaton a (e, r) b
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a e (b, Automaton a e b) -> a (e, r) (b, Automaton a e b)
forall r (a :: * -> * -> *) e b.
ArrowReader r a =>
a e b -> a (e, r) b
newReader a e (b, Automaton a e b)
f a (e, r) (b, Automaton a e b)
-> a (b, Automaton a e b) (b, Automaton a (e, r) b)
-> a (e, r) (b, Automaton a (e, r) b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (Automaton a e b) (Automaton a (e, r) b)
-> a (b, Automaton a e b) (b, Automaton a (e, r) b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Automaton a e b -> Automaton a (e, r) b)
-> a (Automaton a e b) (Automaton a (e, r) b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Automaton a e b -> Automaton a (e, r) b
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 :: Automaton a e s
fetch = a e s -> Automaton 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 :: Automaton a s ()
store = a s () -> Automaton 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

-- encapsulations

instance ArrowAddWriter w a a' =>
        ArrowAddWriter w (Automaton a) (Automaton a') where
    liftWriter :: Automaton a' e b -> Automaton a e b
liftWriter (Automaton a' e (b, Automaton a' e b)
f) =
        a e (b, Automaton a e b) -> Automaton a e b
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a' e (b, Automaton a' e b) -> a e (b, Automaton a' e b)
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 a e (b, Automaton a' e b)
-> a (b, Automaton a' e b) (b, Automaton a e b)
-> a e (b, Automaton 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
>>>
            ((b, Automaton a' e b) -> (b, Automaton a e b))
-> a (b, Automaton a' e b) (b, Automaton a e b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(b
c, Automaton a' e b
f') -> (b
c, Automaton a' e b -> Automaton a e b
forall w (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddWriter w a a' =>
a' e b -> a e b
liftWriter Automaton a' e b
f')))
    elimWriter :: Automaton a e b -> Automaton a' e (b, w)
elimWriter (Automaton a e (b, Automaton a e b)
f) =
        a' e ((b, w), Automaton a' e (b, w)) -> Automaton a' e (b, w)
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a e (b, Automaton a e b) -> a' e ((b, Automaton 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, Automaton a e b)
f a' e ((b, Automaton a e b), w)
-> a' ((b, Automaton a e b), w) ((b, w), Automaton a' e (b, w))
-> a' e ((b, w), Automaton a' e (b, w))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (((b, Automaton a e b), w) -> ((b, w), Automaton a' e (b, w)))
-> a' ((b, Automaton a e b), w) ((b, w), Automaton a' e (b, w))
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), Automaton a e b -> Automaton a' e (b, 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 :: Automaton a' e b -> Automaton a e b
liftReader (Automaton a' e (b, Automaton a' e b)
f) =
        a e (b, Automaton a e b) -> Automaton a e b
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a' e (b, Automaton a' e b) -> a e (b, Automaton a' e b)
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 a e (b, Automaton a' e b)
-> a (b, Automaton a' e b) (b, Automaton a e b)
-> a e (b, Automaton 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
>>>
            ((b, Automaton a' e b) -> (b, Automaton a e b))
-> a (b, Automaton a' e b) (b, Automaton a e b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(b
c, Automaton a' e b
f') -> (b
c, Automaton a' e b -> Automaton a e b
forall r (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddReader r a a' =>
a' e b -> a e b
liftReader Automaton a' e b
f')))
    elimReader :: Automaton a e b -> Automaton a' (e, r) b
elimReader (Automaton a e (b, Automaton a e b)
f) =
        a' (e, r) (b, Automaton a' (e, r) b) -> Automaton a' (e, r) b
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a e (b, Automaton a e b) -> a' (e, r) (b, Automaton a e b)
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 a' (e, r) (b, Automaton a e b)
-> a' (b, Automaton a e b) (b, Automaton a' (e, r) b)
-> a' (e, r) (b, Automaton a' (e, r) b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a' (Automaton a e b) (Automaton a' (e, r) b)
-> a' (b, Automaton a e b) (b, Automaton a' (e, r) b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Automaton a e b -> Automaton a' (e, r) b)
-> a' (Automaton a e b) (Automaton a' (e, r) b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Automaton a e b -> Automaton a' (e, r) b
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 :: Automaton a' e b -> Automaton a e b
liftState (Automaton a' e (b, Automaton a' e b)
f) =
        a e (b, Automaton a e b) -> Automaton a e b
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a' e (b, Automaton a' e b) -> a e (b, Automaton a' e b)
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 a e (b, Automaton a' e b)
-> a (b, Automaton a' e b) (b, Automaton a e b)
-> a e (b, Automaton 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
>>>
            ((b, Automaton a' e b) -> (b, Automaton a e b))
-> a (b, Automaton a' e b) (b, Automaton a e b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\(b
c, Automaton a' e b
f') -> (b
c, Automaton a' e b -> Automaton a e b
forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a' e b -> a e b
liftState Automaton a' e b
f')))
    elimState :: Automaton a e b -> Automaton a' (e, r) (b, r)
elimState (Automaton a e (b, Automaton a e b)
f) =
        a' (e, r) ((b, r), Automaton a' (e, r) (b, r))
-> Automaton a' (e, r) (b, r)
forall (a :: * -> * -> *) b c.
a b (c, Automaton a b c) -> Automaton a b c
Automaton (a e (b, Automaton a e b) -> a' (e, r) ((b, Automaton a e b), r)
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 a' (e, r) ((b, Automaton a e b), r)
-> a'
     ((b, Automaton a e b), r) ((b, r), Automaton a' (e, r) (b, r))
-> a' (e, r) ((b, r), Automaton a' (e, r) (b, r))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            (((b, Automaton a e b), r) -> ((b, r), Automaton a' (e, r) (b, r)))
-> a'
     ((b, Automaton a e b), r) ((b, r), Automaton a' (e, r) (b, r))
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), Automaton a e b -> Automaton a' (e, r) (b, r)
forall s (a :: * -> * -> *) (a' :: * -> * -> *) e b.
ArrowAddState s a a' =>
a e b -> a' (e, s) (b, s)
elimState Automaton a e b
f')))