{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}

{- |
Copyright   :  (c) 2024 Sayo Koyoneda
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,
    bundleN,
    interpret,
    interpretBy,
    nil,
    raise,
    raiseAllH,
    reinterpret,
    unkey,
    (!+),
    (&),
    type (<<|),
    type (<|),
    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 eh ef ans i o where
    Unit
        :: forall i o ans eh ef
         . Eff eh (Input i ': Output o ': ef) ans
        -> Machinery eh ef ans i o
    Connect
        :: forall a b c ans eh ef
         . Machinery eh ef ans a b
        -> Machinery eh ef ans b c
        -> Machinery eh ef ans a c

instance Category (Machinery eh ef ans) where
    id :: forall a. Machinery eh ef ans a a
    id :: forall a. Machinery eh ef ans a a
id =
        Eff eh (Input a : Output a : ef) ans -> Machinery eh ef ans a a
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input i : Output o : ef) ans -> Machinery eh ef ans i o
Unit (Eff eh (Input a : Output a : ef) ans -> Machinery eh ef ans a a)
-> (Eff eh (Input a : Output a : ef) ()
    -> Eff eh (Input a : Output a : ef) ans)
-> Eff eh (Input a : Output a : ef) ()
-> Machinery eh ef ans a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff eh (Input a : Output a : ef) ()
-> Eff eh (Input a : Output a : ef) ans
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Eff eh (Input a : Output a : ef) () -> Machinery eh ef ans a a)
-> Eff eh (Input a : Output a : ef) () -> Machinery eh ef ans a a
forall a b. (a -> b) -> a -> b
$
            forall i (f :: * -> *). SendFOE (Input i) f => f i
input @a Eff eh (Input a : Output a : ef) a
-> (a -> Eff eh (Input a : Output a : ef) ())
-> Eff eh (Input a : Output a : ef) ()
forall a b.
Eff eh (Input a : Output a : ef) a
-> (a -> Eff eh (Input a : Output a : ef) b)
-> Eff eh (Input a : Output a : ef) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Eff eh (Input a : Output a : ef) ()
forall o (f :: * -> *). SendFOE (Output o) f => o -> f ()
output

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

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

instance Arrow (Machinery '[] ef ans) where
    arr :: forall b c. (b -> c) -> Machinery '[] ef ans b c
arr (b -> c
f :: b -> c) =
        Eff '[] (Input b : Output c : ef) ans -> Machinery '[] ef ans b c
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input i : Output o : ef) ans -> Machinery eh ef ans i o
Unit (Eff '[] (Input b : Output c : ef) ans -> Machinery '[] ef ans b c)
-> (Eff '[] (Input b : Output c : ef) ()
    -> Eff '[] (Input b : Output c : ef) ans)
-> Eff '[] (Input b : Output c : ef) ()
-> Machinery '[] ef ans b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[] (Input b : Output c : ef) ()
-> Eff '[] (Input b : Output c : ef) ans
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Eff '[] (Input b : Output c : ef) () -> Machinery '[] ef ans b c)
-> Eff '[] (Input b : Output c : ef) () -> Machinery '[] ef ans b c
forall a b. (a -> b) -> a -> b
$
            forall i (f :: * -> *). SendFOE (Input i) f => f i
input @b Eff '[] (Input b : Output c : ef) b
-> (b -> Eff '[] (Input b : Output c : ef) ())
-> Eff '[] (Input b : Output c : ef) ()
forall a b.
Eff '[] (Input b : Output c : ef) a
-> (a -> Eff '[] (Input b : Output c : ef) b)
-> Eff '[] (Input b : Output c : ef) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Eff '[] (Input b : Output c : ef) ()
forall o (f :: * -> *). SendFOE (Output o) f => o -> f ()
output (c -> Eff '[] (Input b : Output c : ef) ())
-> (b -> c) -> b -> Eff '[] (Input b : Output c : ef) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f

    first
        :: forall b c d
         . Machinery '[] ef ans b c
        -> Machinery '[] ef ans (b, d) (c, d)
    first :: forall b c d.
Machinery '[] ef ans b c -> Machinery '[] ef ans (b, d) (c, d)
first = \case
        Unit Eff '[] (Input b : Output c : ef) ans
m -> Eff '[] (Input (b, d) : Output (c, d) : ef) ans
-> Machinery '[] ef ans (b, d) (c, d)
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input i : Output o : ef) ans -> Machinery eh ef ans i o
Unit (Eff '[] (Input (b, d) : Output (c, d) : ef) ans
 -> Machinery '[] ef ans (b, d) (c, d))
-> Eff '[] (Input (b, d) : Output (c, d) : ef) ans
-> Machinery '[] ef ans (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ Either (Seq c) d
-> Eff
     '[]
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
-> Eff '[] (Input (b, d) : Output (c, d) : ef) ans
forall s (ef :: [* -> *]) a.
s -> Eff '[] (State s : ef) a -> Eff '[] ef 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) : ef)
   ans
 -> Eff '[] (Input (b, d) : Output (c, d) : ef) ans)
-> Eff
     '[]
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
-> Eff '[] (Input (b, d) : Output (c, d) : ef) ans
forall a b. (a -> b) -> a -> b
$ Eff '[] (Input b : Output c : ef) ans
-> Eff
     '[]
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
forall b c d ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input b : Output c : ef) ans
-> Eff
     eh
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
buffering Eff '[] (Input b : Output c : ef) ans
m
        Connect Machinery '[] ef ans b b
a Machinery '[] ef ans b c
b -> Machinery '[] ef ans (b, d) (b, d)
-> Machinery '[] ef ans (b, d) (c, d)
-> Machinery '[] ef ans (b, d) (c, d)
forall a b c ans (eh :: [EffectH]) (ef :: [* -> *]).
Machinery eh ef ans a b
-> Machinery eh ef ans b c -> Machinery eh ef ans a c
Connect (Machinery '[] ef ans b b -> Machinery '[] ef ans (b, d) (b, d)
forall b c d.
Machinery '[] ef ans b c -> Machinery '[] ef ans (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Machinery '[] ef ans b b
a) (Machinery '[] ef ans b c -> Machinery '[] ef ans (b, d) (c, d)
forall b c d.
Machinery '[] ef ans b c -> Machinery '[] ef ans (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Machinery '[] ef ans b c
b)

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

buffering
    :: forall b c d ans eh ef
     . Eff eh (Input b ': Output c ': ef) ans
    -> Eff eh (State (Either (Seq c) d) ': Input (b, d) ': Output (c, d) ': ef) ans
buffering :: forall b c d ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input b : Output c : ef) ans
-> Eff
     eh
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
buffering =
    forall (len :: Nat) (ef :: [* -> *]) (eh :: [EffectH]).
KnownNat len =>
Eff eh ef ~> Eff eh (Union (Take len ef) : Drop len ef)
bundleN @2
        (Eff eh (Input b : Output c : ef) ans
 -> Eff eh (Union '[Input b, Output c] : ef) ans)
-> (Eff eh (Union '[Input b, Output c] : ef) ans
    -> Eff
         eh
         (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
         ans)
-> Eff eh (Input b : Output c : ef) ans
-> Eff
     eh
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Union '[Input b, Output c]
 ~> Eff
      eh
      (("buffer" #> State (Either (Seq c) d))
         : Input (b, d) : Output (c, d) : ef))
-> Eff eh (Union '[Input b, Output c] : ef)
   ~> Eff
        eh
        (("buffer" #> State (Either (Seq c) d))
           : Input (b, d) : Output (c, d) : ef)
forall (e :: * -> *) (ef' :: [* -> *]) (ef :: [* -> *])
       (eh :: [EffectH]).
IsSuffixOf ef ef' =>
(e ~> Eff eh ef') -> Eff eh (e : ef) ~> Eff eh ef'
reinterpret
            ( ( \Input b x
Input -> do
                    (x
b, d
d) <- Eff
  eh
  (("buffer" #> State (Either (Seq c) d))
     : Input (b, d) : Output (c, d) : ef)
  (x, d)
forall i (f :: * -> *). SendFOE (Input i) f => f i
input

                    forall {k} (key :: k) s (f :: * -> *).
SendFOEBy key (State s) f =>
f s
forall (key :: Symbol) s (f :: * -> *).
SendFOEBy key (State s) f =>
f s
get'' @"buffer" Eff
  eh
  (("buffer" #> State (Either (Seq c) d))
     : Input (b, d) : Output (c, d) : ef)
  (Either (Seq c) d)
-> (Either (Seq c) d
    -> Eff
         eh
         (("buffer" #> State (Either (Seq c) d))
            : Input (b, d) : Output (c, d) : ef)
         ())
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     ()
forall a b.
Eff
  eh
  (("buffer" #> State (Either (Seq c) d))
     : Input (b, d) : Output (c, d) : ef)
  a
-> (a
    -> Eff
         eh
         (("buffer" #> State (Either (Seq c) d))
            : Input (b, d) : Output (c, d) : ef)
         b)
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Right d
_ -> ()
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     ()
forall a.
a
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        Left Seq c
outputQueue -> Seq c
-> (c
    -> Eff
         eh
         (("buffer" #> State (Either (Seq c) d))
            : Input (b, d) : Output (c, d) : ef)
         ())
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq c
outputQueue \c
c -> (c, d)
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     ()
forall o (f :: * -> *). SendFOE (Output o) f => o -> f ()
output (c
c, d
d)

                    forall {k} (key :: k) s (f :: * -> *).
SendFOEBy key (State s) f =>
s -> f ()
forall (key :: Symbol) s (f :: * -> *).
SendFOEBy key (State s) f =>
s -> f ()
put'' @"buffer" (Either (Seq c) d
 -> Eff
      eh
      (("buffer" #> State (Either (Seq c) d))
         : Input (b, d) : Output (c, d) : ef)
      ())
-> Either (Seq c) d
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     ()
forall a b. (a -> b) -> a -> b
$ d -> Either (Seq c) d
forall a b. b -> Either a b
Right d
d

                    x
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     x
forall a.
a
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
b
              )
                (Input b x
 -> Eff
      eh
      (("buffer" #> State (Either (Seq c) d))
         : Input (b, d) : Output (c, d) : ef)
      x)
-> (Union '[Output c] x
    -> Eff
         eh
         (("buffer" #> State (Either (Seq c) d))
            : Input (b, d) : Output (c, d) : ef)
         x)
-> Union '[Input b, Output c] x
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     x
forall (e :: * -> *) a r (es :: [* -> *]).
(e a -> r) -> (Union es a -> r) -> Union (e : es) a -> r
!+ ( \(Output c
c) ->
                        forall {k} (key :: k) s (f :: * -> *).
SendFOEBy key (State s) f =>
f s
forall (key :: Symbol) s (f :: * -> *).
SendFOEBy key (State s) f =>
f s
get'' @"buffer" Eff
  eh
  (("buffer" #> State (Either (Seq c) d))
     : Input (b, d) : Output (c, d) : ef)
  (Either (Seq c) d)
-> (Either (Seq c) d
    -> Eff
         eh
         (("buffer" #> State (Either (Seq c) d))
            : Input (b, d) : Output (c, d) : ef)
         x)
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     x
forall a b.
Eff
  eh
  (("buffer" #> State (Either (Seq c) d))
     : Input (b, d) : Output (c, d) : ef)
  a
-> (a
    -> Eff
         eh
         (("buffer" #> State (Either (Seq c) d))
            : Input (b, d) : Output (c, d) : ef)
         b)
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                            Right d
d -> (c, d)
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     ()
forall o (f :: * -> *). SendFOE (Output o) f => o -> f ()
output (c
c, d
d)
                            Left Seq c
outputQueue -> forall {k} (key :: k) s (f :: * -> *).
SendFOEBy key (State s) f =>
s -> f ()
forall (key :: Symbol) s (f :: * -> *).
SendFOEBy key (State s) f =>
s -> f ()
put'' @"buffer" (Either (Seq c) d
 -> Eff
      eh
      (("buffer" #> State (Either (Seq c) d))
         : Input (b, d) : Output (c, d) : ef)
      ())
-> Either (Seq c) d
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     ()
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 x
 -> Eff
      eh
      (("buffer" #> State (Either (Seq c) d))
         : Input (b, d) : Output (c, d) : ef)
      x)
-> (Union '[] x
    -> Eff
         eh
         (("buffer" #> State (Either (Seq c) d))
            : Input (b, d) : Output (c, d) : ef)
         x)
-> Union '[Output c] x
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     x
forall (e :: * -> *) a r (es :: [* -> *]).
(e a -> r) -> (Union es a -> r) -> Union (e : es) a -> r
!+ Union '[] x
-> Eff
     eh
     (("buffer" #> State (Either (Seq c) d))
        : Input (b, d) : Output (c, d) : ef)
     x
forall a r. Union '[] a -> r
nil
            )
        (Eff eh (Union '[Input b, Output c] : ef) ans
 -> Eff
      eh
      (("buffer" #> State (Either (Seq c) d))
         : Input (b, d) : Output (c, d) : ef)
      ans)
-> (Eff
      eh
      (("buffer" #> State (Either (Seq c) d))
         : Input (b, d) : Output (c, d) : ef)
      ans
    -> Eff
         eh
         (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
         ans)
-> Eff eh (Union '[Input b, Output c] : ef) ans
-> Eff
     eh
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     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} (key :: k) (e :: * -> *) (ef :: [* -> *])
       (eh :: [EffectH]) x.
Eff eh ((key #> e) : ef) x -> Eff eh (e : ef) x
forall (key :: Symbol) (e :: * -> *) (ef :: [* -> *])
       (eh :: [EffectH]) x.
Eff eh ((key #> e) : ef) x -> Eff eh (e : ef) x
unkey @"buffer"

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

leftMachinery
    :: forall b c d ans eh ef
     . Machinery eh ef ans b c
    -> Machinery eh ef ans (Either b d) (Either c d)
leftMachinery :: forall b c d ans (eh :: [EffectH]) (ef :: [* -> *]).
Machinery eh ef ans b c
-> Machinery eh ef ans (Either b d) (Either c d)
leftMachinery = \case
    Unit Eff eh (Input b : Output c : ef) ans
m ->
        forall (len :: Nat) (ef :: [* -> *]) (eh :: [EffectH]).
KnownNat len =>
Eff eh ef ~> Eff eh (Union (Take len ef) : Drop len ef)
bundleN @2 Eff eh (Input b : Output c : ef) ans
m
            Eff eh (Union '[Input b, Output c] : ef) ans
-> (Eff eh (Union '[Input b, Output c] : ef) ans
    -> Eff eh (Input (Either b d) : Output (Either c d) : ef) ans)
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) ans
forall a b. a -> (a -> b) -> b
& (Union '[Input b, Output c]
 ~> Eff eh (Input (Either b d) : Output (Either c d) : ef))
-> Eff eh (Union '[Input b, Output c] : ef)
   ~> Eff eh (Input (Either b d) : Output (Either c d) : ef)
forall (e :: * -> *) (ef' :: [* -> *]) (ef :: [* -> *])
       (eh :: [EffectH]).
IsSuffixOf ef ef' =>
(e ~> Eff eh ef') -> Eff eh (e : ef) ~> Eff eh ef'
reinterpret
                ( ( \Input b x
Input -> (Eff eh (Input (Either b d) : Output (Either c d) : ef) x
 -> Eff eh (Input (Either b d) : Output (Either c d) : ef) x)
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) x
forall a. (a -> a) -> a
fix \Eff eh (Input (Either b d) : Output (Either c d) : ef) x
next ->
                        forall i (f :: * -> *). SendFOE (Input i) f => f i
input @(Either b d) Eff eh (Input (Either b d) : Output (Either c d) : ef) (Either b d)
-> (Either b d
    -> Eff eh (Input (Either b d) : Output (Either c d) : ef) x)
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) x
forall a b.
Eff eh (Input (Either b d) : Output (Either c d) : ef) a
-> (a -> Eff eh (Input (Either b d) : Output (Either c d) : ef) b)
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                            Left b
x -> x -> Eff eh (Input (Either b d) : Output (Either c d) : ef) x
forall a.
a -> Eff eh (Input (Either b d) : Output (Either c d) : ef) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
x
                            Right d
o -> do
                                forall o (f :: * -> *). SendFOE (Output o) f => o -> f ()
output @(Either c d) (Either c d
 -> Eff eh (Input (Either b d) : Output (Either c d) : ef) ())
-> Either c d
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) ()
forall a b. (a -> b) -> a -> b
$ d -> Either c d
forall a b. b -> Either a b
Right d
o
                                Eff eh (Input (Either b d) : Output (Either c d) : ef) x
next
                  )
                    (Input b x
 -> Eff eh (Input (Either b d) : Output (Either c d) : ef) x)
-> (Union '[Output c] x
    -> Eff eh (Input (Either b d) : Output (Either c d) : ef) x)
-> Union '[Input b, Output c] x
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) x
forall (e :: * -> *) a r (es :: [* -> *]).
(e a -> r) -> (Union es a -> r) -> Union (e : es) a -> r
!+ (\(Output c
o) -> forall o (f :: * -> *). SendFOE (Output o) f => o -> f ()
output @(Either c d) (Either c d
 -> Eff eh (Input (Either b d) : Output (Either c d) : ef) ())
-> Either c d
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) ()
forall a b. (a -> b) -> a -> b
$ c -> Either c d
forall a b. a -> Either a b
Left c
o)
                    (Output c x
 -> Eff eh (Input (Either b d) : Output (Either c d) : ef) x)
-> (Union '[] x
    -> Eff eh (Input (Either b d) : Output (Either c d) : ef) x)
-> Union '[Output c] x
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) x
forall (e :: * -> *) a r (es :: [* -> *]).
(e a -> r) -> (Union es a -> r) -> Union (e : es) a -> r
!+ Union '[] x
-> Eff eh (Input (Either b d) : Output (Either c d) : ef) x
forall a r. Union '[] a -> r
nil
                )
            Eff eh (Input (Either b d) : Output (Either c d) : ef) ans
-> (Eff eh (Input (Either b d) : Output (Either c d) : ef) ans
    -> Machinery eh ef ans (Either b d) (Either c d))
-> Machinery eh ef ans (Either b d) (Either c d)
forall a b. a -> (a -> b) -> b
& Eff eh (Input (Either b d) : Output (Either c d) : ef) ans
-> Machinery eh ef ans (Either b d) (Either c d)
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input i : Output o : ef) ans -> Machinery eh ef ans i o
Unit
    Connect Machinery eh ef ans b b
a Machinery eh ef ans b c
b -> Machinery eh ef ans (Either b d) (Either b d)
-> Machinery eh ef ans (Either b d) (Either c d)
-> Machinery eh ef ans (Either b d) (Either c d)
forall a b c ans (eh :: [EffectH]) (ef :: [* -> *]).
Machinery eh ef ans a b
-> Machinery eh ef ans b c -> Machinery eh ef ans a c
Connect (Machinery eh ef ans b b
-> Machinery eh ef ans (Either b d) (Either b d)
forall b c d ans (eh :: [EffectH]) (ef :: [* -> *]).
Machinery eh ef ans b c
-> Machinery eh ef ans (Either b d) (Either c d)
leftMachinery Machinery eh ef ans b b
a) (Machinery eh ef ans b c
-> Machinery eh ef ans (Either b d) (Either c d)
forall b c d ans (eh :: [EffectH]) (ef :: [* -> *]).
Machinery eh ef ans b c
-> Machinery eh ef ans (Either b d) (Either c d)
leftMachinery Machinery eh ef 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 :: Eff '[] (Input i ': Output o ': ef) ans -> Machine (Eff eh ef) ans i o
machine :: forall i o (ef :: [* -> *]) ans (eh :: [EffectH]).
Eff '[] (Input i : Output o : ef) ans
-> Machine (Eff eh ef) ans i o
machine =
    forall (len :: Nat) (ef :: [* -> *]) (eh :: [EffectH]).
KnownNat len =>
Eff eh ef ~> Eff eh (Union (Take len ef) : Drop len ef)
bundleN @2
        (Eff '[] (Input i : Output o : ef) ans
 -> Eff '[] (Union '[Input i, Output o] : ef) ans)
-> (Eff '[] (Union '[Input i, Output o] : ef) ans
    -> Machine (Eff eh ef) ans i o)
-> Eff '[] (Input i : Output o : ef) ans
-> Machine (Eff eh ef) 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
>>> (ans -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> Interpreter
     (Union '[Input i, Output o])
     (Eff '[] ef)
     (MachineStatus (Eff eh ef) ans i o)
-> Eff '[] (Union '[Input i, Output o] : ef) ans
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall (e :: * -> *) (ef :: [* -> *]) ans a.
(a -> Eff '[] ef ans)
-> Interpreter e (Eff '[] ef) ans
-> Eff '[] (e : ef) a
-> Eff '[] ef ans
interpretBy
            (MachineStatus (Eff eh ef) ans i o
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall a. a -> Eff '[] ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff eh ef) ans i o
 -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> (ans -> MachineStatus (Eff eh ef) ans i o)
-> ans
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ans -> MachineStatus (Eff eh ef) ans i o
forall (f :: * -> *) ans i o. ans -> MachineStatus f ans i o
Terminated)
            ( (\Input i x
Input x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
k -> MachineStatus (Eff eh ef) ans i o
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall a. a -> Eff '[] ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff eh ef) ans i o
 -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> MachineStatus (Eff eh ef) ans i o
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ (i -> Machine (Eff eh ef) ans i o)
-> MachineStatus (Eff eh ef) ans i o
forall (f :: * -> *) ans i o.
(i -> Machine f ans i o) -> MachineStatus f ans i o
Waiting ((i -> Machine (Eff eh ef) ans i o)
 -> MachineStatus (Eff eh ef) ans i o)
-> (i -> Machine (Eff eh ef) ans i o)
-> MachineStatus (Eff eh ef) ans i o
forall a b. (a -> b) -> a -> b
$ Eff eh ef (MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine (Eff eh ef (MachineStatus (Eff eh ef) ans i o)
 -> Machine (Eff eh ef) ans i o)
-> (i -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> i
-> Machine (Eff eh ef) ans i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall (ef :: [* -> *]) (eh :: [EffectH]) x.
Eff '[] ef x -> Eff eh ef x
raiseAllH (Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> (i -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> i
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
k)
                (Input i x
 -> (x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
 -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> (Union '[Output o] x
    -> (x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
    -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> Union '[Input i, Output o] x
-> (x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall (e :: * -> *) a r (es :: [* -> *]).
(e a -> r) -> (Union es a -> r) -> Union (e : es) a -> r
!+ (\(Output o
o) x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
k -> MachineStatus (Eff eh ef) ans i o
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall a. a -> Eff '[] ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff eh ef) ans i o
 -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> MachineStatus (Eff eh ef) ans i o
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ o
-> Machine (Eff eh ef) ans i o -> MachineStatus (Eff eh ef) ans i o
forall (f :: * -> *) ans i o.
o -> Machine f ans i o -> MachineStatus f ans i o
Produced o
o (Machine (Eff eh ef) ans i o -> MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) ans i o -> MachineStatus (Eff eh ef) ans i o
forall a b. (a -> b) -> a -> b
$ Eff eh ef (MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine (Eff eh ef (MachineStatus (Eff eh ef) ans i o)
 -> Machine (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) ans i o
forall a b. (a -> b) -> a -> b
$ Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall (ef :: [* -> *]) (eh :: [EffectH]) x.
Eff '[] ef x -> Eff eh ef x
raiseAllH (Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
k ())
                (Output o x
 -> (x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
 -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> (Union '[] x
    -> (x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
    -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> Union '[Output o] x
-> (x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall (e :: * -> *) a r (es :: [* -> *]).
(e a -> r) -> (Union es a -> r) -> Union (e : es) a -> r
!+ Union '[] x
-> (x -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
forall a r. Union '[] a -> r
nil
            )
        (Eff '[] (Union '[Input i, Output o] : ef) ans
 -> Eff '[] ef (MachineStatus (Eff eh ef) ans i o))
-> (Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
    -> Machine (Eff eh ef) ans i o)
-> Eff '[] (Union '[Input i, Output o] : ef) ans
-> Machine (Eff eh ef) 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 '[] ef (MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall (ef :: [* -> *]) (eh :: [EffectH]) x.
Eff '[] ef x -> Eff eh ef x
raiseAllH
        (Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> (Eff eh ef (MachineStatus (Eff eh ef) ans i o)
    -> Machine (Eff eh ef) ans i o)
-> Eff '[] ef (MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) 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 eh ef (MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) 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 eh ef
     . (Parallel <<| eh, Semigroup ans)
    => Machinery '[] ef ans i o
    -> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
runMachinery :: forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(Parallel <<| eh, Semigroup ans) =>
Machinery '[] ef ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
runMachinery = MachineryViewL '[] ef ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(Parallel <<| eh, Semigroup ans) =>
MachineryViewL '[] ef ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
runMachineryL (MachineryViewL '[] ef ans i o
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> (Machinery '[] ef ans i o -> MachineryViewL '[] ef ans i o)
-> Machinery '[] ef ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Machinery '[] ef ans i o -> MachineryViewL '[] ef ans i o
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
Machinery eh ef ans i o -> MachineryViewL eh ef ans i o
mviewl

runMachineryL
    :: forall i o ans eh ef
     . (Parallel <<| eh, Semigroup ans)
    => MachineryViewL '[] ef ans i o
    -> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
runMachineryL :: forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(Parallel <<| eh, Semigroup ans) =>
MachineryViewL '[] ef ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
runMachineryL = \case
    MOne Eff '[] (Input i : Output o : ef) ans
m -> Machine (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine (Machine (Eff eh ef) ans i o
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> Machine (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ Eff '[] (Input i : Output o : ef) ans
-> Machine (Eff eh ef) ans i o
forall i o (ef :: [* -> *]) ans (eh :: [EffectH]).
Eff '[] (Input i : Output o : ef) ans
-> Machine (Eff eh ef) ans i o
machine Eff '[] (Input i : Output o : ef) ans
m
    MCons Eff '[] (Input i : Output b : ef) ans
m Machinery '[] ef ans b o
ms -> do
        (MachineStatus (Eff eh ef) ans i b
 -> MachineStatus (Eff eh ef) ans b o
 -> (MachineStatus (Eff eh ef) ans i b,
     MachineStatus (Eff eh ef) ans b o))
-> Eff eh ef (MachineStatus (Eff eh ef) ans i b)
-> Eff eh ef (MachineStatus (Eff eh ef) ans b o)
-> Eff
     eh
     ef
     (MachineStatus (Eff eh ef) ans i b,
      MachineStatus (Eff eh ef) ans b o)
forall a b c (f :: * -> *).
SendHOE Parallel f =>
(a -> b -> c) -> f a -> f b -> f c
liftP2 (,) (Machine (Eff eh ef) ans i b
-> Eff eh ef (MachineStatus (Eff eh ef) ans i b)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine (Machine (Eff eh ef) ans i b
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i b))
-> Machine (Eff eh ef) ans i b
-> Eff eh ef (MachineStatus (Eff eh ef) ans i b)
forall a b. (a -> b) -> a -> b
$ Eff '[] (Input i : Output b : ef) ans
-> Machine (Eff eh ef) ans i b
forall i o (ef :: [* -> *]) ans (eh :: [EffectH]).
Eff '[] (Input i : Output o : ef) ans
-> Machine (Eff eh ef) ans i o
machine Eff '[] (Input i : Output b : ef) ans
m) (Machinery '[] ef ans b o
-> Eff eh ef (MachineStatus (Eff eh ef) ans b o)
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(Parallel <<| eh, Semigroup ans) =>
Machinery '[] ef ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
runMachinery Machinery '[] ef ans b o
ms) Eff
  eh
  ef
  (MachineStatus (Eff eh ef) ans i b,
   MachineStatus (Eff eh ef) ans b o)
-> ((MachineStatus (Eff eh ef) ans i b,
     MachineStatus (Eff eh ef) ans b o)
    -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. Eff eh ef a -> (a -> Eff eh ef b) -> Eff eh ef b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MachineStatus (Eff eh ef) ans i b,
 MachineStatus (Eff eh ef) ans b o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall {i} {i} {o}.
(MachineStatus (Eff eh ef) ans i i,
 MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
loop
      where
        loop :: (MachineStatus (Eff eh ef) ans i i,
 MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
loop = \case
            (Terminated ans
ans, Terminated ans
ans') -> MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a. a -> Eff eh ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff eh ef) ans i o
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ ans -> MachineStatus (Eff eh ef) ans i o
forall (f :: * -> *) ans i o. ans -> MachineStatus f ans i o
Terminated (ans -> MachineStatus (Eff eh ef) ans i o)
-> ans -> MachineStatus (Eff eh ef) 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 eh ef) ans i i
k1, Waiting i -> Machine (Eff eh ef) ans i o
k2) ->
                (MachineStatus (Eff eh ef) ans i i
 -> MachineStatus (Eff eh ef) ans i o
 -> (MachineStatus (Eff eh ef) ans i i,
     MachineStatus (Eff eh ef) ans i o))
-> Eff eh ef (MachineStatus (Eff eh ef) ans i i)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
-> Eff
     eh
     ef
     (MachineStatus (Eff eh ef) ans i i,
      MachineStatus (Eff eh ef) ans i o)
forall a b c (f :: * -> *).
SendHOE Parallel f =>
(a -> b -> c) -> f a -> f b -> f c
liftP2 (,) (Machine (Eff eh ef) ans i i
-> Eff eh ef (MachineStatus (Eff eh ef) ans i i)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine Machine (Eff eh ef) ans i i
k1) (Machine (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine (Machine (Eff eh ef) ans i o
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> Machine (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ i -> Machine (Eff eh ef) ans i o
k2 i
o) Eff
  eh
  ef
  (MachineStatus (Eff eh ef) ans i i,
   MachineStatus (Eff eh ef) ans i o)
-> ((MachineStatus (Eff eh ef) ans i i,
     MachineStatus (Eff eh ef) ans i o)
    -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. Eff eh ef a -> (a -> Eff eh ef b) -> Eff eh ef b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MachineStatus (Eff eh ef) ans i i,
 MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
loop
            (Waiting i -> Machine (Eff eh ef) ans i i
k, MachineStatus (Eff eh ef) ans i o
s) ->
                MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a. a -> Eff eh ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff eh ef) ans i o
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ (i -> Machine (Eff eh ef) ans i o)
-> MachineStatus (Eff eh ef) ans i o
forall (f :: * -> *) ans i o.
(i -> Machine f ans i o) -> MachineStatus f ans i o
Waiting \i
i -> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine do
                    MachineStatus (Eff eh ef) ans i i
s' <- Machine (Eff eh ef) ans i i
-> Eff eh ef (MachineStatus (Eff eh ef) ans i i)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine (Machine (Eff eh ef) ans i i
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i i))
-> Machine (Eff eh ef) ans i i
-> Eff eh ef (MachineStatus (Eff eh ef) ans i i)
forall a b. (a -> b) -> a -> b
$ i -> Machine (Eff eh ef) ans i i
k i
i
                    (MachineStatus (Eff eh ef) ans i i,
 MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
loop (MachineStatus (Eff eh ef) ans i i
s', MachineStatus (Eff eh ef) ans i o
s)
            (MachineStatus (Eff eh ef) ans i i
s, Produced o
o Machine (Eff eh ef) ans i o
k) ->
                MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a. a -> Eff eh ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff eh ef) ans i o
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ o
-> Machine (Eff eh ef) ans i o -> MachineStatus (Eff eh ef) ans i o
forall (f :: * -> *) ans i o.
o -> Machine f ans i o -> MachineStatus f ans i o
Produced o
o (Machine (Eff eh ef) ans i o -> MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) ans i o -> MachineStatus (Eff eh ef) ans i o
forall a b. (a -> b) -> a -> b
$ Eff eh ef (MachineStatus (Eff eh ef) ans i o)
-> Machine (Eff eh ef) ans i o
forall (f :: * -> *) ans i o.
f (MachineStatus f ans i o) -> Machine f ans i o
Machine do
                    MachineStatus (Eff eh ef) ans i o
s' <- Machine (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall (f :: * -> *) ans i o.
Machine f ans i o -> f (MachineStatus f ans i o)
runMachine Machine (Eff eh ef) ans i o
k
                    (MachineStatus (Eff eh ef) ans i i,
 MachineStatus (Eff eh ef) ans i o)
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
loop (MachineStatus (Eff eh ef) ans i i
s, MachineStatus (Eff eh ef) ans i o
s')
            (Terminated ans
ans, Waiting i -> Machine (Eff eh ef) ans i o
_) -> MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a. a -> Eff eh ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff eh ef) ans i o
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ ans -> MachineStatus (Eff eh ef) ans i o
forall (f :: * -> *) ans i o. ans -> MachineStatus f ans i o
Terminated ans
ans
            (Produced i
_ Machine (Eff eh ef) ans i i
_, Terminated ans
ans) -> MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a. a -> Eff eh ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MachineStatus (Eff eh ef) ans i o
 -> Eff eh ef (MachineStatus (Eff eh ef) ans i o))
-> MachineStatus (Eff eh ef) ans i o
-> Eff eh ef (MachineStatus (Eff eh ef) ans i o)
forall a b. (a -> b) -> a -> b
$ ans -> MachineStatus (Eff eh ef) ans i o
forall (f :: * -> *) ans i o. ans -> MachineStatus f ans i o
Terminated ans
ans

newtype MachineryIO eh ef ans i o = MachineryIO {forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
MachineryIO eh ef ans i o -> Machinery eh ef ans i o
unMachineryIO :: Machinery eh ef ans i o}
    deriving newtype ((forall a. MachineryIO eh ef ans a a)
-> (forall b c a.
    MachineryIO eh ef ans b c
    -> MachineryIO eh ef ans a b -> MachineryIO eh ef ans a c)
-> Category (MachineryIO eh ef ans)
forall (eh :: [EffectH]) (ef :: [* -> *]) ans a.
MachineryIO eh ef ans a a
forall (eh :: [EffectH]) (ef :: [* -> *]) ans b c a.
MachineryIO eh ef ans b c
-> MachineryIO eh ef ans a b -> MachineryIO eh ef ans a c
forall a. MachineryIO eh ef ans a a
forall b c a.
MachineryIO eh ef ans b c
-> MachineryIO eh ef ans a b -> MachineryIO eh ef 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 (eh :: [EffectH]) (ef :: [* -> *]) ans a.
MachineryIO eh ef ans a a
id :: forall a. MachineryIO eh ef ans a a
$c. :: forall (eh :: [EffectH]) (ef :: [* -> *]) ans b c a.
MachineryIO eh ef ans b c
-> MachineryIO eh ef ans a b -> MachineryIO eh ef ans a c
. :: forall b c a.
MachineryIO eh ef ans b c
-> MachineryIO eh ef ans a b -> MachineryIO eh ef ans a c
Category)

instance (IO <| ef) => Arrow (MachineryIO eh ef ans) where
    arr :: forall b c. (b -> c) -> MachineryIO eh ef ans b c
arr (b -> c
f :: b -> c) =
        Machinery eh ef ans b c -> MachineryIO eh ef ans b c
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
Machinery eh ef ans i o -> MachineryIO eh ef ans i o
MachineryIO (Machinery eh ef ans b c -> MachineryIO eh ef ans b c)
-> (Eff eh (Input b : Output c : ef) () -> Machinery eh ef ans b c)
-> Eff eh (Input b : Output c : ef) ()
-> MachineryIO eh ef ans b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff eh (Input b : Output c : ef) ans -> Machinery eh ef ans b c
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input i : Output o : ef) ans -> Machinery eh ef ans i o
Unit (Eff eh (Input b : Output c : ef) ans -> Machinery eh ef ans b c)
-> (Eff eh (Input b : Output c : ef) ()
    -> Eff eh (Input b : Output c : ef) ans)
-> Eff eh (Input b : Output c : ef) ()
-> Machinery eh ef ans b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff eh (Input b : Output c : ef) ()
-> Eff eh (Input b : Output c : ef) ans
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Eff eh (Input b : Output c : ef) () -> MachineryIO eh ef ans b c)
-> Eff eh (Input b : Output c : ef) () -> MachineryIO eh ef ans b c
forall a b. (a -> b) -> a -> b
$
            forall i (f :: * -> *). SendFOE (Input i) f => f i
input @b Eff eh (Input b : Output c : ef) b
-> (b -> Eff eh (Input b : Output c : ef) ())
-> Eff eh (Input b : Output c : ef) ()
forall a b.
Eff eh (Input b : Output c : ef) a
-> (a -> Eff eh (Input b : Output c : ef) b)
-> Eff eh (Input b : Output c : ef) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Eff eh (Input b : Output c : ef) ()
forall o (f :: * -> *). SendFOE (Output o) f => o -> f ()
output (c -> Eff eh (Input b : Output c : ef) ())
-> (b -> c) -> b -> Eff eh (Input b : Output c : ef) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f

    first :: forall b c d. MachineryIO eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d)
    first :: forall b c d.
MachineryIO eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d)
first =
        MachineryIO eh ef ans b c -> Machinery eh ef ans b c
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
MachineryIO eh ef ans i o -> Machinery eh ef ans i o
unMachineryIO
            (MachineryIO eh ef ans b c -> Machinery eh ef ans b c)
-> (Machinery eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d))
-> MachineryIO eh ef ans b c
-> MachineryIO eh ef 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 eh ef ans (b, d) (c, d)
-> MachineryIO eh ef ans (b, d) (c, d)
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
Machinery eh ef ans i o -> MachineryIO eh ef ans i o
MachineryIO (Machinery eh ef ans (b, d) (c, d)
 -> MachineryIO eh ef ans (b, d) (c, d))
-> (Machinery eh ef ans b c -> Machinery eh ef ans (b, d) (c, d))
-> Machinery eh ef ans b c
-> MachineryIO eh ef ans (b, d) (c, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                Unit Eff eh (Input b : Output c : ef) ans
m ->
                    Eff eh (Input (b, d) : Output (c, d) : ef) ans
-> Machinery eh ef ans (b, d) (c, d)
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input i : Output o : ef) ans -> Machinery eh ef ans i o
Unit (Eff eh (Input (b, d) : Output (c, d) : ef) ans
 -> Machinery eh ef ans (b, d) (c, d))
-> Eff eh (Input (b, d) : Output (c, d) : ef) ans
-> Machinery eh ef ans (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ Either (Seq c) d
-> Eff
     eh
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
-> Eff eh (Input (b, d) : Output (c, d) : ef) ans
forall s (ef :: [* -> *]) (eh :: [EffectH]) a.
(IO <| ef) =>
s -> Eff eh (State s : ef) a -> Eff eh ef 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
   eh
   (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
   ans
 -> Eff eh (Input (b, d) : Output (c, d) : ef) ans)
-> Eff
     eh
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
-> Eff eh (Input (b, d) : Output (c, d) : ef) ans
forall a b. (a -> b) -> a -> b
$ Eff eh (Input b : Output c : ef) ans
-> Eff
     eh
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
forall b c d ans (eh :: [EffectH]) (ef :: [* -> *]).
Eff eh (Input b : Output c : ef) ans
-> Eff
     eh
     (State (Either (Seq c) d) : Input (b, d) : Output (c, d) : ef)
     ans
buffering Eff eh (Input b : Output c : ef) ans
m
                Connect Machinery eh ef ans b b
a Machinery eh ef ans b c
b ->
                    Machinery eh ef ans (b, d) (b, d)
-> Machinery eh ef ans (b, d) (c, d)
-> Machinery eh ef ans (b, d) (c, d)
forall a b c ans (eh :: [EffectH]) (ef :: [* -> *]).
Machinery eh ef ans a b
-> Machinery eh ef ans b c -> Machinery eh ef ans a c
Connect
                        (MachineryIO eh ef ans (b, d) (b, d)
-> Machinery eh ef ans (b, d) (b, d)
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
MachineryIO eh ef ans i o -> Machinery eh ef ans i o
unMachineryIO (MachineryIO eh ef ans (b, d) (b, d)
 -> Machinery eh ef ans (b, d) (b, d))
-> MachineryIO eh ef ans (b, d) (b, d)
-> Machinery eh ef ans (b, d) (b, d)
forall a b. (a -> b) -> a -> b
$ MachineryIO eh ef ans b b -> MachineryIO eh ef ans (b, d) (b, d)
forall b c d.
MachineryIO eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (MachineryIO eh ef ans b b -> MachineryIO eh ef ans (b, d) (b, d))
-> MachineryIO eh ef ans b b -> MachineryIO eh ef ans (b, d) (b, d)
forall a b. (a -> b) -> a -> b
$ Machinery eh ef ans b b -> MachineryIO eh ef ans b b
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
Machinery eh ef ans i o -> MachineryIO eh ef ans i o
MachineryIO Machinery eh ef ans b b
a)
                        (MachineryIO eh ef ans (b, d) (c, d)
-> Machinery eh ef ans (b, d) (c, d)
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
MachineryIO eh ef ans i o -> Machinery eh ef ans i o
unMachineryIO (MachineryIO eh ef ans (b, d) (c, d)
 -> Machinery eh ef ans (b, d) (c, d))
-> MachineryIO eh ef ans (b, d) (c, d)
-> Machinery eh ef ans (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ MachineryIO eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d)
forall b c d.
MachineryIO eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (MachineryIO eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d))
-> MachineryIO eh ef ans b c -> MachineryIO eh ef ans (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ Machinery eh ef ans b c -> MachineryIO eh ef ans b c
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
Machinery eh ef ans i o -> MachineryIO eh ef ans i o
MachineryIO Machinery eh ef ans b c
b)

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

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

runMachineryIO
    :: forall i o ans eh ef
     . (UnliftIO <<| eh, IO <| ef)
    => Eff eh ef i
    -> (o -> Eff eh ef ())
    -> Machinery eh ef ans i o
    -> Eff eh ef ans
runMachineryIO :: forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(UnliftIO <<| eh, IO <| ef) =>
Eff eh ef i
-> (o -> Eff eh ef ()) -> Machinery eh ef ans i o -> Eff eh ef ans
runMachineryIO Eff eh ef i
i o -> Eff eh ef ()
o = Eff eh ef i
-> (o -> Eff eh ef ())
-> MachineryViewL eh ef ans i o
-> Eff eh ef ans
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(UnliftIO <<| eh, IO <| ef) =>
Eff eh ef i
-> (o -> Eff eh ef ())
-> MachineryViewL eh ef ans i o
-> Eff eh ef ans
runMachineryIOL Eff eh ef i
i o -> Eff eh ef ()
o (MachineryViewL eh ef ans i o -> Eff eh ef ans)
-> (Machinery eh ef ans i o -> MachineryViewL eh ef ans i o)
-> Machinery eh ef ans i o
-> Eff eh ef ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Machinery eh ef ans i o -> MachineryViewL eh ef ans i o
forall (eh :: [EffectH]) (ef :: [* -> *]) ans i o.
Machinery eh ef ans i o -> MachineryViewL eh ef ans i o
mviewl

runMachineryIOL
    :: forall i o ans eh ef
     . (UnliftIO <<| eh, IO <| ef)
    => Eff eh ef i
    -> (o -> Eff eh ef ())
    -> MachineryViewL eh ef ans i o
    -> Eff eh ef ans
runMachineryIOL :: forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(UnliftIO <<| eh, IO <| ef) =>
Eff eh ef i
-> (o -> Eff eh ef ())
-> MachineryViewL eh ef ans i o
-> Eff eh ef ans
runMachineryIOL Eff eh ef i
i o -> Eff eh ef ()
o = \case
    MOne Eff eh (Input i : Output o : ef) ans
m -> (o -> Eff eh ef ())
-> Eff eh (Input i : Output o : ef) ~> Eff eh ef
forall o'.
(o' -> Eff eh ef ())
-> Eff eh (Input i : Output o' : ef) ~> Eff eh ef
runUnit o -> Eff eh ef ()
o Eff eh (Input i : Output o : ef) ans
m
    MCons Eff eh (Input i : Output b : ef) ans
a Machinery eh ef ans b o
b ->
        ((Eff eh ef ~> IO) -> IO ans) -> Eff eh ef ans
forall (f :: * -> *) a.
(UnliftIO <<: f) =>
((f ~> IO) -> IO a) -> f a
withRunInIO \Eff eh ef ~> 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 eh ef ans -> IO ThreadId
runThread Eff eh ef 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 eh ef ans -> IO ans
Eff eh ef ~> IO
run Eff eh ef 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 eh ef ans -> IO ThreadId
runThread (Eff eh ef ans -> IO ThreadId) -> Eff eh ef ans -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (b -> Eff eh ef ())
-> Eff eh (Input i : Output b : ef) ~> Eff eh ef
forall o'.
(o' -> Eff eh ef ())
-> Eff eh (Input i : Output o' : ef) ~> Eff eh ef
runUnit (IO () -> Eff eh ef ()
forall a. IO a -> Eff eh ef a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff eh ef ()) -> (b -> IO ()) -> b -> Eff eh ef ()
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 eh (Input i : Output b : ef) ans
a
                ThreadId
t2 <- Eff eh ef ans -> IO ThreadId
runThread (Eff eh ef ans -> IO ThreadId) -> Eff eh ef ans -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Eff eh ef b
-> (o -> Eff eh ef ()) -> Machinery eh ef ans b o -> Eff eh ef ans
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(UnliftIO <<| eh, IO <| ef) =>
Eff eh ef i
-> (o -> Eff eh ef ()) -> Machinery eh ef ans i o -> Eff eh ef ans
runMachineryIO (IO b -> Eff eh ef b
forall a. IO a -> Eff eh ef a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> Eff eh ef b) -> (STM b -> IO b) -> STM b -> Eff eh ef 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 eh ef b) -> STM b -> Eff eh ef b
forall a b. (a -> b) -> a -> b
$ TMVar b -> STM b
forall a. TMVar a -> STM a
takeTMVar TMVar b
chan) o -> Eff eh ef ()
o Machinery eh ef 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 eh ef ()) -> Eff eh (Input i ': Output o' ': ef) ~> Eff eh ef
    runUnit :: forall o'.
(o' -> Eff eh ef ())
-> Eff eh (Input i : Output o' : ef) ~> Eff eh ef
runUnit o' -> Eff eh ef ()
o' Eff eh (Input i : Output o' : ef) x
m =
        Eff eh (Input i : Output o' : ef) x
m
            Eff eh (Input i : Output o' : ef) x
-> (Eff eh (Input i : Output o' : ef) x
    -> Eff eh (Output o' : ef) x)
-> Eff eh (Output o' : ef) x
forall a b. a -> (a -> b) -> b
& (Input i ~> Eff eh (Output o' : ef))
-> Eff eh (Input i : Output o' : ef) ~> Eff eh (Output o' : ef)
forall (e :: * -> *) (ef :: [* -> *]) (eh :: [EffectH]).
(e ~> Eff eh ef) -> Eff eh (e : ef) ~> Eff eh ef
interpret (\Input i x
Input -> Eff eh ef x -> Eff eh (Output o' : ef) x
forall (e :: * -> *) (ef :: [* -> *]) (eh :: [EffectH]) x.
Eff eh ef x -> Eff eh (e : ef) x
raise Eff eh ef i
Eff eh ef x
i)
            Eff eh (Output o' : ef) x
-> (Eff eh (Output o' : ef) x -> Eff eh ef x) -> Eff eh ef x
forall a b. a -> (a -> b) -> b
& (Output o' ~> Eff eh ef) -> Eff eh (Output o' : ef) ~> Eff eh ef
forall (e :: * -> *) (ef :: [* -> *]) (eh :: [EffectH]).
(e ~> Eff eh ef) -> Eff eh (e : ef) ~> Eff eh ef
interpret (\(Output o'
x) -> o' -> Eff eh ef ()
o' o'
x)

runMachineryIO_
    :: forall ans eh ef
     . (UnliftIO <<| eh, IO <| ef)
    => Machinery eh ef ans () ()
    -> Eff eh ef ans
runMachineryIO_ :: forall ans (eh :: [EffectH]) (ef :: [* -> *]).
(UnliftIO <<| eh, IO <| ef) =>
Machinery eh ef ans () () -> Eff eh ef ans
runMachineryIO_ = Eff eh ef ()
-> (() -> Eff eh ef ())
-> Machinery eh ef ans () ()
-> Eff eh ef ans
forall i o ans (eh :: [EffectH]) (ef :: [* -> *]).
(UnliftIO <<| eh, IO <| ef) =>
Eff eh ef i
-> (o -> Eff eh ef ()) -> Machinery eh ef ans i o -> Eff eh ef ans
runMachineryIO (() -> Eff eh ef ()
forall a. a -> Eff eh ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Eff eh ef () -> () -> Eff eh ef ()
forall a b. a -> b -> a
const (Eff eh ef () -> () -> Eff eh ef ())
-> Eff eh ef () -> () -> Eff eh ef ()
forall a b. (a -> b) -> a -> b
$ () -> Eff eh ef ()
forall a. a -> Eff eh ef 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 eh ef ans i o where
    MOne
        :: forall i o ans eh ef
         . Eff eh (Input i ': Output o ': ef) ans
        -> MachineryViewL eh ef ans i o
    MCons
        :: forall a b c ans eh ef
         . Eff eh (Input a ': Output b ': ef) ans
        -> Machinery eh ef ans b c
        -> MachineryViewL eh ef ans a c

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