From d92722be9c3bac02add35aab1426b2792ebabf22 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 31 May 2023 20:08:49 -0400 Subject: [PATCH] use Editor istead of String --- package.yaml | 1 + src/Mtlstats/Actions.hs | 27 +++++++++------------- src/Mtlstats/Prompt.hs | 51 ++++++++++++++++++++++------------------- src/Mtlstats/Types.hs | 31 +++++++++++++------------ src/Mtlstats/Util.hs | 17 +++++++++++--- test/ActionsSpec.hs | 33 ++++---------------------- test/SpecHelpers.hs | 29 +++++++++++++++++++++++ test/UtilSpec.hs | 4 +++- 8 files changed, 106 insertions(+), 87 deletions(-) create mode 100644 test/SpecHelpers.hs 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" )