module Chiasma.Event where import Exon (exon) import qualified Polysemy.Conc as Conc import Polysemy.Conc (withAsync_) import qualified Polysemy.Log as Log import qualified Polysemy.Time as Time import Polysemy.Time (Seconds (Seconds)) import Prelude hiding (listen) import Chiasma.Data.Event (Event) import Chiasma.Data.ReceiveEvent (ReceiveEvent (ReceiveEvent)) import Chiasma.Data.TmuxError (TmuxError) import Chiasma.Effect.Codec (Codec) import qualified Chiasma.Effect.TmuxApi as TmuxApi import Chiasma.Effect.TmuxApi (TmuxApi) import Chiasma.Effect.TmuxClient (TmuxClient) import Chiasma.Tmux (withTmux) receiveEvent :: ∀ r . Members [TmuxApi ReceiveEvent, Events Event] r => Sem r () receiveEvent :: forall (r :: EffectRow). Members '[TmuxApi ReceiveEvent, Events Event] r => Sem r () receiveEvent = Event -> Sem r () forall e (r :: EffectRow). Member (Events e) r => e -> Sem r () Conc.publish (Event -> Sem r ()) -> Sem r Event -> Sem r () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< ReceiveEvent Event -> Sem r Event forall (command :: * -> *) (r :: EffectRow) a. Member (TmuxApi command) r => command a -> Sem r a TmuxApi.send ReceiveEvent Event ReceiveEvent listenLoop :: ∀ err t d r . Show err => Members [TmuxApi ReceiveEvent !! err, Events Event, Time t d, Log] r => Sem r () listenLoop :: forall err t d (r :: EffectRow). (Show err, Members '[TmuxApi ReceiveEvent !! err, Events Event, Time t d, Log] r) => Sem r () listenLoop = do forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a. Member (Resumable err eff) r => Sem (eff : r) a -> (err -> Sem r a) -> Sem r a resume @_ @(TmuxApi _) Sem (TmuxApi ReceiveEvent : r) () forall (r :: EffectRow). Members '[TmuxApi ReceiveEvent, Events Event] r => Sem r () receiveEvent \ err err -> Text -> Sem r () forall (r :: EffectRow). (HasCallStack, Member Log r) => Text -> Sem r () Log.error [exon|Receiving tmux event: #{show err}|] Sem r () forall err t d (r :: EffectRow). (Show err, Members '[TmuxApi ReceiveEvent !! err, Events Event, Time t d, Log] r) => Sem r () listenLoop listen :: ∀ enc dec err t d r . Show err => Member (Codec ReceiveEvent enc dec !! err) r => Members [Scoped_ (TmuxClient enc dec) !! TmuxError, Events Event, Time t d, Log] r => Sem r () listen :: forall enc dec err t d (r :: EffectRow). (Show err, Member (Codec ReceiveEvent enc dec !! err) r, Members '[Scoped_ (TmuxClient enc dec) !! TmuxError, Events Event, Time t d, Log] r) => Sem r () listen = do forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a. Member (Resumable err eff) r => Sem (eff : r) a -> (err -> Sem r a) -> Sem r a resume @_ @(Scoped_ _) (Sem ((TmuxApi ReceiveEvent !! err) : Scoped_ (TmuxClient enc dec) : r) () -> Sem (Scoped_ (TmuxClient enc dec) : r) () InterpreterFor (TmuxApi ReceiveEvent !! err) (Scoped_ (TmuxClient enc dec) : r) forall (command :: * -> *) err i o (r :: EffectRow). Members '[ScopedTmux i o, Codec command i o !! err] r => InterpreterFor (TmuxApi command !! err) r withTmux Sem ((TmuxApi ReceiveEvent !! err) : Scoped_ (TmuxClient enc dec) : r) () forall err t d (r :: EffectRow). (Show err, Members '[TmuxApi ReceiveEvent !! err, Events Event, Time t d, Log] r) => Sem r () listenLoop) \ TmuxError err -> do Text -> Sem r () forall (r :: EffectRow). (HasCallStack, Member Log r) => Text -> Sem r () Log.error [exon|Lost connection to tmux: #{show err} Reconnecting...|] Seconds -> Sem r () forall t d u (r :: EffectRow). (TimeUnit u, Member (Time t d) r) => u -> Sem r () Time.sleep (Int64 -> Seconds Seconds Int64 1) withTmuxEvents :: Show err => Member (Codec ReceiveEvent enc dec !! err) r => Member (Scoped_ (TmuxClient enc dec) !! TmuxError) r => Members [Events Event, Time t d, Log, Race, Async, Resource] r => Sem r a -> Sem r a withTmuxEvents :: forall err enc dec (r :: EffectRow) t d a. (Show err, Member (Codec ReceiveEvent enc dec !! err) r, Member (Scoped_ (TmuxClient enc dec) !! TmuxError) r, Members '[Events Event, Time t d, Log, Race, Async, Resource] r) => Sem r a -> Sem r a withTmuxEvents = Sem r Any -> Sem r a -> Sem r a forall (r :: EffectRow) b a. Members '[Resource, Race, Async] r => Sem r b -> Sem r a -> Sem r a withAsync_ do Sem r () -> Sem r Any forall (f :: * -> *) a b. Applicative f => f a -> f b forever Sem r () forall enc dec err t d (r :: EffectRow). (Show err, Member (Codec ReceiveEvent enc dec !! err) r, Members '[Scoped_ (TmuxClient enc dec) !! TmuxError, Events Event, Time t d, Log] r) => Sem r () listen