From e0e23367c8002a9787400fc33c1d33a23aa551e7 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Sun, 9 Feb 2020 21:49:01 +0000
Subject: [PATCH] Allow multiline editing

Also adds editor key bindings for the home and end keys
---
 client/Main.hs                  |  5 +++--
 src/Forest/Client/NodeEditor.hs | 24 +++++++++++++++++-------
 2 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/client/Main.hs b/client/Main.hs
index 15f7711..f5b9a3d 100644
--- a/client/Main.hs
+++ b/client/Main.hs
@@ -8,6 +8,7 @@ import           Brick.Widgets.Border.Style
 import           Control.Concurrent.Chan
 import           Control.Exception
 import           Control.Monad
+import           Data.Maybe
 import qualified Data.Set                   as Set
 import qualified Data.Text                  as T
 import qualified Graphics.Vty               as Vty
@@ -132,8 +133,8 @@ onKeyWithEditor ed cs ev = do
 clientDraw :: ClientState -> [Widget ResourceName]
 clientDraw cs = [joinBorders $ withBorderStyle unicode $ tree <+> debug]
   where
-    tree = borderWithLabel (txt "Tree") $ hLimit 50 $ renderTree boxDrawingBranching (csEditor cs) (csTree cs) <=> fill ' '
-    debug = borderWithLabel (txt "Debug") $ txtWrap (T.pack $ show $ csTree cs) <=> fill ' '
+    tree = borderWithLabel (txt "Tree") $ renderTree boxDrawingBranching (csEditor cs) (csTree cs)
+    debug = borderWithLabel (txt "Debug") $ maybe (txt "No editor") (vBox . map txt . getCurrentText) (csEditor cs)
 
 clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState)
 clientHandleEvent cs (VtyEvent ev) = case csEditor cs of
diff --git a/src/Forest/Client/NodeEditor.hs b/src/Forest/Client/NodeEditor.hs
index 2e35b2c..202b2c6 100644
--- a/src/Forest/Client/NodeEditor.hs
+++ b/src/Forest/Client/NodeEditor.hs
@@ -2,6 +2,7 @@
 
 module Forest.Client.NodeEditor
   ( NodeEditor
+  , getCurrentText
   , asReply
   , editNode
   , replyToNode
@@ -22,28 +23,37 @@ data NodeEditor = NodeEditor
   , neReply  :: Bool
   } deriving (Show)
 
+getCurrentText :: NodeEditor -> [T.Text]
+getCurrentText = getEditContents . neEditor
+
 asReply :: NodeEditor -> Bool
 asReply = neReply
 
 editNode :: T.Text -> NodeEditor
 editNode text = NodeEditor
-  { neEditor = applyEdit gotoEOL $ editorText RnEditor (Just 1) text
+  { neEditor = applyEdit gotoEOL $ editorText RnEditor Nothing text
   , neReply = False
   }
 
 replyToNode :: NodeEditor
 replyToNode = NodeEditor
-  { neEditor = editorText RnEditor (Just 1) ""
+  { neEditor = editorText RnEditor Nothing ""
   , neReply = True
   }
 
+edit :: (TextZipper T.Text -> TextZipper T.Text) -> NodeEditor -> EventM ResourceName NodeEditor
+edit z ne = pure $ ne{neEditor = applyEdit z $ neEditor ne}
+
 handleNodeEditorEvent :: Vty.Event -> NodeEditor -> EventM ResourceName NodeEditor
-handleNodeEditorEvent event es = do
-  newEditor <- handleEditorEvent event $ neEditor es
-  pure es{neEditor = newEditor}
+handleNodeEditorEvent (Vty.EvKey Vty.KHome _) ne = edit gotoBOL ne
+handleNodeEditorEvent (Vty.EvKey Vty.KEnd _) ne = edit gotoEOL ne
+handleNodeEditorEvent event ne = do
+  newEditor <- handleEditorEvent event $ neEditor ne
+  pure ne{neEditor = newEditor}
 
 renderNodeEditor :: NodeEditor -> Widget ResourceName
-renderNodeEditor es = renderEditor renderFunc True $ neEditor es
+renderNodeEditor ne = vLimit height $ renderEditor renderFunc True $ neEditor ne
   where
+    height = length $ getCurrentText ne
     renderFunc :: [T.Text] -> Widget ResourceName
-    renderFunc = vBox . map txt
+    renderFunc = vBox . map (\t -> if T.null t then txt " " else txt t)