use Editor istead of String
This commit is contained in:
parent
820aab5e96
commit
d92722be9c
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
-- ^ Buffer for user input
|
||||
, _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
|
||||
|
|
@ -798,7 +799,7 @@ newProgState = ProgState
|
|||
{ _database = newDatabase
|
||||
, _progMode = TitleScreen
|
||||
, _dbName = ""
|
||||
, _inputBuffer = ""
|
||||
, _editorW = editor () (Just 1) ""
|
||||
, _scroller = viewportScroll ()
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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` ""
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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" )
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user