{-# LANGUAGE FlexibleContexts #-}

module Chiasma.Session where

import Control.Monad.Free.Class (MonadFree)

import qualified Chiasma.Codec.Data as Codec (Session(Session), Window(Window))
import Chiasma.Command.Session (existingSessionId, newSession)
import Chiasma.Command.Window (newSessionWindow)
import Chiasma.Data.Ident (Ident)
import Chiasma.Data.TmuxId (SessionId, WindowId)
import Chiasma.Data.TmuxThunk (TmuxThunk)
import qualified Chiasma.Data.View as Tmux (View(viewId, viewIdent), setViewId)
import Chiasma.Data.Views (Views)
import Chiasma.View (findOrCreateView, viewsLogS)
import qualified Chiasma.View as Views (insertSession, session, updateSession, updateWindow)

findOrCreateSession ::
  MonadDeepState s Views m =>
  Ident ->
  m (Tmux.View SessionId)
findOrCreateSession :: Ident -> m (View SessionId)
findOrCreateSession =
  Getter SessionId -> Setter SessionId -> Ident -> m (View SessionId)
forall s (m :: * -> *) a.
MonadDeepState s Views m =>
Getter a -> Setter a -> Ident -> m (View a)
findOrCreateView Getter SessionId
Views.session Setter SessionId
Views.insertSession

spawnSession ::
  MonadDeepState s Views m =>
  MonadFree TmuxThunk m =>
  Tmux.View SessionId ->
  Tmux.View WindowId ->
  m (SessionId, WindowId)
spawnSession :: View SessionId -> View WindowId -> m (SessionId, WindowId)
spawnSession View SessionId
session' View WindowId
window = do
  Codec.Session SessionId
sid <- Ident -> m Session
forall (m :: * -> *). MonadFree TmuxThunk m => Ident -> m Session
newSession (View SessionId -> Ident
forall a. View a -> Ident
Tmux.viewIdent View SessionId
session')
  (Views -> Views) -> m ()
forall s' s (m :: * -> *).
MonadDeepState s s' m =>
(s' -> s') -> m ()
modify ((Views -> Views) -> m ()) -> (Views -> Views) -> m ()
forall a b. (a -> b) -> a -> b
$ Setter SessionId
Views.updateSession Setter SessionId -> Setter SessionId
forall a b. (a -> b) -> a -> b
$ 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 -> m Window
forall (m :: * -> *).
MonadFree TmuxThunk m =>
SessionId -> m Window
newSessionWindow SessionId
sid
  (Views -> Views) -> m ()
forall s' s (m :: * -> *).
MonadDeepState s s' m =>
(s' -> s') -> m ()
modify ((Views -> Views) -> m ()) -> (Views -> Views) -> m ()
forall a b. (a -> b) -> a -> b
$ View WindowId -> Views -> Views
Views.updateWindow (View WindowId -> Views -> Views)
-> View WindowId -> Views -> Views
forall a b. (a -> b) -> a -> b
$ WindowId -> View WindowId -> View WindowId
forall a. a -> View a -> View a
Tmux.setViewId WindowId
wid View WindowId
window
  Text -> m ()
forall s (m :: * -> *). MonadDeepState s Views m => Text -> m ()
viewsLogS (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"spawned session " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> View SessionId -> Text
forall b a. (Show a, IsString b) => a -> b
show View SessionId
session' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with id " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SessionId -> Text
forall b a. (Show a, IsString b) => a -> b
show SessionId
sid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and window id " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WindowId -> Text
forall b a. (Show a, IsString b) => a -> b
show WindowId
wid
  return (SessionId
sid, WindowId
wid)

ensureSession ::
  MonadDeepState s Views m =>
  MonadFree TmuxThunk m =>
  Tmux.View SessionId ->
  Tmux.View WindowId ->
  m (SessionId, Maybe WindowId)
ensureSession :: View SessionId -> View WindowId -> m (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)
-> m (Maybe (Maybe SessionId)) -> m (Maybe SessionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SessionId -> m (Maybe SessionId))
-> Maybe SessionId -> m (Maybe (Maybe SessionId))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SessionId -> m (Maybe SessionId)
forall (m :: * -> *).
MonadFree TmuxThunk m =>
SessionId -> m (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) -> m (SessionId, Maybe WindowId)
forall (m :: * -> *) a. Monad m => a -> m a
return (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))
-> m (SessionId, WindowId) -> m (SessionId, Maybe WindowId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> View SessionId -> View WindowId -> m (SessionId, WindowId)
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
View SessionId -> View WindowId -> m (SessionId, WindowId)
spawnSession View SessionId
session' View WindowId
window