diff --git a/package.yaml b/package.yaml
index ee7b350..e51d753 100644
--- a/package.yaml
+++ b/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
diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs
index 00dfd13..2b6bdf2 100644
--- a/src/Mtlstats/Actions.hs
+++ b/src/Mtlstats/Actions.hs
@@ -19,7 +19,7 @@ along with this program. If not, see .
-}
-{-# 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
@@ -206,9 +197,13 @@ resetCreateGoalieState = progMode.createGoalieStateL
-- | Resets the program state back to the main menu
backHome :: ProgState -> ProgState
backHome
- = (progMode .~ MainMenu)
- . (inputBuffer .~ "")
- . (scroller .~ viewportScroll ())
+ = (progMode .~ MainMenu)
+ . (editorW %~ clearEditor)
+ . (scroller .~ viewportScroll ())
+
+-- | Clears an editor
+clearEditor :: Editor String () -> Editor String ()
+clearEditor = applyEdit $ killToEOF . gotoBOF
-- | Loads the database
loadDatabase :: Action ()
diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs
index ce14916..8b26164 100644
--- a/src/Mtlstats/Prompt.hs
+++ b/src/Mtlstats/Prompt.hs
@@ -48,19 +48,20 @@ module Mtlstats.Prompt (
playerToEditPrompt
) where
-import Brick.Types (BrickEvent (VtyEvent), Location (Location), Widget)
-import Brick.Widgets.Core (showCursor, str, vBox)
+import Brick.Types (BrickEvent (VtyEvent), Widget)
+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.Mtl ((.=), use)
+import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
+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
- inputBuffer .= ""
+ val <- use $ editorW.to userText
+ 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
- pStr = spPrompt params ++ sStr
- pWidth = safeWcswidth pStr
+ sStr = s^.editorW.to userText
+ pStr = spPrompt params
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
- fullStr = pStr ++ s^.inputBuffer
- strWidth = safeWcswidth fullStr
- in showCursor () (Location (strWidth, 0)) $ str fullStr
+drawSimplePrompt pStr s = hBox
+ [ str pStr
+ , renderEditor linesToWidget True (s^.editorW)
+ ]
diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs
index ecef2de..db53b36 100644
--- a/src/Mtlstats/Types.hs
+++ b/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
@@ -241,15 +242,15 @@ type Handler a = BrickEvent () () -> Action a
-- | Represents the program state
data ProgState = ProgState
- { _database :: Database
+ { _database :: Database
-- ^ The data to be saved
- , _progMode :: ProgMode
+ , _progMode :: ProgMode
-- ^ The program's mode
- , _dbName :: String
+ , _dbName :: String
-- ^ The name of the database file
- , _inputBuffer :: String
- -- ^ Buffer for user input
- , _scroller :: ViewportScroll ()
+ , _editorW :: Editor String ()
+ -- ^ 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
- -- ^ Modifies the string based on the character entered
+ , promptProcessChar :: Char -> Editor String () -> Editor String ()
+ -- ^ 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
@@ -795,11 +796,11 @@ esmSubModeL = lens
-- | Constructor for a 'ProgState'
newProgState :: ProgState
newProgState = ProgState
- { _database = newDatabase
- , _progMode = TitleScreen
- , _dbName = ""
- , _inputBuffer = ""
- , _scroller = viewportScroll ()
+ { _database = newDatabase
+ , _progMode = TitleScreen
+ , _dbName = ""
+ , _editorW = editor () (Just 1) ""
+ , _scroller = viewportScroll ()
}
-- | Constructor for a 'GameState'
diff --git a/src/Mtlstats/Util.hs b/src/Mtlstats/Util.hs
index 4a1dda1..06d6fff 100644
--- a/src/Mtlstats/Util.hs
+++ b/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
diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs
index 7f17eef..8ac0919 100644
--- a/test/ActionsSpec.hs
+++ b/test/ActionsSpec.hs
@@ -24,7 +24,7 @@ along with this program. If not, see .
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` ""
diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
new file mode 100644
index 0000000..6c5fcf9
--- /dev/null
+++ b/test/SpecHelpers.hs
@@ -0,0 +1,29 @@
+{-
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+
+
+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 .
+
+-}
+
+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
diff --git a/test/UtilSpec.hs b/test/UtilSpec.hs
index 3c73564..5da4999 100644
--- a/test/UtilSpec.hs
+++ b/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" )