diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index d6fa9bd..0000000 --- a/.travis.yml +++ /dev/null @@ -1,40 +0,0 @@ -# This is the simple Travis configuration, which is intended for use -# on applications which do not require cross-platform and -# multiple-GHC-version support. For more information and other -# options, see: -# -# https://docs.haskellstack.org/en/stable/travis_ci/ -# -# Copy these contents into the root directory of your Github project in a file -# named .travis.yml - -# Choose a build environment -dist: xenial - -# Do not choose a language; we provide our own build tools. -language: generic - -# Caching so the next build will be fast too. -cache: - directories: - - $HOME/.stack - -# Ensure necessary system libraries are present -addons: - apt: - packages: - - libgmp-dev - -before_install: -# Download and unpack the stack executable -- mkdir -p ~/.local/bin -- export PATH=$HOME/.local/bin:$PATH -- travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' - -install: -# Build dependencies -- stack --no-terminal --install-ghc test --only-dependencies - -script: -# Build the package, its tests, and its docs and run the tests -- stack --no-terminal test --haddock --no-haddock-deps diff --git a/ChangeLog.md b/ChangeLog.md index 0e5e67c..67470d8 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,8 @@ # Changelog for mtlstats +## current +- updated code to use brick instead of ncurses + ## 0.16.1 - Don't automatically start a new game on new season diff --git a/Vagrantfile b/Vagrantfile deleted file mode 100644 index 1f739c9..0000000 --- a/Vagrantfile +++ /dev/null @@ -1,10 +0,0 @@ -# -*- mode: ruby -*- -# vi: set ft=ruby : - -Vagrant.configure("2") do |config| - config.vm.box = "ubuntu/xenial64" - config.vm.provision "shell", path: "vagrant/provision.sh" - config.vm.provider :virtualbox do |v| - v.customize ["modifyvm", :id, "--memory", 4096] - end -end diff --git a/app/Main.hs b/app/Main.hs index 8ef98b3..23e8e58 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 afa1d36..e51d753 100644 --- a/package.yaml +++ b/package.yaml @@ -1,10 +1,9 @@ name: mtlstats version: 0.16.1 -github: "mtlstats/mtlstats" -license: GPL-3 +license: GPL-3.0-or-later author: "Jonathan Lamothe" maintainer: "jlamothe1980@gmail.com" -copyright: "Rhéal Lamothe" +copyright: "1984, 1985, 2019-2021, 2023 Rhéal Lamothe" extra-source-files: - README.md @@ -21,17 +20,20 @@ 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 +- text-zipper >= 0.12 && < 0.13 +- time >= 1.11.1.1 && < 1.12 +- vty >= 5.37 && < 5.38 ghc-options: - -Wall @@ -61,5 +63,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 eb796cb..ba904da 100644 --- a/src/Mtlstats.hs +++ b/src/Mtlstats.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -19,40 +19,45 @@ 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 (..), halt, showFirstCursor) +import Brick.Types (BrickEvent (VtyEvent), Widget) +import Brick.Util (on) +import Brick.Widgets.Core (fill) +import Control.Monad.State.Class (gets) +import Graphics.Vty.Attributes.Color (blue, white) +import Graphics.Vty.Input.Events + ( Event (EvKey) + , Modifier (MCtrl) + , Key (KChar) + ) 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 = draw + , appChooseCursor = showFirstCursor + , appHandleEvent = handler + , appStartEvent = return () + , appAttrMap = const myAttrMap + } --- | Main program loop -mainLoop :: Action () -mainLoop = do +draw :: ProgState -> [Widget ()] +draw s = + [ drawController (dispatch s) s + , fill ' ' + ] + +handler :: Handler () +handler (VtyEvent (EvKey (KChar 'c') [MCtrl])) = halt +handler e = do c <- gets dispatch - get >>= lift . draw . drawController c - w <- lift C.defaultWindow - whenM (lift (fromJust <$> C.getEvent w Nothing) >>= handleController c) - mainLoop + 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) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index ab6b0f6..2b6bdf2 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -19,7 +19,7 @@ along with this program. If not, see . -} -{-# LANGUAGE LambdaCase, ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables #-} module Mtlstats.Actions ( startNewSeason @@ -27,8 +27,6 @@ module Mtlstats.Actions , clearRookies , resetStandings , startNewGame - , addChar - , removeChar , createPlayer , createGoalie , edit @@ -41,18 +39,21 @@ module Mtlstats.Actions , resetCreatePlayerState , resetCreateGoalieState , backHome - , scrollUp - , scrollDown + , 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.Trans.State (gets, modify) +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 ( createDirectoryIfMissing , getAppUserDataDirectory @@ -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,17 +197,13 @@ resetCreateGoalieState = progMode.createGoalieStateL -- | Resets the program state back to the main menu backHome :: ProgState -> ProgState backHome - = (progMode .~ MainMenu) - . (inputBuffer .~ "") - . (scrollOffset .~ 0) + = (progMode .~ MainMenu) + . (editorW %~ clearEditor) + . (scroller .~ viewportScroll ()) --- | Scrolls the display up -scrollUp :: ProgState -> ProgState -scrollUp = scrollOffset %~ max 0 . pred - --- | Scrolls the display down -scrollDown :: ProgState -> ProgState -scrollDown = scrollOffset %~ succ +-- | Clears an editor +clearEditor :: Editor String () -> Editor String () +clearEditor = applyEdit $ killToEOF . gotoBOF -- | Loads the database loadDatabase :: Action () @@ -226,18 +213,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/Actions/EditStandings.hs b/src/Mtlstats/Actions/EditStandings.hs index c936609..6e9d889 100644 --- a/src/Mtlstats/Actions/EditStandings.hs +++ b/src/Mtlstats/Actions/EditStandings.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Actions/NewGame.hs b/src/Mtlstats/Actions/NewGame.hs index 44d72b1..27eb790 100644 --- a/src/Mtlstats/Actions/NewGame.hs +++ b/src/Mtlstats/Actions/NewGame.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Actions/NewGame/GoalieInput.hs b/src/Mtlstats/Actions/NewGame/GoalieInput.hs index 6b4df22..3a84ba9 100644 --- a/src/Mtlstats/Actions/NewGame/GoalieInput.hs +++ b/src/Mtlstats/Actions/NewGame/GoalieInput.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Config.hs b/src/Mtlstats/Config.hs index 388d836..11f82e4 100644 --- a/src/Mtlstats/Config.hs +++ b/src/Mtlstats/Config.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index badb7e1..abac5d2 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Control/CreateGoalie.hs b/src/Mtlstats/Control/CreateGoalie.hs index 27b0670..0bfaebe 100644 --- a/src/Mtlstats/Control/CreateGoalie.hs +++ b/src/Mtlstats/Control/CreateGoalie.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -21,15 +21,17 @@ 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 Lens.Micro.Mtl ((.=)) 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 +50,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 - modify $ progMode.createGoalieStateL.cgsActiveFlag .~ ynHandler e - return True + { drawController = const $ str "Is this goalie active? (Y/N)" + , handleController = \e -> + progMode.createGoalieStateL.cgsActiveFlag .= ynHandler e } 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 +81,6 @@ confirmCreateGoalieC = Controller ++ [ "" , "Create goalie: are you sure? (Y/N)" ] - return C.CursorInvisible , handleController = \e -> do cgs <- gets (^.progMode.createGoalieStateL) let @@ -103,5 +99,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 0bc07d8..7db55a2 100644 --- a/src/Mtlstats/Control/CreatePlayer.hs +++ b/src/Mtlstats/Control/CreatePlayer.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -21,15 +21,17 @@ 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 Lens.Micro.Mtl ((.=), use) 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 +54,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 - modify $ progMode.createPlayerStateL.cpsActiveFlag .~ ynHandler e - return True + { drawController = const $ str "Is the player active? (Y/N)" + , handleController = \e -> + progMode.createPlayerStateL.cpsActiveFlag .= ynHandler e } 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,9 +84,8 @@ confirmCreatePlayerC = Controller ++ [ "" , "Create player: are you sure? (Y/N)" ] - return C.CursorInvisible , handleController = \e -> do - cps <- gets (^.progMode.createPlayerStateL) + cps <- use $ progMode.createPlayerStateL let success = cps^.cpsSuccessCallback failure = cps^.cpsFailureCallback @@ -108,5 +102,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 87d75e7..ea05ea4 100644 --- a/src/Mtlstats/Control/EditGoalie.hs +++ b/src/Mtlstats/Control/EditGoalie.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -23,10 +23,12 @@ 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 (modify) import Data.Maybe (fromMaybe) -import Lens.Micro ((^.), (.~), (%~)) -import UI.NCurses as C +import Lens.Micro ((^.)) +import Lens.Micro.Mtl ((.=), (%=), use) import Mtlstats.Actions import Mtlstats.Handlers @@ -90,33 +92,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 + use (progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_ + (\gid -> database.dbGoalies %= dropNth gid) + modify edit + Just False -> progMode.editGoalieStateL.egsMode .= EGMenu + Nothing -> return () } ytdGamesC :: Bool -> Action () -> Controller @@ -173,8 +161,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 ed869b2..b60a766 100644 --- a/src/Mtlstats/Control/EditPlayer.hs +++ b/src/Mtlstats/Control/EditPlayer.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -21,10 +21,12 @@ 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 (modify) import Data.Maybe (fromMaybe) -import Lens.Micro ((^.), (.~), (%~)) -import qualified UI.NCurses as C +import Lens.Micro ((^.)) +import Lens.Micro.Mtl ((.=), (%=), use) import Mtlstats.Actions import Mtlstats.Handlers @@ -81,33 +83,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 + use (progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_ + (\pid -> database.dbPlayers %= dropNth pid) + modify edit + Just False -> progMode.editPlayerStateL.epsMode .= EPMenu + Nothing -> return () } ytdGoalsC :: Bool -> Action () -> Controller @@ -132,8 +120,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 22c41f1..a6ffcf3 100644 --- a/src/Mtlstats/Control/EditStandings.hs +++ b/src/Mtlstats/Control/EditStandings.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 (vBox) import Lens.Micro ((^.)) -import qualified UI.NCurses as C import Mtlstats.Format import Mtlstats.Menu @@ -33,6 +34,7 @@ import Mtlstats.Prompt import Mtlstats.Prompt.EditStandings import Mtlstats.Types import Mtlstats.Types.Menu +import Mtlstats.Util -- | Controller for the edit standings menu editStandingsC :: EditStandingsMode -> Controller @@ -65,17 +67,19 @@ 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 + [ linesToWidget $ table ++ [""] + , w + ] valsFor :: GameStats -> [Int] valsFor gs = diff --git a/src/Mtlstats/Control/NewGame.hs b/src/Mtlstats/Control/NewGame.hs index c596b32..e96fcd0 100644 --- a/src/Mtlstats/Control/NewGame.hs +++ b/src/Mtlstats/Control/NewGame.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 - modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e - return True + { drawController = \s -> header s $ + str "Did the game go into overtime? (Y/N)" + , handleController = \e -> + progMode.gameStateL.overtimeFlag .= ynHandler e } 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 $ linesToWidget $ + [""] ++ + 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,100 @@ 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 linesToWidget 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 . linesToWidget . + 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) $ +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 + [ linesToWidgetC $ ["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 938eb06..b807750 100644 --- a/src/Mtlstats/Control/NewGame/GoalieInput.hs +++ b/src/Mtlstats/Control/NewGame/GoalieInput.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 611b26e..dbe6167 100644 --- a/src/Mtlstats/Control/TitleScreen.hs +++ b/src/Mtlstats/Control/TitleScreen.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -23,34 +23,31 @@ 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 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 +import Mtlstats.Util 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, 2020, 2021 Rhéal Lamothe" - , "" - , "" - , "Press any key to continue..." - ] - return C.CursorInvisible + { drawController = const $ linesToWidgetC + $ [ "" + , "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 +57,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/Format.hs b/src/Mtlstats/Format.hs index 5fcec7e..e063a4f 100644 --- a/src/Mtlstats/Format.hs +++ b/src/Mtlstats/Format.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Handlers.hs b/src/Mtlstats/Handlers.hs index fa79b62..846b90a 100644 --- a/src/Mtlstats/Handlers.hs +++ b/src/Mtlstats/Handlers.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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/Goalie.hs b/src/Mtlstats/Helpers/Goalie.hs index ab0b7c3..be01588 100644 --- a/src/Mtlstats/Helpers/Goalie.hs +++ b/src/Mtlstats/Helpers/Goalie.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Helpers/Player.hs b/src/Mtlstats/Helpers/Player.hs index 408fb65..6ac7caf 100644 --- a/src/Mtlstats/Helpers/Player.hs +++ b/src/Mtlstats/Helpers/Player.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Helpers/Position.hs b/src/Mtlstats/Helpers/Position.hs index 4822a54..9fac6d9 100644 --- a/src/Mtlstats/Helpers/Position.hs +++ b/src/Mtlstats/Helpers/Position.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 2ae5cc4..a6d6b5d 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -34,40 +34,37 @@ module Mtlstats.Menu ( editMenu ) where -import Control.Monad.Trans.State (gets, modify) +import Brick.Main (halt) +import Brick.Types (BrickEvent (VtyEvent), Widget) +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 +79,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 linesToWidgetC 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 f84482f..983017b 100644 --- a/src/Mtlstats/Menu/EditGoalie.hs +++ b/src/Mtlstats/Menu/EditGoalie.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 9773624..a3423ae 100644 --- a/src/Mtlstats/Menu/EditPlayer.hs +++ b/src/Mtlstats/Menu/EditPlayer.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 e3e9fff..1256af1 100644 --- a/src/Mtlstats/Menu/EditStandings.hs +++ b/src/Mtlstats/Menu/EditStandings.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 14661e0..6e654fb 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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,21 @@ module Mtlstats.Prompt ( playerToEditPrompt ) where +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.Trans.State (gets, modify) +import Control.Monad.State.Class (gets, modify) import Data.Char (isAlphaNum, isDigit, toUpper) -import Lens.Micro ((^.), (&), (.~), (?~), (%~)) -import Lens.Micro.Extras (view) +import Data.Text.Zipper (deletePrevChar, insertChar) +import Graphics.Vty.Input.Events + ( Event (EvKey) + , Key (KBS, KChar, KEnter, KFun) + ) +import Lens.Micro ((^.), (&), (.~), (?~), (%~), to) +import Lens.Micro.Mtl ((%=), use) import Text.Read (readMaybe) -import qualified UI.NCurses as C import Mtlstats.Actions import Mtlstats.Config @@ -66,41 +70,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 $ editorW.to userText + editorW %= clearEditor promptAction p val -promptHandler p (C.EventCharacter c) = - modify $ inputBuffer %~ promptProcessChar p c -promptHandler _ (C.EventSpecialKey C.KeyBackspace) = - modify removeChar -promptHandler p (C.EventSpecialKey k) = - promptSpecialKey p k +promptHandler p (VtyEvent (EvKey (KChar c) [])) = + editorW %= promptProcessChar p c +promptHandler _ (VtyEvent (EvKey KBS [])) = + editorW.editContentsL %= deletePrevChar +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 +103,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 +113,10 @@ strPrompt -- ^ The callback function for the result -> Prompt strPrompt pStr act = Prompt - { promptDrawer = drawSimplePrompt pStr - , promptProcessChar = \ch -> (++ [ch]) + { drawPrompt = drawSimplePrompt pStr + , promptProcessChar = \ch -> editContentsL %~ insertChar ch , promptAction = act - , promptSpecialKey = const $ return () + , promptSpecialKey = \_ _ -> return () } -- | Creates an upper case string prompt @@ -133,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 @@ -179,12 +173,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 & editContentsL %~ insertChar ch + else existing , promptAction = maybe fallback act . readMaybe - , promptSpecialKey = const $ return () + , promptSpecialKey = \_ _ -> return () } -- | Prompts for a database name @@ -196,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 } @@ -215,18 +209,23 @@ 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^.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 "F" ++ show n ++ ") " ++ desc) + in str $ "F" ++ show n ++ ") " ++ desc) results - C.moveCursor row col + in vBox $ + [ hBox + [ str pStr + , renderEditor linesToWidget True (s^.editorW) + ] + , str " " + , str $ spSearchHeader params + ] ++ fmtRes , promptProcessChar = spProcessChar params , promptAction = \sStr -> if null sStr then spCallback params Nothing @@ -235,16 +234,16 @@ 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 $ editorW . to userText + 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 - modify $ inputBuffer .~ "" + editorW %= clearEditor spCallback params $ Just sel _ -> return () } @@ -397,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 } @@ -406,5 +405,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 = hBox + [ str pStr + , renderEditor linesToWidget True (s^.editorW) + ] diff --git a/src/Mtlstats/Prompt/EditGoalie.hs b/src/Mtlstats/Prompt/EditGoalie.hs index ae16ab4..82544df 100644 --- a/src/Mtlstats/Prompt/EditGoalie.hs +++ b/src/Mtlstats/Prompt/EditGoalie.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 b064723..43d93df 100644 --- a/src/Mtlstats/Prompt/EditPlayer.hs +++ b/src/Mtlstats/Prompt/EditPlayer.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 01b0cb9..6e8df45 100644 --- a/src/Mtlstats/Prompt/EditStandings.hs +++ b/src/Mtlstats/Prompt/EditStandings.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 a26240e..ccd20d8 100644 --- a/src/Mtlstats/Prompt/NewGame.hs +++ b/src/Mtlstats/Prompt/NewGame.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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 d2c6582..78e1a63 100644 --- a/src/Mtlstats/Prompt/NewGame/GoalieInput.hs +++ b/src/Mtlstats/Prompt/NewGame/GoalieInput.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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/Report.hs b/src/Mtlstats/Report.hs index 8ea8d41..a7558fa 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 2afe782..db53b36 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -24,7 +24,9 @@ along with this program. If not, see . module Mtlstats.Types ( -- * Types Controller (..), + Renderer, Action, + Handler, ProgState (..), ProgMode (..), GameState (..), @@ -51,8 +53,8 @@ module Mtlstats.Types ( database, progMode, dbName, - inputBuffer, - scrollOffset, + editorW, + scroller, -- ** ProgMode Lenses gameStateL, createPlayerStateL, @@ -195,7 +197,9 @@ module Mtlstats.Types ( gsAverage ) where -import Control.Monad.Trans.State (StateT) +import Brick.Main (ViewportScroll, viewportScroll) +import Brick.Types (BrickEvent, EventM, Widget) +import Brick.Widgets.Edit (Editor, editor) import Data.Aeson ( FromJSON , ToJSON @@ -213,35 +217,41 @@ 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 - { _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 - , _scrollOffset :: Int - -- ^ The scrolling offset for the display + , _editorW :: Editor String () + -- ^ Editor widget + , _scroller :: ViewportScroll () + -- ^ Scroller for the reports } -- | The program mode @@ -532,13 +542,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 + , 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 :: C.Key -> Action () + , promptSpecialKey :: Key -> [Modifier] -> Action () -- ^ Action to perform when a special key is pressed } @@ -554,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 @@ -786,11 +796,11 @@ esmSubModeL = lens -- | Constructor for a 'ProgState' newProgState :: ProgState newProgState = ProgState - { _database = newDatabase - , _progMode = TitleScreen - , _dbName = "" - , _inputBuffer = "" - , _scrollOffset = 0 + { _database = newDatabase + , _progMode = TitleScreen + , _dbName = "" + , _editorW = editor () (Just 1) "" + , _scroller = viewportScroll () } -- | Constructor for a 'GameState' diff --git a/src/Mtlstats/Types/Menu.hs b/src/Mtlstats/Types/Menu.hs index ea8a958..a791845 100644 --- a/src/Mtlstats/Types/Menu.hs +++ b/src/Mtlstats/Types/Menu.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/src/Mtlstats/Util.hs b/src/Mtlstats/Util.hs index 1edb1de..06d6fff 100644 --- a/src/Mtlstats/Util.hs +++ b/src/Mtlstats/Util.hs @@ -1,7 +1,7 @@ {- | mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -26,10 +26,19 @@ module Mtlstats.Util , updateMap , slice , 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 @@ -101,13 +110,14 @@ 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 str = str ++ [ch'] +capitalizeName ch e = e & editContentsL %~ insertChar ch' where - ch' = if lockFlag str + s = e^.to userText + ch' = if lockFlag s then toUpper ch else ch lockFlag "" = True @@ -118,3 +128,22 @@ capitalizeName ch str = str ++ [ch'] lockFlag' (c:cs) | isSpace c = lockFlag' cs | otherwise = False + +-- | Converts a list of lines to a widget +linesToWidget :: [String] -> Widget () +linesToWidget = vBox . map (str . keepBlank) + +-- | Converts a list of lines to a widget with each line horizontally +-- centered +linesToWidgetC :: [String] -> Widget () +linesToWidgetC = vBox . map (hCenter . str . keepBlank) + +-- | Fetches the text from an editor widget +userText :: Editor String () -> String +userText w = case getEditContents w of + (x:_) -> x + [] -> "" + +keepBlank :: String -> String +keepBlank "" = " " +keepBlank s = s diff --git a/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 index a782f19..3e0bd6b 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -7,13 +7,13 @@ packages: - completed: hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575 pantry-tree: - size: 674 sha256: 093bdc85ed518c81724f5b6b81c24ab4ebdd231551861f4feaa43361136f70b7 + size: 674 original: hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575 snapshots: - completed: - size: 523443 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/0.yaml - sha256: 283773e7120f5446d961eab35ea95c9af9c24187cc178537bd29273200a05171 - original: lts-14.0 + 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/EditStandingsSpec.hs b/test/Actions/EditStandingsSpec.hs index 23f1986..1126cb3 100644 --- a/test/Actions/EditStandingsSpec.hs +++ b/test/Actions/EditStandingsSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/Actions/NewGame/GoalieInputSpec.hs b/test/Actions/NewGame/GoalieInputSpec.hs index 3e2fe8f..72e3a7d 100644 --- a/test/Actions/NewGame/GoalieInputSpec.hs +++ b/test/Actions/NewGame/GoalieInputSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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/Actions/NewGameSpec.hs b/test/Actions/NewGameSpec.hs index ed343af..49caaa9 100644 --- a/test/Actions/NewGameSpec.hs +++ b/test/Actions/NewGameSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 5fd9884..8ac0919 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -24,7 +24,7 @@ along with this program. If not, see . module ActionsSpec (spec) where import Control.Monad (replicateM) -import Lens.Micro ((^.), (&), (.~), (?~), (%~)) +import Lens.Micro ((^.), (&), (.~), (?~), (%~), to) import Test.Hspec ( Spec , context @@ -37,9 +37,11 @@ import Test.Hspec import Mtlstats.Actions import Mtlstats.Types +import Mtlstats.Util import qualified Actions.NewGameSpec as NewGame import qualified Actions.EditStandingsSpec as EditStandings +import SpecHelpers import qualified TypesSpec as TS spec :: Spec @@ -49,8 +51,6 @@ spec = describe "Mtlstats.Actions" $ do resetYtdSpec clearRookiesSpec resetStandingsSpec - addCharSpec - removeCharSpec createPlayerSpec createGoalieSpec editSpec @@ -63,8 +63,6 @@ spec = describe "Mtlstats.Actions" $ do resetCreatePlayerStateSpec resetCreateGoalieStateSpec backHomeSpec - scrollUpSpec - scrollDownSpec NewGame.spec EditStandings.spec @@ -206,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 @@ -424,8 +399,7 @@ backHomeSpec = describe "backHome" $ do let input = newProgState & progMode.gameStateL .~ newGameState - & inputBuffer .~ "foo" - & scrollOffset .~ 123 + & editorW .~ mkEditor "foo" result = backHome input it "should set the program mode back to MainMenu" $ @@ -434,34 +408,4 @@ backHomeSpec = describe "backHome" $ do _ -> False 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 + result^.editorW.to userText `shouldBe` "" diff --git a/test/FormatSpec.hs b/test/FormatSpec.hs index 7db175c..7ed22d0 100644 --- a/test/FormatSpec.hs +++ b/test/FormatSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/HandlersSpec.hs b/test/HandlersSpec.hs index 71aa355..0e4dbcb 100644 --- a/test/HandlersSpec.hs +++ b/test/HandlersSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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/Helpers/GoalieSpec.hs b/test/Helpers/GoalieSpec.hs index 56ab5c8..b1f24c6 100644 --- a/test/Helpers/GoalieSpec.hs +++ b/test/Helpers/GoalieSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/Helpers/PlayerSpec.hs b/test/Helpers/PlayerSpec.hs index a536856..ef6caa1 100644 --- a/test/Helpers/PlayerSpec.hs +++ b/test/Helpers/PlayerSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/Helpers/PositionSpec.hs b/test/Helpers/PositionSpec.hs index 2d04b1d..08cd129 100644 --- a/test/Helpers/PositionSpec.hs +++ b/test/Helpers/PositionSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/HelpersSpec.hs b/test/HelpersSpec.hs index 86a9e66..97f74a4 100644 --- a/test/HelpersSpec.hs +++ b/test/HelpersSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/ReportSpec.hs b/test/ReportSpec.hs index 7d7f6f5..00a2766 100644 --- a/test/ReportSpec.hs +++ b/test/ReportSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/Spec.hs b/test/Spec.hs index e4f98a7..17f6d30 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs new file mode 100644 index 0000000..6c5fcf9 --- /dev/null +++ b/test/SpecHelpers.hs @@ -0,0 +1,29 @@ +{- + +mtlstats +Copyright (C) Rhéal Lamothe + + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program. If not, see . + +-} + +module SpecHelpers where + +import Brick.Widgets.Edit (Editor, editContentsL, editor) +import Data.Text.Zipper (gotoEOL) +import Lens.Micro ((&), (%~)) + +mkEditor :: String -> Editor String () +mkEditor str = editor () (Just 1) str & editContentsL %~ gotoEOL diff --git a/test/Types/MenuSpec.hs b/test/Types/MenuSpec.hs index c5002b6..62dfbcd 100644 --- a/test/Types/MenuSpec.hs +++ b/test/Types/MenuSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 4b45181..509fa8f 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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) diff --git a/test/UtilSpec.hs b/test/UtilSpec.hs index 8acfb92..5da4999 100644 --- a/test/UtilSpec.hs +++ b/test/UtilSpec.hs @@ -1,7 +1,7 @@ {- mtlstats -Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe +Copyright (C) Rhéal Lamothe This program is free software: you can redistribute it and/or modify @@ -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" ) diff --git a/vagrant/as_user.sh b/vagrant/as_user.sh deleted file mode 100755 index ab1b3c8..0000000 --- a/vagrant/as_user.sh +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -echo "export PATH=\"$HOME/.local/bin:$PATH\"" >>~vagrant/.bashrc -mkdir /vagrant/data -ln -s /vagrant/data ~vagrant/.mtlstats - -cd /vagrant -stack install diff --git a/vagrant/provision.sh b/vagrant/provision.sh deleted file mode 100755 index bb2fffd..0000000 --- a/vagrant/provision.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/sh - -apt-get update -apt-get upgrade -apt-get -y install libghc-ncurses-dev -wget -qO- https://get.haskellstack.org/ | sh - -export HOME=/home/vagrant - -sudo -u vagrant /vagrant/vagrant/as_user.sh