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)