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

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
( 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 ()

View File

@ -48,19 +48,20 @@ module Mtlstats.Prompt (
playerToEditPrompt
) where
import Brick.Types (BrickEvent (VtyEvent), Location (Location), Widget)
import Brick.Widgets.Core (hBox, showCursor, str)
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,18 +210,20 @@ 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
desc = spElemDesc params x
in str $ "F" ++ show n ++ ") " ++ desc)
results
in hBox $
[ showCursor () (Location (0, pWidth)) $ str pStr
, str ""
in vBox $
[ hBox
[ str pStr
, renderEditor linesToWidget True (s^.editorW)
]
, str " "
, str $ spSearchHeader params
] ++ fmtRes
, promptProcessChar = spProcessChar params
@ -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)
]

View File

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

View File

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

View File

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

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 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" )