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 :: 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 a. a -> Sem r a 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 forall ann. Ident -> 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 forall ann. Ident -> 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 forall ann. PaneId -> 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 a. a -> Sem r a 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) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Maybe a -> f (Maybe 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 a. Maybe a -> Maybe a -> Maybe a 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 a. a -> Sem r a 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 ((.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 a. a -> Sem r a 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 ((.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 a. a -> Sem r a 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 a. a -> Sem r a 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 a b. a -> Sem r b -> Sem r a 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 ((.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) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> [a] -> f [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 ann. Text -> Doc ann 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 ann. Maybe RenderableNode -> Doc ann 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 window.windowId 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 nativeRef.paneId