module Chiasma.Session where import Exon (exon) import qualified Chiasma.Codec.Data.Session as Codec (Session (Session)) import qualified Chiasma.Codec.Data.Window as Codec (Window (Window)) import Chiasma.Command.Session (existingSessionId, newSession) import Chiasma.Command.Window (newSessionWindow) import Chiasma.Data.Ident (Ident) import Chiasma.Data.LayoutError (LayoutError) import Chiasma.Data.TmuxId (SessionId, WindowId) import qualified Chiasma.Data.View as Tmux (View (viewId, viewIdent), setViewId) import Chiasma.Data.Views (Views) import Chiasma.Effect.TmuxApi (Tmux) import Chiasma.View (findOrCreateView, viewsLogS) import qualified Chiasma.View as Views (insertSession, session, updateSession, updateWindow) findOrCreateSession :: Member (AtomicState Views) r => Ident -> Sem r (Tmux.View SessionId) findOrCreateSession :: forall (r :: EffectRow). Member (AtomicState Views) r => Ident -> Sem r (View SessionId) findOrCreateSession = Getter SessionId -> Setter SessionId -> Ident -> Sem r (View SessionId) forall (r :: EffectRow) a. Member (AtomicState Views) r => Getter a -> Setter a -> Ident -> Sem r (View a) findOrCreateView Getter SessionId Views.session Setter SessionId Views.insertSession spawnSession :: Members [AtomicState Views, Tmux, Stop LayoutError] r => Tmux.View SessionId -> Tmux.View WindowId -> Sem r (SessionId, WindowId) spawnSession :: forall (r :: EffectRow). Members '[AtomicState Views, Tmux, Stop LayoutError] r => View SessionId -> View WindowId -> Sem r (SessionId, WindowId) spawnSession View SessionId session' View WindowId window = do Codec.Session SessionId sid Text _ <- Ident -> Sem r Session forall (r :: EffectRow). Member Tmux r => Ident -> Sem r Session newSession (View SessionId -> Ident forall a. View a -> Ident Tmux.viewIdent View SessionId session') (Views -> Views) -> Sem r () forall s (r :: EffectRow). Member (AtomicState s) r => (s -> s) -> Sem r () atomicModify' (Setter SessionId Views.updateSession (SessionId -> View SessionId -> View SessionId forall a. a -> View a -> View a Tmux.setViewId SessionId sid View SessionId session')) Codec.Window WindowId wid Int _ Int _ <- SessionId -> Sem r Window forall (r :: EffectRow). Members '[Tmux, Stop LayoutError] r => SessionId -> Sem r Window newSessionWindow SessionId sid (Views -> Views) -> Sem r () forall s (r :: EffectRow). Member (AtomicState s) r => (s -> s) -> Sem r () atomicModify' (View WindowId -> Views -> Views Views.updateWindow (WindowId -> View WindowId -> View WindowId forall a. a -> View a -> View a Tmux.setViewId WindowId wid View WindowId window)) Text -> Sem r () forall (r :: EffectRow). Member (AtomicState Views) r => Text -> Sem r () viewsLogS [exon|spawned session #{show session'} with id #{show sid} and window id #{show wid}|] pure (SessionId sid, WindowId wid) ensureSession :: Members [AtomicState Views, Tmux, Stop LayoutError] r => Tmux.View SessionId -> Tmux.View WindowId -> Sem r (SessionId, Maybe WindowId) ensureSession :: forall (r :: EffectRow). Members '[AtomicState Views, Tmux, Stop LayoutError] r => View SessionId -> View WindowId -> Sem r (SessionId, Maybe WindowId) ensureSession View SessionId session' View WindowId window = do Maybe SessionId existing <- Maybe (Maybe SessionId) -> Maybe SessionId forall (m :: * -> *) a. Monad m => m (m a) -> m a join (Maybe (Maybe SessionId) -> Maybe SessionId) -> Sem r (Maybe (Maybe SessionId)) -> Sem r (Maybe SessionId) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (SessionId -> Sem r (Maybe SessionId)) -> Maybe SessionId -> Sem r (Maybe (Maybe SessionId)) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse SessionId -> Sem r (Maybe SessionId) forall (r :: EffectRow). Member Tmux r => SessionId -> Sem r (Maybe SessionId) existingSessionId (View SessionId -> Maybe SessionId forall a. View a -> Maybe a Tmux.viewId View SessionId session') case Maybe SessionId existing of Just SessionId sid -> (SessionId, Maybe WindowId) -> Sem r (SessionId, Maybe WindowId) forall (f :: * -> *) a. Applicative f => a -> f a pure (SessionId sid, Maybe WindowId forall a. Maybe a Nothing) Maybe SessionId Nothing -> (WindowId -> Maybe WindowId) -> (SessionId, WindowId) -> (SessionId, Maybe WindowId) forall (p :: * -> * -> *) b c a. Bifunctor p => (b -> c) -> p a b -> p a c second WindowId -> Maybe WindowId forall a. a -> Maybe a Just ((SessionId, WindowId) -> (SessionId, Maybe WindowId)) -> Sem r (SessionId, WindowId) -> Sem r (SessionId, Maybe WindowId) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> View SessionId -> View WindowId -> Sem r (SessionId, WindowId) forall (r :: EffectRow). Members '[AtomicState Views, Tmux, Stop LayoutError] r => View SessionId -> View WindowId -> Sem r (SessionId, WindowId) spawnSession View SessionId session' View WindowId window