module Chiasma.Window where

import qualified Data.List.NonEmpty as NonEmpty (head, nonEmpty)
import Path (Abs, Dir, Path, parseAbsDir)
import Prettyprinter (line, pretty, vsep, (<+>))

import qualified Chiasma.Codec.Data.Pane as Pane
import qualified Chiasma.Codec.Data.Pane as Codec (Pane (Pane, paneId))
import Chiasma.Codec.Data.Pane (Pane (Pane))
import qualified Chiasma.Codec.Data.Window as Codec (Window (Window, windowId))
import qualified Chiasma.Command.Pane as Cmd (closePane, firstWindowPane, windowPanes)
import qualified Chiasma.Command.Window as Cmd (newWindow, splitWindowInDir, window)
import Chiasma.Data.Axis (Axis)
import Chiasma.Data.Ident (Ident, identText, identify)
import Chiasma.Data.Panes (TmuxPanes)
import Chiasma.Data.RenderError (RenderError)
import qualified Chiasma.Data.RenderError as RenderError (RenderError (NoPrincipal))
import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)
import qualified Chiasma.Data.View as Tmux (View (View))
import Chiasma.Data.Views (Views)
import Chiasma.Data.WindowState (WindowState (..))
import Chiasma.Effect.TmuxApi (Tmux)
import Chiasma.Pane (addPane)
import Chiasma.Ui.Data.RenderableTree (
  RLayout (..),
  RPane (..),
  Renderable (..),
  RenderableNode,
  RenderableTree,
  )
import qualified Chiasma.Ui.Data.Tree as Tree (Node (Leaf, Sub), 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)

findOrCreateWindow ::
  Member (AtomicState Views) r =>
  Ident ->
  Sem r (Tmux.View WindowId)
findOrCreateWindow :: forall (r :: EffectRow).
Member (AtomicState Views) r =>
Ident -> Sem r (View WindowId)
findOrCreateWindow =
  Getter WindowId
-> Setter WindowId -> Ident -> Sem r (View WindowId)
forall (r :: EffectRow) a.
Member (AtomicState Views) r =>
Getter a -> Setter a -> Ident -> Sem r (View a)
findOrCreateView Getter WindowId
Views.window Setter WindowId
Views.insertWindow

registerWindowId ::
  Member (AtomicState Views) r =>
  Ident ->
  WindowId ->
  Sem r ()
registerWindowId :: forall (r :: EffectRow).
Member (AtomicState Views) r =>
Ident -> WindowId -> Sem r ()
registerWindowId Ident
ident WindowId
windowId =
  (Views -> Views) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (Setter WindowId
Views.updateWindow (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 ::
  Members [AtomicState Views, Tmux] r =>
  SessionId ->
  Ident ->
  Sem r Codec.Window
spawnWindow :: forall (r :: EffectRow).
Members '[AtomicState Views, Tmux] r =>
SessionId -> Ident -> Sem r Window
spawnWindow SessionId
sid Ident
ident = do
  win :: Window
win@(Codec.Window WindowId
windowId Int
_ Int
_) <- SessionId -> Ident -> Sem r Window
forall (r :: EffectRow).
Member Tmux r =>
SessionId -> Ident -> Sem r Window
Cmd.newWindow SessionId
sid Ident
ident
  Ident -> WindowId -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Ident -> WindowId -> Sem r ()
registerWindowId Ident
ident WindowId
windowId
  Text -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Text -> Sem r ()
viewsLogS (Text -> Sem r ()) -> Text -> Sem r ()
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
  pure 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 Text
_))) = 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
firstJust ViewTreeSub -> Maybe PaneView
findPrincipalSub [ViewTreeSub]
sub

principalPane ::
  Members [AtomicState Views, Tmux, Stop RenderError] r =>
  ViewTree ->
  Sem r (Ui.PaneView, Tmux.View PaneId)
principalPane :: forall (r :: EffectRow).
Members '[AtomicState Views, Tmux, Stop RenderError] r =>
Tree LayoutView PaneView -> Sem r (PaneView, View PaneId)
principalPane Tree LayoutView PaneView
tree = do
  uiPane :: PaneView
uiPane@(Ui.View Ident
uiPaneIdent ViewState
_ ViewGeometry
_ Pane
_) <- RenderError -> Maybe PaneView -> Sem r PaneView
forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (Ident -> RenderError
RenderError.NoPrincipal (Tree LayoutView PaneView -> Ident
forall a. Identifiable a => a -> Ident
identify Tree LayoutView PaneView
tree)) (Maybe PaneView -> Sem r PaneView)
-> Maybe PaneView -> Sem r 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))
-> Sem r (Either ViewsError (View PaneId))
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets (Ident -> Views -> Either ViewsError (View PaneId)
Views.pane Ident
uiPaneIdent)
  View PaneId
tmuxPane <- (ViewsError -> Sem r (View PaneId))
-> (View PaneId -> Sem r (View PaneId))
-> Either ViewsError (View PaneId)
-> Sem r (View PaneId)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Sem r (View PaneId) -> ViewsError -> Sem r (View PaneId)
forall a b. a -> b -> a
const (Sem r (View PaneId) -> ViewsError -> Sem r (View PaneId))
-> Sem r (View PaneId) -> ViewsError -> Sem r (View PaneId)
forall a b. (a -> b) -> a -> b
$ Ident -> Sem r (View PaneId)
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Ident -> Sem r (View PaneId)
addPane Ident
uiPaneIdent) View PaneId -> Sem r (View PaneId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ViewsError (View PaneId)
existingTmuxPane
  pure (PaneView
uiPane, View PaneId
tmuxPane)

syncPrincipal ::
  Members [TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r =>
  WindowId ->
  ViewTree ->
  Sem r ()
syncPrincipal :: forall (r :: EffectRow).
Members
  '[TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r =>
WindowId -> Tree LayoutView PaneView -> Sem r ()
syncPrincipal WindowId
windowId tree :: Tree LayoutView PaneView
tree@(Tree (Ui.View Ident
layoutIdent ViewState
_ ViewGeometry
_ Layout
_) [ViewTreeSub]
_) = do
  (Codec.Pane PaneId
paneId Int
_ Int
_ Int
_ Int
_) <- WindowId -> Sem r Pane
forall a (r :: EffectRow).
Member (TmuxPanes a) r =>
WindowId -> Sem r a
Cmd.firstWindowPane WindowId
windowId
  Maybe (View PaneId)
existing <- (Views -> Maybe (View PaneId)) -> Sem r (Maybe (View PaneId))
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets (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 -> Sem r (PaneView, View PaneId)
forall (r :: EffectRow).
Members '[AtomicState Views, Tmux, Stop RenderError] r =>
Tree LayoutView PaneView -> Sem r (PaneView, View PaneId)
principalPane Tree LayoutView PaneView
tree
      Doc AnsiStyle -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Doc AnsiStyle -> Sem r ()
viewsLog (Doc AnsiStyle -> Sem r ()) -> Doc AnsiStyle -> Sem r ()
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) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' ((Views -> Views) -> Sem r ()) -> (Views -> Views) -> Sem r ()
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)
_ -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

ensureWindow ::
  Members [TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r =>
  SessionId ->
  Tmux.View WindowId ->
  Maybe WindowId ->
  ViewTree ->
  Sem r Codec.Window
ensureWindow :: forall (r :: EffectRow).
Members
  '[TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r =>
SessionId
-> View WindowId
-> Maybe WindowId
-> Tree LayoutView PaneView
-> Sem r 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)
-> Sem r (Maybe (Maybe Window)) -> Sem r (Maybe Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WindowId -> Sem r (Maybe Window))
-> Maybe WindowId -> Sem r (Maybe (Maybe Window))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse WindowId -> Sem r (Maybe Window)
forall (r :: EffectRow).
Member Tmux r =>
WindowId -> Sem r (Maybe Window)
Cmd.window (Maybe WindowId
newSessionWid Maybe WindowId -> Maybe WindowId -> Maybe WindowId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe WindowId
mayWid)
  Window
window <- Sem r Window
-> (Window -> Sem r Window) -> Maybe Window -> Sem r Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SessionId -> Ident -> Sem r Window
forall (r :: EffectRow).
Members '[AtomicState Views, Tmux] r =>
SessionId -> Ident -> Sem r Window
spawnWindow SessionId
sid Ident
ident) Window -> Sem r Window
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Window
preexisting
  WindowId -> Tree LayoutView PaneView -> Sem r ()
forall (r :: EffectRow).
Members
  '[TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r =>
WindowId -> Tree LayoutView PaneView -> Sem r ()
syncPrincipal (Window -> WindowId
Codec.windowId Window
window) Tree LayoutView PaneView
tree
  pure Window
window

findOrCreatePane ::
  Member (AtomicState Views) r =>
  Ident ->
  Sem r (Tmux.View PaneId)
findOrCreatePane :: forall (r :: EffectRow).
Member (AtomicState Views) r =>
Ident -> Sem r (View PaneId)
findOrCreatePane =
  (Ident -> Views -> Either ViewsError (View PaneId))
-> (View PaneId -> Views -> Views) -> Ident -> Sem r (View PaneId)
forall (r :: EffectRow) a.
Member (AtomicState Views) r =>
Getter a -> Setter a -> Ident -> Sem r (View a)
findOrCreateView Ident -> Views -> Either ViewsError (View PaneId)
Views.pane View PaneId -> Views -> Views
Views.insertPane

nativePane ::
  Member (TmuxPanes Pane) r =>
  WindowId ->
  Tmux.View PaneId ->
  Sem r (Maybe Pane)
nativePane :: forall (r :: EffectRow).
Member (TmuxPanes Pane) r =>
WindowId -> View PaneId -> Sem r (Maybe Pane)
nativePane WindowId
windowId (Tmux.View Ident
_ (Just PaneId
paneId)) =
  (Pane -> Bool) -> [Pane] -> Maybe Pane
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Pane -> Bool
sameId ([Pane] -> Maybe Pane) -> Sem r [Pane] -> Sem r (Maybe Pane)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowId -> Sem r [Pane]
forall a (r :: EffectRow).
Member (TmuxPanes a) r =>
WindowId -> Sem r [a]
Cmd.windowPanes WindowId
windowId
  where
    sameId :: Pane -> Bool
sameId (Pane 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 Pane -> Sem r (Maybe Pane)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Pane
forall a. Maybe a
Nothing

openPane ::
  Members [AtomicState Views, Tmux] r =>
  Path Abs Dir ->
  WindowId ->
  Sem r Pane
openPane :: forall (r :: EffectRow).
Members '[AtomicState Views, Tmux] r =>
Path Abs Dir -> WindowId -> Sem r Pane
openPane Path Abs Dir
dir WindowId
windowId = do
  Pane
detail <- Path Abs Dir -> WindowId -> Sem r Pane
forall (r :: EffectRow).
Member Tmux r =>
Path Abs Dir -> WindowId -> Sem r Pane
Cmd.splitWindowInDir Path Abs Dir
dir WindowId
windowId
  Text -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Text -> Sem r ()
viewsLogS (Text -> Sem r ()) -> Text -> Sem r ()
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 (Pane -> PaneId
Pane.paneId Pane
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
  pure Pane
detail

ensurePaneOpen ::
  Members [AtomicState Views, Tmux] r =>
  Path Abs Dir ->
  Maybe Pane ->
  WindowId ->
  Sem r Pane
ensurePaneOpen :: forall (r :: EffectRow).
Members '[AtomicState Views, Tmux] r =>
Path Abs Dir -> Maybe Pane -> WindowId -> Sem r Pane
ensurePaneOpen Path Abs Dir
_ (Just Pane
detail) WindowId
_ =
  Pane -> Sem r Pane
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pane
detail
ensurePaneOpen Path Abs Dir
dir Maybe Pane
Nothing WindowId
windowId =
  Path Abs Dir -> WindowId -> Sem r Pane
forall (r :: EffectRow).
Members '[AtomicState Views, Tmux] r =>
Path Abs Dir -> WindowId -> Sem r Pane
openPane Path Abs Dir
dir WindowId
windowId

ensurePaneClosed ::
  Members [AtomicState Views, Tmux] r =>
  Maybe Pane ->
  Sem r ()
ensurePaneClosed :: forall (r :: EffectRow).
Members '[AtomicState Views, Tmux] r =>
Maybe Pane -> Sem r ()
ensurePaneClosed (Just (Pane PaneId
i Int
_ Int
_ Int
_ Int
_)) = do
  Text -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Text -> Sem r ()
viewsLogS (Text -> Sem r ()) -> Text -> Sem r ()
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 -> Sem r ()
forall (r :: EffectRow). Member Tmux r => PaneId -> Sem r ()
Cmd.closePane PaneId
i
ensurePaneClosed Maybe Pane
_ = () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

ensurePane ::
  Members [TmuxPanes Pane, AtomicState Views, Tmux] r =>
  Path Abs Dir ->
  WindowId ->
  Ui.PaneView ->
  Sem r (Maybe RenderableNode)
ensurePane :: forall (r :: EffectRow).
Members '[TmuxPanes Pane, AtomicState Views, Tmux] r =>
Path Abs Dir
-> WindowId -> PaneView -> Sem r (Maybe RenderableNode)
ensurePane Path Abs Dir
cwd WindowId
windowId (Ui.View Ident
paneIdent ViewState
vState ViewGeometry
geometry (Ui.Pane Bool
open Bool
_ Maybe Text
customDir)) = do
  View PaneId
tmuxPane <- Ident -> Sem r (View PaneId)
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Ident -> Sem r (View PaneId)
findOrCreatePane Ident
paneIdent
  Maybe Pane
existingPane <- WindowId -> View PaneId -> Sem r (Maybe Pane)
forall (r :: EffectRow).
Member (TmuxPanes Pane) r =>
WindowId -> View PaneId -> Sem r (Maybe Pane)
nativePane WindowId
windowId View PaneId
tmuxPane
  Maybe Pane
updatedPane <-
    if Bool
open then Pane -> Maybe Pane
forall a. a -> Maybe a
Just (Pane -> Maybe Pane) -> Sem r Pane -> Sem r (Maybe Pane)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> Maybe Pane -> WindowId -> Sem r Pane
forall (r :: EffectRow).
Members '[AtomicState Views, Tmux] r =>
Path Abs Dir -> Maybe Pane -> WindowId -> Sem r Pane
ensurePaneOpen Path Abs Dir
dir Maybe Pane
existingPane WindowId
windowId
    else Maybe Pane
forall a. Maybe a
Nothing Maybe Pane -> Sem r () -> Sem r (Maybe Pane)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe Pane -> Sem r ()
forall (r :: EffectRow).
Members '[AtomicState Views, Tmux] r =>
Maybe Pane -> Sem r ()
ensurePaneClosed Maybe Pane
existingPane
  (Views -> Views) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' ((Views -> Views) -> Sem r ()) -> (Views -> Views) -> Sem r ()
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 (Pane -> PaneId
Pane.paneId (Pane -> PaneId) -> Maybe Pane -> Maybe PaneId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Pane
updatedPane))
  pure $ Pane -> RenderableNode
cons (Pane -> RenderableNode) -> Maybe Pane -> Maybe RenderableNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Pane
updatedPane
  where
    dir :: Path Abs Dir
dir = Path Abs Dir -> Maybe (Path Abs Dir) -> Path Abs Dir
forall a. a -> Maybe a -> a
fromMaybe Path Abs Dir
cwd (FilePath -> Maybe (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir (FilePath -> Maybe (Path Abs Dir))
-> (Text -> FilePath) -> Text -> Maybe (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> Maybe (Path Abs Dir))
-> Maybe Text -> Maybe (Path Abs Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
customDir)
    cons :: Pane -> RenderableNode
cons (Pane 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 Axis
_)) NonEmpty RenderableNode
_)) = RPane
ref
refPane (Tree.Leaf (Renderable ViewState
_ ViewGeometry
_ RPane
pane)) = RPane
pane

renderableTree ::
  ViewState ->
  ViewGeometry ->
  Axis ->
  [RenderableNode] ->
  Maybe RenderableTree
renderableTree :: ViewState
-> ViewGeometry
-> Axis
-> [RenderableNode]
-> Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
renderableTree ViewState
vState ViewGeometry
geometry Axis
axis [RenderableNode]
sub = do
  NonEmpty RenderableNode
sub' <- [RenderableNode] -> Maybe (NonEmpty RenderableNode)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [RenderableNode]
sub
  pure $ 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 -> Axis -> 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') Axis
axis)) 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 ::
  Members [TmuxPanes Pane, AtomicState Views, Tmux] r =>
  Path Abs Dir ->
  WindowId ->
  ViewTree ->
  Sem r (Maybe RenderableTree)
ensureView :: forall (r :: EffectRow).
Members '[TmuxPanes Pane, AtomicState Views, Tmux] r =>
Path Abs Dir
-> WindowId
-> Tree LayoutView PaneView
-> Sem
     r (Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
ensureView Path Abs Dir
cwd WindowId
windowId =
  Tree LayoutView PaneView
-> Sem
     r (Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
ensureTree
  where
    ensureTree :: Tree LayoutView PaneView
-> Sem
     r (Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
ensureTree (Tree (Ui.View Ident
layoutIdent ViewState
vState ViewGeometry
geometry (Ui.Layout Axis
axis)) [ViewTreeSub]
sub) = do
      [Maybe RenderableNode]
ensuredSub <- (ViewTreeSub -> Sem r (Maybe RenderableNode))
-> [ViewTreeSub] -> Sem r [Maybe RenderableNode]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ViewTreeSub -> Sem r (Maybe RenderableNode)
ensureNode [ViewTreeSub]
sortedSub
      Doc AnsiStyle -> Sem r ()
forall (r :: EffectRow).
Member (AtomicState Views) r =>
Doc AnsiStyle -> Sem r ()
viewsLog (Doc AnsiStyle -> Sem r ()) -> Doc AnsiStyle -> Sem r ()
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)
      pure $ ViewState
-> ViewGeometry
-> Axis
-> [RenderableNode]
-> Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
renderableTree ViewState
vState ViewGeometry
geometry Axis
axis ([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 -> Sem r (Maybe RenderableNode)
ensureNode (TreeNode Tree LayoutView PaneView
t) = do
      Maybe (Tree NonEmpty RenderableLayout (Renderable RPane))
newTree <- Tree LayoutView PaneView
-> Sem
     r (Maybe (Tree NonEmpty RenderableLayout (Renderable RPane)))
ensureTree Tree LayoutView PaneView
t
      pure $ 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) =
      Path Abs Dir
-> WindowId -> PaneView -> Sem r (Maybe RenderableNode)
forall (r :: EffectRow).
Members '[TmuxPanes Pane, AtomicState Views, Tmux] r =>
Path Abs Dir
-> WindowId -> PaneView -> Sem r (Maybe RenderableNode)
ensurePane Path Abs Dir
cwd WindowId
windowId PaneView
v

windowState ::
  Member (TmuxPanes Pane) r =>
  Ident ->
  Codec.Window ->
  RenderableTree ->
  Sem r WindowState
windowState :: forall (r :: EffectRow).
Member (TmuxPanes Pane) r =>
Ident
-> Window
-> Tree NonEmpty RenderableLayout (Renderable RPane)
-> Sem r WindowState
windowState Ident
windowIdent Window
window Tree NonEmpty RenderableLayout (Renderable RPane)
tree = do
  Pane
nativeRef <- WindowId -> Sem r Pane
forall a (r :: EffectRow).
Member (TmuxPanes a) r =>
WindowId -> Sem r a
Cmd.firstWindowPane (Window -> WindowId
Codec.windowId Window
window)
  pure $ 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)