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)