Garmelon/forest
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[client] Unfold a node when replying to it

Browse source
This commit is contained in:
Joscha 2020-02-19 23:45:54 +00:00
parent 1fd476e585
commit ec61c4d092
2 changed files with 14 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/Forest/Client.hs
View file

@ -57,14 +57,14 @@ onUiState' cs f = do
onKeyWithoutEditor :: ClientState -> Vty.Event -> ClientM (Next ClientState) onKeyWithoutEditor :: ClientState -> Vty.Event -> ClientM (Next ClientState)
onKeyWithoutEditor cs (Vty.EvKey k _) onKeyWithoutEditor cs (Vty.EvKey k _)
| k `elem` quitKeys = halt cs | 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` upKeys = onUiState cs moveFocusUp
| k `elem` downKeys = onUiState cs moveFocusDown | k `elem` downKeys = onUiState cs moveFocusDown
| k `elem` editKeys = onUiState cs editCurrentNode | k `elem` editKeys = onUiState cs editCurrentNode
| k `elem` deleteKeys = do | k `elem` deleteKeys = do
liftIO $ sendPacket (csConn cs) $ ClientDelete (getFocusedPath $ csUiState cs) liftIO $ sendPacket (csConn cs) $ ClientDelete (getFocusedPath $ csUiState cs)
continue cs continue cs
| k `elem` replyKeys = onUiState cs replyToCurrentNode | k `elem` replyKeys = onUiState cs (replyToCurrentNode . unfoldAtFocus)
| k `elem` replyKeys' = onUiState cs replyAfterCurrentNode | k `elem` replyKeys' = onUiState cs replyAfterCurrentNode
| k `elem` actKeys = do | k `elem` actKeys = do
liftIO $ sendPacket (csConn cs) $ ClientAct (getFocusedPath $ csUiState cs) liftIO $ sendPacket (csConn cs) $ ClientAct (getFocusedPath $ csUiState cs)

20
src/Forest/Client/UiState.hs
View file

@ -10,6 +10,8 @@ module Forest.Client.UiState
, moveFocusUp , moveFocusUp
, moveFocusDown , moveFocusDown
, foldAtFocus , foldAtFocus
, unfoldAtFocus
, toggleFoldAtFocus
-- ** The node editor -- ** The node editor
-- *** Creating -- *** Creating
, editCurrentNode , editCurrentNode
@ -81,7 +83,7 @@ findValidParent :: Node -> Path -> Path
findValidParent _ (Path []) = Path [] findValidParent _ (Path []) = Path []
findValidParent node (Path (x:xs)) = case applyId x node of findValidParent node (Path (x:xs)) = case applyId x node of
Nothing -> Path [] 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. -- | Modify the focused path so it always points to an existing node.
validateFocused :: UiState n -> UiState n validateFocused :: UiState n -> UiState n
@ -119,13 +121,15 @@ moveFocusDown s =
in s {uiFocused = findNextNode foldedRootNode $ uiFocused s} in s {uiFocused = findNextNode foldedRootNode $ uiFocused s}
foldAtFocus :: UiState n -> UiState n foldAtFocus :: UiState n -> UiState n
foldAtFocus s = foldAtFocus s = validateUnfolded $ s {uiUnfolded = Set.delete (uiFocused s) (uiUnfolded s)}
let focused = uiFocused s
unfolded = uiUnfolded s unfoldAtFocus :: UiState n -> UiState n
newUnfolded = if focused `Set.member` unfolded unfoldAtFocus s = validateUnfolded $ s {uiUnfolded = Set.insert (uiFocused s) (uiUnfolded s)}
then Set.delete focused unfolded
else Set.insert focused unfolded toggleFoldAtFocus :: UiState n -> UiState n
in validateUnfolded s {uiUnfolded = newUnfolded} toggleFoldAtFocus s = if uiFocused s `Set.member` uiUnfolded s
then foldAtFocus s
else unfoldAtFocus s
editNode :: Bool -> Path -> UiState n -> UiState n editNode :: Bool -> Path -> UiState n -> UiState n
editNode reply path s = editNode reply path s =