{-# LANGUAGE UndecidableInstances #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024 Sayo contributors
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp

Coroutine-based, composable, and resumable concurrent streams.
-}
module Control.Monad.Hefty.Concurrent.Stream (
    module Control.Monad.Hefty.Concurrent.Stream,
    module Control.Monad.Hefty.Input,
    module Control.Monad.Hefty.Output,
)
where

import Control.Arrow (Arrow, ArrowChoice, arr, first, left, (>>>))
import Control.Category (Category)
import Control.Category qualified as C
import Control.Monad (forM_, forever)
import Control.Monad.Hefty (
    Eff,
    Emb,
    FOEs,
    RemoveHOEs,
    WeakenHOEs,
    interpret,
    interpretsBy,
    nil,
    onlyFOEs,
    raise,
    reinterprets,
    untag,
    (!:),
    (&),
    (:>),
    type (~>),
 )
import Control.Monad.Hefty.Concurrent.Parallel (Parallel, liftP2)
import Control.Monad.Hefty.Input
import Control.Monad.Hefty.Output
import Control.Monad.Hefty.State (State, evalState, evalStateIORef, get'', put'')
import Data.Effect.Unlift (UnliftIO, withRunInIO)
import Data.Function (fix)
import Data.Sequence (Seq ((:|>)))
import Data.Sequence qualified as Seq
import UnliftIO (
    atomically,
    liftIO,
    mask,
    newEmptyTMVarIO,
    putTMVar,
    readTMVar,
    takeTMVar,
    uninterruptibleMask_,
 )
import UnliftIO.Concurrent (forkIO, killThread)

data Machinery es ans i o where
    Unit
        :: forall i o ans es
         . Eff (Input i ': Output o ': es) ans
        -> Machinery es ans i o
    Connect
        :: forall a b c ans es
         . Machinery es ans a b
        -> Machinery es ans b c
        -> Machinery es ans a c

instance Category (Machinery es ans) where
    id :: forall a. Machinery es ans a a
    id :: forall a. Machinery es ans a a
id =
        Eff (Input a : Output a : es) ans -> Machinery es ans a a
forall i o ans (es :: [(* -> *) -> * -> *]).
Eff (Input i : Output o : es) ans -> Machinery es ans i o
Unit (Eff (Input a : Output a : es) ans -> Machinery es ans a a)
-> (Eff Freer (Input a : Output a : es) ()
    -> Eff (Input a : Output a : es) ans)
-> Eff Freer (Input a : Output a : es) ()
-> Machinery es ans a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff Freer (Input a : Output a : es) ()
-> Eff (Input a : Output a : es) ans
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Eff Freer (Input a : Output a : es) () -> Machinery es ans a a)
-> Eff Freer (Input a : Output a : es) () -> Machinery es ans a a
forall a b. (a -> b) -> a -> b
$
            forall i (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Input i :> es) =>
f i
input @a Eff Freer (Input a : Output a : es) a
-> (a -> Eff Freer (Input a : Output a : es) ())
-> Eff Freer (Input a : Output a : es) ()
forall a b.
Eff Freer (Input a : Output a : es) a
-> (a -> Eff Freer (Input a : Output a : es) b)
-> Eff Freer (Input a : Output a : es) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Eff Freer (Input a : Output a : es) ()
forall o (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Output o :> es) =>
o -> f ()
output

    . :: forall b c a.
Machinery es ans b c
-> Machinery es ans a b -> Machinery es ans a c
(.) = (Machinery es ans a b
 -> Machinery es ans b c -> Machinery es ans a c)
-> Machinery es ans b c
-> Machinery es ans a b
-> Machinery es ans a c
forall a b c. (a -> b -> c) -> b -> a -> c
flip Machinery es ans a b
-> Machinery es ans b c -> Machinery es ans a c
forall a b c ans (es :: [(* -> *) -> * -> *]).
Machinery es ans a b
-> Machinery es ans b c -> Machinery es ans a c
Connect

    {-# INLINE id #-}
    {-# INLINE (.) #-}

instance (FOEs es) => Arrow (Machinery es ans) where
    arr :: forall b c. (b -> c) -> Machinery es ans b c
arr (b -> c
f :: b -> c) =
        Eff (Input b : Output c : es) ans -> Machinery es ans b c
forall i o ans (es :: [(* -> *) -> * -> *]).
Eff (Input i : Output o : es) ans -> Machinery es ans i o
Unit (Eff (Input b : Output c : es) ans -> Machinery es ans b c)
-> (Eff Freer (Input b : Output c : es) ()
    -> Eff (Input b : Output c : es) ans)
-> Eff Freer (Input b : Output c : es) ()
-> Machinery es ans b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff Freer (Input b : Output c : es) ()
-> Eff (Input b : Output c : es) ans
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Eff Freer (Input b : Output c : es) () -> Machinery es ans b c)
-> Eff Freer (Input b : Output c : es) () -> Machinery es ans b c
forall a b. (a -> b) -> a -> b
$
            forall i (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Input i :> es) =>
f i
input @b Eff Freer (Input b : Output c : es) b
-> (b -> Eff Freer (Input b : Output c : es) ())
-> Eff Freer (Input b : Output c : es) ()
forall a b.
Eff Freer (Input b : Output c : es) a
-> (a -> Eff Freer (Input b : Output c : es) b)
-> Eff Freer (Input b : Output c : es) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Eff Freer (Input b : Output c : es) ()
forall o (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Output o :> es) =>
o -> f ()
output (c -> Eff Freer (Input b : Output c : es) ())
-> (b -> c) -> b -> Eff Freer (Input b : Output c : es) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f

    first
        :: forall b c d
         . Machinery es ans b c
        -> Machinery es ans (b, d) (c, d)
    first :: forall b c d.
Machinery es ans b c -> Machinery es ans (b, d) (c, d)
first = \case
        Unit Eff (Input b : Output c : es) ans
m -> Eff (Input (b, d) : Output (c, d) : es) ans
-> Machinery es ans (b, d) (c, d)
forall i o ans (es :: [(* -> *) -> * -> *]).
Eff (Input i : Output o : es) ans -> Machinery es ans i o
Unit (Eff (Input (b, d) : Output (c, d) : es) ans
 -> Machinery es ans (b, d) (c, d))
-> Eff (Input (b, d) : Output (c, d) : es) ans
-> Machinery es ans (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ Either (Seq c) d
-> FOEs (Input (b, d) : Output (c, d) : es) =>
   Eff
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans
   -> Eff (Input (b, d) : Output (c, d) : es) ans
forall s (es :: [(* -> *) -> * -> *]) a.
s -> FOEs es => Eff (State s : es) a -> Eff es a
evalState (Seq c -> Either (Seq c) d
forall a b. a -> Either a b
Left Seq c
forall a. Seq a
Seq.Empty) (Eff
   (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans
 -> Eff (Input (b, d) : Output (c, d) : es) ans)
-> Eff
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans
-> Eff (Input (b, d) : Output (c, d) : es) ans
forall a b. (a -> b) -> a -> b
$ Eff (Input b : Output c : es) ans
-> Eff
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans
forall b c d ans (es :: [(* -> *) -> * -> *]).
Eff (Input b : Output c : es) ans
-> Eff
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans
buffering Eff (Input b : Output c : es) ans
m
        Connect Machinery es ans b b
a Machinery es ans b c
b -> Machinery es ans (b, d) (b, d)
-> Machinery es ans (b, d) (c, d) -> Machinery es ans (b, d) (c, d)
forall a b c ans (es :: [(* -> *) -> * -> *]).
Machinery es ans a b
-> Machinery es ans b c -> Machinery es ans a c
Connect (Machinery es ans b b -> Machinery es ans (b, d) (b, d)
forall b c d.
Machinery es ans b c -> Machinery es ans (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Machinery es ans b b
a) (Machinery es ans b c -> Machinery es ans (b, d) (c, d)
forall b c d.
Machinery es ans b c -> Machinery es ans (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Machinery es ans b c
b)

    {-# INLINE arr #-}
    {-# INLINE first #-}

buffering
    :: forall b c d ans es
     . Eff (Input b ': Output c ': es) ans
    -> Eff (State (Either (Seq c) d) ': Input (b, d) ': Output (c, d) ': es) ans
buffering :: forall b c d ans (es :: [(* -> *) -> * -> *]).
Eff (Input b : Output c : es) ans
-> Eff
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans
buffering =
    (Union
   '[Input b, Output c]
   (Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es))
 ~> Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es))
-> Eff Freer ('[Input b, Output c] ++ es) ans
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     ans
forall (es :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *])
       (r' :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
       (c :: (* -> *) -> Constraint).
(Suffix r r', KnownLength es, Free c ff) =>
(Union es (Eff ff r') ~> Eff ff r')
-> Eff ff (es ++ r) a -> Eff ff r' a
reinterprets
        ( ( \Input
  b
  (Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es))
  x
Input -> do
                (x
b, d
d) <- Eff
  Freer
  ((State (Either (Seq c) d) # "buffer")
     : Input (b, d) : Output (c, d) : es)
  (x, d)
forall i (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Input i :> es) =>
f i
input

                forall {k} (tag :: k) s (a :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Tagged tag (State s) :> es) =>
a s
forall (tag :: Symbol) s (a :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Tagged tag (State s) :> es) =>
a s
get'' @"buffer" Eff
  Freer
  ((State (Either (Seq c) d) # "buffer")
     : Input (b, d) : Output (c, d) : es)
  (Either (Seq c) d)
-> (Either (Seq c) d
    -> Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es)
         ())
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     ()
forall a b.
Eff
  Freer
  ((State (Either (Seq c) d) # "buffer")
     : Input (b, d) : Output (c, d) : es)
  a
-> (a
    -> Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es)
         b)
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Right d
_ -> ()
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     ()
forall a.
a
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    Left Seq c
outputQueue -> Seq c
-> (c
    -> Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es)
         ())
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq c
outputQueue \c
c -> (c, d)
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     ()
forall o (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Output o :> es) =>
o -> f ()
output (c
c, d
d)

                forall {k} (tag :: k) s (a :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Tagged tag (State s) :> es) =>
s -> a ()
forall (tag :: Symbol) s (a :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Tagged tag (State s) :> es) =>
s -> a ()
put'' @"buffer" (Either (Seq c) d
 -> Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es)
      ())
-> Either (Seq c) d
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     ()
forall a b. (a -> b) -> a -> b
$ d -> Either (Seq c) d
forall a b. b -> Either a b
Right d
d

                x
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     x
forall a.
a
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
b
          )
            (Input
   b
   (Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es))
   x
 -> Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es)
      x)
-> (Union
      '[Output c]
      (Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es))
      x
    -> Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es)
         x)
-> Union
     '[Input b, Output c]
     (Eff
        Freer
        ((State (Either (Seq c) d) # "buffer")
           : Input (b, d) : Output (c, d) : es))
     x
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     x
forall (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
(Input b f a -> r)
-> (Union es f a -> r) -> Union (Input b : es) f a -> r
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: ( \(Output c
c) ->
                    forall {k} (tag :: k) s (a :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Tagged tag (State s) :> es) =>
a s
forall (tag :: Symbol) s (a :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Tagged tag (State s) :> es) =>
a s
get'' @"buffer" Eff
  Freer
  ((State (Either (Seq c) d) # "buffer")
     : Input (b, d) : Output (c, d) : es)
  (Either (Seq c) d)
-> (Either (Seq c) d
    -> Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es)
         x)
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     x
forall a b.
Eff
  Freer
  ((State (Either (Seq c) d) # "buffer")
     : Input (b, d) : Output (c, d) : es)
  a
-> (a
    -> Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es)
         b)
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Right d
d -> (c, d)
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     ()
forall o (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Output o :> es) =>
o -> f ()
output (c
c, d
d)
                        Left Seq c
outputQueue -> forall {k} (tag :: k) s (a :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Tagged tag (State s) :> es) =>
s -> a ()
forall (tag :: Symbol) s (a :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Tagged tag (State s) :> es) =>
s -> a ()
put'' @"buffer" (Either (Seq c) d
 -> Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es)
      ())
-> Either (Seq c) d
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     ()
forall a b. (a -> b) -> a -> b
$ Seq c -> Either (Seq c) d
forall a b. a -> Either a b
Left (Seq c -> Either (Seq c) d) -> Seq c -> Either (Seq c) d
forall a b. (a -> b) -> a -> b
$ Seq c
outputQueue Seq c -> c -> Seq c
forall a. Seq a -> a -> Seq a
:|> c
c
               )
            (Output
   c
   (Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es))
   x
 -> Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es)
      x)
-> (Union
      '[]
      (Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es))
      x
    -> Eff
         Freer
         ((State (Either (Seq c) d) # "buffer")
            : Input (b, d) : Output (c, d) : es)
         x)
-> Union
     '[Output c]
     (Eff
        Freer
        ((State (Either (Seq c) d) # "buffer")
           : Input (b, d) : Output (c, d) : es))
     x
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     x
forall (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
(Output c f a -> r)
-> (Union es f a -> r) -> Union (Output c : es) f a -> r
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: Union
  '[]
  (Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es))
  x
-> Eff
     Freer
     ((State (Either (Seq c) d) # "buffer")
        : Input (b, d) : Output (c, d) : es)
     x
forall (f :: * -> *) a r. Union '[] f a -> r
nil
        )
        (Eff (Input b : Output c : es) ans
 -> Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es)
      ans)
-> (Eff
      Freer
      ((State (Either (Seq c) d) # "buffer")
         : Input (b, d) : Output (c, d) : es)
      ans
    -> Eff
         (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans)
-> Eff (Input b : Output c : es) ans
-> Eff
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {k} (tag :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]) a (ff :: (* -> *) -> * -> *)
       (c :: (* -> *) -> Constraint).
(KnownOrder e, KnownOrder (e # tag), Free c ff) =>
Eff ff ((e # tag) : es) a -> Eff ff (e : es) a
forall (tag :: Symbol) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]) a (ff :: (* -> *) -> * -> *)
       (c :: (* -> *) -> Constraint).
(KnownOrder e, KnownOrder (e # tag), Free c ff) =>
Eff ff ((e # tag) : es) a -> Eff ff (e : es) a
untag @"buffer"

instance (FOEs es) => ArrowChoice (Machinery es ans) where
    left :: forall b c d.
Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
left = Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
forall b c d ans (es :: [(* -> *) -> * -> *]).
Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
leftMachinery
    {-# INLINE left #-}

leftMachinery
    :: forall b c d ans es
     . Machinery es ans b c
    -> Machinery es ans (Either b d) (Either c d)
leftMachinery :: forall b c d ans (es :: [(* -> *) -> * -> *]).
Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
leftMachinery = \case
    Unit Eff (Input b : Output c : es) ans
m ->
        Eff (Input b : Output c : es) ans
m
            Eff (Input b : Output c : es) ans
-> (Eff (Input b : Output c : es) ans
    -> Eff Freer (Input (Either b d) : Output (Either c d) : es) ans)
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) ans
forall a b. a -> (a -> b) -> b
& (Union
   '[Input b, Output c]
   (Eff Freer (Input (Either b d) : Output (Either c d) : es))
 ~> Eff Freer (Input (Either b d) : Output (Either c d) : es))
-> Eff Freer ('[Input b, Output c] ++ es) ans
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) ans
forall (es :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *])
       (r' :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
       (c :: (* -> *) -> Constraint).
(Suffix r r', KnownLength es, Free c ff) =>
(Union es (Eff ff r') ~> Eff ff r')
-> Eff ff (es ++ r) a -> Eff ff r' a
reinterprets
                ( ( \Input
  b (Eff Freer (Input (Either b d) : Output (Either c d) : es)) x
Input -> (Eff Freer (Input (Either b d) : Output (Either c d) : es) x
 -> Eff Freer (Input (Either b d) : Output (Either c d) : es) x)
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) x
forall a. (a -> a) -> a
fix \Eff Freer (Input (Either b d) : Output (Either c d) : es) x
next ->
                        forall i (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Input i :> es) =>
f i
input @(Either b d) Eff
  Freer (Input (Either b d) : Output (Either c d) : es) (Either b d)
-> (Either b d
    -> Eff Freer (Input (Either b d) : Output (Either c d) : es) x)
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) x
forall a b.
Eff Freer (Input (Either b d) : Output (Either c d) : es) a
-> (a
    -> Eff Freer (Input (Either b d) : Output (Either c d) : es) b)
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                            Left b
x -> x -> Eff Freer (Input (Either b d) : Output (Either c d) : es) x
forall a.
a -> Eff Freer (Input (Either b d) : Output (Either c d) : es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
x
                            Right d
o -> do
                                forall o (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Output o :> es) =>
o -> f ()
output @(Either c d) (Either c d
 -> Eff Freer (Input (Either b d) : Output (Either c d) : es) ())
-> Either c d
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) ()
forall a b. (a -> b) -> a -> b
$ d -> Either c d
forall a b. b -> Either a b
Right d
o
                                Eff Freer (Input (Either b d) : Output (Either c d) : es) x
next
                  )
                    (Input
   b (Eff Freer (Input (Either b d) : Output (Either c d) : es)) x
 -> Eff Freer (Input (Either b d) : Output (Either c d) : es) x)
-> (Union
      '[Output c]
      (Eff Freer (Input (Either b d) : Output (Either c d) : es))
      x
    -> Eff Freer (Input (Either b d) : Output (Either c d) : es) x)
-> Union
     '[Input b, Output c]
     (Eff Freer (Input (Either b d) : Output (Either c d) : es))
     x
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) x
forall (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
(Input b f a -> r)
-> (Union es f a -> r) -> Union (Input b : es) f a -> r
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: (\(Output c
o) -> forall o (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Output o :> es) =>
o -> f ()
output @(Either c d) (Either c d
 -> Eff Freer (Input (Either b d) : Output (Either c d) : es) ())
-> Either c d
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) ()
forall a b. (a -> b) -> a -> b
$ c -> Either c d
forall a b. a -> Either a b
Left c
o)
                    (Output
   c (Eff Freer (Input (Either b d) : Output (Either c d) : es)) x
 -> Eff Freer (Input (Either b d) : Output (Either c d) : es) x)
-> (Union
      '[] (Eff Freer (Input (Either b d) : Output (Either c d) : es)) x
    -> Eff Freer (Input (Either b d) : Output (Either c d) : es) x)
-> Union
     '[Output c]
     (Eff Freer (Input (Either b d) : Output (Either c d) : es))
     x
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) x
forall (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
(Output c f a -> r)
-> (Union es f a -> r) -> Union (Output c : es) f a -> r
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: Union
  '[] (Eff Freer (Input (Either b d) : Output (Either c d) : es)) x
-> Eff Freer (Input (Either b d) : Output (Either c d) : es) x
forall (f :: * -> *) a r. Union '[] f a -> r
nil
                )
            Eff Freer (Input (Either b d) : Output (Either c d) : es) ans
-> (Eff Freer (Input (Either b d) : Output (Either c d) : es) ans
    -> Machinery es ans (Either b d) (Either c d))
-> Machinery es ans (Either b d) (Either c d)
forall a b. a -> (a -> b) -> b
& Eff Freer (Input (Either b d) : Output (Either c d) : es) ans
-> Machinery es ans (Either b d) (Either c d)
forall i o ans (es :: [(* -> *) -> * -> *]).
Eff (Input i : Output o : es) ans -> Machinery es ans i o
Unit
    Connect Machinery es ans b b
a Machinery es ans b c
b -> Machinery es ans (Either b d) (Either b d)
-> Machinery es ans (Either b d) (Either c d)
-> Machinery es ans (Either b d) (Either c d)
forall a b c ans (es :: [(* -> *) -> * -> *]).
Machinery es ans a b
-> Machinery es ans b c -> Machinery es ans a c
Connect (Machinery es ans b b -> Machinery es ans (Either b d) (Either b d)
forall b c d ans (es :: [(* -> *) -> * -> *]).
Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
leftMachinery Machinery es ans b b
a) (Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
forall b c d ans (es :: [(* -> *) -> * -> *]).
Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
leftMachinery Machinery es ans b c
b)

newtype Machine f ans i o = Machine
    {forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine :: f (MachineStatus f ans i o)}

data MachineStatus f ans i o
    = Terminated ans
    | Waiting (i -> Machine f ans i o)
    | Produced o (Machine f ans i o)

machine :: (WeakenHOEs es) => Eff (Input i ': Output o ': RemoveHOEs es) ans -> Machine (Eff es) ans i o
machine :: forall (es :: [(* -> *) -> * -> *]) i o ans.
WeakenHOEs es =>
Eff (Input i : Output o : RemoveHOEs es) ans
-> Machine (Eff es) ans i o
machine =
    (ans -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> AlgHandler
     (Union '[Input i, Output o])
     (Eff ('[Input i, Output o] ++ RemoveHOEs es))
     (Eff Freer (RemoveHOEs es))
     (MachineStatus (Eff es) ans i o)
-> Eff ('[Input i, Output o] ++ RemoveHOEs es) ans
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall (es :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *]) ans
       a.
(FOEs r, KnownLength es) =>
(a -> Eff r ans)
-> AlgHandler (Union es) (Eff (es ++ r)) (Eff r) ans
-> Eff (es ++ r) a
-> Eff r ans
interpretsBy
        (MachineStatus (Eff es) ans i o
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall a. a -> Eff Freer (RemoveHOEs es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff es) ans i o
 -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> (ans -> MachineStatus (Eff es) ans i o)
-> ans
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ans -> MachineStatus (Eff es) ans i o
forall (f :: * -> *) ans i o. ans -> MachineStatus f ans i o
Terminated)
        ( (\Input i (Eff (Input i : Output o : RemoveHOEs es)) x
Input x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
k -> MachineStatus (Eff es) ans i o
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall a. a -> Eff Freer (RemoveHOEs es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff es) ans i o
 -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> MachineStatus (Eff es) ans i o
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ (i -> Machine (Eff es) ans i o) -> MachineStatus (Eff es) ans i o
forall (f :: * -> *) ans i o.
(i -> Machine f ans i o) -> MachineStatus f ans i o
Waiting ((i -> Machine (Eff es) ans i o) -> MachineStatus (Eff es) ans i o)
-> (i -> Machine (Eff es) ans i o)
-> MachineStatus (Eff es) ans i o
forall a b. (a -> b) -> a -> b
$ Eff Freer es (MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine (Eff Freer es (MachineStatus (Eff es) ans i o)
 -> Machine (Eff es) ans i o)
-> (i -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> i
-> Machine (Eff es) ans i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall (es :: [(* -> *) -> * -> *]) a (ff :: (* -> *) -> * -> *)
       (c :: (* -> *) -> Constraint).
(Free c ff, WeakenHOEs es) =>
Eff ff (RemoveHOEs es) a -> Eff ff es a
onlyFOEs (Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> (i -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> i
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
k)
            (Input i (Eff (Input i : Output o : RemoveHOEs es)) x
 -> (x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
 -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> (Union '[Output o] (Eff (Input i : Output o : RemoveHOEs es)) x
    -> (x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
    -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> Union
     '[Input i, Output o] (Eff (Input i : Output o : RemoveHOEs es)) x
-> (x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
(Input i f a -> r)
-> (Union es f a -> r) -> Union (Input i : es) f a -> r
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: (\(Output o
o) x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
k -> MachineStatus (Eff es) ans i o
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall a. a -> Eff Freer (RemoveHOEs es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff es) ans i o
 -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> MachineStatus (Eff es) ans i o
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ o -> Machine (Eff es) ans i o -> MachineStatus (Eff es) ans i o
forall (f :: * -> *) ans i o.
o -> Machine f ans i o -> MachineStatus f ans i o
Produced o
o (Machine (Eff es) ans i o -> MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o -> MachineStatus (Eff es) ans i o
forall a b. (a -> b) -> a -> b
$ Eff Freer es (MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine (Eff Freer es (MachineStatus (Eff es) ans i o)
 -> Machine (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o
forall a b. (a -> b) -> a -> b
$ Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall (es :: [(* -> *) -> * -> *]) a (ff :: (* -> *) -> * -> *)
       (c :: (* -> *) -> Constraint).
(Free c ff, WeakenHOEs es) =>
Eff ff (RemoveHOEs es) a -> Eff ff es a
onlyFOEs (Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
k ())
            (Output o (Eff (Input i : Output o : RemoveHOEs es)) x
 -> (x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
 -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> (Union '[] (Eff (Input i : Output o : RemoveHOEs es)) x
    -> (x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
    -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> Union '[Output o] (Eff (Input i : Output o : RemoveHOEs es)) x
-> (x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
(Output o f a -> r)
-> (Union es f a -> r) -> Union (Output o : es) f a -> r
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: Union '[] (Eff (Input i : Output o : RemoveHOEs es)) x
-> (x -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
forall (f :: * -> *) a r. Union '[] f a -> r
nil
        )
        (Eff (Input i : Output o : RemoveHOEs es) ans
 -> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o))
-> (Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
    -> Machine (Eff es) ans i o)
-> Eff (Input i : Output o : RemoveHOEs es) ans
-> Machine (Eff es) ans i o
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall (es :: [(* -> *) -> * -> *]) a (ff :: (* -> *) -> * -> *)
       (c :: (* -> *) -> Constraint).
(Free c ff, WeakenHOEs es) =>
Eff ff (RemoveHOEs es) a -> Eff ff es a
onlyFOEs
        (Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> (Eff Freer es (MachineStatus (Eff es) ans i o)
    -> Machine (Eff es) ans i o)
-> Eff (RemoveHOEs es) (MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Eff Freer es (MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine

runMachinery
    :: forall i o ans es
     . (Parallel :> es, Semigroup ans, WeakenHOEs es)
    => Machinery (RemoveHOEs es) ans i o
    -> Eff es (MachineStatus (Eff es) ans i o)
runMachinery :: forall i o ans (es :: [(* -> *) -> * -> *]).
(Parallel :> es, Semigroup ans, WeakenHOEs es) =>
Machinery (RemoveHOEs es) ans i o
-> Eff es (MachineStatus (Eff es) ans i o)
runMachinery = MachineryViewL (RemoveHOEs es) ans i o
-> Eff es (MachineStatus (Eff es) ans i o)
forall i o ans (es :: [(* -> *) -> * -> *]).
(Parallel :> es, Semigroup ans, WeakenHOEs es) =>
MachineryViewL (RemoveHOEs es) ans i o
-> Eff es (MachineStatus (Eff es) ans i o)
runMachineryL (MachineryViewL (RemoveHOEs es) ans i o
 -> Eff es (MachineStatus (Eff es) ans i o))
-> (Machinery (RemoveHOEs es) ans i o
    -> MachineryViewL (RemoveHOEs es) ans i o)
-> Machinery (RemoveHOEs es) ans i o
-> Eff es (MachineStatus (Eff es) ans i o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Machinery (RemoveHOEs es) ans i o
-> MachineryViewL (RemoveHOEs es) ans i o
forall (es :: [(* -> *) -> * -> *]) ans i o.
Machinery es ans i o -> MachineryViewL es ans i o
mviewl

runMachineryL
    :: forall i o ans es
     . (Parallel :> es, Semigroup ans, WeakenHOEs es)
    => MachineryViewL (RemoveHOEs es) ans i o
    -> Eff es (MachineStatus (Eff es) ans i o)
runMachineryL :: forall i o ans (es :: [(* -> *) -> * -> *]).
(Parallel :> es, Semigroup ans, WeakenHOEs es) =>
MachineryViewL (RemoveHOEs es) ans i o
-> Eff es (MachineStatus (Eff es) ans i o)
runMachineryL = \case
    MOne Eff (Input i : Output o : RemoveHOEs es) ans
m -> Machine (Eff es) ans i o -> Eff es (MachineStatus (Eff es) ans i o)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine (Machine (Eff es) ans i o
 -> Eff es (MachineStatus (Eff es) ans i o))
-> Machine (Eff es) ans i o
-> Eff es (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ Eff (Input i : Output o : RemoveHOEs es) ans
-> Machine (Eff es) ans i o
forall (es :: [(* -> *) -> * -> *]) i o ans.
WeakenHOEs es =>
Eff (Input i : Output o : RemoveHOEs es) ans
-> Machine (Eff es) ans i o
machine Eff (Input i : Output o : RemoveHOEs es) ans
m
    MCons Eff (Input i : Output b : RemoveHOEs es) ans
m Machinery (RemoveHOEs es) ans b o
ms -> do
        (MachineStatus (Eff es) ans i b
 -> MachineStatus (Eff es) ans b o
 -> (MachineStatus (Eff es) ans i b,
     MachineStatus (Eff es) ans b o))
-> Eff Freer es (MachineStatus (Eff es) ans i b)
-> Eff Freer es (MachineStatus (Eff es) ans b o)
-> Eff
     Freer
     es
     (MachineStatus (Eff es) ans i b, MachineStatus (Eff es) ans b o)
forall a b c1 (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c2 :: (* -> *) -> Constraint).
(Free c2 ff, f ~ Eff ff es, Parallel :> es) =>
(a -> b -> c1) -> f a -> f b -> f c1
liftP2 (,) (Machine (Eff es) ans i b
-> Eff Freer es (MachineStatus (Eff es) ans i b)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine (Machine (Eff es) ans i b
 -> Eff Freer es (MachineStatus (Eff es) ans i b))
-> Machine (Eff es) ans i b
-> Eff Freer es (MachineStatus (Eff es) ans i b)
forall a b. (a -> b) -> a -> b
$ Eff (Input i : Output b : RemoveHOEs es) ans
-> Machine (Eff es) ans i b
forall (es :: [(* -> *) -> * -> *]) i o ans.
WeakenHOEs es =>
Eff (Input i : Output o : RemoveHOEs es) ans
-> Machine (Eff es) ans i o
machine Eff (Input i : Output b : RemoveHOEs es) ans
m) (Machinery (RemoveHOEs es) ans b o
-> Eff Freer es (MachineStatus (Eff es) ans b o)
forall i o ans (es :: [(* -> *) -> * -> *]).
(Parallel :> es, Semigroup ans, WeakenHOEs es) =>
Machinery (RemoveHOEs es) ans i o
-> Eff es (MachineStatus (Eff es) ans i o)
runMachinery Machinery (RemoveHOEs es) ans b o
ms) Eff
  Freer
  es
  (MachineStatus (Eff es) ans i b, MachineStatus (Eff es) ans b o)
-> ((MachineStatus (Eff es) ans i b,
     MachineStatus (Eff es) ans b o)
    -> Eff es (MachineStatus (Eff es) ans i o))
-> Eff es (MachineStatus (Eff es) ans i o)
forall a b.
Eff Freer es a -> (a -> Eff Freer es b) -> Eff Freer es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MachineStatus (Eff es) ans i b, MachineStatus (Eff es) ans b o)
-> Eff es (MachineStatus (Eff es) ans i o)
forall {i} {i} {o}.
(MachineStatus (Eff es) ans i i, MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
loop
      where
        loop :: (MachineStatus (Eff es) ans i i, MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
loop = \case
            (Terminated ans
ans, Terminated ans
ans') -> MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff es) ans i o
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ ans -> MachineStatus (Eff es) ans i o
forall (f :: * -> *) ans i o. ans -> MachineStatus f ans i o
Terminated (ans -> MachineStatus (Eff es) ans i o)
-> ans -> MachineStatus (Eff es) ans i o
forall a b. (a -> b) -> a -> b
$ ans
ans ans -> ans -> ans
forall a. Semigroup a => a -> a -> a
<> ans
ans'
            (Produced i
o Machine (Eff es) ans i i
k1, Waiting i -> Machine (Eff es) ans i o
k2) ->
                (MachineStatus (Eff es) ans i i
 -> MachineStatus (Eff es) ans i o
 -> (MachineStatus (Eff es) ans i i,
     MachineStatus (Eff es) ans i o))
-> Eff Freer es (MachineStatus (Eff es) ans i i)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
-> Eff
     Freer
     es
     (MachineStatus (Eff es) ans i i, MachineStatus (Eff es) ans i o)
forall a b c1 (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c2 :: (* -> *) -> Constraint).
(Free c2 ff, f ~ Eff ff es, Parallel :> es) =>
(a -> b -> c1) -> f a -> f b -> f c1
liftP2 (,) (Machine (Eff es) ans i i
-> Eff Freer es (MachineStatus (Eff es) ans i i)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine Machine (Eff es) ans i i
k1) (Machine (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine (Machine (Eff es) ans i o
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> Machine (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ i -> Machine (Eff es) ans i o
k2 i
o) Eff
  Freer
  es
  (MachineStatus (Eff es) ans i i, MachineStatus (Eff es) ans i o)
-> ((MachineStatus (Eff es) ans i i,
     MachineStatus (Eff es) ans i o)
    -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a b.
Eff Freer es a -> (a -> Eff Freer es b) -> Eff Freer es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MachineStatus (Eff es) ans i i, MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
loop
            (Waiting i -> Machine (Eff es) ans i i
k, MachineStatus (Eff es) ans i o
s) ->
                MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff es) ans i o
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ (i -> Machine (Eff es) ans i o) -> MachineStatus (Eff es) ans i o
forall (f :: * -> *) ans i o.
(i -> Machine f ans i o) -> MachineStatus f ans i o
Waiting \i
i -> Eff Freer es (MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine do
                    MachineStatus (Eff es) ans i i
s' <- Machine (Eff es) ans i i
-> Eff Freer es (MachineStatus (Eff es) ans i i)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine (Machine (Eff es) ans i i
 -> Eff Freer es (MachineStatus (Eff es) ans i i))
-> Machine (Eff es) ans i i
-> Eff Freer es (MachineStatus (Eff es) ans i i)
forall a b. (a -> b) -> a -> b
$ i -> Machine (Eff es) ans i i
k i
i
                    (MachineStatus (Eff es) ans i i, MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
loop (MachineStatus (Eff es) ans i i
s', MachineStatus (Eff es) ans i o
s)
            (MachineStatus (Eff es) ans i i
s, Produced o
o Machine (Eff es) ans i o
k) ->
                MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff es) ans i o
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ o -> Machine (Eff es) ans i o -> MachineStatus (Eff es) ans i o
forall (f :: * -> *) ans i o.
o -> Machine f ans i o -> MachineStatus f ans i o
Produced o
o (Machine (Eff es) ans i o -> MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o -> MachineStatus (Eff es) ans i o
forall a b. (a -> b) -> a -> b
$ Eff Freer es (MachineStatus (Eff es) ans i o)
-> Machine (Eff es) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine do
                    MachineStatus (Eff es) ans i o
s' <- Machine (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine Machine (Eff es) ans i o
k
                    (MachineStatus (Eff es) ans i i, MachineStatus (Eff es) ans i o)
-> Eff Freer es (MachineStatus (Eff es) ans i o)
loop (MachineStatus (Eff es) ans i i
s, MachineStatus (Eff es) ans i o
s')
            (Terminated ans
ans, Waiting i -> Machine (Eff es) ans i o
_) -> MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff es) ans i o
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ ans -> MachineStatus (Eff es) ans i o
forall (f :: * -> *) ans i o. ans -> MachineStatus f ans i o
Terminated ans
ans
            (Produced i
_ Machine (Eff es) ans i i
_, Terminated ans
ans) -> MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff es) ans i o
 -> Eff Freer es (MachineStatus (Eff es) ans i o))
-> MachineStatus (Eff es) ans i o
-> Eff Freer es (MachineStatus (Eff es) ans i o)
forall a b. (a -> b) -> a -> b
$ ans -> MachineStatus (Eff es) ans i o
forall (f :: * -> *) ans i o. ans -> MachineStatus f ans i o
Terminated ans
ans

newtype MachineryIO es ans i o = MachineryIO {forall (es :: [(* -> *) -> * -> *]) ans i o.
MachineryIO es ans i o -> Machinery es ans i o
unMachineryIO :: Machinery es ans i o}
    deriving newtype ((forall a. MachineryIO es ans a a)
-> (forall b c a.
    MachineryIO es ans b c
    -> MachineryIO es ans a b -> MachineryIO es ans a c)
-> Category (MachineryIO es ans)
forall (es :: [(* -> *) -> * -> *]) ans a. MachineryIO es ans a a
forall (es :: [(* -> *) -> * -> *]) ans b c a.
MachineryIO es ans b c
-> MachineryIO es ans a b -> MachineryIO es ans a c
forall a. MachineryIO es ans a a
forall b c a.
MachineryIO es ans b c
-> MachineryIO es ans a b -> MachineryIO es ans a c
forall {k} (cat :: k -> k -> *).
(forall (a :: k). cat a a)
-> (forall (b :: k) (c :: k) (a :: k).
    cat b c -> cat a b -> cat a c)
-> Category cat
$cid :: forall (es :: [(* -> *) -> * -> *]) ans a. MachineryIO es ans a a
id :: forall a. MachineryIO es ans a a
$c. :: forall (es :: [(* -> *) -> * -> *]) ans b c a.
MachineryIO es ans b c
-> MachineryIO es ans a b -> MachineryIO es ans a c
. :: forall b c a.
MachineryIO es ans b c
-> MachineryIO es ans a b -> MachineryIO es ans a c
Category)

instance (Emb IO :> es) => Arrow (MachineryIO es ans) where
    arr :: forall b c. (b -> c) -> MachineryIO es ans b c
arr (b -> c
f :: b -> c) =
        Machinery es ans b c -> MachineryIO es ans b c
forall (es :: [(* -> *) -> * -> *]) ans i o.
Machinery es ans i o -> MachineryIO es ans i o
MachineryIO (Machinery es ans b c -> MachineryIO es ans b c)
-> (Eff Freer (Input b : Output c : es) () -> Machinery es ans b c)
-> Eff Freer (Input b : Output c : es) ()
-> MachineryIO es ans b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Input b : Output c : es) ans -> Machinery es ans b c
forall i o ans (es :: [(* -> *) -> * -> *]).
Eff (Input i : Output o : es) ans -> Machinery es ans i o
Unit (Eff (Input b : Output c : es) ans -> Machinery es ans b c)
-> (Eff Freer (Input b : Output c : es) ()
    -> Eff (Input b : Output c : es) ans)
-> Eff Freer (Input b : Output c : es) ()
-> Machinery es ans b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff Freer (Input b : Output c : es) ()
-> Eff (Input b : Output c : es) ans
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Eff Freer (Input b : Output c : es) () -> MachineryIO es ans b c)
-> Eff Freer (Input b : Output c : es) () -> MachineryIO es ans b c
forall a b. (a -> b) -> a -> b
$
            forall i (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Input i :> es) =>
f i
input @b Eff Freer (Input b : Output c : es) b
-> (b -> Eff Freer (Input b : Output c : es) ())
-> Eff Freer (Input b : Output c : es) ()
forall a b.
Eff Freer (Input b : Output c : es) a
-> (a -> Eff Freer (Input b : Output c : es) b)
-> Eff Freer (Input b : Output c : es) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Eff Freer (Input b : Output c : es) ()
forall o (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(Free c ff, f ~ Eff ff es, Output o :> es) =>
o -> f ()
output (c -> Eff Freer (Input b : Output c : es) ())
-> (b -> c) -> b -> Eff Freer (Input b : Output c : es) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f

    first :: forall b c d. MachineryIO es ans b c -> MachineryIO es ans (b, d) (c, d)
    first :: forall b c d.
MachineryIO es ans b c -> MachineryIO es ans (b, d) (c, d)
first =
        MachineryIO es ans b c -> Machinery es ans b c
forall (es :: [(* -> *) -> * -> *]) ans i o.
MachineryIO es ans i o -> Machinery es ans i o
unMachineryIO
            (MachineryIO es ans b c -> Machinery es ans b c)
-> (Machinery es ans b c -> MachineryIO es ans (b, d) (c, d))
-> MachineryIO es ans b c
-> MachineryIO es ans (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
>>> Machinery es ans (b, d) (c, d) -> MachineryIO es ans (b, d) (c, d)
forall (es :: [(* -> *) -> * -> *]) ans i o.
Machinery es ans i o -> MachineryIO es ans i o
MachineryIO (Machinery es ans (b, d) (c, d)
 -> MachineryIO es ans (b, d) (c, d))
-> (Machinery es ans b c -> Machinery es ans (b, d) (c, d))
-> Machinery es ans b c
-> MachineryIO es ans (b, d) (c, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                Unit Eff (Input b : Output c : es) ans
m ->
                    Eff (Input (b, d) : Output (c, d) : es) ans
-> Machinery es ans (b, d) (c, d)
forall i o ans (es :: [(* -> *) -> * -> *]).
Eff (Input i : Output o : es) ans -> Machinery es ans i o
Unit (Eff (Input (b, d) : Output (c, d) : es) ans
 -> Machinery es ans (b, d) (c, d))
-> Eff (Input (b, d) : Output (c, d) : es) ans
-> Machinery es ans (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ Either (Seq c) d
-> Eff
     Freer
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es)
     ans
-> Eff (Input (b, d) : Output (c, d) : es) ans
forall s (es :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
       (c :: (* -> *) -> Constraint).
(Emb IO :> es, Monad (Eff ff es), Free c ff) =>
s -> Eff ff (State s : es) a -> Eff ff es a
evalStateIORef (Seq c -> Either (Seq c) d
forall a b. a -> Either a b
Left Seq c
forall a. Seq a
Seq.Empty) (Eff
   Freer
   (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es)
   ans
 -> Eff (Input (b, d) : Output (c, d) : es) ans)
-> Eff
     Freer
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es)
     ans
-> Eff (Input (b, d) : Output (c, d) : es) ans
forall a b. (a -> b) -> a -> b
$ Eff (Input b : Output c : es) ans
-> Eff
     Freer
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es)
     ans
forall b c d ans (es :: [(* -> *) -> * -> *]).
Eff (Input b : Output c : es) ans
-> Eff
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : es) ans
buffering Eff (Input b : Output c : es) ans
m
                Connect Machinery es ans b b
a Machinery es ans b c
b ->
                    Machinery es ans (b, d) (b, d)
-> Machinery es ans (b, d) (c, d) -> Machinery es ans (b, d) (c, d)
forall a b c ans (es :: [(* -> *) -> * -> *]).
Machinery es ans a b
-> Machinery es ans b c -> Machinery es ans a c
Connect
                        (MachineryIO es ans (b, d) (b, d) -> Machinery es ans (b, d) (b, d)
forall (es :: [(* -> *) -> * -> *]) ans i o.
MachineryIO es ans i o -> Machinery es ans i o
unMachineryIO (MachineryIO es ans (b, d) (b, d)
 -> Machinery es ans (b, d) (b, d))
-> MachineryIO es ans (b, d) (b, d)
-> Machinery es ans (b, d) (b, d)
forall a b. (a -> b) -> a -> b
$ MachineryIO es ans b b -> MachineryIO es ans (b, d) (b, d)
forall b c d.
MachineryIO es ans b c -> MachineryIO es ans (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (MachineryIO es ans b b -> MachineryIO es ans (b, d) (b, d))
-> MachineryIO es ans b b -> MachineryIO es ans (b, d) (b, d)
forall a b. (a -> b) -> a -> b
$ Machinery es ans b b -> MachineryIO es ans b b
forall (es :: [(* -> *) -> * -> *]) ans i o.
Machinery es ans i o -> MachineryIO es ans i o
MachineryIO Machinery es ans b b
a)
                        (MachineryIO es ans (b, d) (c, d) -> Machinery es ans (b, d) (c, d)
forall (es :: [(* -> *) -> * -> *]) ans i o.
MachineryIO es ans i o -> Machinery es ans i o
unMachineryIO (MachineryIO es ans (b, d) (c, d)
 -> Machinery es ans (b, d) (c, d))
-> MachineryIO es ans (b, d) (c, d)
-> Machinery es ans (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ MachineryIO es ans b c -> MachineryIO es ans (b, d) (c, d)
forall b c d.
MachineryIO es ans b c -> MachineryIO es ans (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (MachineryIO es ans b c -> MachineryIO es ans (b, d) (c, d))
-> MachineryIO es ans b c -> MachineryIO es ans (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ Machinery es ans b c -> MachineryIO es ans b c
forall (es :: [(* -> *) -> * -> *]) ans i o.
Machinery es ans i o -> MachineryIO es ans i o
MachineryIO Machinery es ans b c
b)

    {-# INLINE arr #-}
    {-# INLINE first #-}

instance (Emb IO :> es) => ArrowChoice (MachineryIO es ans) where
    left :: forall b c d.
MachineryIO es ans b c
-> MachineryIO es ans (Either b d) (Either c d)
left = Machinery es ans (Either b d) (Either c d)
-> MachineryIO es ans (Either b d) (Either c d)
forall (es :: [(* -> *) -> * -> *]) ans i o.
Machinery es ans i o -> MachineryIO es ans i o
MachineryIO (Machinery es ans (Either b d) (Either c d)
 -> MachineryIO es ans (Either b d) (Either c d))
-> (MachineryIO es ans b c
    -> Machinery es ans (Either b d) (Either c d))
-> MachineryIO es ans b c
-> MachineryIO es ans (Either b d) (Either c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
forall b c d ans (es :: [(* -> *) -> * -> *]).
Machinery es ans b c -> Machinery es ans (Either b d) (Either c d)
leftMachinery (Machinery es ans b c
 -> Machinery es ans (Either b d) (Either c d))
-> (MachineryIO es ans b c -> Machinery es ans b c)
-> MachineryIO es ans b c
-> Machinery es ans (Either b d) (Either c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MachineryIO es ans b c -> Machinery es ans b c
forall (es :: [(* -> *) -> * -> *]) ans i o.
MachineryIO es ans i o -> Machinery es ans i o
unMachineryIO
    {-# INLINE left #-}

runMachineryIO
    :: forall i o ans es
     . (UnliftIO :> es, Emb IO :> es)
    => Eff es i
    -> (o -> Eff es ())
    -> Machinery es ans i o
    -> Eff es ans
runMachineryIO :: forall i o ans (es :: [(* -> *) -> * -> *]).
(UnliftIO :> es, Emb IO :> es) =>
Eff es i -> (o -> Eff es ()) -> Machinery es ans i o -> Eff es ans
runMachineryIO Eff es i
i o -> Eff es ()
o = Eff es i
-> (o -> Eff es ()) -> MachineryViewL es ans i o -> Eff es ans
forall i o ans (es :: [(* -> *) -> * -> *]).
(UnliftIO :> es, Emb IO :> es) =>
Eff es i
-> (o -> Eff es ()) -> MachineryViewL es ans i o -> Eff es ans
runMachineryIOL Eff es i
i o -> Eff es ()
o (MachineryViewL es ans i o -> Eff es ans)
-> (Machinery es ans i o -> MachineryViewL es ans i o)
-> Machinery es ans i o
-> Eff es ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Machinery es ans i o -> MachineryViewL es ans i o
forall (es :: [(* -> *) -> * -> *]) ans i o.
Machinery es ans i o -> MachineryViewL es ans i o
mviewl

runMachineryIOL
    :: forall i o ans es
     . (UnliftIO :> es, Emb IO :> es)
    => Eff es i
    -> (o -> Eff es ())
    -> MachineryViewL es ans i o
    -> Eff es ans
runMachineryIOL :: forall i o ans (es :: [(* -> *) -> * -> *]).
(UnliftIO :> es, Emb IO :> es) =>
Eff es i
-> (o -> Eff es ()) -> MachineryViewL es ans i o -> Eff es ans
runMachineryIOL Eff es i
i o -> Eff es ()
o = \case
    MOne Eff (Input i : Output o : es) ans
m -> (o -> Eff es ()) -> Eff (Input i : Output o : es) ~> Eff es
forall o'.
(o' -> Eff es ()) -> Eff (Input i : Output o' : es) ~> Eff es
runUnit o -> Eff es ()
o Eff (Input i : Output o : es) ans
m
    MCons Eff (Input i : Output b : es) ans
a Machinery es ans b o
b ->
        ((Eff es ~> IO) -> IO ans) -> Eff es ans
forall (es :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
       (c :: (* -> *) -> Constraint).
(UnliftIO :> es, Free c ff) =>
((Eff ff es ~> IO) -> IO a) -> Eff ff es a
withRunInIO \Eff es ~> IO
run -> do
            TMVar b
chan <- IO (TMVar b)
forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
            TMVar ans
ans <- IO (TMVar ans)
forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
            ((forall a. IO a -> IO a) -> IO ans) -> IO ans
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
mask \forall a. IO a -> IO a
restore -> do
                let runThread :: Eff es ans -> IO ThreadId
runThread Eff es ans
m = IO () -> IO ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO do
                        ans
x <- IO ans -> IO ans
forall a. IO a -> IO a
restore (IO ans -> IO ans) -> IO ans -> IO ans
forall a b. (a -> b) -> a -> b
$ Eff es ans -> IO ans
Eff es ~> IO
run Eff es ans
m
                        STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar ans -> ans -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ans
ans ans
x

                ThreadId
t1 <- Eff es ans -> IO ThreadId
runThread (Eff es ans -> IO ThreadId) -> Eff es ans -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (b -> Eff es ()) -> Eff (Input i : Output b : es) ~> Eff es
forall o'.
(o' -> Eff es ()) -> Eff (Input i : Output o' : es) ~> Eff es
runUnit (IO () -> Eff es ()
forall a. IO a -> Eff Freer es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff es ()) -> (b -> IO ()) -> b -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> (b -> STM ()) -> b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar b -> b -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar b
chan) Eff (Input i : Output b : es) ans
a
                ThreadId
t2 <- Eff es ans -> IO ThreadId
runThread (Eff es ans -> IO ThreadId) -> Eff es ans -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Eff es b -> (o -> Eff es ()) -> Machinery es ans b o -> Eff es ans
forall i o ans (es :: [(* -> *) -> * -> *]).
(UnliftIO :> es, Emb IO :> es) =>
Eff es i -> (o -> Eff es ()) -> Machinery es ans i o -> Eff es ans
runMachineryIO (IO b -> Eff es b
forall a. IO a -> Eff Freer es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> Eff es b) -> (STM b -> IO b) -> STM b -> Eff es b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM b -> IO b
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM b -> Eff es b) -> STM b -> Eff es b
forall a b. (a -> b) -> a -> b
$ TMVar b -> STM b
forall a. TMVar a -> STM a
takeTMVar TMVar b
chan) o -> Eff es ()
o Machinery es ans b o
b

                STM ans -> IO ans
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TMVar ans -> STM ans
forall a. TMVar a -> STM a
readTMVar TMVar ans
ans)
                    IO ans -> IO () -> IO ans
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m a
uninterruptibleMask_ (ThreadId -> IO ()
forall (m :: * -> *). MonadIO m => ThreadId -> m ()
killThread ThreadId
t1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ThreadId -> IO ()
forall (m :: * -> *). MonadIO m => ThreadId -> m ()
killThread ThreadId
t2)
  where
    runUnit :: (o' -> Eff es ()) -> Eff (Input i ': Output o' ': es) ~> Eff es
    runUnit :: forall o'.
(o' -> Eff es ()) -> Eff (Input i : Output o' : es) ~> Eff es
runUnit o' -> Eff es ()
o' Eff (Input i : Output o' : es) x
m =
        Eff (Input i : Output o' : es) x
m
            Eff (Input i : Output o' : es) x
-> (Eff (Input i : Output o' : es) x
    -> Eff Freer (Output o' : es) x)
-> Eff Freer (Output o' : es) x
forall a b. a -> (a -> b) -> b
& (Input i ~~> Eff Freer (Output o' : es))
-> Eff (Input i : Output o' : es) x -> Eff Freer (Output o' : es) x
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret (\Input i (Eff Freer (Output o' : es)) x
Input -> Eff Freer es x -> Eff Freer (Output o' : es) x
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
Free c ff =>
Eff ff es a -> Eff ff (e : es) a
raise Eff es i
Eff Freer es x
i)
            Eff Freer (Output o' : es) x
-> (Eff Freer (Output o' : es) x -> Eff es x) -> Eff es x
forall a b. a -> (a -> b) -> b
& (Output o' ~~> Eff es) -> Eff Freer (Output o' : es) x -> Eff es x
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret (\(Output o'
x) -> o' -> Eff es ()
o' o'
x)

runMachineryIO_
    :: forall ans es
     . (UnliftIO :> es, Emb IO :> es)
    => Machinery es ans () ()
    -> Eff es ans
runMachineryIO_ :: forall ans (es :: [(* -> *) -> * -> *]).
(UnliftIO :> es, Emb IO :> es) =>
Machinery es ans () () -> Eff es ans
runMachineryIO_ = Eff es ()
-> (() -> Eff es ()) -> Machinery es ans () () -> Eff es ans
forall i o ans (es :: [(* -> *) -> * -> *]).
(UnliftIO :> es, Emb IO :> es) =>
Eff es i -> (o -> Eff es ()) -> Machinery es ans i o -> Eff es ans
runMachineryIO (() -> Eff es ()
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Eff es () -> () -> Eff es ()
forall a b. a -> b -> a
const (Eff es () -> () -> Eff es ()) -> Eff es () -> () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ () -> Eff es ()
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE runMachineryIO_ #-}

-- Inspired by https://hackage.haskell.org/package/freer-simple-1.2.1.2/docs/Data-FTCQueue.html

{- |
Left view deconstruction data structure for Machinery Pipeline.

This allows the number of generated threads to be reduced to the number of machine units.
-}
data MachineryViewL es ans i o where
    MOne
        :: forall i o ans es
         . Eff (Input i ': Output o ': es) ans
        -> MachineryViewL es ans i o
    MCons
        :: forall a b c ans es
         . Eff (Input a ': Output b ': es) ans
        -> Machinery es ans b c
        -> MachineryViewL es ans a c

-- | Left view deconstruction for Machinery Pipeline. [average O(1)]
mviewl :: Machinery es ans i o -> MachineryViewL es ans i o
mviewl :: forall (es :: [(* -> *) -> * -> *]) ans i o.
Machinery es ans i o -> MachineryViewL es ans i o
mviewl = \case
    Unit Eff (Input i : Output o : es) ans
m -> Eff (Input i : Output o : es) ans -> MachineryViewL es ans i o
forall i o ans (es :: [(* -> *) -> * -> *]).
Eff (Input i : Output o : es) ans -> MachineryViewL es ans i o
MOne Eff (Input i : Output o : es) ans
m
    Connect Machinery es ans i b
a Machinery es ans b o
b -> Machinery es ans i b
-> Machinery es ans b o -> MachineryViewL es ans i o
forall (es :: [(* -> *) -> * -> *]) ans a b c.
Machinery es ans a b
-> Machinery es ans b c -> MachineryViewL es ans a c
connect Machinery es ans i b
a Machinery es ans b o
b
  where
    connect
        :: Machinery es ans a b
        -> Machinery es ans b c
        -> MachineryViewL es ans a c
    connect :: forall (es :: [(* -> *) -> * -> *]) ans a b c.
Machinery es ans a b
-> Machinery es ans b c -> MachineryViewL es ans a c
connect (Unit Eff (Input a : Output b : es) ans
m) Machinery es ans b c
r = Eff (Input a : Output b : es) ans
m Eff (Input a : Output b : es) ans
-> Machinery es ans b c -> MachineryViewL es ans a c
forall a b c ans (es :: [(* -> *) -> * -> *]).
Eff (Input a : Output b : es) ans
-> Machinery es ans b c -> MachineryViewL es ans a c
`MCons` Machinery es ans b c
r
    connect (Connect Machinery es ans a b
a Machinery es ans b b
b) Machinery es ans b c
r = Machinery es ans a b
-> Machinery es ans b c -> MachineryViewL es ans a c
forall (es :: [(* -> *) -> * -> *]) ans a b c.
Machinery es ans a b
-> Machinery es ans b c -> MachineryViewL es ans a c
connect Machinery es ans a b
a (Machinery es ans b b
-> Machinery es ans b c -> Machinery es ans b c
forall a b c ans (es :: [(* -> *) -> * -> *]).
Machinery es ans a b
-> Machinery es ans b c -> Machinery es ans a c
Connect Machinery es ans b b
b Machinery es ans b c
r)