{-# options_haddock prune #-}

-- |Listen, Internal
module Helic.Listen where

import qualified Polysemy.Conc as Conc
import Polysemy.Conc (interpretSync, withAsync_)
import qualified Polysemy.Conc.Sync as Sync
import Prelude hiding (listen)

import Helic.Data.Event (Event)
import qualified Helic.Effect.History as History
import Helic.Effect.History (History)

-- |Signal type that indicates that the subscriber of 'listen' is running.
data Listening =
  Listening
  deriving stock (Listening -> Listening -> Bool
(Listening -> Listening -> Bool)
-> (Listening -> Listening -> Bool) -> Eq Listening
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Listening -> Listening -> Bool
$c/= :: Listening -> Listening -> Bool
== :: Listening -> Listening -> Bool
$c== :: Listening -> Listening -> Bool
Eq, Int -> Listening -> ShowS
[Listening] -> ShowS
Listening -> String
(Int -> Listening -> ShowS)
-> (Listening -> String)
-> ([Listening] -> ShowS)
-> Show Listening
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Listening] -> ShowS
$cshowList :: [Listening] -> ShowS
show :: Listening -> String
$cshow :: Listening -> String
showsPrec :: Int -> Listening -> ShowS
$cshowsPrec :: Int -> Listening -> ShowS
Show)

-- |Listen for 'Event' via 'Polysemy.Conc.Events', broadcasting them to agents.
listen ::
  Members [EventConsumer token Event, History, Sync Listening] r =>
  Sem r ()
listen :: Sem r ()
listen =
  Sem (Consume Event : r) () -> Sem r ()
forall e resource (r :: EffectRow).
Member (Scoped (EventResource resource) (Consume e)) r =>
InterpreterFor (Consume e) r
Conc.subscribe do
    Listening -> Sem (Consume Event : r) ()
forall d (r :: EffectRow). Member (Sync d) r => d -> Sem r ()
Sync.putBlock Listening
Listening
    Sem (Consume Event : r) () -> Sem (Consume Event : r) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Event -> Sem (Consume Event : r) ()
forall (r :: EffectRow). Member History r => Event -> Sem r ()
History.receive (Event -> Sem (Consume Event : r) ())
-> Sem (Consume Event : r) Event -> Sem (Consume Event : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Consume Event : r) Event
forall e (r :: EffectRow). Member (Consume e) r => Sem r e
Conc.consume)

-- |Run an action with 'listen' in a thread, waiting for the event subscriber to be up and running before executing the
-- action.
withListen ::
  Members [EventConsumer token Event, History, Resource, Race, Async, Embed IO] r =>
  Sem r a ->
  Sem r a
withListen :: Sem r a -> Sem r a
withListen Sem r a
ma =
  Sem (Sync Listening : r) a -> Sem r a
forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
InterpreterFor (Sync d) r
interpretSync (Sem (Sync Listening : r) a -> Sem r a)
-> Sem (Sync Listening : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$
  Sem (Sync Listening : r) ()
-> Sem (Sync Listening : r) a -> Sem (Sync Listening : r) a
forall (r :: EffectRow) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ Sem (Sync Listening : r) ()
forall token (r :: EffectRow).
Members '[EventConsumer token Event, History, Sync Listening] r =>
Sem r ()
listen do
    Listening
Listening <- Sem (Sync Listening : r) Listening
forall d (r :: EffectRow). Member (Sync d) r => Sem r d
Sync.takeBlock
    Sem r a -> Sem (Sync Listening : r) a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise Sem r a
ma