Compare commits

..

2 Commits

Author SHA1 Message Date
Jonathan Lamothe d92722be9c use Editor istead of String 2023-05-31 20:08:49 -04:00
Jonathan Lamothe 820aab5e96 fix layout of selection prompt 2023-05-31 13:21:49 -04:00
8 changed files with 108 additions and 89 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

29
test/SpecHelpers.hs Normal file
View File

@ -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

View File

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