module Chiasma.Render where

import qualified Chiasma.Codec.Data as Codec (Window(Window))
import Chiasma.Data.Ident (Ident, identText)
import Chiasma.Data.RenderError (RenderError)
import Chiasma.Data.TmuxThunk (TmuxThunk)
import Chiasma.Data.Views (Views)
import Chiasma.Pack (packWindow)
import Chiasma.Session (ensureSession, findOrCreateSession)
import Chiasma.Ui.Data.RenderableTree (RenderableTree)
import Chiasma.Ui.Data.View (ViewTree)
import Chiasma.View (viewsLog)
import Chiasma.Window (ensureView, ensureWindow, findOrCreateWindow, windowState)
import Control.Monad.Error.Class (MonadError)
import Control.Monad.Free.Class (MonadFree)
import Data.Text.Prettyprint.Doc (line, pretty)

renderTree ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>
  Ident ->
  Codec.Window ->
  RenderableTree ->
  m ()
renderTree :: Ident -> Window -> RenderableTree -> m ()
renderTree Ident
windowIdent Window
window RenderableTree
tree = do
  Doc AnsiStyle -> m ()
forall s (m :: * -> *).
MonadDeepState s Views m =>
Doc AnsiStyle -> m ()
viewsLog (Doc AnsiStyle -> m ()) -> Doc AnsiStyle -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Text
"rendering tree in window " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
windowIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> RenderableTree -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty RenderableTree
tree
  WindowState
wState <- Ident -> Window -> RenderableTree -> m WindowState
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
Ident -> Window -> RenderableTree -> m WindowState
windowState Ident
windowIdent Window
window RenderableTree
tree
  WindowState -> m ()
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
WindowState -> m ()
packWindow WindowState
wState

render ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m, MonadError RenderError m) =>
  FilePath ->
  Ident ->
  Ident ->
  ViewTree ->
  m ()
render :: FilePath -> Ident -> Ident -> ViewTree -> m ()
render FilePath
cwd Ident
sessionIdent Ident
windowIdent ViewTree
tree = do
  View SessionId
initialSession <- Ident -> m (View SessionId)
forall s (m :: * -> *).
MonadDeepState s Views m =>
Ident -> m (View SessionId)
findOrCreateSession Ident
sessionIdent
  View WindowId
initialWindow <- Ident -> m (View WindowId)
forall s (m :: * -> *).
MonadDeepState s Views m =>
Ident -> m (View WindowId)
findOrCreateWindow Ident
windowIdent
  (SessionId
sid, Maybe WindowId
newSessionWid) <- View SessionId -> View WindowId -> m (SessionId, Maybe WindowId)
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
View SessionId -> View WindowId -> m (SessionId, Maybe WindowId)
ensureSession View SessionId
initialSession View WindowId
initialWindow
  window :: Window
window@(Codec.Window WindowId
windowId Int
_ Int
_) <- SessionId
-> View WindowId -> Maybe WindowId -> ViewTree -> m Window
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m,
 MonadError RenderError m) =>
SessionId
-> View WindowId -> Maybe WindowId -> ViewTree -> m Window
ensureWindow SessionId
sid View WindowId
initialWindow Maybe WindowId
newSessionWid ViewTree
tree
  (RenderableTree -> m ()) -> Maybe RenderableTree -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ident -> Window -> RenderableTree -> m ()
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
Ident -> Window -> RenderableTree -> m ()
renderTree Ident
windowIdent Window
window) (Maybe RenderableTree -> m ()) -> m (Maybe RenderableTree) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> WindowId -> ViewTree -> m (Maybe RenderableTree)
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
FilePath -> WindowId -> ViewTree -> m (Maybe RenderableTree)
ensureView FilePath
cwd WindowId
windowId ViewTree
tree