use Editor istead of String

package.yaml

@@ -31,6 +31,7 @@ dependencies:
 - microlens-th >= 0.4.2.3 && < 0.5
 - mtl >= 2.2.2 && < 2.3
 - random >= 1.2.1.1 && < 1.3
+- text-zipper >= 0.12 && < 0.13
 - time >= 1.11.1.1 && < 1.12
 - vty >= 5.37 && < 5.38
 

src/Mtlstats/Actions.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Mtlstats.Actions
   ( startNewSeason
@@ -27,8 +27,6 @@ module Mtlstats.Actions
   , clearRookies
   , resetStandings
   , startNewGame
-  , addChar
-  , removeChar
   , createPlayer
   , createGoalie
   , edit
@@ -41,16 +39,19 @@ module Mtlstats.Actions
   , resetCreatePlayerState
   , resetCreateGoalieState
   , backHome
+  , clearEditor
   , loadDatabase
   , saveDatabase
   ) where
 
 import Brick.Main (viewportScroll)
+import Brick.Widgets.Edit (Editor, applyEdit)
 import Control.Exception (IOException, catch)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.State.Class (modify)
 import Data.Aeson (decodeFileStrict, encodeFile)
 import Data.Maybe (fromMaybe)
+import Data.Text.Zipper (gotoBOF, killToEOF)
 import Lens.Micro ((^.), (&), (.~), (%~))
 import Lens.Micro.Mtl ((.=), use)
 import System.EasyFile
@@ -93,16 +94,6 @@ startNewGame
   = (progMode .~ NewGame newGameState)
   . (database . dbGames %~ succ)
 
--- | Adds a character to the input buffer
-addChar :: Char -> ProgState -> ProgState
-addChar c = inputBuffer %~ (++[c])
-
--- | Removes a character from the input buffer (if possible)
-removeChar :: ProgState -> ProgState
-removeChar = inputBuffer %~ \case
-  ""  -> ""
-  str -> init str
-
 -- | Starts player creation mode
 createPlayer :: ProgState -> ProgState
 createPlayer = let
@@ -207,9 +198,13 @@ resetCreateGoalieState = progMode.createGoalieStateL
 backHome :: ProgState -> ProgState
 backHome
   = (progMode .~ MainMenu)
-  . (inputBuffer .~ "")
+  . (editorW  %~ clearEditor)
   . (scroller .~ viewportScroll ())
 
+-- | Clears an editor
+clearEditor :: Editor String () -> Editor String ()
+clearEditor = applyEdit $ killToEOF . gotoBOF
+
 -- | Loads the database
 loadDatabase :: Action ()
 loadDatabase = do

src/Mtlstats/Prompt.hs

@@ -48,19 +48,20 @@ module Mtlstats.Prompt (
   playerToEditPrompt
 ) where
 
-import Brick.Types (BrickEvent (VtyEvent), Location (Location), Widget)
+import Brick.Types (BrickEvent (VtyEvent), Widget)
-import Brick.Widgets.Core (showCursor, str, vBox)
+import Brick.Widgets.Core (hBox, str, vBox)
+import Brick.Widgets.Edit (editContentsL, renderEditor)
 import Control.Monad (when)
 import Control.Monad.Extra (whenJust)
 import Control.Monad.State.Class (gets, modify)
 import Data.Char (isAlphaNum, isDigit, toUpper)
-import Graphics.Text.Width (safeWcswidth)
+import Data.Text.Zipper (deletePrevChar, insertChar)
 import Graphics.Vty.Input.Events
   ( Event (EvKey)
   , Key (KBS, KChar, KEnter, KFun)
   )
-import Lens.Micro ((^.), (&), (.~), (?~), (%~))
+import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
-import Lens.Micro.Mtl ((.=), use)
+import Lens.Micro.Mtl ((%=), use)
 import Text.Read (readMaybe)
 
 import Mtlstats.Actions
@@ -72,13 +73,13 @@ import Mtlstats.Util
 -- | Event handler for a prompt
 promptHandler :: Prompt -> Handler ()
 promptHandler p (VtyEvent (EvKey KEnter [])) = do
-  val <- use inputBuffer
+  val <- use $ editorW.to userText
-  inputBuffer .= ""
+  editorW %= clearEditor
   promptAction p val
 promptHandler p (VtyEvent (EvKey (KChar c) [])) =
-  modify $ inputBuffer %~ promptProcessChar p c
+  modify $ editorW %~ promptProcessChar p c
 promptHandler _ (VtyEvent (EvKey KBS [])) =
-  modify removeChar
+  modify (editorW.editContentsL %~ deletePrevChar)
 promptHandler p (VtyEvent (EvKey k m)) =
   promptSpecialKey p k m
 promptHandler _ _ = return ()
@@ -113,7 +114,7 @@ strPrompt
   -> Prompt
 strPrompt pStr act = Prompt
   { drawPrompt        = drawSimplePrompt pStr
-  , promptProcessChar = \ch -> (++ [ch])
+  , promptProcessChar = \ch -> editContentsL %~ insertChar ch
   , promptAction      = act
   , promptSpecialKey  = \_ _ -> return ()
   }
@@ -126,7 +127,7 @@ ucStrPrompt
   -- ^ The callback function for the result
   -> Prompt
 ucStrPrompt pStr act = (strPrompt pStr act)
-  { promptProcessChar = \ch -> (++ [toUpper ch]) }
+  { promptProcessChar = \ch -> editContentsL %~ insertChar ch }
 
 -- | Creates a prompt which forces capitalization of input to
 -- accomodate a player or goalie name
@@ -174,7 +175,7 @@ numPromptWithFallback
 numPromptWithFallback pStr fallback act = Prompt
   { drawPrompt        = drawSimplePrompt pStr
   , promptProcessChar = \ch existing -> if isDigit ch
-    then existing ++ [ch]
+    then existing & editContentsL %~ insertChar ch
     else existing
   , promptAction      = maybe fallback act . readMaybe
   , promptSpecialKey  = \_ _ -> return ()
@@ -189,7 +190,7 @@ dbNamePrompt
   -> Prompt
 dbNamePrompt pStr act = (strPrompt pStr act)
   { promptProcessChar = \ch -> if isAlphaNum ch || ch == '-'
-    then (++[toUpper ch])
+    then editContentsL %~ insertChar (toUpper ch)
     else id
   }
 
@@ -209,9 +210,8 @@ newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
 selectPrompt :: SelectParams a -> Prompt
 selectPrompt params = Prompt
   { drawPrompt = \s -> let
-    sStr       = s^.inputBuffer
+    sStr       = s^.editorW.to userText
-    pStr       = spPrompt params ++ sStr
+    pStr       = spPrompt params
-    pWidth     = safeWcswidth pStr
     results    = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
     fmtRes     = map
       (\(n, (_, x)) -> let
@@ -219,7 +219,10 @@ selectPrompt params = Prompt
         in str $ "F" ++ show n ++ ") " ++ desc)
       results
     in vBox $
-      [ showCursor () (Location (pWidth, 0)) $ str pStr
+      [ hBox
+        [ str pStr
+        , renderEditor linesToWidget True (s^.editorW)
+        ]
       , str " "
       , str $ spSearchHeader params
       ] ++ fmtRes
@@ -233,14 +236,14 @@ selectPrompt params = Prompt
         Just n  -> spCallback params $ Just n
   , promptSpecialKey = \key _ -> case key of
     KFun rawK -> do
-      sStr <- use inputBuffer
+      sStr <- use $ editorW . to userText
       db   <- use database
       let
         n       = pred rawK
         results = spSearch params sStr db
       when (n < maxFunKeys) $
         whenJust (nth n results) $ \(sel, _) -> do
-          modify $ inputBuffer .~ ""
+          modify $ editorW %~ clearEditor
           spCallback params $ Just sel
     _ -> return ()
   }
@@ -393,7 +396,7 @@ selectPositionPrompt pStr callback = selectPrompt SelectParams
   , spSearch = posSearch
   , spSearchExact = posSearchExact
   , spElemDesc = id
-  , spProcessChar = \ch -> (++ [toUpper ch])
+  , spProcessChar = \c -> editContentsL %~ insertChar (toUpper c)
   , spCallback = posCallback callback
   , spNotFound = callback
   }
@@ -403,7 +406,7 @@ playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
   modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
 
 drawSimplePrompt :: String -> Renderer
-drawSimplePrompt pStr s = let
+drawSimplePrompt pStr s = hBox
-  fullStr  = pStr ++ s^.inputBuffer
+  [ str pStr
-  strWidth = safeWcswidth fullStr
+  , renderEditor linesToWidget True (s^.editorW)
-  in showCursor () (Location (strWidth, 0)) $ str fullStr
+  ]

src/Mtlstats/Types.hs

@@ -53,7 +53,7 @@ module Mtlstats.Types (
   database,
   progMode,
   dbName,
-  inputBuffer,
+  editorW,
   scroller,
   -- ** ProgMode Lenses
   gameStateL,
@@ -199,6 +199,7 @@ module Mtlstats.Types (
 
 import Brick.Main (ViewportScroll, viewportScroll)
 import Brick.Types (BrickEvent, EventM, Widget)
+import Brick.Widgets.Edit (Editor, editor)
 import Data.Aeson
   ( FromJSON
   , ToJSON
@@ -247,8 +248,8 @@ data ProgState = ProgState
   -- ^ The program's mode
   , _dbName   :: String
   -- ^ The name of the database file
-  , _inputBuffer  :: String
+  , _editorW  :: Editor String ()
-  -- ^ Buffer for user input
+  -- ^ Editor widget
   , _scroller :: ViewportScroll ()
   -- ^ Scroller for the reports
   }
@@ -543,8 +544,8 @@ data GameStats = GameStats
 data Prompt = Prompt
   { drawPrompt        :: ProgState -> Widget ()
   -- ^ Draws the prompt to the screen
-  , promptProcessChar :: Char -> String -> String
+  , promptProcessChar :: Char -> Editor String () -> Editor String ()
-  -- ^ Modifies the string based on the character entered
+  -- ^ Modifies an editor based on the character entered
   , promptAction      :: String -> Action ()
   -- ^ Action to perform when the value is entered
   , promptSpecialKey  :: Key -> [Modifier] -> Action ()
@@ -563,7 +564,7 @@ data SelectParams a = SelectParams
   -- ^ Search function looking for an exact match
   , spElemDesc     :: a -> String
   -- ^ Provides a string description of an element
-  , spProcessChar  :: Char -> String -> String
+  , spProcessChar  :: Char -> Editor String () -> Editor String ()
   -- ^ Processes a character entered by the user
   , spCallback     :: Maybe Int -> Action ()
   -- ^ The function when the selection is made
@@ -798,7 +799,7 @@ newProgState = ProgState
   { _database = newDatabase
   , _progMode = TitleScreen
   , _dbName   = ""
-  , _inputBuffer = ""
+  , _editorW  = editor () (Just 1) ""
   , _scroller = viewportScroll ()
   }
 

src/Mtlstats/Util.hs

@@ -28,13 +28,17 @@ module Mtlstats.Util
   , capitalizeName
   , linesToWidget
   , linesToWidgetC
+  , userText
   ) where
 
 import Brick.Types (Widget)
 import Brick.Widgets.Center (hCenter)
 import Brick.Widgets.Core (str, vBox)
+import Brick.Widgets.Edit (Editor, editContentsL, getEditContents)
 import Data.Char (isSpace, toUpper)
 import qualified Data.Map as M
+import Data.Text.Zipper (insertChar)
+import Lens.Micro ((^.), (&), (%~), to)
 
 -- | Attempt to select the element from a list at a given index
 nth
@@ -106,12 +110,13 @@ slice offset len = take len . drop offset
 capitalizeName
   :: Char
   -- ^ The character being input
-  -> String
+  -> Editor String ()
   -- ^ The current string
-  -> String
+  -> Editor String ()
   -- ^ The resulting string
-capitalizeName ch s = s ++ [ch']
+capitalizeName ch e = e & editContentsL %~ insertChar ch'
   where
+    s   = e^.to userText
     ch' = if lockFlag s
       then toUpper ch
       else ch
@@ -133,6 +138,12 @@ linesToWidget = vBox . map (str . keepBlank)
 linesToWidgetC :: [String] -> Widget ()
 linesToWidgetC = vBox . map (hCenter . str . keepBlank)
 
+-- | Fetches the text from an editor widget
+userText :: Editor String () -> String
+userText w = case getEditContents w of
+  (x:_) -> x
+  []    -> ""
+
 keepBlank :: String -> String
 keepBlank "" = " "
 keepBlank s = s

test/ActionsSpec.hs

@@ -24,7 +24,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module ActionsSpec (spec) where
 
 import Control.Monad (replicateM)
-import Lens.Micro ((^.), (&), (.~), (?~), (%~))
+import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
 import Test.Hspec
   ( Spec
   , context
@@ -37,9 +37,11 @@ import Test.Hspec
 
 import Mtlstats.Actions
 import Mtlstats.Types
+import Mtlstats.Util
 
 import qualified Actions.NewGameSpec as NewGame
 import qualified Actions.EditStandingsSpec as EditStandings
+import SpecHelpers
 import qualified TypesSpec as TS
 
 spec :: Spec
@@ -49,8 +51,6 @@ spec = describe "Mtlstats.Actions" $ do
   resetYtdSpec
   clearRookiesSpec
   resetStandingsSpec
-  addCharSpec
-  removeCharSpec
   createPlayerSpec
   createGoalieSpec
   editSpec
@@ -204,29 +204,6 @@ resetStandingsSpec = describe "resetStandings" $ do
     it "should be reset" $
       ps^.database.dbAwayGameStats `shouldBe` newGameStats
 
-addCharSpec :: Spec
-addCharSpec = describe "addChar" $
-  it "should add the character to the input buffer" $ let
-    s = newProgState
-      & inputBuffer .~ "foo"
-      & addChar 'd'
-  in s ^. inputBuffer `shouldBe` "food"
-
-removeCharSpec :: Spec
-removeCharSpec = describe "removeChar" $ do
-
-  context "empty" $
-    it "should remove the character from the input buffer" $ let
-      s = removeChar newProgState
-      in s ^. inputBuffer `shouldBe` ""
-
-  context "not empty" $
-    it "should remove the character from the input buffer" $ let
-      s = newProgState
-        & inputBuffer .~ "foo"
-        & removeChar
-      in s ^. inputBuffer `shouldBe` "fo"
-
 createPlayerSpec :: Spec
 createPlayerSpec = describe "createPlayer" $
   it "should change the mode appropriately" $ let
@@ -422,7 +399,7 @@ backHomeSpec = describe "backHome" $ do
   let
     input = newProgState
       & progMode.gameStateL .~ newGameState
-      & inputBuffer         .~ "foo"
+      & editorW             .~ mkEditor "foo"
     result = backHome input
 
   it "should set the program mode back to MainMenu" $
@@ -431,4 +408,4 @@ backHomeSpec = describe "backHome" $ do
       _        -> False
 
   it "should clear the input buffer" $
-    result^.inputBuffer `shouldBe` ""
+    result^.editorW.to userText `shouldBe` ""

test/SpecHelpers.hs

@@ -0,0 +1,29 @@
+{-
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module SpecHelpers where
+
+import Brick.Widgets.Edit (Editor, editContentsL, editor)
+import Data.Text.Zipper (gotoEOL)
+import Lens.Micro ((&), (%~))
+
+mkEditor :: String -> Editor String ()
+mkEditor str = editor () (Just 1) str & editContentsL %~ gotoEOL

test/UtilSpec.hs

@@ -26,6 +26,8 @@ import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Util
 
+import SpecHelpers
+
 spec :: Spec
 spec = describe "Mtlstats.Util" $ do
   nthSpec
@@ -114,7 +116,7 @@ capitalizeNameSpec :: Spec
 capitalizeNameSpec = describe "capitalizeName" $ mapM_
   (\(label, ch, str, expected) -> context label $
     it ("should be " ++ expected) $
-      capitalizeName ch str `shouldBe` expected)
+      userText (capitalizeName ch $ mkEditor str) `shouldBe` expected)
   --  label,                        character, string,   expected
   [ ( "initial lower",              'a',       "",       "A"       )
   , ( "initial upper",              'A',       "",       "A"       )