{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
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_ #-}
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
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)