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

Add test interactions for moving and folding

Browse source
This commit is contained in:
Joscha 2020-02-09 11:29:44 +00:00
parent 19a4350cb6
commit 909d587c53
1 changed files with 27 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

31
client/Main.hs
View file

@ -6,6 +6,7 @@ import Brick
import Control.Concurrent.Chan import Control.Concurrent.Chan
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import qualified Data.Set as Set
import qualified Data.Text as T import qualified Data.Text as T
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import qualified Network.WebSockets as WS import qualified Network.WebSockets as WS
@ -45,16 +46,36 @@ data ClientState = ClientState
newClientState :: Node -> ClientState newClientState :: Node -> ClientState
newClientState node = ClientState newClientState node = ClientState
{ csTree = newTree node { csTree = newTree node localPath Set.empty
, csEditor = Nothing , csEditor = Nothing
} }
clientDraw :: ClientState -> [Widget ResourceName] clientDraw :: ClientState -> [Widget ResourceName]
clientDraw cs = [renderTree boxDrawingBranching (csEditor cs) (csTree cs)] clientDraw cs = [renderTree boxDrawingBranching (csEditor cs) (csTree cs)]
isQuitEvent :: BrickEvent a b -> Bool
isQuitEvent (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = True
isQuitEvent _ = False
isFocusDownEvent :: BrickEvent a b -> Bool
isFocusDownEvent (VtyEvent (Vty.EvKey (Vty.KChar 'j') [])) = True
isFocusDownEvent _ = False
isFocusUpEvent :: BrickEvent a b -> Bool
isFocusUpEvent (VtyEvent (Vty.EvKey (Vty.KChar 'k') [])) = True
isFocusUpEvent _ = False
isToggleFoldEvent :: BrickEvent a b -> Bool
isToggleFoldEvent (VtyEvent (Vty.EvKey (Vty.KChar '\t') [])) = True
isToggleFoldEvent _ = False
clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState) clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState)
clientHandleEvent cs (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = halt cs clientHandleEvent cs e
clientHandleEvent cs _ = continue cs | isQuitEvent e = halt cs
| isFocusUpEvent e = continue cs{csTree = moveUp $ csTree cs}
| isFocusDownEvent e = continue cs{csTree = moveDown $ csTree cs}
| isToggleFoldEvent e = continue cs{csTree = toggleFold $ csTree cs}
| otherwise = continue cs
clientAttrMap :: AttrMap clientAttrMap :: AttrMap
clientAttrMap = attrMap Vty.defAttr clientAttrMap = attrMap Vty.defAttr
@ -72,4 +93,6 @@ clientApp = App
} }
main :: IO () main :: IO ()
main = void $ defaultMain clientApp $ newClientState exampleNode main = void $ defaultMain clientApp testState
where
testState = ClientState {csTree = exampleTree, csEditor = Nothing}