module Polysemy.Input.Streaming
  ( -- * Underlying Effect
    module Polysemy.Input

    -- * Actions
  , yieldInput
  , yieldRace
  , exhaust

    -- * Intepretations
  , runInputViaStream
  , runInputViaInfiniteStream
  ) where

import qualified Control.Concurrent.Async as A
import           Data.Functor.Of
import           Data.Void
import           Polysemy
import           Polysemy.Final
import           Polysemy.Input
import           Polysemy.State
import qualified Streaming as S
import qualified Streaming.Prelude as S



runInputViaStream
    :: S.Stream (Of i) (Sem r) ()
    -> InterpreterFor (Input (Maybe i)) r
runInputViaStream :: Stream (Of i) (Sem r) () -> InterpreterFor (Input (Maybe i)) r
runInputViaStream Stream (Of i) (Sem r) ()
stream
  = Maybe (Stream (Of i) (Sem r) ())
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) a -> Sem r a
forall s (r :: [(* -> *) -> * -> *]) a.
s -> Sem (State s : r) a -> Sem r a
evalState (Stream (Of i) (Sem r) () -> Maybe (Stream (Of i) (Sem r) ())
forall a. a -> Maybe a
Just Stream (Of i) (Sem r) ()
stream)
  (Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) a -> Sem r a)
-> (Sem (Input (Maybe i) : r) a
    -> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) a)
-> Sem (Input (Maybe i) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: [(* -> *) -> * -> *]) x.
 Input (Maybe i) (Sem rInitial) x
 -> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) x)
-> Sem (Input (Maybe i) : r) a
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret ( \Input (Maybe i) (Sem rInitial) x
Input ->
      Sem
  (State (Maybe (Stream (Of i) (Sem r) ())) : r)
  (Maybe (Stream (Of i) (Sem r) ()))
forall s (r :: [(* -> *) -> * -> *]). Member (State s) r => Sem r s
get Sem
  (State (Maybe (Stream (Of i) (Sem r) ())) : r)
  (Maybe (Stream (Of i) (Sem r) ()))
-> (Maybe (Stream (Of i) (Sem r) ())
    -> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i))
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Stream (Of i) (Sem r) ())
Nothing -> Maybe i
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe i
forall a. Maybe a
Nothing
        Just Stream (Of i) (Sem r) ()
s ->
          Sem r (Either () (Of i (Stream (Of i) (Sem r) ())))
-> Sem
     (State (Maybe (Stream (Of i) (Sem r) ())) : r)
     (Either () (Of i (Stream (Of i) (Sem r) ())))
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Stream (Of i) (Sem r) ()
-> Sem r (Either () (Of i (Stream (Of i) (Sem r) ())))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
S.inspect Stream (Of i) (Sem r) ()
s) Sem
  (State (Maybe (Stream (Of i) (Sem r) ())) : r)
  (Either () (Of i (Stream (Of i) (Sem r) ())))
-> (Either () (Of i (Stream (Of i) (Sem r) ()))
    -> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i))
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left () -> Maybe i
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe i
forall a. Maybe a
Nothing
            Right (i
i :> Stream (Of i) (Sem r) ()
s') -> do
              Maybe (Stream (Of i) (Sem r) ())
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) ()
forall s (r :: [(* -> *) -> * -> *]).
Member (State s) r =>
s -> Sem r ()
put (Maybe (Stream (Of i) (Sem r) ())
 -> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) ())
-> Maybe (Stream (Of i) (Sem r) ())
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) ()
forall a b. (a -> b) -> a -> b
$ Stream (Of i) (Sem r) () -> Maybe (Stream (Of i) (Sem r) ())
forall a. a -> Maybe a
Just Stream (Of i) (Sem r) ()
s'
              Maybe i
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe i
 -> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i))
-> Maybe i
-> Sem (State (Maybe (Stream (Of i) (Sem r) ())) : r) (Maybe i)
forall a b. (a -> b) -> a -> b
$ i -> Maybe i
forall a. a -> Maybe a
Just i
i
  )


runInputViaInfiniteStream
    :: forall i r
     . S.Stream (Of i) (Sem r) Void
    -> InterpreterFor (Input i) r
runInputViaInfiniteStream :: Stream (Of i) (Sem r) Void -> InterpreterFor (Input i) r
runInputViaInfiniteStream Stream (Of i) (Sem r) Void
stream
  = Stream (Of i) (Sem r) Void
-> Sem (State (Stream (Of i) (Sem r) Void) : r) a -> Sem r a
forall s (r :: [(* -> *) -> * -> *]) a.
s -> Sem (State s : r) a -> Sem r a
evalState Stream (Of i) (Sem r) Void
stream
  (Sem (State (Stream (Of i) (Sem r) Void) : r) a -> Sem r a)
-> (Sem (Input i : r) a
    -> Sem (State (Stream (Of i) (Sem r) Void) : r) a)
-> Sem (Input i : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: [(* -> *) -> * -> *]) x.
 Input i (Sem rInitial) x
 -> Sem (State (Stream (Of i) (Sem r) Void) : r) x)
-> Sem (Input i : r) a
-> Sem (State (Stream (Of i) (Sem r) Void) : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret ( \Input i (Sem rInitial) x
Input -> do
      Stream (Of x) (Sem r) Void
s <- Sem
  (State (Stream (Of i) (Sem r) Void) : r)
  (Stream (Of x) (Sem r) Void)
forall s (r :: [(* -> *) -> * -> *]). Member (State s) r => Sem r s
get
      Sem r (Either Void (Of x (Stream (Of x) (Sem r) Void)))
-> Sem
     (State (Stream (Of i) (Sem r) Void) : r)
     (Either Void (Of x (Stream (Of x) (Sem r) Void)))
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Stream (Of x) (Sem r) Void
-> Sem r (Either Void (Of x (Stream (Of x) (Sem r) Void)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
S.inspect Stream (Of x) (Sem r) Void
s) Sem
  (State (Stream (Of i) (Sem r) Void) : r)
  (Either Void (Of x (Stream (Of x) (Sem r) Void)))
-> (Either Void (Of x (Stream (Of x) (Sem r) Void))
    -> Sem (State (Stream (Of i) (Sem r) Void) : r) x)
-> Sem (State (Stream (Of i) (Sem r) Void) : r) x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Void
g -> Void -> Sem (State (Stream (Of i) (Sem r) Void) : r) x
forall a. Void -> a
absurd Void
g
        Right (x
i :> Stream (Of x) (Sem r) Void
s') -> do
          Stream (Of x) (Sem r) Void
-> Sem (State (Stream (Of i) (Sem r) Void) : r) ()
forall s (r :: [(* -> *) -> * -> *]).
Member (State s) r =>
s -> Sem r ()
put Stream (Of x) (Sem r) Void
s'
          x -> Sem (State (Stream (Of i) (Sem r) Void) : r) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
i
  )


yieldRace
    :: Members
        '[ Final IO
         , Input i1
         , Input i2
         ] r
    => S.Stream (S.Of (Either i1 i2)) (Sem r) ()
yieldRace :: Stream (Of (Either i1 i2)) (Sem r) ()
yieldRace = do
  Either i1 i2
z <- Sem r (Either i1 i2)
-> Stream (Of (Either i1 i2)) (Sem r) (Either i1 i2)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
S.lift (Sem r (Either i1 i2)
 -> Stream (Of (Either i1 i2)) (Sem r) (Either i1 i2))
-> Sem r (Either i1 i2)
-> Stream (Of (Either i1 i2)) (Sem r) (Either i1 i2)
forall a b. (a -> b) -> a -> b
$ Strategic IO (Sem r) (Either i1 i2) -> Sem r (Either i1 i2)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal (Strategic IO (Sem r) (Either i1 i2) -> Sem r (Either i1 i2))
-> Strategic IO (Sem r) (Either i1 i2) -> Sem r (Either i1 i2)
forall a b. (a -> b) -> a -> b
$ do
         IO (f i1)
input1 <- Sem r i1 -> Sem (WithStrategy IO f (Sem r)) (IO (f i1))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem r i1
forall i (r :: [(* -> *) -> * -> *]). Member (Input i) r => Sem r i
input
         IO (f i2)
input2 <- Sem r i2 -> Sem (WithStrategy IO f (Sem r)) (IO (f i2))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem r i2
forall i (r :: [(* -> *) -> * -> *]). Member (Input i) r => Sem r i
input
         IO (f (Either i1 i2))
-> Sem (WithStrategy IO f (Sem r)) (IO (f (Either i1 i2)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (f (Either i1 i2))
 -> Sem (WithStrategy IO f (Sem r)) (IO (f (Either i1 i2))))
-> IO (f (Either i1 i2))
-> Sem (WithStrategy IO f (Sem r)) (IO (f (Either i1 i2)))
forall a b. (a -> b) -> a -> b
$ (Either (f i1) (f i2) -> f (Either i1 i2))
-> IO (Either (f i1) (f i2)) -> IO (f (Either i1 i2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (f i1) (f i2) -> f (Either i1 i2)
forall (f :: * -> *) a b.
Functor f =>
Either (f a) (f b) -> f (Either a b)
sequenceEither (IO (Either (f i1) (f i2)) -> IO (f (Either i1 i2)))
-> IO (Either (f i1) (f i2)) -> IO (f (Either i1 i2))
forall a b. (a -> b) -> a -> b
$ IO (f i1) -> IO (f i2) -> IO (Either (f i1) (f i2))
forall a b. IO a -> IO b -> IO (Either a b)
A.race IO (f i1)
input1 IO (f i2)
input2
  Either i1 i2 -> Stream (Of (Either i1 i2)) (Sem r) ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield Either i1 i2
z


sequenceEither :: Functor f => Either (f a) (f b) -> f (Either a b)
sequenceEither :: Either (f a) (f b) -> f (Either a b)
sequenceEither (Left f a
fa) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> f a -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
sequenceEither (Right f b
fb) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
fb


yieldInput :: Member (Input i) r => S.Stream (Of i) (Sem r) ()
yieldInput :: Stream (Of i) (Sem r) ()
yieldInput = Sem r i -> Stream (Of i) (Sem r) i
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
S.lift Sem r i
forall i (r :: [(* -> *) -> * -> *]). Member (Input i) r => Sem r i
input Stream (Of i) (Sem r) i
-> (i -> Stream (Of i) (Sem r) ()) -> Stream (Of i) (Sem r) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= i -> Stream (Of i) (Sem r) ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield


exhaust :: Member (Input i) r => S.Stream (Of i) (Sem r) a
exhaust :: Stream (Of i) (Sem r) a
exhaust = Sem r i -> Stream (Of i) (Sem r) a
forall (m :: * -> *) a r. Monad m => m a -> Stream (Of a) m r
S.repeatM Sem r i
forall i (r :: [(* -> *) -> * -> *]). Member (Input i) r => Sem r i
input