diff --git a/src/Forest/Client.hs b/src/Forest/Client.hs index 5b727da..df887a0 100644 --- a/src/Forest/Client.hs +++ b/src/Forest/Client.hs @@ -57,14 +57,14 @@ onUiState' cs f = do onKeyWithoutEditor :: ClientState -> Vty.Event -> ClientM (Next ClientState) onKeyWithoutEditor cs (Vty.EvKey k _) | k `elem` quitKeys = halt cs - | k `elem` foldKeys = onUiState cs foldAtFocus + | k `elem` foldKeys = onUiState cs toggleFoldAtFocus | k `elem` upKeys = onUiState cs moveFocusUp | k `elem` downKeys = onUiState cs moveFocusDown | k `elem` editKeys = onUiState cs editCurrentNode | k `elem` deleteKeys = do liftIO $ sendPacket (csConn cs) $ ClientDelete (getFocusedPath $ csUiState cs) continue cs - | k `elem` replyKeys = onUiState cs replyToCurrentNode + | k `elem` replyKeys = onUiState cs (replyToCurrentNode . unfoldAtFocus) | k `elem` replyKeys' = onUiState cs replyAfterCurrentNode | k `elem` actKeys = do liftIO $ sendPacket (csConn cs) $ ClientAct (getFocusedPath $ csUiState cs) diff --git a/src/Forest/Client/UiState.hs b/src/Forest/Client/UiState.hs index 82e625a..21b1056 100644 --- a/src/Forest/Client/UiState.hs +++ b/src/Forest/Client/UiState.hs @@ -10,6 +10,8 @@ module Forest.Client.UiState , moveFocusUp , moveFocusDown , foldAtFocus + , unfoldAtFocus + , toggleFoldAtFocus -- ** The node editor -- *** Creating , editCurrentNode @@ -81,7 +83,7 @@ findValidParent :: Node -> Path -> Path findValidParent _ (Path []) = Path [] findValidParent node (Path (x:xs)) = case applyId x node of Nothing -> Path [] - Just child -> findValidParent child (Path xs) + Just child -> Path [x] <> findValidParent child (Path xs) -- | Modify the focused path so it always points to an existing node. validateFocused :: UiState n -> UiState n @@ -119,13 +121,15 @@ moveFocusDown s = in s {uiFocused = findNextNode foldedRootNode $ uiFocused s} foldAtFocus :: UiState n -> UiState n -foldAtFocus s = - let focused = uiFocused s - unfolded = uiUnfolded s - newUnfolded = if focused `Set.member` unfolded - then Set.delete focused unfolded - else Set.insert focused unfolded - in validateUnfolded s {uiUnfolded = newUnfolded} +foldAtFocus s = validateUnfolded $ s {uiUnfolded = Set.delete (uiFocused s) (uiUnfolded s)} + +unfoldAtFocus :: UiState n -> UiState n +unfoldAtFocus s = validateUnfolded $ s {uiUnfolded = Set.insert (uiFocused s) (uiUnfolded s)} + +toggleFoldAtFocus :: UiState n -> UiState n +toggleFoldAtFocus s = if uiFocused s `Set.member` uiUnfolded s + then foldAtFocus s + else unfoldAtFocus s editNode :: Bool -> Path -> UiState n -> UiState n editNode reply path s =