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)) 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 = findOrCreateView Views.window Views.insertWindow registerWindowId :: Member (AtomicState Views) r => Ident -> WindowId -> Sem r () registerWindowId ident windowId = atomicModify' (Views.updateWindow (Tmux.View ident (Just windowId))) spawnWindow :: Members [AtomicState Views, Tmux] r => SessionId -> Ident -> Sem r Codec.Window spawnWindow sid ident = do win@(Codec.Window windowId _ _) <- Cmd.newWindow sid ident registerWindowId ident windowId viewsLogS $ "spawned window in session " <> show sid <> " with id " <> show windowId pure win findPrincipalSub :: ViewTreeSub -> Maybe Ui.PaneView findPrincipalSub (TreeNode t) = findPrincipal t findPrincipalSub (TreeLeaf p@(Ui.View _ _ _ (Ui.Pane True _ _))) = Just p findPrincipalSub _ = Nothing findPrincipal :: ViewTree -> Maybe Ui.PaneView findPrincipal (Tree _ sub) = firstJust findPrincipalSub sub principalPane :: Members [AtomicState Views, Tmux, Stop RenderError] r => ViewTree -> Sem r (Ui.PaneView, Tmux.View PaneId) principalPane tree = do uiPane@(Ui.View uiPaneIdent _ _ _) <- stopNote (RenderError.NoPrincipal (identify tree)) $ (findPrincipal tree) existingTmuxPane <- atomicGets (Views.pane uiPaneIdent) tmuxPane <- either (const $ addPane uiPaneIdent) pure existingTmuxPane pure (uiPane, tmuxPane) syncPrincipal :: Members [TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r => WindowId -> ViewTree -> Sem r () syncPrincipal windowId tree@(Tree (Ui.View layoutIdent _ _ _) _) = do (Codec.Pane paneId _ _ _ _) <- Cmd.firstWindowPane windowId existing <- atomicGets (Views.paneById paneId) case existing of Nothing -> do (_, Tmux.View paneIdent _) <- principalPane tree viewsLog $ "setting principal of layout" <+> pretty layoutIdent <+> " to pane " <+> pretty paneIdent <+> "/" <+> pretty paneId atomicModify' $ Views.updatePane (Tmux.View paneIdent (Just paneId)) _ -> pure () ensureWindow :: Members [TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r => SessionId -> Tmux.View WindowId -> Maybe WindowId -> ViewTree -> Sem r Codec.Window ensureWindow sid (Tmux.View ident mayWid) newSessionWid tree = do preexisting <- join <$> traverse Cmd.window (newSessionWid <|> mayWid) window <- maybe (spawnWindow sid ident) pure preexisting syncPrincipal ((.windowId) window) tree pure window findOrCreatePane :: Member (AtomicState Views) r => Ident -> Sem r (Tmux.View PaneId) findOrCreatePane = findOrCreateView Views.pane Views.insertPane nativePane :: Member (TmuxPanes Pane) r => WindowId -> Tmux.View PaneId -> Sem r (Maybe Pane) nativePane windowId (Tmux.View _ (Just paneId)) = find sameId <$> Cmd.windowPanes windowId where sameId (Pane i _ _ _ _) = i == paneId nativePane _ _ = pure Nothing openPane :: Members [AtomicState Views, Tmux] r => Path Abs Dir -> WindowId -> Sem r Pane openPane dir windowId = do detail <- Cmd.splitWindowInDir dir windowId viewsLogS $ "opened pane " <> show ((.paneId) detail) <> " in window " <> show windowId pure detail ensurePaneOpen :: Members [AtomicState Views, Tmux] r => Path Abs Dir -> Maybe Pane -> WindowId -> Sem r Pane ensurePaneOpen _ (Just detail) _ = pure detail ensurePaneOpen dir Nothing windowId = openPane dir windowId ensurePaneClosed :: Members [AtomicState Views, Tmux] r => Maybe Pane -> Sem r () ensurePaneClosed (Just (Pane i _ _ _ _)) = do viewsLogS $ "closing pane " <> show i Cmd.closePane i ensurePaneClosed _ = pure () ensurePane :: Members [TmuxPanes Pane, AtomicState Views, Tmux] r => Path Abs Dir -> WindowId -> Ui.PaneView -> Sem r (Maybe RenderableNode) ensurePane cwd windowId (Ui.View paneIdent vState geometry (Ui.Pane open _ customDir)) = do tmuxPane <- findOrCreatePane paneIdent existingPane <- nativePane windowId tmuxPane updatedPane <- if open then Just <$> ensurePaneOpen dir existingPane windowId else Nothing <$ ensurePaneClosed existingPane atomicModify' $ Views.updatePane (Tmux.View paneIdent ((.paneId) <$> updatedPane)) pure $ cons <$> updatedPane where dir = fromMaybe cwd (parseAbsDir . toString =<< customDir) cons (Pane i _ _ top left) = Tree.Leaf . Renderable vState geometry $ RPane i top left refPane :: RenderableNode -> RPane refPane (Tree.Sub (Tree.Tree (Renderable _ _ (RLayout ref _)) _)) = ref refPane (Tree.Leaf (Renderable _ _ pane)) = pane renderableTree :: ViewState -> ViewGeometry -> Axis -> [RenderableNode] -> Maybe RenderableTree renderableTree vState geometry axis sub = do sub' <- NonEmpty.nonEmpty sub pure $ Tree.Tree (Renderable vState geometry (RLayout (refPane $ NonEmpty.head sub') axis)) sub' viewPosition :: ViewTreeSub -> Float viewPosition (TreeNode (Tree (Ui.View _ _ ViewGeometry { position = pos } _) _)) = fromMaybe 0.5 pos viewPosition (TreeLeaf (Ui.View _ _ ViewGeometry { position = pos } _)) = fromMaybe 0.5 pos ensureView :: Members [TmuxPanes Pane, AtomicState Views, Tmux] r => Path Abs Dir -> WindowId -> ViewTree -> Sem r (Maybe RenderableTree) ensureView cwd windowId = ensureTree where ensureTree (Tree (Ui.View layoutIdent vState geometry (Ui.Layout axis)) sub) = do ensuredSub <- traverse ensureNode sortedSub viewsLog $ pretty ("new sub for layout `" <> identText layoutIdent <> "`:") <> line <> vsep (pretty <$> ensuredSub) pure $ renderableTree vState geometry axis $ catMaybes ensuredSub where sortedSub = sortOn viewPosition sub ensureNode (TreeNode t) = do newTree <- ensureTree t pure $ Tree.Sub <$> newTree ensureNode (TreeLeaf v) = ensurePane cwd windowId v windowState :: Member (TmuxPanes Pane) r => Ident -> Codec.Window -> RenderableTree -> Sem r WindowState windowState windowIdent window tree = do nativeRef <- Cmd.firstWindowPane window.windowId pure $ WindowState window nativeRef windowIdent tree nativeRef.paneId