{-# LANGUAGE Arrows,LambdaCase #-}
-- | A set of functions for working with the 'Arrow' known as a Mealy automata,
-- here referred to as 'Circuit's. Circuits are essentialy a way of building
-- composable fold and iterator operations, where some of the values being
-- processed can be hidden.
module Goal.Core.Circuit
    ( -- * Circuits
    Circuit (Circuit, runCircuit)
    , accumulateFunction
    , accumulateCircuit
    , streamCircuit
    , iterateCircuit
    , loopCircuit
    , loopAccumulator
    , arrM
    -- * Chains
    , Chain
    , chain
    , chainCircuit
    , streamChain
    , iterateChain
    , skipChain
    , skipChain0
    -- ** Recursive Computations
    , iterateM
    , iterateM'
    ) where

--- Imports ---


-- Unqualified --

import Control.Arrow

-- Qualified --

import qualified Control.Category as C

--- Circuits ---

-- | An arrow which takes an input, monadically produces an output, and updates
-- an (inaccessable) internal state.
newtype Circuit m a b = Circuit
    { Circuit m a b -> a -> m (b, Circuit m a b)
runCircuit :: a -> m (b, Circuit m a b) }

-- | Takes a function from a value and an accumulator (e.g. just a sum value or
-- an evolving set of parameters for some model) to a value and an accumulator.
-- The accumulator is then looped back into the function, returning a Circuit
-- from a to b, which updates the accumulator every step.
accumulateFunction :: Monad m => acc -> (a -> acc -> m (b,acc)) -> Circuit m a b
{-# INLINE accumulateFunction #-}
accumulateFunction :: acc -> (a -> acc -> m (b, acc)) -> Circuit m a b
accumulateFunction acc
acc a -> acc -> m (b, acc)
f = (a -> m (b, Circuit m a b)) -> Circuit m a b
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit ((a -> m (b, Circuit m a b)) -> Circuit m a b)
-> (a -> m (b, Circuit m a b)) -> Circuit m a b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    (b
b,acc
acc') <- a -> acc -> m (b, acc)
f a
a acc
acc
    (b, Circuit m a b) -> m (b, Circuit m a b)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (b
b,acc -> (a -> acc -> m (b, acc)) -> Circuit m a b
forall (m :: Type -> Type) acc a b.
Monad m =>
acc -> (a -> acc -> m (b, acc)) -> Circuit m a b
accumulateFunction acc
acc' a -> acc -> m (b, acc)
f)

-- | accumulateCircuit takes a 'Circuit' and an inital value and loops it.
accumulateCircuit :: Monad m => acc -> Circuit m (a,acc) (b,acc) -> Circuit m a b
{-# INLINE accumulateCircuit #-}
accumulateCircuit :: acc -> Circuit m (a, acc) (b, acc) -> Circuit m a b
accumulateCircuit acc
acc0 Circuit m (a, acc) (b, acc)
mly0 = (acc, Circuit m (a, acc) (b, acc))
-> (a
    -> (acc, Circuit m (a, acc) (b, acc))
    -> m (b, (acc, Circuit m (a, acc) (b, acc))))
-> Circuit m a b
forall (m :: Type -> Type) acc a b.
Monad m =>
acc -> (a -> acc -> m (b, acc)) -> Circuit m a b
accumulateFunction (acc
acc0,Circuit m (a, acc) (b, acc)
mly0) ((a
  -> (acc, Circuit m (a, acc) (b, acc))
  -> m (b, (acc, Circuit m (a, acc) (b, acc))))
 -> Circuit m a b)
-> (a
    -> (acc, Circuit m (a, acc) (b, acc))
    -> m (b, (acc, Circuit m (a, acc) (b, acc))))
-> Circuit m a b
forall a b. (a -> b) -> a -> b
$ \a
a (acc
acc,Circuit (a, acc) -> m ((b, acc), Circuit m (a, acc) (b, acc))
crcf) -> do
    ((b
b,acc
acc'),Circuit m (a, acc) (b, acc)
mly') <- (a, acc) -> m ((b, acc), Circuit m (a, acc) (b, acc))
crcf (a
a,acc
acc)
    (b, (acc, Circuit m (a, acc) (b, acc)))
-> m (b, (acc, Circuit m (a, acc) (b, acc)))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (b
b,(acc
acc',Circuit m (a, acc) (b, acc)
mly'))

-- | Takes a Circuit and an inital value and loops it, but continues
-- to return both the output and the accumulated value.
loopCircuit :: Monad m => acc -> Circuit m (a,acc) (b,acc) -> Circuit m a (b,acc)
{-# INLINE loopCircuit #-}
loopCircuit :: acc -> Circuit m (a, acc) (b, acc) -> Circuit m a (b, acc)
loopCircuit acc
acc0 Circuit m (a, acc) (b, acc)
mly0 = (acc, Circuit m (a, acc) (b, acc))
-> (a
    -> (acc, Circuit m (a, acc) (b, acc))
    -> m ((b, acc), (acc, Circuit m (a, acc) (b, acc))))
-> Circuit m a (b, acc)
forall (m :: Type -> Type) acc a b.
Monad m =>
acc -> (a -> acc -> m (b, acc)) -> Circuit m a b
accumulateFunction (acc
acc0,Circuit m (a, acc) (b, acc)
mly0) ((a
  -> (acc, Circuit m (a, acc) (b, acc))
  -> m ((b, acc), (acc, Circuit m (a, acc) (b, acc))))
 -> Circuit m a (b, acc))
-> (a
    -> (acc, Circuit m (a, acc) (b, acc))
    -> m ((b, acc), (acc, Circuit m (a, acc) (b, acc))))
-> Circuit m a (b, acc)
forall a b. (a -> b) -> a -> b
$ \a
a (acc
acc,Circuit (a, acc) -> m ((b, acc), Circuit m (a, acc) (b, acc))
crcf) -> do
    ((b
b,acc
acc'),Circuit m (a, acc) (b, acc)
mly') <- (a, acc) -> m ((b, acc), Circuit m (a, acc) (b, acc))
crcf (a
a,acc
acc)
    ((b, acc), (acc, Circuit m (a, acc) (b, acc)))
-> m ((b, acc), (acc, Circuit m (a, acc) (b, acc)))
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((b
b,acc
acc'),(acc
acc',Circuit m (a, acc) (b, acc)
mly'))

-- | Takes a Circuit which only produces an accumulating value, and loops it.
loopAccumulator :: Monad m => acc -> Circuit m (a,acc) acc -> Circuit m a acc
{-# INLINE loopAccumulator #-}
loopAccumulator :: acc -> Circuit m (a, acc) acc -> Circuit m a acc
loopAccumulator acc
acc0 Circuit m (a, acc) acc
mly0 = (acc, Circuit m (a, acc) acc)
-> (a
    -> (acc, Circuit m (a, acc) acc)
    -> m (acc, (acc, Circuit m (a, acc) acc)))
-> Circuit m a acc
forall (m :: Type -> Type) acc a b.
Monad m =>
acc -> (a -> acc -> m (b, acc)) -> Circuit m a b
accumulateFunction (acc
acc0,Circuit m (a, acc) acc
mly0) ((a
  -> (acc, Circuit m (a, acc) acc)
  -> m (acc, (acc, Circuit m (a, acc) acc)))
 -> Circuit m a acc)
-> (a
    -> (acc, Circuit m (a, acc) acc)
    -> m (acc, (acc, Circuit m (a, acc) acc)))
-> Circuit m a acc
forall a b. (a -> b) -> a -> b
$ \a
a (acc
acc,Circuit (a, acc) -> m (acc, Circuit m (a, acc) acc)
crcf) -> do
    (acc
acc',Circuit m (a, acc) acc
mly') <- (a, acc) -> m (acc, Circuit m (a, acc) acc)
crcf (a
a,acc
acc)
    (acc, (acc, Circuit m (a, acc) acc))
-> m (acc, (acc, Circuit m (a, acc) acc))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (acc
acc',(acc
acc',Circuit m (a, acc) acc
mly'))

-- | Feeds a list of inputs into a 'Circuit' and returns the (monadic) list of outputs.
streamCircuit :: Monad m => Circuit m a b -> [a] -> m [b]
{-# INLINE streamCircuit #-}
streamCircuit :: Circuit m a b -> [a] -> m [b]
streamCircuit Circuit m a b
_ [] = [b] -> m [b]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
streamCircuit (Circuit a -> m (b, Circuit m a b)
mf) (a
a:[a]
as) = do
    (b
b,Circuit m a b
crc') <- a -> m (b, Circuit m a b)
mf a
a
    (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) ([b] -> [b]) -> m [b] -> m [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Circuit m a b -> [a] -> m [b]
forall (m :: Type -> Type) a b.
Monad m =>
Circuit m a b -> [a] -> m [b]
streamCircuit Circuit m a b
crc' [a]
as

-- | Feeds a list of inputs into a Circuit automata and returns the final
-- monadic output. Throws an error on the empty list.
iterateCircuit :: Monad m => Circuit m a b -> [a] -> m b
{-# INLINE iterateCircuit #-}
iterateCircuit :: Circuit m a b -> [a] -> m b
iterateCircuit Circuit m a b
_ [] = [Char] -> m b
forall a. HasCallStack => [Char] -> a
error [Char]
"Empty list fed to iterateCircuit"
iterateCircuit (Circuit a -> m (b, Circuit m a b)
mf) [a
a] = (b, Circuit m a b) -> b
forall a b. (a, b) -> a
fst ((b, Circuit m a b) -> b) -> m (b, Circuit m a b) -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (b, Circuit m a b)
mf a
a
iterateCircuit (Circuit a -> m (b, Circuit m a b)
mf) (a
a:[a]
as) = do
    (b
_,Circuit m a b
crc') <- a -> m (b, Circuit m a b)
mf a
a
    Circuit m a b -> [a] -> m b
forall (m :: Type -> Type) a b.
Monad m =>
Circuit m a b -> [a] -> m b
iterateCircuit Circuit m a b
crc' [a]
as

-- | Turn a monadic function into a circuit.
arrM :: Monad m => (a -> m b) -> Circuit m a b
{-# INLINE arrM #-}
arrM :: (a -> m b) -> Circuit m a b
arrM a -> m b
mf = (a -> m (b, Circuit m a b)) -> Circuit m a b
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit ((a -> m (b, Circuit m a b)) -> Circuit m a b)
-> (a -> m (b, Circuit m a b)) -> Circuit m a b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    b
b <- a -> m b
mf a
a
    (b, Circuit m a b) -> m (b, Circuit m a b)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (b
b, (a -> m b) -> Circuit m a b
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Circuit m a b
arrM a -> m b
mf)


--- Chains ---


-- | A 'Chain' is an iterator built on a 'Circuit'. 'Chain' constructors are
-- designed to ensure that the first value returned is the initial value of the
-- iterator (this is not entirely trivial).
type Chain m x = Circuit m () x

-- | Creates a 'Chain' from an initial state and a transition function. The
-- first step of the chain returns the initial state, and then continues with
-- generated states.
chain
    :: Monad m
    => x -- ^ The initial state
    -> (x -> m x) -- ^ The transition function
    -> Chain m x -- ^ The resulting 'Chain'
{-# INLINE chain #-}
chain :: x -> (x -> m x) -> Chain m x
chain x
x0 x -> m x
mf = x -> (() -> x -> m (x, x)) -> Chain m x
forall (m :: Type -> Type) acc a b.
Monad m =>
acc -> (a -> acc -> m (b, acc)) -> Circuit m a b
accumulateFunction x
x0 ((() -> x -> m (x, x)) -> Chain m x)
-> (() -> x -> m (x, x)) -> Chain m x
forall a b. (a -> b) -> a -> b
$ \() x
x -> do
    x
x' <- x -> m x
mf x
x
    (x, x) -> m (x, x)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (x
x,x
x')

-- | Creates a 'Chain' from an initial state and a transition circuit. The
-- first step of the chain returns the initial state, and then continues with
-- generated states.
chainCircuit
    :: Monad m
    => x -- ^ The initial state
    -> Circuit m x x -- ^ The transition circuit
    -> Chain m x -- ^ The resulting 'Chain'
{-# INLINE chainCircuit #-}
chainCircuit :: x -> Circuit m x x -> Chain m x
chainCircuit x
x0 Circuit m x x
crc = x -> Circuit m ((), x) (x, x) -> Chain m x
forall (m :: Type -> Type) acc a b.
Monad m =>
acc -> Circuit m (a, acc) (b, acc) -> Circuit m a b
accumulateCircuit x
x0 (Circuit m ((), x) (x, x) -> Chain m x)
-> Circuit m ((), x) (x, x) -> Chain m x
forall a b. (a -> b) -> a -> b
$ proc ((),x
x) -> do
    x
x' <- Circuit m x x
crc -< x
x
    Circuit m (x, x) (x, x)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< (x
x,x
x')

-- | Returns the specified number of the given 'Chain's output.
streamChain :: Monad m => Int -> Chain m x -> m [x]
{-# INLINE streamChain #-}
streamChain :: Int -> Chain m x -> m [x]
streamChain Int
n Chain m x
chn = Chain m x -> [()] -> m [x]
forall (m :: Type -> Type) a b.
Monad m =>
Circuit m a b -> [a] -> m [b]
streamCircuit Chain m x
chn ([()] -> m [x]) -> [()] -> m [x]
forall a b. (a -> b) -> a -> b
$ Int -> () -> [()]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ()

-- | Returns the given 'Chain's output at the given index.
iterateChain :: Monad m => Int -> Chain m x -> m x
{-# INLINE iterateChain #-}
iterateChain :: Int -> Chain m x -> m x
iterateChain Int
0 (Circuit () -> m (x, Chain m x)
mf) = (x, Chain m x) -> x
forall a b. (a, b) -> a
fst ((x, Chain m x) -> x) -> m (x, Chain m x) -> m x
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> m (x, Chain m x)
mf ()
iterateChain Int
k (Circuit () -> m (x, Chain m x)
mf) = () -> m (x, Chain m x)
mf () m (x, Chain m x) -> ((x, Chain m x) -> m x) -> m x
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Chain m x -> m x
forall (m :: Type -> Type) x. Monad m => Int -> Chain m x -> m x
iterateChain (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Chain m x -> m x)
-> ((x, Chain m x) -> Chain m x) -> (x, Chain m x) -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, Chain m x) -> Chain m x
forall a b. (a, b) -> b
snd

-- | Modify the given 'Chain' so that it returns the initial value, and then
-- skips the specified number of outputs before producing each subsequent output.
skipChain :: Monad m => Int -> Chain m x -> Chain m x
{-# INLINE skipChain #-}
skipChain :: Int -> Chain m x -> Chain m x
skipChain Int
n (Circuit () -> m (x, Chain m x)
mf) = (() -> m (x, Chain m x)) -> Chain m x
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit ((() -> m (x, Chain m x)) -> Chain m x)
-> (() -> m (x, Chain m x)) -> Chain m x
forall a b. (a -> b) -> a -> b
$ \() -> do
    (x
x',Chain m x
crc') <- () -> m (x, Chain m x)
mf ()
    (x, Chain m x) -> m (x, Chain m x)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (x
x', Int -> Chain m x -> Chain m x
forall (m :: Type -> Type) x.
Monad m =>
Int -> Chain m x -> Chain m x
skipChain0 Int
n Chain m x
crc')

-- | Modify the given 'Chain' so that it skips the specified number of outputs
-- before producing each subsequent output (this skips the initial output too).
skipChain0 :: Monad m => Int -> Chain m x -> Chain m x
{-# INLINE skipChain0 #-}
skipChain0 :: Int -> Chain m x -> Chain m x
skipChain0 Int
n Chain m x
crc = (() -> m (x, Chain m x)) -> Chain m x
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit ((() -> m (x, Chain m x)) -> Chain m x)
-> (() -> m (x, Chain m x)) -> Chain m x
forall a b. (a -> b) -> a -> b
$ \() -> do
    (Circuit () -> m (x, Chain m x)
mf) <- Int -> (Chain m x -> m (Chain m x)) -> Chain m x -> m (Chain m x)
forall (m :: Type -> Type) x.
Monad m =>
Int -> (x -> m x) -> x -> m x
iterateM' Int
n Chain m x -> m (Chain m x)
forall (f :: Type -> Type) a.
Functor f =>
Circuit f () a -> f (Circuit f () a)
iterator Chain m x
crc
    (x
x',Chain m x
crc') <- () -> m (x, Chain m x)
mf ()
    (x, Chain m x) -> m (x, Chain m x)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (x
x', Int -> Chain m x -> Chain m x
forall (m :: Type -> Type) x.
Monad m =>
Int -> Chain m x -> Chain m x
skipChain0 Int
n Chain m x
crc')
        where iterator :: Circuit f () a -> f (Circuit f () a)
iterator (Circuit () -> f (a, Circuit f () a)
mf') = (a, Circuit f () a) -> Circuit f () a
forall a b. (a, b) -> b
snd ((a, Circuit f () a) -> Circuit f () a)
-> f (a, Circuit f () a) -> f (Circuit f () a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> f (a, Circuit f () a)
mf' ()


-- | Iterate a monadic action the given number of times, returning the complete
-- sequence of values.
iterateM :: Monad m => Int -> (x -> m x) -> x -> m [x]
{-# INLINE iterateM #-}
iterateM :: Int -> (x -> m x) -> x -> m [x]
iterateM Int
n x -> m x
mf x
x0 = Int -> Chain m x -> m [x]
forall (m :: Type -> Type) x. Monad m => Int -> Chain m x -> m [x]
streamChain Int
n (Chain m x -> m [x]) -> Chain m x -> m [x]
forall a b. (a -> b) -> a -> b
$ x -> (x -> m x) -> Chain m x
forall (m :: Type -> Type) x.
Monad m =>
x -> (x -> m x) -> Chain m x
chain x
x0 x -> m x
mf

-- | Iterate a monadic action the given number of times, returning the final value.
iterateM' :: Monad m => Int -> (x -> m x) -> x -> m x
{-# INLINE iterateM' #-}
iterateM' :: Int -> (x -> m x) -> x -> m x
iterateM' Int
n x -> m x
mf x
x0 = Int -> Chain m x -> m x
forall (m :: Type -> Type) x. Monad m => Int -> Chain m x -> m x
iterateChain Int
n (Chain m x -> m x) -> Chain m x -> m x
forall a b. (a -> b) -> a -> b
$ x -> (x -> m x) -> Chain m x
forall (m :: Type -> Type) x.
Monad m =>
x -> (x -> m x) -> Chain m x
chain x
x0 x -> m x
mf



--- Instances ---


instance Monad m => C.Category (Circuit m) where
    --id :: Circuit a a
    {-# INLINE id #-}
    id :: Circuit m a a
id = (a -> m (a, Circuit m a a)) -> Circuit m a a
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit ((a -> m (a, Circuit m a a)) -> Circuit m a a)
-> (a -> m (a, Circuit m a a)) -> Circuit m a a
forall a b. (a -> b) -> a -> b
$ \a
a -> (a, Circuit m a a) -> m (a, Circuit m a a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
a,Circuit m a a
forall k (cat :: k -> k -> Type) (a :: k). Category cat => cat a a
C.id)
    --(.) :: Circuit b c -> Circuit a b -> Circuit a c
    {-# INLINE (.) #-}
    . :: Circuit m b c -> Circuit m a b -> Circuit m a c
(.) = Circuit m b c -> Circuit m a b -> Circuit m a c
forall (m :: Type -> Type) a b a.
Monad m =>
Circuit m a b -> Circuit m a a -> Circuit m a b
dot
        where dot :: Circuit m a b -> Circuit m a a -> Circuit m a b
dot (Circuit a -> m (b, Circuit m a b)
crc1) (Circuit a -> m (a, Circuit m a a)
crc2) = (a -> m (b, Circuit m a b)) -> Circuit m a b
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit ((a -> m (b, Circuit m a b)) -> Circuit m a b)
-> (a -> m (b, Circuit m a b)) -> Circuit m a b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
                  (a
b, Circuit m a a
crcA2') <- a -> m (a, Circuit m a a)
crc2 a
a
                  (b
c, Circuit m a b
crcA1') <- a -> m (b, Circuit m a b)
crc1 a
b
                  (b, Circuit m a b) -> m (b, Circuit m a b)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (b
c, Circuit m a b
crcA1' Circuit m a b -> Circuit m a a -> Circuit m a b
`dot` Circuit m a a
crcA2')

instance Monad m => Arrow (Circuit m) where
    --arr :: (a -> b) -> Circuit a b
    {-# INLINE arr #-}
    arr :: (b -> c) -> Circuit m b c
arr b -> c
f = (b -> m (c, Circuit m b c)) -> Circuit m b c
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit ((b -> m (c, Circuit m b c)) -> Circuit m b c)
-> (b -> m (c, Circuit m b c)) -> Circuit m b c
forall a b. (a -> b) -> a -> b
$ \b
a -> (c, Circuit m b c) -> m (c, Circuit m b c)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (b -> c
f b
a, (b -> c) -> Circuit m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr b -> c
f)
    --first :: Circuit a b -> Circuit (a,c) (b,c)
    {-# INLINE first #-}
    first :: Circuit m b c -> Circuit m (b, d) (c, d)
first (Circuit b -> m (c, Circuit m b c)
crcf) = ((b, d) -> m ((c, d), Circuit m (b, d) (c, d)))
-> Circuit m (b, d) (c, d)
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit (((b, d) -> m ((c, d), Circuit m (b, d) (c, d)))
 -> Circuit m (b, d) (c, d))
-> ((b, d) -> m ((c, d), Circuit m (b, d) (c, d)))
-> Circuit m (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ \(b
a,d
c) -> do
        (c
b, Circuit m b c
crcA') <- b -> m (c, Circuit m b c)
crcf b
a
        ((c, d), Circuit m (b, d) (c, d))
-> m ((c, d), Circuit m (b, d) (c, d))
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((c
b,d
c), Circuit m b c -> Circuit m (b, d) (c, d)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Circuit m b c
crcA')

instance Monad m => ArrowChoice (Circuit m) where
    --left :: Circuit a b -> Circuit (Either a c) (Either b c)
    {-# INLINE left #-}
    left :: Circuit m b c -> Circuit m (Either b d) (Either c d)
left crcA :: Circuit m b c
crcA@(Circuit b -> m (c, Circuit m b c)
crcf) = (Either b d -> m (Either c d, Circuit m (Either b d) (Either c d)))
-> Circuit m (Either b d) (Either c d)
forall (m :: Type -> Type) a b.
(a -> m (b, Circuit m a b)) -> Circuit m a b
Circuit ((Either b d
  -> m (Either c d, Circuit m (Either b d) (Either c d)))
 -> Circuit m (Either b d) (Either c d))
-> (Either b d
    -> m (Either c d, Circuit m (Either b d) (Either c d)))
-> Circuit m (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$
        \case
          Left b
a -> do
              (c
b,Circuit m b c
crcA') <- b -> m (c, Circuit m b c)
crcf b
a
              (Either c d, Circuit m (Either b d) (Either c d))
-> m (Either c d, Circuit m (Either b d) (Either c d))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (c -> Either c d
forall a b. a -> Either a b
Left c
b,Circuit m b c -> Circuit m (Either b d) (Either c d)
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Circuit m b c
crcA')
          Right d
c -> (Either c d, Circuit m (Either b d) (Either c d))
-> m (Either c d, Circuit m (Either b d) (Either c d))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (d -> Either c d
forall a b. b -> Either a b
Right d
c,Circuit m b c -> Circuit m (Either b d) (Either c d)
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Circuit m b c
crcA)