module Chiasma.Window where

import qualified Chiasma.Codec.Data as Codec (Pane(Pane, paneId), Window(Window, windowId))
import qualified Chiasma.Codec.Data.PaneDetail as Codec (PaneDetail(PaneDetail))
import qualified Chiasma.Codec.Data.PaneDetail as PaneDetail (PaneDetail(..))
import qualified Chiasma.Command.Pane as Cmd (closePane, firstWindowPane, windowPanesAs)
import qualified Chiasma.Command.Window as Cmd (newWindow, splitWindowAs, window)
import Chiasma.Data.Ident (Ident, identText, identify)
import Chiasma.Data.Maybe (findMaybe, maybeExcept, orElse)
import Chiasma.Data.RenderError (RenderError)
import qualified Chiasma.Data.RenderError as RenderError (RenderError(NoPrincipal))
import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)
import Chiasma.Data.TmuxThunk (TmuxThunk)
import qualified Chiasma.Data.View as Tmux (View(View))
import Chiasma.Data.Views (Views)
import Chiasma.Data.WindowState (WindowState(..))
import Chiasma.Pane (addPane)
import Chiasma.Ui.Data.RenderableTree (
  RLayout(..),
  RPane(..),
  Renderable(..),
  RenderableNode,
  RenderableTree,
  )
import qualified Chiasma.Ui.Data.Tree as Tree (Node(Sub, Leaf), Tree(Tree))
import Chiasma.Ui.Data.View (Tree(..), TreeSub(..), ViewTree, ViewTreeSub)
import qualified Chiasma.Ui.Data.View as Ui (Layout(..), Pane(Pane), PaneView, View(View))
import Chiasma.Ui.Data.ViewGeometry (ViewGeometry(ViewGeometry, position))
import Chiasma.Ui.Data.ViewState (ViewState)
import Chiasma.View (findOrCreateView, viewsLog, viewsLogS)
import qualified Chiasma.View as Views (insertPane, insertWindow, pane, paneById, updatePane, updateWindow, window)
import Control.Monad.Error.Class (MonadError)
import Control.Monad.Free.Class (MonadFree)
import qualified Data.List.NonEmpty as NonEmpty (head, nonEmpty)
import Data.Text.Prettyprint.Doc (line, pretty, vsep, (<+>))

findOrCreateWindow ::
  (MonadDeepState s Views m) =>
  Ident ->
  m (Tmux.View WindowId)
findOrCreateWindow :: Ident -> m (View WindowId)
findOrCreateWindow =
  Getter WindowId -> Setter WindowId -> Ident -> m (View WindowId)
forall s (m :: * -> *) a.
MonadDeepState s Views m =>
Getter a -> Setter a -> Ident -> m (View a)
findOrCreateView Getter WindowId
Views.window Setter WindowId
Views.insertWindow

registerWindowId ::
  (MonadDeepState s Views m) =>
  Ident ->
  WindowId ->
  m ()
registerWindowId :: Ident -> WindowId -> m ()
registerWindowId Ident
ident WindowId
windowId =
  (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 WindowId
Views.updateWindow Setter WindowId -> Setter WindowId
forall a b. (a -> b) -> a -> b
$ Ident -> Maybe WindowId -> View WindowId
forall a. Ident -> Maybe a -> View a
Tmux.View Ident
ident (WindowId -> Maybe WindowId
forall a. a -> Maybe a
Just WindowId
windowId)

spawnWindow ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>
  SessionId ->
  Ident ->
  m Codec.Window
spawnWindow :: SessionId -> Ident -> m Window
spawnWindow SessionId
sid Ident
ident = do
  win :: Window
win@(Codec.Window WindowId
windowId Int
_ Int
_) <- SessionId -> Ident -> m Window
forall (m :: * -> *).
MonadFree TmuxThunk m =>
SessionId -> Ident -> m Window
Cmd.newWindow SessionId
sid Ident
ident
  Ident -> WindowId -> m ()
forall s (m :: * -> *).
MonadDeepState s Views m =>
Ident -> WindowId -> m ()
registerWindowId Ident
ident WindowId
windowId
  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 window in session " 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
" with id " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WindowId -> Text
forall b a. (Show a, IsString b) => a -> b
show WindowId
windowId
  return Window
win

findPrincipalSub :: ViewTreeSub -> Maybe Ui.PaneView
findPrincipalSub :: ViewTreeSub -> Maybe PaneView
findPrincipalSub (TreeNode Tree LayoutView PaneView
t) = Tree LayoutView PaneView -> Maybe PaneView
findPrincipal Tree LayoutView PaneView
t
findPrincipalSub (TreeLeaf p :: PaneView
p@(Ui.View Ident
_ ViewState
_ ViewGeometry
_ (Ui.Pane Bool
True Bool
_ Maybe FilePath
_))) = PaneView -> Maybe PaneView
forall a. a -> Maybe a
Just PaneView
p
findPrincipalSub ViewTreeSub
_ = Maybe PaneView
forall a. Maybe a
Nothing

findPrincipal :: ViewTree -> Maybe Ui.PaneView
findPrincipal :: Tree LayoutView PaneView -> Maybe PaneView
findPrincipal (Tree LayoutView
_ [ViewTreeSub]
sub) =
  (ViewTreeSub -> Maybe PaneView) -> [ViewTreeSub] -> Maybe PaneView
forall a b. (a -> Maybe b) -> [a] -> Maybe b
findMaybe ViewTreeSub -> Maybe PaneView
findPrincipalSub [ViewTreeSub]
sub

principalPane ::
  (MonadDeepState s Views m, MonadError RenderError m) =>
  ViewTree ->
  m (Ui.PaneView, Tmux.View PaneId)
principalPane :: Tree LayoutView PaneView -> m (PaneView, View PaneId)
principalPane Tree LayoutView PaneView
tree = do
  uiPane :: PaneView
uiPane@(Ui.View Ident
uiPaneIdent ViewState
_ ViewGeometry
_ Pane
_) <- RenderError -> Maybe PaneView -> m PaneView
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeExcept (Ident -> RenderError
RenderError.NoPrincipal (Ident -> RenderError) -> Ident -> RenderError
forall a b. (a -> b) -> a -> b
$ Tree LayoutView PaneView -> Ident
forall a. Identifiable a => a -> Ident
identify Tree LayoutView PaneView
tree) (Maybe PaneView -> m PaneView) -> Maybe PaneView -> m PaneView
forall a b. (a -> b) -> a -> b
$ Tree LayoutView PaneView -> Maybe PaneView
findPrincipal Tree LayoutView PaneView
tree
  Either ViewsError (View PaneId)
existingTmuxPane <- (Views -> Either ViewsError (View PaneId))
-> m (Either ViewsError (View PaneId))
forall s' s (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> a) -> m a
gets ((Views -> Either ViewsError (View PaneId))
 -> m (Either ViewsError (View PaneId)))
-> (Views -> Either ViewsError (View PaneId))
-> m (Either ViewsError (View PaneId))
forall a b. (a -> b) -> a -> b
$ Ident -> Views -> Either ViewsError (View PaneId)
Views.pane Ident
uiPaneIdent
  View PaneId
tmuxPane <- (ViewsError -> m (View PaneId))
-> (View PaneId -> m (View PaneId))
-> Either ViewsError (View PaneId)
-> m (View PaneId)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m (View PaneId) -> ViewsError -> m (View PaneId)
forall a b. a -> b -> a
const (m (View PaneId) -> ViewsError -> m (View PaneId))
-> m (View PaneId) -> ViewsError -> m (View PaneId)
forall a b. (a -> b) -> a -> b
$ Ident -> m (View PaneId)
forall s (m :: * -> *).
MonadDeepState s Views m =>
Ident -> m (View PaneId)
addPane Ident
uiPaneIdent) View PaneId -> m (View PaneId)
forall (m :: * -> *) a. Monad m => a -> m a
return Either ViewsError (View PaneId)
existingTmuxPane
  return (PaneView
uiPane, View PaneId
tmuxPane)

syncPrincipal ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m, MonadError RenderError m) =>
  WindowId ->
  ViewTree ->
  m ()
syncPrincipal :: WindowId -> Tree LayoutView PaneView -> m ()
syncPrincipal WindowId
windowId tree :: Tree LayoutView PaneView
tree@(Tree (Ui.View Ident
layoutIdent ViewState
_ ViewGeometry
_ Layout
_) [ViewTreeSub]
_) = do
  (Codec.Pane PaneId
paneId Int
_ Int
_) <- WindowId -> m Pane
forall (m :: * -> *). MonadFree TmuxThunk m => WindowId -> m Pane
Cmd.firstWindowPane WindowId
windowId
  Maybe (View PaneId)
existing <- (Views -> Maybe (View PaneId)) -> m (Maybe (View PaneId))
forall s' s (m :: * -> *) a.
MonadDeepState s s' m =>
(s' -> a) -> m a
gets (PaneId -> Views -> Maybe (View PaneId)
Views.paneById PaneId
paneId)
  case Maybe (View PaneId)
existing of
    Maybe (View PaneId)
Nothing -> do
      (PaneView
_, Tmux.View Ident
paneIdent Maybe PaneId
_) <- Tree LayoutView PaneView -> m (PaneView, View PaneId)
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadError RenderError m) =>
Tree LayoutView PaneView -> m (PaneView, View PaneId)
principalPane Tree LayoutView PaneView
tree
      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
$ Doc AnsiStyle
"setting principal of layout" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Ident
layoutIdent Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
" to pane " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Ident
paneIdent Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"/" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
        PaneId -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty PaneId
paneId
      (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 PaneId -> Views -> Views
Views.updatePane (Ident -> Maybe PaneId -> View PaneId
forall a. Ident -> Maybe a -> View a
Tmux.View Ident
paneIdent (PaneId -> Maybe PaneId
forall a. a -> Maybe a
Just PaneId
paneId))
    Maybe (View PaneId)
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

ensureWindow ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m, MonadError RenderError m) =>
  SessionId ->
  Tmux.View WindowId ->
  Maybe WindowId ->
  ViewTree ->
  m Codec.Window
ensureWindow :: SessionId
-> View WindowId
-> Maybe WindowId
-> Tree LayoutView PaneView
-> m Window
ensureWindow SessionId
sid (Tmux.View Ident
ident Maybe WindowId
mayWid) Maybe WindowId
newSessionWid Tree LayoutView PaneView
tree = do
  Maybe Window
preexisting <- Maybe (Maybe Window) -> Maybe Window
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Window) -> Maybe Window)
-> m (Maybe (Maybe Window)) -> m (Maybe Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WindowId -> m (Maybe Window))
-> Maybe WindowId -> m (Maybe (Maybe Window))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse WindowId -> m (Maybe Window)
forall (m :: * -> *).
MonadFree TmuxThunk m =>
WindowId -> m (Maybe Window)
Cmd.window (Maybe WindowId -> Maybe WindowId -> Maybe WindowId
forall a. Maybe a -> Maybe a -> Maybe a
orElse Maybe WindowId
newSessionWid Maybe WindowId
mayWid)
  Window
window <- m Window -> (Window -> m Window) -> Maybe Window -> m Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SessionId -> Ident -> m Window
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
SessionId -> Ident -> m Window
spawnWindow SessionId
sid Ident
ident) Window -> m Window
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Window
preexisting
  WindowId -> Tree LayoutView PaneView -> m ()
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m,
 MonadError RenderError m) =>
WindowId -> Tree LayoutView PaneView -> m ()
syncPrincipal (Window -> WindowId
Codec.windowId Window
window) Tree LayoutView PaneView
tree
  return Window
window

findOrCreatePane :: MonadDeepState s Views m => Ident -> m (Tmux.View PaneId)
findOrCreatePane :: Ident -> m (View PaneId)
findOrCreatePane =
  (Ident -> Views -> Either ViewsError (View PaneId))
-> (View PaneId -> Views -> Views) -> Ident -> m (View PaneId)
forall s (m :: * -> *) a.
MonadDeepState s Views m =>
Getter a -> Setter a -> Ident -> m (View a)
findOrCreateView Ident -> Views -> Either ViewsError (View PaneId)
Views.pane View PaneId -> Views -> Views
Views.insertPane

nativePane ::
  MonadFree TmuxThunk m =>
  WindowId ->
  Tmux.View PaneId ->
  m (Maybe Codec.PaneDetail)
nativePane :: WindowId -> View PaneId -> m (Maybe PaneDetail)
nativePane WindowId
windowId (Tmux.View Ident
_ (Just PaneId
paneId)) =
  (PaneDetail -> Bool) -> [PaneDetail] -> Maybe PaneDetail
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find PaneDetail -> Bool
sameId ([PaneDetail] -> Maybe PaneDetail)
-> m [PaneDetail] -> m (Maybe PaneDetail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowId -> m [PaneDetail]
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a) =>
WindowId -> m [a]
Cmd.windowPanesAs WindowId
windowId
  where
    sameId :: PaneDetail -> Bool
sameId (Codec.PaneDetail PaneId
i Int
_ Int
_ Int
_ Int
_) = PaneId
i PaneId -> PaneId -> Bool
forall a. Eq a => a -> a -> Bool
== PaneId
paneId
nativePane WindowId
_ View PaneId
_ = Maybe PaneDetail -> m (Maybe PaneDetail)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PaneDetail
forall a. Maybe a
Nothing

openPane ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>
  FilePath ->
  WindowId ->
  m Codec.PaneDetail
openPane :: FilePath -> WindowId -> m PaneDetail
openPane FilePath
dir WindowId
windowId = do
  PaneDetail
detail <- FilePath -> WindowId -> m PaneDetail
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a) =>
FilePath -> WindowId -> m a
Cmd.splitWindowAs FilePath
dir WindowId
windowId
  Text -> m ()
forall s (m :: * -> *). MonadDeepState s Views m => Text -> m ()
viewsLogS (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"opened pane " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PaneId -> Text
forall b a. (Show a, IsString b) => a -> b
show (PaneDetail -> PaneId
PaneDetail.paneId PaneDetail
detail) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in window " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WindowId -> Text
forall b a. (Show a, IsString b) => a -> b
show WindowId
windowId
  return PaneDetail
detail

ensurePaneOpen ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>
  FilePath ->
  Maybe Codec.PaneDetail ->
  WindowId ->
  m Codec.PaneDetail
ensurePaneOpen :: FilePath -> Maybe PaneDetail -> WindowId -> m PaneDetail
ensurePaneOpen FilePath
_ (Just PaneDetail
detail) WindowId
_ =
  PaneDetail -> m PaneDetail
forall (m :: * -> *) a. Monad m => a -> m a
return PaneDetail
detail
ensurePaneOpen FilePath
dir Maybe PaneDetail
Nothing WindowId
windowId =
  FilePath -> WindowId -> m PaneDetail
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
FilePath -> WindowId -> m PaneDetail
openPane FilePath
dir WindowId
windowId

ensurePaneClosed ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>
  Maybe Codec.PaneDetail ->
  m ()
ensurePaneClosed :: Maybe PaneDetail -> m ()
ensurePaneClosed (Just (Codec.PaneDetail PaneId
i Int
_ Int
_ Int
_ Int
_)) = do
  Text -> m ()
forall s (m :: * -> *). MonadDeepState s Views m => Text -> m ()
viewsLogS (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"closing pane " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PaneId -> Text
forall b a. (Show a, IsString b) => a -> b
show PaneId
i
  PaneId -> m ()
forall (m :: * -> *). MonadFree TmuxThunk m => PaneId -> m ()
Cmd.closePane PaneId
i
ensurePaneClosed Maybe PaneDetail
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

ensurePane ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>
  FilePath ->
  WindowId ->
  Ui.PaneView ->
  m (Maybe RenderableNode)
ensurePane :: FilePath -> WindowId -> PaneView -> m (Maybe RenderableNode)
ensurePane FilePath
cwd WindowId
windowId (Ui.View Ident
paneIdent ViewState
vState ViewGeometry
geometry (Ui.Pane Bool
open Bool
_ Maybe FilePath
customDir)) = do
  View PaneId
tmuxPane <- Ident -> m (View PaneId)
forall s (m :: * -> *).
MonadDeepState s Views m =>
Ident -> m (View PaneId)
findOrCreatePane Ident
paneIdent
  Maybe PaneDetail
existingPane <- WindowId -> View PaneId -> m (Maybe PaneDetail)
forall (m :: * -> *).
MonadFree TmuxThunk m =>
WindowId -> View PaneId -> m (Maybe PaneDetail)
nativePane WindowId
windowId View PaneId
tmuxPane
  Maybe PaneDetail
updatedPane <-
    if Bool
open then PaneDetail -> Maybe PaneDetail
forall a. a -> Maybe a
Just (PaneDetail -> Maybe PaneDetail)
-> m PaneDetail -> m (Maybe PaneDetail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Maybe PaneDetail -> WindowId -> m PaneDetail
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
FilePath -> Maybe PaneDetail -> WindowId -> m PaneDetail
ensurePaneOpen FilePath
dir Maybe PaneDetail
existingPane WindowId
windowId
    else Maybe PaneDetail
forall a. Maybe a
Nothing Maybe PaneDetail -> m () -> m (Maybe PaneDetail)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe PaneDetail -> m ()
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
Maybe PaneDetail -> m ()
ensurePaneClosed Maybe PaneDetail
existingPane
  (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 PaneId -> Views -> Views
Views.updatePane (Ident -> Maybe PaneId -> View PaneId
forall a. Ident -> Maybe a -> View a
Tmux.View Ident
paneIdent (PaneDetail -> PaneId
PaneDetail.paneId (PaneDetail -> PaneId) -> Maybe PaneDetail -> Maybe PaneId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PaneDetail
updatedPane))
  return $ PaneDetail -> RenderableNode
cons (PaneDetail -> RenderableNode)
-> Maybe PaneDetail -> Maybe RenderableNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PaneDetail
updatedPane
  where
    dir :: FilePath
dir = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
cwd Maybe FilePath
customDir
    cons :: PaneDetail -> RenderableNode
cons (Codec.PaneDetail PaneId
i Int
_ Int
_ Int
top Int
left) =
      Renderable RPane -> RenderableNode
forall (f :: * -> *) l p. p -> Node f l p
Tree.Leaf (Renderable RPane -> RenderableNode)
-> (RPane -> Renderable RPane) -> RPane -> RenderableNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewState -> ViewGeometry -> RPane -> Renderable RPane
forall a. ViewState -> ViewGeometry -> a -> Renderable a
Renderable ViewState
vState ViewGeometry
geometry (RPane -> RenderableNode) -> RPane -> RenderableNode
forall a b. (a -> b) -> a -> b
$ PaneId -> Int -> Int -> RPane
RPane PaneId
i Int
top Int
left

refPane :: RenderableNode -> RPane
refPane :: RenderableNode -> RPane
refPane (Tree.Sub (Tree.Tree (Renderable ViewState
_ ViewGeometry
_ (RLayout RPane
ref Bool
_)) NonEmpty RenderableNode
_)) = RPane
ref
refPane (Tree.Leaf (Renderable ViewState
_ ViewGeometry
_ RPane
pane)) = RPane
pane

renderableTree ::
  ViewState ->
  ViewGeometry ->
  Bool ->
  [RenderableNode] ->
  Maybe RenderableTree
renderableTree :: ViewState
-> ViewGeometry
-> Bool
-> [RenderableNode]
-> Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
renderableTree ViewState
vState ViewGeometry
geometry Bool
vertical [RenderableNode]
sub = do
  NonEmpty RenderableNode
sub' <- [RenderableNode] -> Maybe (NonEmpty RenderableNode)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [RenderableNode]
sub
  return $ RenderableLayout
-> NonEmpty RenderableNode
-> Tree NonEmpty RenderableLayout (Renderable RPane)
forall (f :: * -> *) l p. l -> f (Node f l p) -> Tree f l p
Tree.Tree (ViewState -> ViewGeometry -> RLayout -> RenderableLayout
forall a. ViewState -> ViewGeometry -> a -> Renderable a
Renderable ViewState
vState ViewGeometry
geometry (RPane -> Bool -> RLayout
RLayout (RenderableNode -> RPane
refPane (RenderableNode -> RPane) -> RenderableNode -> RPane
forall a b. (a -> b) -> a -> b
$ NonEmpty RenderableNode -> RenderableNode
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty RenderableNode
sub') Bool
vertical)) NonEmpty RenderableNode
sub'

viewPosition :: ViewTreeSub -> Float
viewPosition :: ViewTreeSub -> Float
viewPosition (TreeNode (Tree (Ui.View Ident
_ ViewState
_ ViewGeometry { $sel:position:ViewGeometry :: ViewGeometry -> Maybe Float
position = Maybe Float
pos } Layout
_) [ViewTreeSub]
_)) =
  Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
0.5 Maybe Float
pos
viewPosition (TreeLeaf (Ui.View Ident
_ ViewState
_ ViewGeometry { $sel:position:ViewGeometry :: ViewGeometry -> Maybe Float
position = Maybe Float
pos } Pane
_)) =
  Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
0.5 Maybe Float
pos

ensureView ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>
  FilePath ->
  WindowId ->
  ViewTree ->
  m (Maybe RenderableTree)
ensureView :: FilePath
-> WindowId
-> Tree LayoutView PaneView
-> m (Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
ensureView FilePath
cwd WindowId
windowId =
  Tree LayoutView PaneView
-> m (Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
ensureTree
  where
    ensureTree :: Tree LayoutView PaneView
-> m (Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
ensureTree (Tree (Ui.View Ident
layoutIdent ViewState
vState ViewGeometry
geometry (Ui.Layout Bool
vertical)) [ViewTreeSub]
sub) = do
      [Maybe RenderableNode]
ensuredSub <- (ViewTreeSub -> m (Maybe RenderableNode))
-> [ViewTreeSub] -> m [Maybe RenderableNode]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ViewTreeSub -> m (Maybe RenderableNode)
ensureNode [ViewTreeSub]
sortedSub
      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
"new sub for layout `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
layoutIdent 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
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep (Maybe RenderableNode -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Maybe RenderableNode -> Doc AnsiStyle)
-> [Maybe RenderableNode] -> [Doc AnsiStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe RenderableNode]
ensuredSub)
      return $ ViewState
-> ViewGeometry
-> Bool
-> [RenderableNode]
-> Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
renderableTree ViewState
vState ViewGeometry
geometry Bool
vertical ([RenderableNode]
 -> Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
-> [RenderableNode]
-> Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
forall a b. (a -> b) -> a -> b
$ [Maybe RenderableNode] -> [RenderableNode]
forall a. [Maybe a] -> [a]
catMaybes [Maybe RenderableNode]
ensuredSub
      where
        sortedSub :: [ViewTreeSub]
sortedSub = (ViewTreeSub -> Float) -> [ViewTreeSub] -> [ViewTreeSub]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ViewTreeSub -> Float
viewPosition [ViewTreeSub]
sub
    ensureNode :: ViewTreeSub -> m (Maybe RenderableNode)
ensureNode (TreeNode Tree LayoutView PaneView
t) = do
      Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
newTree <- Tree LayoutView PaneView
-> m (Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
ensureTree Tree LayoutView PaneView
t
      return $ Tree NonEmpty RenderableLayout (Renderable RPane) -> RenderableNode
forall (f :: * -> *) l p. Tree f l p -> Node f l p
Tree.Sub (Tree NonEmpty RenderableLayout (Renderable RPane)
 -> RenderableNode)
-> Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
-> Maybe RenderableNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
newTree
    ensureNode (TreeLeaf PaneView
v) =
      FilePath -> WindowId -> PaneView -> m (Maybe RenderableNode)
forall s (m :: * -> *).
(MonadDeepState s Views m, MonadFree TmuxThunk m) =>
FilePath -> WindowId -> PaneView -> m (Maybe RenderableNode)
ensurePane FilePath
cwd WindowId
windowId PaneView
v

windowState ::
  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>
  Ident ->
  Codec.Window ->
  RenderableTree ->
  m WindowState
windowState :: Ident
-> Window
-> Tree NonEmpty RenderableLayout (Renderable RPane)
-> m WindowState
windowState Ident
windowIdent Window
window Tree NonEmpty RenderableLayout (Renderable RPane)
tree = do
  Pane
nativeRef <- WindowId -> m Pane
forall (m :: * -> *). MonadFree TmuxThunk m => WindowId -> m Pane
Cmd.firstWindowPane (Window -> WindowId
Codec.windowId Window
window)
  return $ Window
-> Pane
-> Ident
-> Tree NonEmpty RenderableLayout (Renderable RPane)
-> PaneId
-> WindowState
WindowState Window
window Pane
nativeRef Ident
windowIdent Tree NonEmpty RenderableLayout (Renderable RPane)
tree (Pane -> PaneId
Codec.paneId Pane
nativeRef)