From 227401461b99cbca5ab4a315eae3e51dc31a088f Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 25 May 2023 19:36:03 -0400 Subject: [PATCH] wip: switching from ncurses to brick --- app/Main.hs | 7 +- package.yaml | 20 ++- src/Mtlstats.hs | 54 +++--- src/Mtlstats/Actions.hs | 26 +-- src/Mtlstats/Control/CreateGoalie.hs | 28 ++- src/Mtlstats/Control/CreatePlayer.hs | 26 +-- src/Mtlstats/Control/EditGoalie.hs | 58 +++--- src/Mtlstats/Control/EditPlayer.hs | 58 +++--- src/Mtlstats/Control/EditStandings.hs | 18 +- src/Mtlstats/Control/NewGame.hs | 185 ++++++++++---------- src/Mtlstats/Control/NewGame/GoalieInput.hs | 9 +- src/Mtlstats/Control/TitleScreen.hs | 40 ++--- src/Mtlstats/Handlers.hs | 7 +- src/Mtlstats/Helpers/Position.hs | 4 +- src/Mtlstats/Menu.hs | 52 +++--- src/Mtlstats/Menu/EditGoalie.hs | 2 +- src/Mtlstats/Menu/EditPlayer.hs | 2 +- src/Mtlstats/Menu/EditStandings.hs | 2 +- src/Mtlstats/Prompt.hs | 101 ++++++----- src/Mtlstats/Prompt/EditGoalie.hs | 2 +- src/Mtlstats/Prompt/EditPlayer.hs | 2 +- src/Mtlstats/Prompt/EditStandings.hs | 2 +- src/Mtlstats/Prompt/NewGame.hs | 2 +- src/Mtlstats/Prompt/NewGame/GoalieInput.hs | 2 +- src/Mtlstats/Types.hs | 41 +++-- src/Mtlstats/Util.hs | 10 +- stack.yaml | 2 +- stack.yaml.lock | 19 ++ test/Actions/NewGame/GoalieInputSpec.hs | 6 +- test/ActionsSpec.hs | 33 ---- test/HandlersSpec.hs | 24 ++- test/TypesSpec.hs | 2 +- 32 files changed, 400 insertions(+), 446 deletions(-) create mode 100644 stack.yaml.lock diff --git a/app/Main.hs b/app/Main.hs index 3716eb3..23e8e58 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -21,10 +21,11 @@ along with this program. If not, see . module Main where -import Control.Monad.Trans.State (evalStateT) -import UI.NCurses (runCurses) +import Brick.Main (defaultMain) +import Control.Monad (void) import Mtlstats +import Mtlstats.Types main :: IO () -main = runCurses $ initState >>= evalStateT mainLoop +main = void $ defaultMain app newProgState diff --git a/package.yaml b/package.yaml index e2b8c24..ee7b350 100644 --- a/package.yaml +++ b/package.yaml @@ -20,17 +20,19 @@ description: Please see the README on GitHub at = 4.7 && < 5 -- aeson >= 1.4.4.0 && < 1.5 +- aeson >= 2.0.3.0 && < 2.1 +- bytestring >= 0.11.4.0 && < 0.12 +- brick >= 1.4 && < 1.5 - containers >= 0.6.0.1 && < 0.7 - easy-file >= 0.2.2 && < 0.3 -- extra >= 1.6.17 && < 1.7 +- extra >= 1.7.13 && < 1.8 +- microlens >= 0.4.12.0 && < 0.5 +- microlens-mtl >= 0.2.0.3 && < 0.3 - microlens-th >= 0.4.2.3 && < 0.5 -- ncurses >= 0.2.16 && < 0.3 -- random >= 1.1 && < 1.2 -- time >= 1.8.0.2 && < 1.9 -- transformers >= 0.5.6.2 && < 0.6 -- bytestring -- microlens +- mtl >= 2.2.2 && < 2.3 +- random >= 1.2.1.1 && < 1.3 +- time >= 1.11.1.1 && < 1.12 +- vty >= 5.37 && < 5.38 ghc-options: - -Wall @@ -60,5 +62,5 @@ tests: - -with-rtsopts=-N dependencies: - mtlstats - - hspec >= 2.7.1 && < 2.8 + - hspec >= 2.9.7 && < 2.10 - unordered-containers diff --git a/src/Mtlstats.hs b/src/Mtlstats.hs index 13fead6..b6e6b02 100644 --- a/src/Mtlstats.hs +++ b/src/Mtlstats.hs @@ -19,40 +19,34 @@ along with this program. If not, see . -} -module Mtlstats (initState, mainLoop) where +module Mtlstats (app) where -import Control.Monad (void) -import Control.Monad.Extra (whenM) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.State (get, gets) -import Data.Maybe (fromJust) -import qualified UI.NCurses as C +import Brick.AttrMap (AttrMap, forceAttrMap) +import Brick.Main (App (..), showFirstCursor) +import Brick.Util (on) +import Graphics.Vty.Attributes.Color (blue, white) +import Lens.Micro (to) +import Lens.Micro.Mtl (use) import Mtlstats.Control import Mtlstats.Types --- | Initializes the progran -initState :: C.Curses ProgState -initState = do - C.setEcho False - void $ C.setCursorMode C.CursorInvisible - return newProgState +-- | The main application +app :: App ProgState () () +app = App + { appDraw = \s -> [drawController (dispatch s) s] + , appChooseCursor = showFirstCursor + , appHandleEvent = handler + , appStartEvent = return () + , appAttrMap = const myAttrMap + } --- | Main program loop -mainLoop :: Action () -mainLoop = do - c <- gets dispatch - get >>= lift . draw . drawController c - w <- lift C.defaultWindow - whenM (lift (fromJust <$> C.getEvent w Nothing) >>= handleController c) - mainLoop +handler :: Handler () +handler e = do + c <- use (to dispatch) + handleController c e -draw :: C.Update C.CursorMode -> C.Curses () -draw u = do - void $ C.setCursorMode C.CursorInvisible - w <- C.defaultWindow - cm <- C.updateWindow w $ do - C.clear - u - C.render - void $ C.setCursorMode cm +myAttrMap :: AttrMap +myAttrMap = forceAttrMap (white `on` blue) + +--jl diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 019bb0d..00dfd13 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -41,18 +41,18 @@ module Mtlstats.Actions , resetCreatePlayerState , resetCreateGoalieState , backHome - , scrollUp - , scrollDown , loadDatabase , saveDatabase ) where +import Brick.Main (viewportScroll) import Control.Exception (IOException, catch) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.State (gets, modify) +import Control.Monad.State.Class (modify) import Data.Aeson (decodeFileStrict, encodeFile) import Data.Maybe (fromMaybe) import Lens.Micro ((^.), (&), (.~), (%~)) +import Lens.Micro.Mtl ((.=), use) import System.EasyFile ( createDirectoryIfMissing , getAppUserDataDirectory @@ -206,17 +206,9 @@ resetCreateGoalieState = progMode.createGoalieStateL -- | Resets the program state back to the main menu backHome :: ProgState -> ProgState backHome - = (progMode .~ MainMenu) - . (inputBuffer .~ "") - . (scrollOffset .~ 0) - --- | Scrolls the display up -scrollUp :: ProgState -> ProgState -scrollUp = scrollOffset %~ max 0 . pred - --- | Scrolls the display down -scrollDown :: ProgState -> ProgState -scrollDown = scrollOffset %~ succ + = (progMode .~ MainMenu) + . (inputBuffer .~ "") + . (scroller .~ viewportScroll ()) -- | Loads the database loadDatabase :: Action () @@ -226,18 +218,18 @@ loadDatabase = do (catch (decodeFileStrict dbFile) (\(_ :: IOException) -> return Nothing)) - >>= mapM_ (modify . (database .~)) + >>= mapM_ (database .=) -- | Saves the database saveDatabase :: Action () saveDatabase = do - db <- gets (^.database) + db <- use database dbFile <- dbSetup liftIO $ encodeFile dbFile db dbSetup :: Action String dbSetup = do - fn <- gets (^.dbName) + fn <- use dbName liftIO $ do dir <- getAppUserDataDirectory appName createDirectoryIfMissing True dir diff --git a/src/Mtlstats/Control/CreateGoalie.hs b/src/Mtlstats/Control/CreateGoalie.hs index 60866a6..9a5852e 100644 --- a/src/Mtlstats/Control/CreateGoalie.hs +++ b/src/Mtlstats/Control/CreateGoalie.hs @@ -21,15 +21,16 @@ along with this program. If not, see . module Mtlstats.Control.CreateGoalie (createGoalieC) where -import Control.Monad.Trans.State (gets, modify) +import Brick.Widgets.Core (str) +import Control.Monad.State.Class (gets, modify) import Lens.Micro ((^.), (.~), (?~), (%~), to) -import qualified UI.NCurses as C import Mtlstats.Actions import Mtlstats.Format import Mtlstats.Handlers import Mtlstats.Prompt import Mtlstats.Types +import Mtlstats.Util -- | Handles goalie creation createGoalieC :: CreateGoalieState -> Controller @@ -48,33 +49,28 @@ getGoalieNameC = promptController goalieNamePrompt getRookieFlagC :: Controller getRookieFlagC = Controller - { drawController = const $ do - C.drawString "Is this goalie a rookie? (Y/N)" - return C.CursorInvisible - , handleController = \e -> do + { drawController = const $ + str "Is this goalie a rookie? (Y/N)" + , handleController = \e -> modify $ case ynHandler e of Just True -> progMode.createGoalieStateL %~ (cgsRookieFlag ?~ True) . (cgsActiveFlag ?~ True) rf -> progMode.createGoalieStateL.cgsRookieFlag .~ rf - return True } getActiveFlagC :: Controller getActiveFlagC = Controller - { drawController = const $ do - C.drawString "Is this goalie active? (Y/N)" - return C.CursorInvisible - , handleController = \e -> do + { drawController = const $ str "Is this goalie active? (Y/N)" + , handleController = \e -> modify $ progMode.createGoalieStateL.cgsActiveFlag .~ ynHandler e - return True } confirmCreateGoalieC :: Controller confirmCreateGoalieC = Controller - { drawController = \s -> do - let cgs = s^.progMode.createGoalieStateL - C.drawString $ unlines + { drawController = \s -> let + cgs = s^.progMode.createGoalieStateL + in linesToWidget $ labelTable [ ( "Goalie number", maybe "?" show $ cgs^.cgsNumber ) , ( "Goalie name", cgs^.cgsName ) @@ -84,7 +80,6 @@ confirmCreateGoalieC = Controller ++ [ "" , "Create goalie: are you sure? (Y/N)" ] - return C.CursorInvisible , handleController = \e -> do cgs <- gets (^.progMode.createGoalieStateL) let @@ -103,5 +98,4 @@ confirmCreateGoalieC = Controller . (egsCallback .~ success) Just False -> failure Nothing -> return () - return True } diff --git a/src/Mtlstats/Control/CreatePlayer.hs b/src/Mtlstats/Control/CreatePlayer.hs index 14772ca..3f55751 100644 --- a/src/Mtlstats/Control/CreatePlayer.hs +++ b/src/Mtlstats/Control/CreatePlayer.hs @@ -21,15 +21,16 @@ along with this program. If not, see . module Mtlstats.Control.CreatePlayer (createPlayerC) where -import Control.Monad.Trans.State (gets, modify) +import Brick.Widgets.Core (str) +import Control.Monad.State.Class (gets, modify) import Lens.Micro ((^.), (.~), (?~), (%~), to) -import qualified UI.NCurses as C import Mtlstats.Actions import Mtlstats.Format import Mtlstats.Handlers import Mtlstats.Prompt import Mtlstats.Types +import Mtlstats.Util -- | Handles player creation createPlayerC :: CreatePlayerState -> Controller @@ -52,33 +53,26 @@ getPlayerPosC = promptController playerPosPrompt getRookieFlagC :: Controller getRookieFlagC = Controller - { drawController = const $ do - C.drawString "Is this player a rookie? (Y/N)" - return C.CursorInvisible - , handleController = \e -> do + { drawController = const $ str "Is this player a rookie? (Y/N)" + , handleController = \e -> modify $ case ynHandler e of Just True -> progMode.createPlayerStateL %~ (cpsRookieFlag ?~ True) . (cpsActiveFlag ?~ True) rf -> progMode.createPlayerStateL.cpsRookieFlag .~ rf - return True } getActiveFlagC :: Controller getActiveFlagC = Controller - { drawController = const $ do - C.drawString "Is the player active? (Y/N)" - return C.CursorInvisible - , handleController = \e -> do + { drawController = const $ str "Is the player active? (Y/N)" + , handleController = \e -> modify $ progMode.createPlayerStateL.cpsActiveFlag .~ ynHandler e - return True } confirmCreatePlayerC :: Controller confirmCreatePlayerC = Controller - { drawController = \s -> do - let cps = s^.progMode.createPlayerStateL - C.drawString $ unlines + { drawController = \s -> let cps = s^.progMode.createPlayerStateL + in linesToWidget $ labelTable [ ( "Player number", maybe "?" show $ cps^.cpsNumber ) , ( "Player name", cps^.cpsName ) @@ -89,7 +83,6 @@ confirmCreatePlayerC = Controller ++ [ "" , "Create player: are you sure? (Y/N)" ] - return C.CursorInvisible , handleController = \e -> do cps <- gets (^.progMode.createPlayerStateL) let @@ -108,5 +101,4 @@ confirmCreatePlayerC = Controller . (epsCallback .~ success) Just False -> failure Nothing -> return () - return True } diff --git a/src/Mtlstats/Control/EditGoalie.hs b/src/Mtlstats/Control/EditGoalie.hs index ecd8084..179db42 100644 --- a/src/Mtlstats/Control/EditGoalie.hs +++ b/src/Mtlstats/Control/EditGoalie.hs @@ -23,10 +23,11 @@ along with this program. If not, see . module Mtlstats.Control.EditGoalie (editGoalieC) where -import Control.Monad.Trans.State (gets, modify) +import Brick.Types (Widget) +import Brick.Widgets.Core (str, vBox) +import Control.Monad.State.Class (gets, modify) import Data.Maybe (fromMaybe) import Lens.Micro ((^.), (.~), (%~)) -import UI.NCurses as C import Mtlstats.Actions import Mtlstats.Handlers @@ -90,33 +91,19 @@ lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu deleteC :: Action () -> Controller deleteC _ = Controller - { drawController = \s -> do - - C.drawString $ let - - hdr = fromMaybe [] $ do - gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie - goalie <- nth gid $ s^.database.dbGoalies - Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n" - - in hdr ++ "Are you sure you want to delete this goalie? (Y/N)" - - return C.CursorInvisible - - , handleController = \e -> do - - case ynHandler e of - - Just True -> do - gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_ - (\gid -> modify $ database.dbGoalies %~ dropNth gid) - modify edit - - Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu - Nothing -> return () - - return True - + { drawController = \s -> let + hdr = fromMaybe "" $ do + gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie + goalie <- nth gid $ s^.database.dbGoalies + Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n" + in str $ hdr ++ "Are you sure you want to delete this goalie? (Y/N)" + , handleController = \e -> case ynHandler e of + Just True -> do + gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_ + (\gid -> modify $ database.dbGoalies %~ dropNth gid) + modify edit + Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu + Nothing -> return () } ytdGamesC :: Bool -> Action () -> Controller @@ -173,8 +160,11 @@ ltLossesC = curry $ promptController . ltTiesC :: Action () -> Controller ltTiesC = promptController . editGoalieLtTiesPrompt -header :: ProgState -> C.Update () -header s = C.drawString $ fromMaybe "" $ do - gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie - g <- nth gid $ s^.database.dbGoalies - Just $ goalieDetails g ++ "\n" +header :: ProgState -> Widget () -> Widget () +header s w = vBox + [ str $ fromMaybe "" $ do + gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie + g <- nth gid $ s^.database.dbGoalies + Just $ goalieDetails g + , w + ] diff --git a/src/Mtlstats/Control/EditPlayer.hs b/src/Mtlstats/Control/EditPlayer.hs index 6d1bd47..fb348b5 100644 --- a/src/Mtlstats/Control/EditPlayer.hs +++ b/src/Mtlstats/Control/EditPlayer.hs @@ -21,10 +21,11 @@ along with this program. If not, see . module Mtlstats.Control.EditPlayer (editPlayerC) where -import Control.Monad.Trans.State (gets, modify) +import Brick.Types (Widget) +import Brick.Widgets.Core (emptyWidget, str, vBox) +import Control.Monad.State.Class (gets, modify) import Data.Maybe (fromMaybe) import Lens.Micro ((^.), (.~), (%~)) -import qualified UI.NCurses as C import Mtlstats.Actions import Mtlstats.Handlers @@ -81,33 +82,19 @@ lifetimeC _ = menuControllerWith header editPlayerLtMenu deleteC :: Action () -> Controller deleteC _ = Controller - { drawController = \s -> do - - C.drawString $ let - - hdr = fromMaybe [] $ do - pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer - player <- nth pid $ s^.database.dbPlayers - Just $ "Player: " ++ playerDetails player ++ "\n\n" - - in hdr ++ "Are you sure you want to delete this player? (Y/N)" - - return C.CursorInvisible - - , handleController = \e -> do - - case ynHandler e of - - Just True -> do - gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_ - (\pid -> modify $ database.dbPlayers %~ dropNth pid) - modify edit - - Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu - Nothing -> return () - - return True - + { drawController = \s -> let + hdr = fromMaybe [] $ do + pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer + player <- nth pid $ s^.database.dbPlayers + Just $ "Player: " ++ playerDetails player ++ "\n" + in str $ hdr ++ "Are you sure you want to delete this player? (Y/N)" + , handleController = \e -> case ynHandler e of + Just True -> do + gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_ + (\pid -> modify $ database.dbPlayers %~ dropNth pid) + modify edit + Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu + Nothing -> return () } ytdGoalsC :: Bool -> Action () -> Controller @@ -132,8 +119,11 @@ ltAssistsC batchMode callback = promptController $ ltPMinC :: Action () -> Controller ltPMinC = promptController . editPlayerLtPMinPrompt -header :: ProgState -> C.Update () -header s = C.drawString $ fromMaybe "" $ do - pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer - player <- nth pid $ s^.database.dbPlayers - Just $ playerDetails player ++ "\n" +header :: ProgState -> Widget () -> Widget () +header s w = vBox + [ fromMaybe emptyWidget $ do + pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer + player <- nth pid $ s^.database.dbPlayers + Just $ str $ playerDetails player + , w + ] diff --git a/src/Mtlstats/Control/EditStandings.hs b/src/Mtlstats/Control/EditStandings.hs index 85201e3..1ad18ae 100644 --- a/src/Mtlstats/Control/EditStandings.hs +++ b/src/Mtlstats/Control/EditStandings.hs @@ -23,8 +23,9 @@ along with this program. If not, see . module Mtlstats.Control.EditStandings (editStandingsC) where +import Brick.Types (Widget) +import Brick.Widgets.Core (str, vBox) import Lens.Micro ((^.)) -import qualified UI.NCurses as C import Mtlstats.Format import Mtlstats.Menu @@ -65,17 +66,16 @@ menuC = menuControllerWith header promptC :: Prompt -> Controller promptC = promptControllerWith header -header :: ProgState -> C.Update () -header = do - db <- (^.database) - let - home = db^.dbHomeGameStats - away = db^.dbAwayGameStats - table = numTable [" W", " L", " OT", " GF", " GA"] +header :: ProgState -> Widget () -> Widget () +header s w = let + db = s^.database + home = db^.dbHomeGameStats + away = db^.dbAwayGameStats + table = numTable [" W", " L", " OT", " GF", " GA"] [ ( "HOME", valsFor home ) , ( "ROAD", valsFor away ) ] - return $ C.drawString $ unlines $ table ++ [""] + in vBox $ map str (table ++ [""]) ++ [w] valsFor :: GameStats -> [Int] valsFor gs = diff --git a/src/Mtlstats/Control/NewGame.hs b/src/Mtlstats/Control/NewGame.hs index 77080bc..318a60d 100644 --- a/src/Mtlstats/Control/NewGame.hs +++ b/src/Mtlstats/Control/NewGame.hs @@ -21,11 +21,23 @@ along with this program. If not, see . module Mtlstats.Control.NewGame (newGameC) where +import Brick.Main (vScrollBy, vScrollToBeginning) +import Brick.Types + ( BrickEvent (VtyEvent) + , ViewportType (Vertical) + , Widget + ) +import Brick.Widgets.Center (hCenter) +import Brick.Widgets.Core (str, vBox, viewport) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.State (get, gets, modify) +import Control.Monad.State.Class (get, gets, modify) import Data.Maybe (fromJust, fromMaybe, isJust) +import Graphics.Vty.Input.Events + ( Event (EvKey) + , Key (KDown, KHome, KEnter, KUp) + ) import Lens.Micro ((^.), (.~)) -import qualified UI.NCurses as C +import Lens.Micro.Mtl (use) import Mtlstats.Actions import Mtlstats.Actions.NewGame @@ -81,32 +93,30 @@ awayScoreC = promptControllerWith header awayScorePrompt overtimeFlagC :: Controller overtimeFlagC = Controller - { drawController = \s -> do - header s - C.drawString "Did the game go into overtime? (Y/N)" - return C.CursorInvisible - , handleController = \e -> do + { drawController = \s -> header s $ + str "Did the game go into overtime? (Y/N)" + , handleController = \e -> modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e - return True } verifyDataC :: Controller verifyDataC = Controller - { drawController = \s -> do - let gs = s^.progMode.gameStateL - header s - C.drawString "\n" - C.drawString $ unlines $ labelTable + { drawController = \s -> let + gs = s^.progMode.gameStateL + in header s $ vBox $ map str $ + [""] ++ + labelTable [ ( "Date", gameDate gs ) , ( "Game type", show $ fromJust $ gs^.gameType ) , ( "Other team", gs^.otherTeam ) , ( "Home score", show $ fromJust $ gs^.homeScore ) , ( "Away score", show $ fromJust $ gs^.awayScore ) , ( "Overtime", show $ fromJust $ gs^.overtimeFlag ) - ] - C.drawString "\nIs the above information correct? (Y/N)" - return C.CursorInvisible - , handleController = \e -> do + ] ++ + [ "" + , "Is the above information correct? (Y/N)" + ] + , handleController = \e -> case ynHandler e of Just True -> modify $ (progMode.gameStateL.dataVerified .~ True) @@ -114,7 +124,6 @@ verifyDataC = Controller . awardShutouts Just False -> modify $ progMode.gameStateL .~ newGameState Nothing -> return () - return True } goalInput :: GameState -> Controller @@ -131,7 +140,6 @@ recordGoalC = Controller , handleController = \e -> do (game, goal) <- gets gameGoal promptHandler (recordGoalPrompt game goal) e - return True } recordAssistC :: Controller @@ -142,114 +150,97 @@ recordAssistC = Controller , handleController = \e -> do (game, goal, assist) <- gets gameGoalAssist promptHandler (recordAssistPrompt game goal assist) e - return True } confirmGoalDataC :: Controller confirmGoalDataC = Controller - { drawController = \s -> do - let - (game, goal) = gameGoal s - gs = s^.progMode.gameStateL - players = s^.database.dbPlayers - msg = unlines $ - [ " Game: " ++ padNum 2 game - , " Goal: " ++ show goal - , "Goal scored by: " ++ - playerSummary (fromJust $ gs^.goalBy >>= flip nth players) - ] ++ - map - (\pid -> " Assisted by: " ++ - playerSummary (fromJust $ nth pid players)) - (gs^.assistsBy) ++ - [ "" - , "Is the above information correct? (Y/N)" - ] - C.drawString msg - return C.CursorInvisible + { drawController = \s -> let + (game, goal) = gameGoal s + gs = s^.progMode.gameStateL + players = s^.database.dbPlayers + msg = + [ " Game: " ++ padNum 2 game + , " Goal: " ++ show goal + , "Goal scored by: " ++ + playerSummary (fromJust $ gs^.goalBy >>= flip nth players) + ] ++ + map + ( \pid -> " Assisted by: " ++ + playerSummary (fromJust $ nth pid players) + ) + (gs^.assistsBy) ++ + [ "" + , "Is the above information correct? (Y/N)" + ] + in vBox $ map str msg , handleController = \e -> do case ynHandler e of Just True -> modify recordGoalAssists Just False -> modify resetGoalData Nothing -> return () - return True } pMinPlayerC :: Controller pMinPlayerC = Controller - { drawController = \s -> do - header s + { drawController = \s -> header s $ drawPrompt pMinPlayerPrompt s - , handleController = \e -> do - promptHandler pMinPlayerPrompt e - return True + , handleController = promptHandler pMinPlayerPrompt } getPMinsC :: Controller getPMinsC = Controller - { drawController = \s -> do - header s - C.drawString $ fromMaybe "" $ do + { drawController = \s -> header s $ vBox + [ str $ fromMaybe "" $ do pid <- s^.progMode.gameStateL.gameSelectedPlayer player <- nth pid $ s^.database.dbPlayers - Just $ playerSummary player ++ "\n" - drawPrompt assignPMinsPrompt s - , handleController = \e -> do - promptHandler assignPMinsPrompt e - return True + Just $ playerSummary player + , drawPrompt assignPMinsPrompt s + ] + , handleController = promptHandler assignPMinsPrompt } reportC :: Controller reportC = Controller - { drawController = \s -> do - (rows, cols) <- C.windowSize - C.drawString $ unlines $ slice - (s^.scrollOffset) - (fromInteger $ pred rows) - (displayReport (fromInteger $ pred cols) s) - return C.CursorInvisible + { drawController = viewport () Vertical . hCenter . vBox . map str . + displayReport reportCols , handleController = \e -> do + scr <- use scroller case e of - C.EventSpecialKey C.KeyUpArrow -> modify scrollUp - C.EventSpecialKey C.KeyDownArrow -> modify scrollDown - C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0 - - C.EventCharacter '\n' -> do - get >>= liftIO . writeFile reportFilename . exportReport reportCols - modify backHome - + VtyEvent (EvKey k []) -> case k of + KUp -> vScrollBy scr (-1) + KDown -> vScrollBy scr 1 + KHome -> vScrollToBeginning scr + KEnter -> do + get >>= liftIO . writeFile reportFilename . exportReport reportCols + modify backHome + _ -> return () _ -> return () - return True } -header :: ProgState -> C.Update () -header s = C.drawString $ - "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n" +header :: ProgState -> Widget () -> Widget () +header s w = vBox + [ str $ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n" + , w + ] -monthHeader :: ProgState -> C.Update () -monthHeader s = do - (_, cols) <- C.windowSize - header s - - let - table = labelTable $ zip (map show ([1..] :: [Int])) - [ "JANUARY" - , "FEBRUARY" - , "MARCH" - , "APRIL" - , "MAY" - , "JUNE" - , "JULY" - , "AUGUST" - , "SEPTEMBER" - , "OCTOBER" - , "NOVEMBER" - , "DECEMBER" - ] - - C.drawString $ unlines $ - map (centre $ fromIntegral $ pred cols) $ - ["MONTH:", ""] ++ table ++ [""] +monthHeader :: ProgState -> Widget () -> Widget () +monthHeader s w = let + table = labelTable $ zip (map show ([1..] :: [Int])) + [ "JANUARY" + , "FEBRUARY" + , "MARCH" + , "APRIL" + , "MAY" + , "JUNE" + , "JULY" + , "AUGUST" + , "SEPTEMBER" + , "OCTOBER" + , "NOVEMBER" + , "DECEMBER" + ] + in header s $ vBox $ map (hCenter . str) + (["MONTH:", ""] ++ table ++ [""]) ++ [w] gameGoal :: ProgState -> (Int, Int) gameGoal s = diff --git a/src/Mtlstats/Control/NewGame/GoalieInput.hs b/src/Mtlstats/Control/NewGame/GoalieInput.hs index d436b5b..b807750 100644 --- a/src/Mtlstats/Control/NewGame/GoalieInput.hs +++ b/src/Mtlstats/Control/NewGame/GoalieInput.hs @@ -21,9 +21,10 @@ along with this program. If not, see . module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where +import Brick.Types (Widget) +import Brick.Widgets.Core (str, vBox) import Data.Maybe (fromMaybe) import Lens.Micro ((^.)) -import qualified UI.NCurses as C import Mtlstats.Format import Mtlstats.Menu @@ -52,11 +53,11 @@ goalsAllowedC = promptControllerWith header goalsAllowedPrompt selectGameGoalieC :: Controller selectGameGoalieC = menuStateController gameGoalieMenu -header :: ProgState -> C.Update () -header s = C.drawString $ unlines +header :: ProgState -> Widget () -> Widget () +header s w = vBox $ map str [ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***" , fromMaybe "" $ do n <- s^.progMode.gameStateL.gameSelectedGoalie g <- nth n $ s^.database.dbGoalies Just $ goalieSummary g - ] + ] ++ [w] diff --git a/src/Mtlstats/Control/TitleScreen.hs b/src/Mtlstats/Control/TitleScreen.hs index c535aab..23e5bfc 100644 --- a/src/Mtlstats/Control/TitleScreen.hs +++ b/src/Mtlstats/Control/TitleScreen.hs @@ -23,34 +23,32 @@ along with this program. If not, see . module Mtlstats.Control.TitleScreen (titleScreenC) where -import Control.Monad.Trans.State (modify) +import Brick.Types (BrickEvent (VtyEvent)) +import Brick.Widgets.Center (hCenter) +import Brick.Widgets.Core (str, vBox) +import Control.Monad.State.Class (modify) import Data.Char (chr) -import qualified UI.NCurses as C +import Graphics.Vty.Input.Events (Event (EvKey)) import Mtlstats.Actions -import Mtlstats.Format import Mtlstats.Types titleScreenC :: Controller titleScreenC = Controller - { drawController = const $ do - (_, cols) <- C.windowSize - C.drawString $ unlines $ map (centre $ fromIntegral $ pred cols) - $ [ "" - , "MONTREAL CANADIENS STATISTICS" - ] - ++ titleText - ++ [ "" - , "Copyright (C) 1984, 1985, 2019-2021, 2023 Rhéal Lamothe" - , "" - , "" - , "Press any key to continue..." - ] - return C.CursorInvisible + { drawController = const $ vBox $ map (hCenter . str) + $ [ "" + , "MONTREAL CANADIENS STATISTICS" + ] + ++ titleText + ++ [ "" + , "Copyright (C) 1984, 1985, 2019-2021, 2023 Rhéal Lamothe" + , "" + , "" + , "Press any key to continue..." + ] , handleController = \case - C.EventCharacter _ -> modify backHome >> return True - C.EventSpecialKey _ -> modify backHome >> return True - _ -> return True + VtyEvent (EvKey _ _) -> modify backHome + _ -> return () } titleText :: [String] @@ -60,7 +58,7 @@ titleText = box $ map (map blockify) $ foldl joinBlocks (repeat "") box :: [String] -> [String] box strs = [[tl] ++ replicate width horiz ++ [tr]] - ++ map (\str -> [vert] ++ str ++ [vert]) strs + ++ map (\s -> [vert] ++ s ++ [vert]) strs ++ [[bl] ++ replicate width horiz ++ [br]] where width = length $ head strs diff --git a/src/Mtlstats/Handlers.hs b/src/Mtlstats/Handlers.hs index 0d70cbc..59177c9 100644 --- a/src/Mtlstats/Handlers.hs +++ b/src/Mtlstats/Handlers.hs @@ -21,12 +21,13 @@ along with this program. If not, see . module Mtlstats.Handlers (ynHandler) where +import Brick.Types (BrickEvent (VtyEvent)) import Data.Char (toUpper) -import qualified UI.NCurses as C +import Graphics.Vty.Input.Events (Event (EvKey), Key (KChar)) -- | Handler for a yes/no prompt -ynHandler :: C.Event -> Maybe Bool -ynHandler (C.EventCharacter c) = case toUpper c of +ynHandler :: BrickEvent () () -> Maybe Bool +ynHandler (VtyEvent (EvKey (KChar c) _)) = case toUpper c of 'Y' -> Just True 'N' -> Just False _ -> Nothing diff --git a/src/Mtlstats/Helpers/Position.hs b/src/Mtlstats/Helpers/Position.hs index 08ca69b..9fac6d9 100644 --- a/src/Mtlstats/Helpers/Position.hs +++ b/src/Mtlstats/Helpers/Position.hs @@ -28,12 +28,12 @@ module Mtlstats.Helpers.Position , getPositions ) where -import Control.Monad.Trans.State (gets) import Data.Char (toUpper) import Data.List (isInfixOf) import Data.Maybe (fromMaybe) import qualified Data.Set as S import Lens.Micro ((^.), to) +import Lens.Micro.Mtl (use) import Mtlstats.Types import Mtlstats.Util @@ -78,7 +78,7 @@ posCallback posCallback callback = \case Nothing -> callback "" Just n -> do - ps <- gets (^.database.to getPositions) + ps <- use (database.to getPositions) let pos = fromMaybe "" $ nth n ps callback pos diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index a0ca403..aad2274 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -34,40 +34,39 @@ module Mtlstats.Menu ( editMenu ) where -import Control.Monad.Trans.State (gets, modify) +import Brick.Main (halt) +import Brick.Types (BrickEvent (VtyEvent), Widget) +import Brick.Widgets.Center (hCenter) +import Brick.Widgets.Core (str, vBox) +import Control.Monad.State.Class (gets, modify) import Data.Char (toUpper) import qualified Data.Map as M import Data.Maybe (mapMaybe) +import Graphics.Vty.Input.Events (Event (EvKey), Key (KChar)) import Lens.Micro ((^.), (?~)) -import qualified UI.NCurses as C import Mtlstats.Actions import qualified Mtlstats.Actions.NewGame.GoalieInput as GI import Mtlstats.Actions.EditStandings -import Mtlstats.Format import Mtlstats.Types import Mtlstats.Types.Menu import Mtlstats.Util -- | Generates a simple 'Controller' for a Menu menuController :: Menu () -> Controller -menuController = menuControllerWith $ const $ return () +menuController = menuControllerWith $ const id -- | Generate a simple 'Controller' for a 'Menu' with a header menuControllerWith - :: (ProgState -> C.Update ()) - -- ^ Generates the header + :: (ProgState -> Widget () -> Widget()) + -- ^ Function to attach the header -> Menu () -- ^ The menu -> Controller -- ^ The resulting controller menuControllerWith header menu = Controller - { drawController = \s -> do - header s - drawMenu menu - , handleController = \e -> do - menuHandler menu e - return True + { drawController = \s -> header s $ drawMenu menu + , handleController = menuHandler menu } -- | Generate and create a controller for a menu based on the current @@ -82,38 +81,33 @@ menuStateController menuFunc = Controller , handleController = \e -> do menu <- gets menuFunc menuHandler menu e - return True } -- | The draw function for a 'Menu' -drawMenu :: Menu a -> C.Update C.CursorMode -drawMenu m = do - (_, cols) <- C.windowSize - let - width = fromIntegral $ pred cols - menuText = map (centre width) $ lines $ show m - C.drawString $ unlines menuText - return C.CursorInvisible +drawMenu :: Menu a -> Widget () +drawMenu m = let + menuLines = lines $ show m + in hCenter $ vBox $ map str menuLines -- | The event handler for a 'Menu' -menuHandler :: Menu a -> C.Event -> Action a -menuHandler m (C.EventCharacter c) = +menuHandler :: Menu a -> Handler a +menuHandler m (VtyEvent (EvKey (KChar c) [])) = case filter (\i -> i^.miKey == toUpper c) $ m^.menuItems of i:_ -> i^.miAction [] -> return $ m^.menuDefault menuHandler m _ = return $ m^.menuDefault -- | The main menu -mainMenu :: Menu Bool -mainMenu = Menu "MASTER MENU" True +mainMenu :: Menu () +mainMenu = Menu "MASTER MENU" () [ MenuItem 'A' "NEW SEASON" $ - modify startNewSeason >> return True + modify startNewSeason , MenuItem 'B' "NEW GAME" $ - modify startNewGame >> return True + modify startNewGame , MenuItem 'C' "EDIT MENU" $ - modify edit >> return True + modify edit , MenuItem 'E' "EXIT" $ - saveDatabase >> return False + saveDatabase >> halt ] -- | The new season menu diff --git a/src/Mtlstats/Menu/EditGoalie.hs b/src/Mtlstats/Menu/EditGoalie.hs index 838c799..983017b 100644 --- a/src/Mtlstats/Menu/EditGoalie.hs +++ b/src/Mtlstats/Menu/EditGoalie.hs @@ -25,7 +25,7 @@ module Mtlstats.Menu.EditGoalie , editGoalieLtMenu ) where -import Control.Monad.Trans.State (modify) +import Control.Monad.State.Class (modify) import Lens.Micro ((.~), (%~)) import Mtlstats.Actions diff --git a/src/Mtlstats/Menu/EditPlayer.hs b/src/Mtlstats/Menu/EditPlayer.hs index 0363d47..a3423ae 100644 --- a/src/Mtlstats/Menu/EditPlayer.hs +++ b/src/Mtlstats/Menu/EditPlayer.hs @@ -25,7 +25,7 @@ module Mtlstats.Menu.EditPlayer , editPlayerLtMenu ) where -import Control.Monad.Trans.State (modify) +import Control.Monad.State.Class (modify) import Lens.Micro ((.~), (%~)) import Mtlstats.Actions diff --git a/src/Mtlstats/Menu/EditStandings.hs b/src/Mtlstats/Menu/EditStandings.hs index 328549c..1256af1 100644 --- a/src/Mtlstats/Menu/EditStandings.hs +++ b/src/Mtlstats/Menu/EditStandings.hs @@ -25,7 +25,7 @@ module Mtlstats.Menu.EditStandings , editAwayStandingsMenu ) where -import Control.Monad.Trans.State (modify) +import Control.Monad.State.Class (modify) import Mtlstats.Actions import Mtlstats.Actions.EditStandings diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 0ca366e..5df3392 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -19,11 +19,8 @@ along with this program. If not, see . -} -{-# LANGUAGE LambdaCase #-} - module Mtlstats.Prompt ( -- * Prompt Functions - drawPrompt, promptHandler, promptControllerWith, promptController, @@ -51,14 +48,20 @@ module Mtlstats.Prompt ( playerToEditPrompt ) where +import Brick.Types (BrickEvent (VtyEvent), Location (Location), Widget) +import Brick.Widgets.Core (hBox, showCursor, str) import Control.Monad (when) import Control.Monad.Extra (whenJust) -import Control.Monad.Trans.State (gets, modify) +import Control.Monad.State.Class (gets, modify) import Data.Char (isAlphaNum, isDigit, toUpper) +import Graphics.Text.Width (safeWcswidth) +import Graphics.Vty.Input.Events + ( Event (EvKey) + , Key (KChar, KEnter, KEsc, KFun) + ) import Lens.Micro ((^.), (&), (.~), (?~), (%~)) -import Lens.Micro.Extras (view) +import Lens.Micro.Mtl ((.=), use) import Text.Read (readMaybe) -import qualified UI.NCurses as C import Mtlstats.Actions import Mtlstats.Config @@ -66,41 +69,31 @@ import Mtlstats.Helpers.Position import Mtlstats.Types import Mtlstats.Util --- | Draws the prompt to the screen -drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode -drawPrompt p s = do - promptDrawer p s - return C.CursorVisible - -- | Event handler for a prompt -promptHandler :: Prompt -> C.Event -> Action () -promptHandler p (C.EventCharacter '\n') = do - val <- gets $ view inputBuffer - modify $ inputBuffer .~ "" +promptHandler :: Prompt -> Handler () +promptHandler p (VtyEvent (EvKey KEnter [])) = do + val <- use inputBuffer + inputBuffer .= "" promptAction p val -promptHandler p (C.EventCharacter c) = +promptHandler p (VtyEvent (EvKey (KChar c) [])) = modify $ inputBuffer %~ promptProcessChar p c -promptHandler _ (C.EventSpecialKey C.KeyBackspace) = +promptHandler _ (VtyEvent (EvKey KEsc [])) = modify removeChar -promptHandler p (C.EventSpecialKey k) = - promptSpecialKey p k +promptHandler p (VtyEvent (EvKey k m)) = + promptSpecialKey p k m promptHandler _ _ = return () -- | Builds a controller out of a prompt with a header promptControllerWith - :: (ProgState -> C.Update ()) + :: (ProgState -> Widget () -> Widget ()) -- ^ The header -> Prompt -- ^ The prompt to use -> Controller -- ^ The resulting controller promptControllerWith header prompt = Controller - { drawController = \s -> do - header s - drawPrompt prompt s - , handleController = \e -> do - promptHandler prompt e - return True + { drawController = \s -> header s $ drawPrompt prompt s + , handleController = promptHandler prompt } -- | Builds a controller out of a prompt @@ -109,7 +102,7 @@ promptController -- ^ The prompt to use -> Controller -- ^ The resulting controller -promptController = promptControllerWith (const $ return ()) +promptController = promptControllerWith $ const id -- | Builds a string prompt strPrompt @@ -119,10 +112,10 @@ strPrompt -- ^ The callback function for the result -> Prompt strPrompt pStr act = Prompt - { promptDrawer = drawSimplePrompt pStr + { drawPrompt = drawSimplePrompt pStr , promptProcessChar = \ch -> (++ [ch]) , promptAction = act - , promptSpecialKey = const $ return () + , promptSpecialKey = \_ _ -> return () } -- | Creates an upper case string prompt @@ -179,12 +172,12 @@ numPromptWithFallback -- ^ The callback function for the result -> Prompt numPromptWithFallback pStr fallback act = Prompt - { promptDrawer = drawSimplePrompt pStr - , promptProcessChar = \ch str -> if isDigit ch - then str ++ [ch] - else str + { drawPrompt = drawSimplePrompt pStr + , promptProcessChar = \ch existing -> if isDigit ch + then existing ++ [ch] + else existing , promptAction = maybe fallback act . readMaybe - , promptSpecialKey = const $ return () + , promptSpecialKey = \_ _ -> return () } -- | Prompts for a database name @@ -215,18 +208,21 @@ newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn -> -- | Builds a selection prompt selectPrompt :: SelectParams a -> Prompt selectPrompt params = Prompt - { promptDrawer = \s -> do - let sStr = s^.inputBuffer - C.drawString $ spPrompt params ++ sStr - (row, col) <- C.cursorPosition - C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n" - let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database) - C.drawString $ unlines $ map + { drawPrompt = \s -> let + sStr = s^.inputBuffer + pStr = spPrompt params ++ sStr + pWidth = safeWcswidth pStr + results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database) + fmtRes = map (\(n, (_, x)) -> let desc = spElemDesc params x - in "F" ++ show n ++ ") " ++ desc) + in str $ "F" ++ show n ++ ") " ++ desc) results - C.moveCursor row col + in hBox $ + [ showCursor () (Location (0, pWidth)) $ str pStr + , str "" + , str $ spSearchHeader params + ] ++ fmtRes , promptProcessChar = spProcessChar params , promptAction = \sStr -> if null sStr then spCallback params Nothing @@ -235,12 +231,12 @@ selectPrompt params = Prompt case spSearchExact params sStr db of Nothing -> spNotFound params sStr Just n -> spCallback params $ Just n - , promptSpecialKey = \case - C.KeyFunction rawK -> do - sStr <- gets (^.inputBuffer) - db <- gets (^.database) + , promptSpecialKey = \key _ -> case key of + KFun rawK -> do + sStr <- use inputBuffer + db <- use database let - n = pred $ fromInteger rawK + n = pred rawK results = spSearch params sStr db when (n < maxFunKeys) $ whenJust (nth n results) $ \(sel, _) -> do @@ -406,5 +402,8 @@ playerToEditPrompt :: Prompt playerToEditPrompt = selectPlayerPrompt "Player to edit: " $ modify . (progMode.editPlayerStateL.epsSelectedPlayer .~) -drawSimplePrompt :: String -> ProgState -> C.Update () -drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer +drawSimplePrompt :: String -> Renderer +drawSimplePrompt pStr s = let + fullStr = pStr ++ s^.inputBuffer + strWidth = safeWcswidth fullStr + in showCursor () (Location (0, strWidth)) $ str fullStr diff --git a/src/Mtlstats/Prompt/EditGoalie.hs b/src/Mtlstats/Prompt/EditGoalie.hs index fdf5835..82544df 100644 --- a/src/Mtlstats/Prompt/EditGoalie.hs +++ b/src/Mtlstats/Prompt/EditGoalie.hs @@ -39,7 +39,7 @@ module Mtlstats.Prompt.EditGoalie , editGoalieLtTiesPrompt ) where -import Control.Monad.Trans.State (modify) +import Control.Monad.State.Class (modify) import Lens.Micro ((.~)) import Mtlstats.Actions diff --git a/src/Mtlstats/Prompt/EditPlayer.hs b/src/Mtlstats/Prompt/EditPlayer.hs index 1191764..43d93df 100644 --- a/src/Mtlstats/Prompt/EditPlayer.hs +++ b/src/Mtlstats/Prompt/EditPlayer.hs @@ -31,7 +31,7 @@ module Mtlstats.Prompt.EditPlayer , editPlayerLtPMinPrompt ) where -import Control.Monad.Trans.State (modify) +import Control.Monad.State.Class (modify) import Lens.Micro ((.~)) import Mtlstats.Actions diff --git a/src/Mtlstats/Prompt/EditStandings.hs b/src/Mtlstats/Prompt/EditStandings.hs index 6a67702..6e8df45 100644 --- a/src/Mtlstats/Prompt/EditStandings.hs +++ b/src/Mtlstats/Prompt/EditStandings.hs @@ -32,7 +32,7 @@ module Mtlstats.Prompt.EditStandings , editAwayGoalsAgainstPrompt ) where -import Control.Monad.Trans.State (modify) +import Control.Monad.State.Class (modify) import Lens.Micro ((.~), (%~)) import Mtlstats.Prompt diff --git a/src/Mtlstats/Prompt/NewGame.hs b/src/Mtlstats/Prompt/NewGame.hs index 478756d..ccd20d8 100644 --- a/src/Mtlstats/Prompt/NewGame.hs +++ b/src/Mtlstats/Prompt/NewGame.hs @@ -35,7 +35,7 @@ module Mtlstats.Prompt.NewGame ) where import Control.Monad (when) -import Control.Monad.Trans.State (gets, modify) +import Control.Monad.State.Class (gets, modify) import Lens.Micro ((^.), (.~), (?~), (%~)) import Mtlstats.Actions.NewGame diff --git a/src/Mtlstats/Prompt/NewGame/GoalieInput.hs b/src/Mtlstats/Prompt/NewGame/GoalieInput.hs index 19ea0f2..78e1a63 100644 --- a/src/Mtlstats/Prompt/NewGame/GoalieInput.hs +++ b/src/Mtlstats/Prompt/NewGame/GoalieInput.hs @@ -27,7 +27,7 @@ module Mtlstats.Prompt.NewGame.GoalieInput , goalsAllowedPrompt ) where -import Control.Monad.Trans.State (modify) +import Control.Monad.State.Class (modify) import Lens.Micro ((?~)) import Mtlstats.Actions.NewGame.GoalieInput diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index a810f6e..ecef2de 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -24,7 +24,9 @@ along with this program. If not, see . module Mtlstats.Types ( -- * Types Controller (..), + Renderer, Action, + Handler, ProgState (..), ProgMode (..), GameState (..), @@ -52,7 +54,7 @@ module Mtlstats.Types ( progMode, dbName, inputBuffer, - scrollOffset, + scroller, -- ** ProgMode Lenses gameStateL, createPlayerStateL, @@ -195,7 +197,8 @@ module Mtlstats.Types ( gsAverage ) where -import Control.Monad.Trans.State (StateT) +import Brick.Main (ViewportScroll, viewportScroll) +import Brick.Types (BrickEvent, EventM, Widget) import Data.Aeson ( FromJSON , ToJSON @@ -213,22 +216,28 @@ import Data.Aeson import Data.Char (toUpper) import Data.List (find, isInfixOf) import qualified Data.Map as M +import Graphics.Vty.Input.Events (Key, Modifier) import Lens.Micro (Lens', lens, (&), (^.), (.~)) import Lens.Micro.TH (makeLenses) -import qualified UI.NCurses as C import Mtlstats.Config -- | Controls the program flow data Controller = Controller - { drawController :: ProgState -> C.Update C.CursorMode - -- ^ The drawing phase - , handleController :: C.Event -> Action Bool + { drawController :: Renderer + -- ^ The drawing routine + , handleController :: Handler () -- ^ The event handler } +-- | Renders a view based on a "ProgState" +type Renderer = ProgState -> Widget () + -- | Action which maintains program state -type Action a = StateT ProgState C.Curses a +type Action a = EventM () ProgState a + +-- | Handles an event +type Handler a = BrickEvent () () -> Action a -- | Represents the program state data ProgState = ProgState @@ -240,8 +249,8 @@ data ProgState = ProgState -- ^ The name of the database file , _inputBuffer :: String -- ^ Buffer for user input - , _scrollOffset :: Int - -- ^ The scrolling offset for the display + , _scroller :: ViewportScroll () + -- ^ Scroller for the reports } -- | The program mode @@ -532,13 +541,13 @@ data GameStats = GameStats -- | Defines a user prompt data Prompt = Prompt - { promptDrawer :: ProgState -> C.Update () + { drawPrompt :: ProgState -> Widget () -- ^ Draws the prompt to the screen , promptProcessChar :: Char -> String -> String -- ^ Modifies the string based on the character entered , promptAction :: String -> Action () -- ^ Action to perform when the value is entered - , promptSpecialKey :: C.Key -> Action () + , promptSpecialKey :: Key -> [Modifier] -> Action () -- ^ Action to perform when a special key is pressed } @@ -786,11 +795,11 @@ esmSubModeL = lens -- | Constructor for a 'ProgState' newProgState :: ProgState newProgState = ProgState - { _database = newDatabase - , _progMode = TitleScreen - , _dbName = "" - , _inputBuffer = "" - , _scrollOffset = 0 + { _database = newDatabase + , _progMode = TitleScreen + , _dbName = "" + , _inputBuffer = "" + , _scroller = viewportScroll () } -- | Constructor for a 'GameState' diff --git a/src/Mtlstats/Util.hs b/src/Mtlstats/Util.hs index 6616a0f..c06e520 100644 --- a/src/Mtlstats/Util.hs +++ b/src/Mtlstats/Util.hs @@ -26,8 +26,11 @@ module Mtlstats.Util , updateMap , slice , capitalizeName + , linesToWidget ) where +import Brick.Types (Widget) +import Brick.Widgets.Core (str, vBox) import Data.Char (isSpace, toUpper) import qualified Data.Map as M @@ -105,9 +108,9 @@ capitalizeName -- ^ The current string -> String -- ^ The resulting string -capitalizeName ch str = str ++ [ch'] +capitalizeName ch s = s ++ [ch'] where - ch' = if lockFlag str + ch' = if lockFlag s then toUpper ch else ch lockFlag "" = True @@ -118,3 +121,6 @@ capitalizeName ch str = str ++ [ch'] lockFlag' (c:cs) | isSpace c = lockFlag' cs | otherwise = False + +linesToWidget :: [String] -> Widget () +linesToWidget = vBox . map str diff --git a/stack.yaml b/stack.yaml index 678c723..8367588 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-14.0 +resolver: lts-20.22 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..3e0bd6b --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,19 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575 + pantry-tree: + sha256: 093bdc85ed518c81724f5b6b81c24ab4ebdd231551861f4feaa43361136f70b7 + size: 674 + original: + hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575 +snapshots: +- completed: + sha256: dcf4fc28f12d805480ddbe8eb8c370e11db12f0461d0110a4240af27ac88d725 + size: 650255 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/22.yaml + original: lts-20.22 diff --git a/test/Actions/NewGame/GoalieInputSpec.hs b/test/Actions/NewGame/GoalieInputSpec.hs index 1b0137a..72e3a7d 100644 --- a/test/Actions/NewGame/GoalieInputSpec.hs +++ b/test/Actions/NewGame/GoalieInputSpec.hs @@ -215,7 +215,7 @@ setGameGoalieSpec = describe "setGameGoalie" $ mapM_ let ps' = setGameGoalie goalieId ps - [joe', bob'] = ps'^.database.dbGoalies + (joe', bob') = getFirstTwo $ ps'^.database.dbGoalies gStats' = ps'^.progMode.gameStateL.gameGoalieStats context "Joe" $ joe' `TS.compareTest` expectedJoe @@ -380,3 +380,7 @@ setGameGoalieSpec = describe "setGameGoalie" $ mapM_ incSO = gsShutouts %~ succ incLoss = gsLosses %~ succ incOT = gsTies %~ succ + +getFirstTwo :: [a] -> (a, a) +getFirstTwo (x:y:_) = (x, y) +getFirstTwo _ = error "insufficient members of list" diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index afad41d..7f17eef 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -63,8 +63,6 @@ spec = describe "Mtlstats.Actions" $ do resetCreatePlayerStateSpec resetCreateGoalieStateSpec backHomeSpec - scrollUpSpec - scrollDownSpec NewGame.spec EditStandings.spec @@ -425,7 +423,6 @@ backHomeSpec = describe "backHome" $ do input = newProgState & progMode.gameStateL .~ newGameState & inputBuffer .~ "foo" - & scrollOffset .~ 123 result = backHome input it "should set the program mode back to MainMenu" $ @@ -435,33 +432,3 @@ backHomeSpec = describe "backHome" $ do it "should clear the input buffer" $ result^.inputBuffer `shouldBe` "" - - it "should reset the scroll offset" $ - result^.scrollOffset `shouldBe` 0 - -scrollUpSpec :: Spec -scrollUpSpec = describe "scrollUp" $ do - - context "scrolled down" $ - it "should decrease the scroll offset by one" $ let - ps = newProgState & scrollOffset .~ 10 - ps' = scrollUp ps - in ps'^.scrollOffset `shouldBe` 9 - - context "at top" $ - it "should keep the scroll offset at zero" $ let - ps = scrollUp newProgState - in ps^.scrollOffset `shouldBe` 0 - - context "above top" $ - it "should return the scroll offset to zero" $ let - ps = newProgState & scrollOffset .~ (-10) - ps' = scrollUp ps - in ps'^.scrollOffset `shouldBe` 0 - -scrollDownSpec :: Spec -scrollDownSpec = describe "scrollDown" $ - it "should increase the scroll offset" $ let - ps = newProgState & scrollOffset .~ 10 - ps' = scrollDown ps - in ps'^.scrollOffset `shouldBe` 11 diff --git a/test/HandlersSpec.hs b/test/HandlersSpec.hs index 625ba28..0e4dbcb 100644 --- a/test/HandlersSpec.hs +++ b/test/HandlersSpec.hs @@ -22,7 +22,9 @@ along with this program. If not, see . module HandlersSpec (spec) where import Test.Hspec (Spec, context, describe, it, shouldBe) -import qualified UI.NCurses as C + +import Brick.Types (BrickEvent (VtyEvent)) +import Graphics.Vty.Input.Events (Event (EvKey, EvResize), Key (KChar)) import Mtlstats.Handlers @@ -37,10 +39,18 @@ ynHandlerSpec = describe "ynHandler" $ mapM_ it ("should be " ++ show expected) $ ynHandler event `shouldBe` expected) -- description, event, expected - [ ( "Y pressed", C.EventCharacter 'Y', Just True ) - , ( "y pressed", C.EventCharacter 'y', Just True ) - , ( "N pressed", C.EventCharacter 'N', Just False ) - , ( "n pressed", C.EventCharacter 'n', Just False ) - , ( "x pressed", C.EventCharacter 'x', Nothing ) - , ( "other event", C.EventResized, Nothing ) + [ ( "Y pressed", capitalY, Just True ) + , ( "y pressed", lowerY, Just True ) + , ( "N pressed", capitalN, Just False ) + , ( "n pressed", lowerN, Just False ) + , ( "x pressed", lowerX, Nothing ) + , ( "other event", otherEvent, Nothing ) ] + where + capitalY = chE 'Y' + lowerY = chE 'y' + capitalN = chE 'N' + lowerN = chE 'n' + lowerX = chE 'x' + otherEvent = VtyEvent $ EvResize 0 0 + chE c = VtyEvent $ EvKey (KChar c) [] diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 45b5331..509fa8f 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -34,8 +34,8 @@ import Control.Monad (replicateM) import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON) import Data.Aeson.Types (Value (Object)) import qualified Data.Map.Lazy as M -import qualified Data.HashMap.Strict as HM import Data.Ratio ((%)) +import qualified GHC.Exts as HM import Lens.Micro (Lens', (&), (^.), (.~), (?~)) import System.Random (randomIO, randomRIO) import Test.Hspec (Spec, context, describe, it, shouldBe)