Compare commits
68 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 93048d6053 | |||
| d55f7b1f50 | |||
| a5679cb1fc | |||
| bdbf7daf4e | |||
| e0efe2657f | |||
| 886cf0b243 | |||
| 251dc90cea | |||
| 17b3f9a03e | |||
| 01457dbe6f | |||
| 134787e1be | |||
| 284a8c6725 | |||
| d92722be9c | |||
| 820aab5e96 | |||
| 2d5c4e6471 | |||
| 097d51f34b | |||
| 166483dc50 | |||
| 08e0f96a81 | |||
| afae5ea14a | |||
| ea9a9c6a85 | |||
| d40b56da37 | |||
| 5ea2d77921 | |||
| 227401461b | |||
| 458554bef2 | |||
| 855854cd42 | |||
| da6d01b258 | |||
| f869209ec6 | |||
|
|
c6393830e2 | ||
| b054ba66f2 | |||
|
|
1e0b72fc40 | ||
|
|
2c5b4a0791 | ||
|
|
bce31d059b | ||
|
|
99baebe144 | ||
|
|
eb3714c40a | ||
|
|
1bd3ae9564 | ||
|
|
2adfe9b016 | ||
|
|
85a8e3baf1 | ||
|
|
393a2c6dc4 | ||
|
|
ed240c6a38 | ||
|
|
4f147cd5a4 | ||
|
|
9b6dfc4be9 | ||
|
|
c20fb30f5b | ||
|
|
3c0e690ed3 | ||
|
|
f37e231623 | ||
|
|
fbaf2a1e60 | ||
|
|
65979329bd | ||
|
|
ded019faac | ||
|
|
1322004d38 | ||
|
|
2cb279e7e7 | ||
|
|
7ca66ad801 | ||
|
|
82544046ce | ||
|
|
95c97d722e | ||
|
|
0eb46cacce | ||
|
|
25f887a5e8 | ||
|
|
7ba670948b | ||
|
|
ca06b0570e | ||
|
|
1e8473538a | ||
|
|
87336dcd1d | ||
|
|
ffa241c1f7 | ||
|
|
f9085832f4 | ||
|
|
e15623bde3 | ||
|
|
db62fbb542 | ||
|
|
4a8515b862 | ||
|
|
e4c668d1e4 | ||
|
|
9ee33cbd03 | ||
|
|
53c49492cb | ||
|
|
4d1eaa1523 | ||
|
|
8a8a550854 | ||
|
|
6227df8e01 |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -1,3 +1,6 @@
|
||||
.stack-work/
|
||||
mtlstats.cabal
|
||||
.vagrant
|
||||
data
|
||||
*.log
|
||||
*~
|
||||
40
.travis.yml
40
.travis.yml
@@ -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
|
||||
27
ChangeLog.md
27
ChangeLog.md
@@ -1,5 +1,32 @@
|
||||
# Changelog for mtlstats
|
||||
|
||||
## 0.17.0.1
|
||||
- fixed autocapitalization
|
||||
|
||||
## 0.17.0
|
||||
- updated code to use brick instead of ncurses
|
||||
|
||||
## 0.16.1
|
||||
- Don't automatically start a new game on new season
|
||||
|
||||
## 0.16.0
|
||||
- enter months by number
|
||||
|
||||
## 0.15.2
|
||||
- allow ties
|
||||
|
||||
## 0.15.1
|
||||
- only search for active players/goalies on game data input
|
||||
|
||||
## 0.15.0
|
||||
- Ask for database to load on start-up
|
||||
- Add page break to report file
|
||||
- Implemented player/goalie deletion
|
||||
|
||||
## 0.14.0
|
||||
- Fixed a bug that was causing shutouts to not be recorded
|
||||
- Output report to a text file (report.txt)
|
||||
|
||||
## 0.13.0
|
||||
- Added autocomplete to player position prompt
|
||||
- Don't prompt for lifetime stats on rookie player/goalie creation
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,10 +21,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
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
|
||||
|
||||
28
package.yaml
28
package.yaml
@@ -1,10 +1,9 @@
|
||||
name: mtlstats
|
||||
version: 0.13.0
|
||||
github: "mtlstats/mtlstats"
|
||||
license: GPL-3
|
||||
version: 0.17.0.1
|
||||
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 <https://github.com/mtls
|
||||
|
||||
dependencies:
|
||||
- base >= 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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,56 +19,45 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Mtlstats (app) where
|
||||
|
||||
module Mtlstats (initState, mainLoop) where
|
||||
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 Control.Exception (IOException, catch)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.Extra (whenM)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.Trans.State (get, gets)
|
||||
import Data.Aeson (decodeFileStrict)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Lens.Micro ((&), (.~))
|
||||
import System.EasyFile (getAppUserDataDirectory, (</>))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Control
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Initializes the progran
|
||||
initState :: C.Curses ProgState
|
||||
initState = do
|
||||
C.setEcho False
|
||||
void $ C.setCursorMode C.CursorInvisible
|
||||
db <- liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
let dbFile = dir </> dbFname
|
||||
fromMaybe newDatabase <$> catch
|
||||
(decodeFileStrict dbFile)
|
||||
(\(_ :: IOException) -> return Nothing)
|
||||
return
|
||||
$ newProgState
|
||||
& database .~ db
|
||||
-- | 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)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Mtlstats.Actions
|
||||
( startNewSeason
|
||||
@@ -27,8 +27,6 @@ module Mtlstats.Actions
|
||||
, clearRookies
|
||||
, resetStandings
|
||||
, startNewGame
|
||||
, addChar
|
||||
, removeChar
|
||||
, createPlayer
|
||||
, createGoalie
|
||||
, edit
|
||||
@@ -41,16 +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 Data.Aeson (encodeFile)
|
||||
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
|
||||
@@ -91,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
|
||||
@@ -204,24 +197,35 @@ 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
|
||||
-- | Clears an editor
|
||||
clearEditor :: Editor String () -> Editor String ()
|
||||
clearEditor = applyEdit $ killToEOF . gotoBOF
|
||||
|
||||
-- | Scrolls the display down
|
||||
scrollDown :: ProgState -> ProgState
|
||||
scrollDown = scrollOffset %~ succ
|
||||
-- | Loads the database
|
||||
loadDatabase :: Action ()
|
||||
loadDatabase = do
|
||||
dbFile <- dbSetup
|
||||
liftIO
|
||||
(catch
|
||||
(decodeFileStrict dbFile)
|
||||
(\(_ :: IOException) -> return Nothing))
|
||||
>>= mapM_ (database .=)
|
||||
|
||||
-- | Saves the database
|
||||
saveDatabase :: String -> Action ()
|
||||
saveDatabase fn = do
|
||||
db <- gets (^.database)
|
||||
saveDatabase :: Action ()
|
||||
saveDatabase = do
|
||||
db <- use database
|
||||
dbFile <- dbSetup
|
||||
liftIO $ encodeFile dbFile db
|
||||
|
||||
dbSetup :: Action String
|
||||
dbSetup = do
|
||||
fn <- use dbName
|
||||
liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
let dbFile = dir </> fn
|
||||
createDirectoryIfMissing True dir
|
||||
encodeFile dbFile db
|
||||
return $ dir </> fn ++ ".json"
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -43,9 +43,7 @@ import Mtlstats.Util
|
||||
overtimeCheck :: ProgState -> ProgState
|
||||
overtimeCheck s
|
||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL
|
||||
%~ (homeScore .~ Nothing)
|
||||
. (awayScore .~ Nothing)
|
||||
s & progMode.gameStateL.overtimeFlag ?~ True
|
||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||
| otherwise = s
|
||||
@@ -124,12 +122,13 @@ awardGoal n ps = ps
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psGoals %~ succ) m)
|
||||
& database.dbPlayers %~ map
|
||||
(\(i, p) -> if i == n
|
||||
& database.dbPlayers %~ zipWith
|
||||
(\i p -> if i == n
|
||||
then p
|
||||
& pYtd.psGoals %~ succ
|
||||
& pLifetime.psGoals %~ succ
|
||||
else p) . zip [0..]
|
||||
else p)
|
||||
[0..]
|
||||
|
||||
-- | Awards an assist to a player
|
||||
awardAssist
|
||||
@@ -142,12 +141,13 @@ awardAssist n ps = ps
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psAssists %~ succ) m)
|
||||
& database.dbPlayers %~ map
|
||||
(\(i, p) -> if i == n
|
||||
& database.dbPlayers %~ zipWith
|
||||
(\i p -> if i == n
|
||||
then p
|
||||
& pYtd.psAssists %~ succ
|
||||
& pLifetime.psAssists %~ succ
|
||||
else p) . zip [0..]
|
||||
else p)
|
||||
[0..]
|
||||
|
||||
-- | Resets the entered data for the current goal
|
||||
resetGoalData :: ProgState -> ProgState
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -87,18 +87,22 @@ setGameGoalie
|
||||
-> ProgState
|
||||
setGameGoalie gid s = fromMaybe s $ do
|
||||
let gs = s^.progMode.gameStateL
|
||||
won <- gameWon gs
|
||||
lost <- gameLost gs
|
||||
tied <- gs^.overtimeFlag
|
||||
won <- gameWon gs
|
||||
lost <- gameLost gs
|
||||
tied <- gs^.overtimeFlag
|
||||
shutout <- (==0) <$> otherScore gs
|
||||
|
||||
let
|
||||
w = if won then 1 else 0
|
||||
l = if lost then 1 else 0
|
||||
t = if tied then 1 else 0
|
||||
w = if won then 1 else 0
|
||||
l = if lost then 1 else 0
|
||||
t = if tied then 1 else 0
|
||||
so = if shutout then 1 else 0
|
||||
|
||||
updateStats
|
||||
= (gsWins +~ w)
|
||||
. (gsLosses +~ l)
|
||||
. (gsTies +~ t)
|
||||
= (gsWins +~ w)
|
||||
. (gsLosses +~ l)
|
||||
. (gsTies +~ t)
|
||||
. (gsShutouts +~ so)
|
||||
|
||||
updateGoalie
|
||||
= (gYtd %~ updateStats)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -33,10 +33,6 @@ maxFunKeys = 9
|
||||
appName :: String
|
||||
appName = "mtlstats"
|
||||
|
||||
-- | The database filename
|
||||
dbFname :: String
|
||||
dbFname = "database.json"
|
||||
|
||||
-- | The maximum number of assists
|
||||
maxAssists :: Int
|
||||
maxAssists = 2
|
||||
@@ -44,3 +40,11 @@ maxAssists = 2
|
||||
-- | The length of a typical game (in minutes)
|
||||
gameLength :: Int
|
||||
gameLength = 60
|
||||
|
||||
-- | Report output filename
|
||||
reportFilename :: FilePath
|
||||
reportFilename = "report.txt"
|
||||
|
||||
-- | Number of columns in report file
|
||||
reportCols :: Int
|
||||
reportCols = 79
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -39,7 +39,7 @@ import Mtlstats.Types
|
||||
dispatch :: ProgState -> Controller
|
||||
dispatch s = case s^.progMode of
|
||||
TitleScreen -> titleScreenC
|
||||
MainMenu -> mainMenuC
|
||||
MainMenu -> mainMenuC s
|
||||
NewSeason flag -> newSeasonC flag
|
||||
NewGame gs -> newGameC gs
|
||||
EditMenu -> editMenuC
|
||||
@@ -49,11 +49,13 @@ dispatch s = case s^.progMode of
|
||||
EditGoalie egs -> editGoalieC egs
|
||||
(EditStandings esm) -> editStandingsC esm
|
||||
|
||||
mainMenuC :: Controller
|
||||
mainMenuC = Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
mainMenuC :: ProgState -> Controller
|
||||
mainMenuC s = if null $ s^.dbName
|
||||
then promptController getDBPrompt
|
||||
else Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
|
||||
newSeasonC :: Bool -> Controller
|
||||
newSeasonC False = promptController newSeasonPrompt
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,15 +21,17 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,15 +21,17 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -23,10 +23,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Control.EditGoalie (editGoalieC) where
|
||||
|
||||
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.Mtl ((.=), (%=), use)
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditGoalie
|
||||
@@ -52,6 +57,7 @@ editC cb =
|
||||
EGName -> nameC
|
||||
EGYtd -> ytdMenuC
|
||||
EGLifetime -> lifetimeMenuC
|
||||
EGDelete -> deleteC
|
||||
EGYtdGames b -> ytdGamesC b
|
||||
EGYtdMins b -> ytdMinsC b
|
||||
EGYtdGoals b -> ytdGoalsC b
|
||||
@@ -83,6 +89,24 @@ ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
|
||||
lifetimeMenuC :: Action () -> Controller
|
||||
lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
|
||||
|
||||
deleteC :: Action () -> Controller
|
||||
deleteC _ = Controller
|
||||
|
||||
{ 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
|
||||
ytdGamesC = curry $ promptController .
|
||||
uncurry editGoalieYtdGamesPrompt
|
||||
@@ -137,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
|
||||
]
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,10 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Control.EditPlayer (editPlayerC) where
|
||||
|
||||
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.Mtl ((.=), (%=), use)
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditPlayer
|
||||
@@ -45,6 +50,7 @@ editPlayerC eps
|
||||
EPPosition -> positionC
|
||||
EPYtd -> ytdC
|
||||
EPLifetime -> lifetimeC
|
||||
EPDelete -> deleteC
|
||||
EPYtdGoals b -> ytdGoalsC b
|
||||
EPYtdAssists b -> ytdAssistsC b
|
||||
EPYtdPMin -> ytdPMinC
|
||||
@@ -74,6 +80,24 @@ ytdC _ = menuControllerWith header editPlayerYtdMenu
|
||||
lifetimeC :: Action () -> Controller
|
||||
lifetimeC _ = menuControllerWith header editPlayerLtMenu
|
||||
|
||||
deleteC :: Action () -> Controller
|
||||
deleteC _ = Controller
|
||||
|
||||
{ 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
|
||||
ytdGoalsC batchMode callback = promptController $
|
||||
editPlayerYtdGoalsPrompt batchMode callback
|
||||
@@ -96,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
|
||||
]
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -23,8 +23,9 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
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 =
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,13 +21,27 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Control.NewGame (newGameC) where
|
||||
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
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.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
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Control.NewGame.GoalieInput
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Handlers
|
||||
@@ -60,7 +74,7 @@ gameYearC :: Controller
|
||||
gameYearC = promptControllerWith header gameYearPrompt
|
||||
|
||||
gameMonthC :: Controller
|
||||
gameMonthC = menuControllerWith header gameMonthMenu
|
||||
gameMonthC = promptControllerWith monthHeader gameMonthPrompt
|
||||
|
||||
gameDayC :: Controller
|
||||
gameDayC = promptControllerWith header gameDayPrompt
|
||||
@@ -79,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)
|
||||
@@ -112,7 +124,6 @@ verifyDataC = Controller
|
||||
. awardShutouts
|
||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
goalInput :: GameState -> Controller
|
||||
@@ -129,7 +140,6 @@ recordGoalC = Controller
|
||||
, handleController = \e -> do
|
||||
(game, goal) <- gets gameGoal
|
||||
promptHandler (recordGoalPrompt game goal) e
|
||||
return True
|
||||
}
|
||||
|
||||
recordAssistC :: Controller
|
||||
@@ -140,86 +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)
|
||||
(report (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.EventSpecialKey _ -> modify backHome
|
||||
C.EventCharacter _ -> modify backHome
|
||||
_ -> return ()
|
||||
return True
|
||||
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 ()
|
||||
}
|
||||
|
||||
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 -> 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 =
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,9 +21,10 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
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]
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -23,34 +23,31 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
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 Rhéal Lamothe"
|
||||
, "<rheal.lamothe@gmail.com>"
|
||||
, ""
|
||||
, "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"
|
||||
, "<rheal.lamothe@gmail.com>"
|
||||
, ""
|
||||
, "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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -129,9 +129,14 @@ month _ = ""
|
||||
labelTable :: [(String, String)] -> [String]
|
||||
labelTable xs = let
|
||||
labelWidth = maximum $ map (length . fst) xs
|
||||
valWidth = maximum $ map (length . snd) xs
|
||||
|
||||
in map
|
||||
(\(label, val) -> right labelWidth label ++ ": " ++ val)
|
||||
xs
|
||||
( \(label, val)
|
||||
-> right labelWidth label
|
||||
++ ": "
|
||||
++ left valWidth val
|
||||
) xs
|
||||
|
||||
-- | Creates a variable column table of numbers with two axes
|
||||
numTable
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,12 +21,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
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
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -29,47 +29,42 @@ module Mtlstats.Menu (
|
||||
-- * Menus
|
||||
mainMenu,
|
||||
newSeasonMenu,
|
||||
gameMonthMenu,
|
||||
gameTypeMenu,
|
||||
gameGoalieMenu,
|
||||
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.Config
|
||||
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
|
||||
@@ -84,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 dbFname >> return False
|
||||
saveDatabase >> halt
|
||||
]
|
||||
|
||||
-- | The new season menu
|
||||
@@ -125,30 +115,10 @@ newSeasonMenu = Menu "SEASON TYPE" ()
|
||||
$ resetYtd
|
||||
. clearRookies
|
||||
. resetStandings
|
||||
. startNewGame
|
||||
. backHome
|
||||
, MenuItem 'P' "PLAYOFFS" $ modify
|
||||
$ resetStandings
|
||||
. startNewGame
|
||||
]
|
||||
|
||||
-- | Requests the month in which the game took place
|
||||
gameMonthMenu :: Menu ()
|
||||
gameMonthMenu = Menu "MONTH:" () $ map
|
||||
(\(ch, name, val) ->
|
||||
MenuItem ch name $
|
||||
modify $ progMode.gameStateL.gameMonth ?~ val)
|
||||
[ ( 'A', "JANUARY", 1 )
|
||||
, ( 'B', "FEBRUARY", 2 )
|
||||
, ( 'C', "MARCH", 3 )
|
||||
, ( 'D', "APRIL", 4 )
|
||||
, ( 'E', "MAY", 5 )
|
||||
, ( 'F', "JUNE", 6 )
|
||||
, ( 'G', "JULY", 7 )
|
||||
, ( 'H', "AUGUST", 8 )
|
||||
, ( 'I', "SEPTEMBER", 9 )
|
||||
, ( 'J', "OCTOBER", 10 )
|
||||
, ( 'K', "NOVEMBER", 11 )
|
||||
, ( 'L', "DECEMBER", 12 )
|
||||
. backHome
|
||||
]
|
||||
|
||||
-- | The game type menu (home/away)
|
||||
@@ -170,10 +140,11 @@ gameGoalieMenu s = let
|
||||
goalie <- nth n $ s^.database.dbGoalies
|
||||
Just (n, goalie))
|
||||
gids
|
||||
in Menu title () $ map
|
||||
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
|
||||
modify $ GI.setGameGoalie gid) $
|
||||
zip ['1'..] goalies
|
||||
in Menu title () $ zipWith
|
||||
(\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $
|
||||
modify $ GI.setGameGoalie gid)
|
||||
['1'..]
|
||||
goalies
|
||||
|
||||
-- | The edit menu
|
||||
editMenu :: Menu ()
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
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
|
||||
@@ -44,6 +44,7 @@ editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
|
||||
, ( 'D', "ACTIVE FLAG", toggleActive )
|
||||
, ( 'E', "YTD STATS", set EGYtd )
|
||||
, ( 'F', "LIFETIME STATS", set EGLifetime )
|
||||
, ( 'G', "DELETE RECORD", set EGDelete )
|
||||
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||
]
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
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
|
||||
@@ -45,6 +45,7 @@ editPlayerMenu = Menu "EDIT PLAYER" () $ map
|
||||
, ( 'E', "ACTIVE FLAG", toggleActive )
|
||||
, ( 'F', "YTD STATS", set EPYtd )
|
||||
, ( 'G', "LIFETIME STATS", set EPLifetime )
|
||||
, ( 'H', "DELETE RECORD", set EPDelete )
|
||||
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||
]
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,11 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Prompt (
|
||||
-- * Prompt Functions
|
||||
drawPrompt,
|
||||
promptHandler,
|
||||
promptControllerWith,
|
||||
promptController,
|
||||
@@ -31,9 +28,12 @@ module Mtlstats.Prompt (
|
||||
ucStrPrompt,
|
||||
namePrompt,
|
||||
numPrompt,
|
||||
numPromptRange,
|
||||
numPromptWithFallback,
|
||||
dbNamePrompt,
|
||||
selectPrompt,
|
||||
-- * Individual prompts
|
||||
getDBPrompt,
|
||||
newSeasonPrompt,
|
||||
playerNumPrompt,
|
||||
playerNamePrompt,
|
||||
@@ -41,19 +41,28 @@ module Mtlstats.Prompt (
|
||||
goalieNumPrompt,
|
||||
goalieNamePrompt,
|
||||
selectPlayerPrompt,
|
||||
selectActivePlayerPrompt,
|
||||
selectGoaliePrompt,
|
||||
selectActiveGoaliePrompt,
|
||||
selectPositionPrompt,
|
||||
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
|
||||
@@ -61,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
|
||||
@@ -104,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
|
||||
@@ -114,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
|
||||
@@ -128,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 (toUpper ch) }
|
||||
|
||||
-- | Creates a prompt which forces capitalization of input to
|
||||
-- accomodate a player or goalie name
|
||||
@@ -150,6 +149,20 @@ numPrompt
|
||||
-> Prompt
|
||||
numPrompt pStr = numPromptWithFallback pStr $ return ()
|
||||
|
||||
-- | Builds a numberic prompt with a range
|
||||
numPromptRange
|
||||
:: Int
|
||||
-- ^ The minimum value
|
||||
-> Int
|
||||
-- ^ The maximum value
|
||||
-> String
|
||||
-- ^ The prompt string
|
||||
-> (Int -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
numPromptRange nMin nMax pStr callback = numPrompt pStr $ \n ->
|
||||
when (n >= nMin && n <= nMax) $ callback n
|
||||
|
||||
-- | Builds a numeric prompt with a fallback action
|
||||
numPromptWithFallback
|
||||
:: String
|
||||
@@ -160,50 +173,59 @@ 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
|
||||
, promptAction = \inStr -> case readMaybe inStr of
|
||||
Nothing -> fallback
|
||||
Just n -> act n
|
||||
, promptSpecialKey = const $ return ()
|
||||
{ drawPrompt = drawSimplePrompt pStr
|
||||
, promptProcessChar = \ch existing -> if isDigit ch
|
||||
then existing & editContentsL %~ insertChar ch
|
||||
else existing
|
||||
, promptAction = maybe fallback act . readMaybe
|
||||
, promptSpecialKey = \_ _ -> return ()
|
||||
}
|
||||
|
||||
-- | Prompts for a database name
|
||||
dbNamePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (String -> Action ())
|
||||
-- ^ The callback to pass the result to
|
||||
-> Prompt
|
||||
dbNamePrompt pStr act = (strPrompt pStr act)
|
||||
{ promptProcessChar = \ch -> if isAlphaNum ch || ch == '-'
|
||||
then editContentsL %~ insertChar (toUpper ch)
|
||||
else id
|
||||
}
|
||||
|
||||
-- | Prompts the user for a filename to save a backup of the database
|
||||
-- to
|
||||
newSeasonPrompt :: Prompt
|
||||
newSeasonPrompt = prompt
|
||||
{ promptProcessChar = \ch str -> if validChar ch
|
||||
then str ++ [toUpper ch]
|
||||
else str
|
||||
}
|
||||
where
|
||||
|
||||
prompt = strPrompt "Filename to save database: " $ \fn ->
|
||||
if null fn
|
||||
then modify backHome
|
||||
else do
|
||||
saveDatabase $ fn ++ ".json"
|
||||
modify $ progMode .~ NewSeason True
|
||||
|
||||
validChar = (||) <$> isAlphaNum <*> (=='-')
|
||||
newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
|
||||
if null fn
|
||||
then modify backHome
|
||||
else do
|
||||
saveDatabase
|
||||
modify
|
||||
$ (dbName .~ fn)
|
||||
. (progMode .~ NewSeason True)
|
||||
|
||||
-- | 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
|
||||
@@ -212,20 +234,26 @@ 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 ()
|
||||
}
|
||||
|
||||
-- | Prompts for the database to load
|
||||
getDBPrompt :: Prompt
|
||||
getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
|
||||
modify $ dbName .~ fn
|
||||
loadDatabase
|
||||
|
||||
-- | Prompts for a new player's number
|
||||
playerNumPrompt :: Prompt
|
||||
playerNumPrompt = numPrompt "Player number: " $
|
||||
@@ -251,18 +279,21 @@ goalieNamePrompt :: Prompt
|
||||
goalieNamePrompt = namePrompt "Goalie name: " $
|
||||
modify . (progMode.createGoalieStateL.cgsName .~)
|
||||
|
||||
-- | Selects a player (creating one if necessary)
|
||||
selectPlayerPrompt
|
||||
:: String
|
||||
-- | Selects a player using a specified search function (creating the
|
||||
-- player if necessary)
|
||||
selectPlayerPromptWith
|
||||
:: (String -> [Player] -> [(Int, Player)])
|
||||
-- ^ The search function
|
||||
-> String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the payer as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
||||
selectPlayerPromptWith sFunc pStr callback = selectPrompt SelectParams
|
||||
{ spPrompt = pStr
|
||||
, spSearchHeader = "Player select:"
|
||||
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
|
||||
, spSearch = \sStr db -> sFunc sStr (db^.dbPlayers)
|
||||
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
||||
, spElemDesc = playerSummary
|
||||
, spProcessChar = capitalizeName
|
||||
@@ -280,18 +311,41 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
||||
modify $ progMode .~ CreatePlayer cps
|
||||
}
|
||||
|
||||
-- | Selects a goalie (creating one if necessary)
|
||||
selectGoaliePrompt
|
||||
-- | Selects a player (creating one if necessary)
|
||||
selectPlayerPrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the payer as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectPlayerPrompt = selectPlayerPromptWith playerSearch
|
||||
|
||||
-- | Selects an active player (creating one if necessary)
|
||||
selectActivePlayerPrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the payer as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectActivePlayerPrompt = selectPlayerPromptWith activePlayerSearch
|
||||
|
||||
-- | Selects a goalie with a specified search criteria (creating the
|
||||
-- goalie if necessary)
|
||||
selectGoaliePromptWith
|
||||
:: (String -> [Goalie] -> [(Int, Goalie)])
|
||||
-- ^ The search criteria
|
||||
-> String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the goalie as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
||||
selectGoaliePromptWith criteria pStr callback = selectPrompt SelectParams
|
||||
{ spPrompt = pStr
|
||||
, spSearchHeader = "Goalie select:"
|
||||
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
|
||||
, spSearch = \sStr db -> criteria sStr (db^.dbGoalies)
|
||||
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
||||
, spElemDesc = goalieSummary
|
||||
, spProcessChar = capitalizeName
|
||||
@@ -309,6 +363,26 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
||||
modify $ progMode .~ CreateGoalie cgs
|
||||
}
|
||||
|
||||
-- | Selects a goalie (creating one if necessary)
|
||||
selectGoaliePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the goalie as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectGoaliePrompt = selectGoaliePromptWith goalieSearch
|
||||
|
||||
-- | Selects an active goalie (creating one if necessary)
|
||||
selectActiveGoaliePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the goalie as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectActiveGoaliePrompt = selectGoaliePromptWith activeGoalieSearch
|
||||
|
||||
-- | Selects (or creates) a player position
|
||||
selectPositionPrompt
|
||||
:: String
|
||||
@@ -322,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
|
||||
}
|
||||
@@ -331,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)
|
||||
]
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -23,6 +23,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Prompt.NewGame
|
||||
( gameYearPrompt
|
||||
, gameMonthPrompt
|
||||
, gameDayPrompt
|
||||
, otherTeamPrompt
|
||||
, homeScorePrompt
|
||||
@@ -34,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
|
||||
@@ -48,6 +49,11 @@ gameYearPrompt :: Prompt
|
||||
gameYearPrompt = numPrompt "Game year: " $
|
||||
modify . (progMode.gameStateL.gameYear ?~)
|
||||
|
||||
-- | Prompts for the game month
|
||||
gameMonthPrompt :: Prompt
|
||||
gameMonthPrompt = numPromptRange 1 12 "Game month: " $
|
||||
modify . (progMode.gameStateL.gameMonth ?~)
|
||||
|
||||
-- | Prompts for the day of the month the game took place
|
||||
gameDayPrompt :: Prompt
|
||||
gameDayPrompt = numPrompt "Day of month: " $
|
||||
@@ -76,7 +82,7 @@ recordGoalPrompt
|
||||
-> Int
|
||||
-- ^ The goal number
|
||||
-> Prompt
|
||||
recordGoalPrompt game goal = selectPlayerPrompt
|
||||
recordGoalPrompt game goal = selectActivePlayerPrompt
|
||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||
++ "Who scored goal number " ++ show goal ++ "? "
|
||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
||||
@@ -90,7 +96,7 @@ recordAssistPrompt
|
||||
-> Int
|
||||
-- ^ The assist number
|
||||
-> Prompt
|
||||
recordAssistPrompt game goal assist = selectPlayerPrompt
|
||||
recordAssistPrompt game goal assist = selectActivePlayerPrompt
|
||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||
++ "Goal: " ++ show goal ++ "\n"
|
||||
++ "Assist #" ++ show assist ++ ": "
|
||||
@@ -104,7 +110,7 @@ recordAssistPrompt game goal assist = selectPlayerPrompt
|
||||
|
||||
-- | Prompts for the player to assign penalty minutes to
|
||||
pMinPlayerPrompt :: Prompt
|
||||
pMinPlayerPrompt = selectPlayerPrompt
|
||||
pMinPlayerPrompt = selectActivePlayerPrompt
|
||||
"Assign penalty minutes to: " $
|
||||
\case
|
||||
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
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
|
||||
@@ -36,7 +36,8 @@ import Mtlstats.Types
|
||||
|
||||
-- | Prompts for a goalie who played in the game
|
||||
selectGameGoaliePrompt :: Prompt
|
||||
selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
|
||||
selectGameGoaliePrompt = selectActiveGoaliePrompt
|
||||
"Which goalie played this game: " $
|
||||
\case
|
||||
Nothing -> modify finishGoalieEntry
|
||||
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Report (report, gameDate) where
|
||||
module Mtlstats.Report (displayReport, exportReport, gameDate) where
|
||||
|
||||
import Data.List (sortOn)
|
||||
import qualified Data.Map as M
|
||||
@@ -34,21 +34,37 @@ import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Generates the report
|
||||
report
|
||||
-- | Generates the report displayed on screen
|
||||
displayReport
|
||||
:: Int
|
||||
-- ^ The number of columns for the report
|
||||
-> ProgState
|
||||
-- ^ The program state
|
||||
-> [String]
|
||||
displayReport width s
|
||||
= report width s
|
||||
++ [""]
|
||||
++ lifetimeStatsReport width s
|
||||
|
||||
-- | Generates the report to be exported to file
|
||||
exportReport
|
||||
:: Int
|
||||
-- ^ The number of columns in the report
|
||||
-> ProgState
|
||||
-- ^ The program state
|
||||
-> String
|
||||
exportReport width s
|
||||
= unlines (report width s)
|
||||
++ "\f"
|
||||
++ unlines (lifetimeStatsReport width s)
|
||||
|
||||
report :: Int -> ProgState -> [String]
|
||||
report width s
|
||||
= standingsReport width s
|
||||
++ [""]
|
||||
++ gameStatsReport width s
|
||||
++ [""]
|
||||
++ yearToDateStatsReport width s
|
||||
++ [""]
|
||||
++ lifetimeStatsReport width s
|
||||
|
||||
standingsReport :: Int -> ProgState -> [String]
|
||||
standingsReport width s = fromMaybe [] $ do
|
||||
@@ -241,8 +257,7 @@ filteredPlayerReport width label criteria showTotals lineNumbers ps = let
|
||||
else repeat ""
|
||||
|
||||
table = overlayLast olayText
|
||||
$ map (\(ln, line) -> overlay ln $ centre width line)
|
||||
$ zip lnOverlay
|
||||
$ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ tHeader : body ++ if showTotals
|
||||
then [separator, totals]
|
||||
@@ -301,8 +316,7 @@ goalieReport width showTotals lineNumbers goalieData = let
|
||||
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||
else repeat ""
|
||||
|
||||
in map (\(ln, line) -> overlay ln $ centre width line)
|
||||
$ zip lnOverlay
|
||||
in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
|
||||
$ overlayLast olayText
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ header : body ++ if showTotals
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -24,7 +24,9 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module Mtlstats.Types (
|
||||
-- * Types
|
||||
Controller (..),
|
||||
Renderer,
|
||||
Action,
|
||||
Handler,
|
||||
ProgState (..),
|
||||
ProgMode (..),
|
||||
GameState (..),
|
||||
@@ -50,8 +52,9 @@ module Mtlstats.Types (
|
||||
-- ** ProgState Lenses
|
||||
database,
|
||||
progMode,
|
||||
inputBuffer,
|
||||
scrollOffset,
|
||||
dbName,
|
||||
editorW,
|
||||
scroller,
|
||||
-- ** ProgMode Lenses
|
||||
gameStateL,
|
||||
createPlayerStateL,
|
||||
@@ -175,6 +178,7 @@ module Mtlstats.Types (
|
||||
addGameStats,
|
||||
-- ** Player Helpers
|
||||
playerSearch,
|
||||
activePlayerSearch,
|
||||
playerSearchExact,
|
||||
modifyPlayer,
|
||||
playerSummary,
|
||||
@@ -184,6 +188,7 @@ module Mtlstats.Types (
|
||||
addPlayerStats,
|
||||
-- ** Goalie Helpers
|
||||
goalieSearch,
|
||||
activeGoalieSearch,
|
||||
goalieSearchExact,
|
||||
goalieSummary,
|
||||
goalieIsActive,
|
||||
@@ -192,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
|
||||
@@ -208,36 +215,43 @@ import Data.Aeson
|
||||
, (.=)
|
||||
)
|
||||
import Data.Char (toUpper)
|
||||
import Data.List (isInfixOf)
|
||||
import Data.List (find, isInfixOf)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (listToMaybe)
|
||||
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
|
||||
, _inputBuffer :: String
|
||||
-- ^ Buffer for user input
|
||||
, _scrollOffset :: Int
|
||||
-- ^ The scrolling offset for the display
|
||||
, _dbName :: String
|
||||
-- ^ The name of the database file
|
||||
, _editorW :: Editor String ()
|
||||
-- ^ Editor widget
|
||||
, _scroller :: ViewportScroll ()
|
||||
-- ^ Scroller for the reports
|
||||
}
|
||||
|
||||
-- | The program mode
|
||||
@@ -376,6 +390,7 @@ data EditPlayerMode
|
||||
| EPPosition
|
||||
| EPYtd
|
||||
| EPLifetime
|
||||
| EPDelete
|
||||
| EPYtdGoals Bool
|
||||
| EPYtdAssists Bool
|
||||
| EPYtdPMin
|
||||
@@ -401,6 +416,7 @@ data EditGoalieMode
|
||||
| EGName
|
||||
| EGYtd
|
||||
| EGLifetime
|
||||
| EGDelete
|
||||
| EGYtdGames Bool
|
||||
| EGYtdMins Bool
|
||||
| EGYtdGoals Bool
|
||||
@@ -526,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
|
||||
}
|
||||
|
||||
@@ -548,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
|
||||
@@ -780,10 +796,11 @@ esmSubModeL = lens
|
||||
-- | Constructor for a 'ProgState'
|
||||
newProgState :: ProgState
|
||||
newProgState = ProgState
|
||||
{ _database = newDatabase
|
||||
, _progMode = TitleScreen
|
||||
, _inputBuffer = ""
|
||||
, _scrollOffset = 0
|
||||
{ _database = newDatabase
|
||||
, _progMode = TitleScreen
|
||||
, _dbName = ""
|
||||
, _editorW = editor () (Just 1) ""
|
||||
, _scroller = viewportScroll ()
|
||||
}
|
||||
|
||||
-- | Constructor for a 'GameState'
|
||||
@@ -998,6 +1015,23 @@ addGameStats s1 s2 = GameStats
|
||||
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
|
||||
}
|
||||
|
||||
-- | Searches through a list of players with a specified criteria
|
||||
playerSearchWith
|
||||
:: (Player -> Bool)
|
||||
-- ^ The search criteria
|
||||
-> String
|
||||
-- ^ The search string
|
||||
-> [Player]
|
||||
-- ^ The list of players to search
|
||||
-> [(Int, Player)]
|
||||
-- ^ The matching players with their index numbers
|
||||
playerSearchWith criteria sStr =
|
||||
filter match . zip [0..]
|
||||
where
|
||||
match (_, p)
|
||||
= map toUpper sStr `isInfixOf` map toUpper (p^.pName)
|
||||
&& criteria p
|
||||
|
||||
-- | Searches through a list of players
|
||||
playerSearch
|
||||
:: String
|
||||
@@ -1006,9 +1040,17 @@ playerSearch
|
||||
-- ^ The list of players to search
|
||||
-> [(Int, Player)]
|
||||
-- ^ The matching players with their index numbers
|
||||
playerSearch sStr =
|
||||
filter match . zip [0..]
|
||||
where match (_, p) = map toUpper sStr `isInfixOf` map toUpper (p^.pName)
|
||||
playerSearch = playerSearchWith $ const True
|
||||
|
||||
-- | Searches through a list of players for an active player
|
||||
activePlayerSearch
|
||||
:: String
|
||||
-- ^ The search string
|
||||
-> [Player]
|
||||
-- ^ The list of players to search
|
||||
-> [(Int, Player)]
|
||||
-- ^ The matching players with their index numbers
|
||||
activePlayerSearch = playerSearchWith (^.pActive)
|
||||
|
||||
-- | Searches for a player by exact match on name
|
||||
playerSearchExact
|
||||
@@ -1019,7 +1061,7 @@ playerSearchExact
|
||||
-> Maybe (Int, Player)
|
||||
-- ^ The player's index and value
|
||||
playerSearchExact sStr =
|
||||
listToMaybe . filter match . zip [0..]
|
||||
find match . zip [0..]
|
||||
where match (_, p) = p^.pName == sStr
|
||||
|
||||
-- | Modifies a player with a given name
|
||||
@@ -1063,6 +1105,23 @@ addPlayerStats s1 s2 = newPlayerStats
|
||||
& psAssists .~ s1^.psAssists + s2^.psAssists
|
||||
& psPMin .~ s1^.psPMin + s2^.psPMin
|
||||
|
||||
-- | Searches a list of goalies with a search criteria
|
||||
goalieSearchWith
|
||||
:: (Goalie -> Bool)
|
||||
-- ^ The search criteria
|
||||
-> String
|
||||
-- ^ The search string
|
||||
-> [Goalie]
|
||||
-- ^ The list to search
|
||||
-> [(Int, Goalie)]
|
||||
-- ^ The search results with their corresponding index numbers
|
||||
goalieSearchWith criteria sStr =
|
||||
filter match . zip [0..]
|
||||
where
|
||||
match (_, g)
|
||||
= map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
||||
&& criteria g
|
||||
|
||||
-- | Searches a list of goalies
|
||||
goalieSearch
|
||||
:: String
|
||||
@@ -1071,9 +1130,17 @@ goalieSearch
|
||||
-- ^ The list to search
|
||||
-> [(Int, Goalie)]
|
||||
-- ^ The search results with their corresponding index numbers
|
||||
goalieSearch sStr =
|
||||
filter match . zip [0..]
|
||||
where match (_, g) = map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
||||
goalieSearch = goalieSearchWith $ const True
|
||||
|
||||
-- | Searches a list of goalies for an active goalie
|
||||
activeGoalieSearch
|
||||
:: String
|
||||
-- ^ The search string
|
||||
-> [Goalie]
|
||||
-- ^ The list to search
|
||||
-> [(Int, Goalie)]
|
||||
-- ^ The search results with their corresponding index numbers
|
||||
activeGoalieSearch = goalieSearchWith (^.gActive)
|
||||
|
||||
-- | Searches a list of goalies for an exact match
|
||||
goalieSearchExact
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -22,13 +22,23 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module Mtlstats.Util
|
||||
( nth
|
||||
, modifyNth
|
||||
, dropNth
|
||||
, 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
|
||||
@@ -52,8 +62,21 @@ modifyNth
|
||||
-> [a]
|
||||
-- ^ The list
|
||||
-> [a]
|
||||
modifyNth n f = map (\(i, x) -> if i == n then f x else x)
|
||||
. zip [0..]
|
||||
modifyNth n f = zipWith
|
||||
(\i x -> if i == n then f x else x)
|
||||
[0..]
|
||||
|
||||
-- | Attempt to drop the nth element from a list
|
||||
dropNth
|
||||
:: Int
|
||||
-- ^ The index of the element to drop
|
||||
-> [a]
|
||||
-- ^ The list to be modified
|
||||
-> [a]
|
||||
-- ^ The modified list
|
||||
dropNth n = foldr
|
||||
(\(i, x) acc -> if i == n then acc else x : acc)
|
||||
[] . zip [0..]
|
||||
|
||||
-- | Modify a value indexed by a given key in a map using a default
|
||||
-- initial value if not present
|
||||
@@ -87,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
|
||||
@@ -104,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
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -33,7 +33,7 @@ import Mtlstats.Util
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Actions.GoalieInput" $ do
|
||||
spec = describe "GoalieInput" $ do
|
||||
finishGoalieEntrySpec
|
||||
recordGoalieStatsSpec
|
||||
setGameGoalieSpec
|
||||
@@ -208,107 +208,179 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||
]
|
||||
|
||||
setGameGoalieSpec :: Spec
|
||||
setGameGoalieSpec = describe "setGameGoalie" $ let
|
||||
setGameGoalieSpec = describe "setGameGoalie" $ mapM_
|
||||
|
||||
goalieStats w l t = newGoalieStats
|
||||
& gsWins .~ w
|
||||
& gsLosses .~ l
|
||||
& gsTies .~ t
|
||||
(\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
|
||||
context label $ do
|
||||
|
||||
bob = newGoalie 2 "Bob"
|
||||
& gYtd .~ goalieStats 10 11 12
|
||||
& gLifetime .~ goalieStats 20 21 22
|
||||
let
|
||||
ps' = setGameGoalie goalieId ps
|
||||
(joe', bob') = getFirstTwo $ ps'^.database.dbGoalies
|
||||
gStats' = ps'^.progMode.gameStateL.gameGoalieStats
|
||||
|
||||
joe = newGoalie 3 "Joe"
|
||||
& gYtd .~ goalieStats 30 31 32
|
||||
& gLifetime .~ goalieStats 40 41 42
|
||||
context "Joe" $ joe' `TS.compareTest` expectedJoe
|
||||
context "Bob" $ bob' `TS.compareTest` expectedBob
|
||||
context "game stats" $ gStats' `TS.compareTest` expectedGStats)
|
||||
|
||||
gameState h a ot = newGameState
|
||||
& gameType ?~ HomeGame
|
||||
& homeScore ?~ h
|
||||
& awayScore ?~ a
|
||||
& overtimeFlag ?~ ot
|
||||
[ ( "Joe wins - no shutout"
|
||||
, 0
|
||||
, psWin
|
||||
, joeWin
|
||||
, bob
|
||||
, gsJoeWin
|
||||
)
|
||||
|
||||
winningGame = gameState 1 0 False
|
||||
losingGame = gameState 0 1 False
|
||||
tiedGame = gameState 0 1 True
|
||||
, ( "Bob wins - no shutout"
|
||||
, 1
|
||||
, psWin
|
||||
, joe
|
||||
, bobWin
|
||||
, gsBobWin
|
||||
)
|
||||
|
||||
in mapM_
|
||||
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
|
||||
, ( "Joe wins - shutout"
|
||||
, 0
|
||||
, psWinSO
|
||||
, joeWinSO
|
||||
, bob
|
||||
, gsJoeWinSO
|
||||
)
|
||||
|
||||
progState = newProgState
|
||||
& database.dbGoalies .~ [bob, joe]
|
||||
& progMode.gameStateL .~ gs
|
||||
& setGameGoalie setGid
|
||||
, ( "Bob wins - shutout"
|
||||
, 1
|
||||
, psWinSO
|
||||
, joe
|
||||
, bobWinSO
|
||||
, gsBobWinSO
|
||||
)
|
||||
|
||||
in mapM_
|
||||
(\( chkLabel
|
||||
, chkGid
|
||||
, ( gWins
|
||||
, gLosses
|
||||
, gTies
|
||||
, ytdWins
|
||||
, ytdLosses
|
||||
, ytdTies
|
||||
, ltWins
|
||||
, ltLosses
|
||||
, ltTies
|
||||
)
|
||||
) -> context chkLabel $ do
|
||||
let
|
||||
goalie = (progState^.database.dbGoalies) !! chkGid
|
||||
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
||||
game = M.findWithDefault newGoalieStats chkGid gameStats
|
||||
ytd = goalie^.gYtd
|
||||
lifetime = goalie^.gLifetime
|
||||
, ( "Joe loses"
|
||||
, 0
|
||||
, psLose
|
||||
, joeLose
|
||||
, bob
|
||||
, gsJoeLose
|
||||
)
|
||||
|
||||
mapM_
|
||||
(\(label', expected, actual) -> context label' $
|
||||
expected `TS.compareTest` actual)
|
||||
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
||||
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
||||
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
|
||||
]
|
||||
, ( "Bob loses"
|
||||
, 1
|
||||
, psLose
|
||||
, joe
|
||||
, bobLose
|
||||
, gsBobLose
|
||||
)
|
||||
|
||||
it "should set the gameGoalieAssigned flag" $
|
||||
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
|
||||
[ ( "checking Bob", 0, bobData )
|
||||
, ( "checking Joe", 1, joeData )
|
||||
])
|
||||
[ ( "Bob wins"
|
||||
, winningGame
|
||||
, 0
|
||||
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
|
||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||
)
|
||||
, ( "Bob loses"
|
||||
, losingGame
|
||||
, 0
|
||||
, ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
|
||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||
)
|
||||
, ( "Bob ties"
|
||||
, tiedGame
|
||||
, 0
|
||||
, ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
|
||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||
)
|
||||
, ( "Joe wins"
|
||||
, winningGame
|
||||
, 1
|
||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
|
||||
)
|
||||
, ( "Joe loses"
|
||||
, losingGame
|
||||
, 1
|
||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
|
||||
)
|
||||
, ( "Joe ties"
|
||||
, tiedGame
|
||||
, 1
|
||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
|
||||
)
|
||||
]
|
||||
, ( "Joe overtime"
|
||||
, 0
|
||||
, psOT
|
||||
, joeOT
|
||||
, bob
|
||||
, gsJoeOT
|
||||
)
|
||||
|
||||
, ( "Bob overtime"
|
||||
, 1
|
||||
, psOT
|
||||
, joe
|
||||
, bobOT
|
||||
, gsBobOT
|
||||
)
|
||||
]
|
||||
|
||||
where
|
||||
|
||||
joe
|
||||
= newGoalie 2 "Joe"
|
||||
& gYtd
|
||||
%~ (gsShutouts .~ 11)
|
||||
. (gsWins .~ 12)
|
||||
. (gsLosses .~ 13)
|
||||
. (gsTies .~ 14)
|
||||
& gLifetime
|
||||
%~ (gsShutouts .~ 21)
|
||||
. (gsWins .~ 22)
|
||||
. (gsLosses .~ 23)
|
||||
. (gsTies .~ 24)
|
||||
|
||||
bob
|
||||
= newGoalie 3 "Bob"
|
||||
& gYtd
|
||||
%~ (gsShutouts .~ 31)
|
||||
. (gsWins .~ 32)
|
||||
. (gsLosses .~ 33)
|
||||
. (gsTies .~ 34)
|
||||
& gLifetime
|
||||
%~ (gsShutouts .~ 41)
|
||||
. (gsWins .~ 42)
|
||||
. (gsLosses .~ 43)
|
||||
. (gsTies .~ 44)
|
||||
|
||||
joeWin = win joe
|
||||
bobWin = win bob
|
||||
joeWinSO = winSO joe
|
||||
bobWinSO = winSO bob
|
||||
joeLose = lose joe
|
||||
bobLose = lose bob
|
||||
joeOT = tie joe
|
||||
bobOT = tie bob
|
||||
|
||||
psWin = mkProgState
|
||||
$ (homeScore ?~ 2)
|
||||
. (awayScore ?~ 1)
|
||||
|
||||
psWinSO = mkProgState
|
||||
$ (homeScore ?~ 1)
|
||||
. (awayScore ?~ 0)
|
||||
|
||||
psLose = mkProgState
|
||||
$ (homeScore ?~ 0)
|
||||
. (awayScore ?~ 1)
|
||||
|
||||
psOT = mkProgState
|
||||
$ (homeScore ?~ 0)
|
||||
. (awayScore ?~ 1)
|
||||
. (overtimeFlag ?~ True)
|
||||
|
||||
mkProgState f
|
||||
= newProgState
|
||||
& database.dbGoalies .~ [joe, bob]
|
||||
& progMode.gameStateL
|
||||
%~ f
|
||||
. (gameType ?~ HomeGame)
|
||||
. (overtimeFlag ?~ False)
|
||||
|
||||
gsJoeWin = mkGameStats 0 incWin
|
||||
gsBobWin = mkGameStats 1 incWin
|
||||
gsJoeWinSO = mkGameStats 0 $ incWin . incSO
|
||||
gsBobWinSO = mkGameStats 1 $ incWin . incSO
|
||||
gsJoeLose = mkGameStats 0 incLoss
|
||||
gsBobLose = mkGameStats 1 incLoss
|
||||
gsJoeOT = mkGameStats 0 incOT
|
||||
gsBobOT = mkGameStats 1 incOT
|
||||
|
||||
mkGameStats n f = M.fromList [(n, f newGoalieStats)]
|
||||
|
||||
win
|
||||
= (gYtd %~ incWin)
|
||||
. (gLifetime %~ incWin)
|
||||
|
||||
winSO
|
||||
= (gYtd %~ (incWin . incSO))
|
||||
. (gLifetime %~ (incWin . incSO))
|
||||
|
||||
lose
|
||||
= (gYtd %~ incLoss)
|
||||
. (gLifetime %~ incLoss)
|
||||
|
||||
tie
|
||||
= (gYtd %~ incOT)
|
||||
. (gLifetime %~ incOT)
|
||||
|
||||
incWin = gsWins %~ succ
|
||||
incSO = gsShutouts %~ succ
|
||||
incLoss = gsLosses %~ succ
|
||||
incOT = gsTies %~ succ
|
||||
|
||||
getFirstTwo :: [a] -> (a, a)
|
||||
getFirstTwo (x:y:_) = (x, y)
|
||||
getFirstTwo _ = error "insufficient members of list"
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -48,61 +48,31 @@ spec = describe "NewGame" $ do
|
||||
GoalieInput.spec
|
||||
|
||||
overtimeCheckSpec :: Spec
|
||||
overtimeCheckSpec = describe "overtimeCheck" $ do
|
||||
overtimeCheckSpec = describe "overtimeCheck" $ mapM_
|
||||
(\(label, expectation, gt, home, away, otf) ->
|
||||
context label $
|
||||
it expectation $ let
|
||||
ps = newProgState & progMode.gameStateL
|
||||
%~ (gameType ?~ gt)
|
||||
. (homeScore ?~ home)
|
||||
. (awayScore ?~ away)
|
||||
|
||||
context "tie game" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
ps' = overtimeCheck ps
|
||||
in ps'^.progMode.gameStateL.overtimeFlag `shouldBe` otf)
|
||||
|
||||
it "should clear the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
||||
-- label, expectation, type, home, away, ot flag
|
||||
[ ( "home win", clearFlag, HomeGame, 2, 1, Just False )
|
||||
, ( "home loss", leaveFlag, HomeGame, 1, 2, Nothing )
|
||||
, ( "home tie", setFlag, HomeGame, 1, 1, Just True )
|
||||
, ( "away win", clearFlag, AwayGame, 1, 2, Just False )
|
||||
, ( "away loss", leaveFlag, AwayGame, 2, 1, Nothing )
|
||||
, ( "away tie", setFlag, AwayGame, 1, 1, Just True )
|
||||
]
|
||||
|
||||
it "should clear the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
||||
|
||||
it "should leave the overtimeFlag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
context "game won" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 2)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
||||
|
||||
it "should set the overtimeCheck flag to False" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
||||
|
||||
context "game lost" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 2)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
||||
|
||||
it "should leave the overtimeCheck flag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
where
|
||||
clearFlag = "should set the overtimeFlag to True"
|
||||
setFlag = "should set the overtimeFlag to False"
|
||||
leaveFlag = "should leave the overtimeFlag as Nothing"
|
||||
|
||||
updateGameStatsSpec :: Spec
|
||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -24,7 +24,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module ActionsSpec (spec) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
|
||||
import Test.Hspec
|
||||
( Spec
|
||||
, context
|
||||
@@ -37,9 +37,11 @@ import Test.Hspec
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
import qualified Actions.NewGameSpec as NewGame
|
||||
import qualified Actions.EditStandingsSpec as EditStandings
|
||||
import SpecHelpers
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
@@ -49,8 +51,6 @@ spec = describe "Mtlstats.Actions" $ do
|
||||
resetYtdSpec
|
||||
clearRookiesSpec
|
||||
resetStandingsSpec
|
||||
addCharSpec
|
||||
removeCharSpec
|
||||
createPlayerSpec
|
||||
createGoalieSpec
|
||||
editSpec
|
||||
@@ -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` ""
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -141,9 +141,9 @@ labelTableSpec = describe "labelTable" $
|
||||
]
|
||||
|
||||
expected =
|
||||
[ " foo: bar"
|
||||
[ " foo: bar "
|
||||
, " baz: quux"
|
||||
, "longer: x"
|
||||
, "longer: x "
|
||||
]
|
||||
|
||||
in labelTable input `shouldBe` expected
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -22,7 +22,9 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
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) []
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -54,7 +54,7 @@ goalieDetailsSpec = describe "goalieDetails" $ let
|
||||
. ( gsTies .~ 15 )
|
||||
|
||||
expected = unlines
|
||||
[ "Number: 1"
|
||||
[ "Number: 1 "
|
||||
, " Name: Joe*"
|
||||
, ""
|
||||
, " YTD Lifetime"
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -50,8 +50,8 @@ playerDetailsSpec = describe "playerDetails" $
|
||||
}
|
||||
|
||||
expected = unlines
|
||||
[ " Number: 1"
|
||||
, " Name: Joe*"
|
||||
[ " Number: 1 "
|
||||
, " Name: Joe* "
|
||||
, "Position: centre"
|
||||
, ""
|
||||
, " YTD Lifetime"
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
29
test/SpecHelpers.hs
Normal file
29
test/SpecHelpers.hs
Normal file
@@ -0,0 +1,29 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module SpecHelpers where
|
||||
|
||||
import Brick.Widgets.Edit (Editor, editContentsL, editor)
|
||||
import Data.Text.Zipper (gotoEOL)
|
||||
import Lens.Micro ((&), (%~))
|
||||
|
||||
mkEditor :: String -> Editor String ()
|
||||
mkEditor str = editor () (Just 1) str & editContentsL %~ gotoEOL
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
||||
{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
|
||||
|
||||
module TypesSpec
|
||||
( Comparable (..)
|
||||
@@ -33,8 +33,9 @@ module TypesSpec
|
||||
import Control.Monad (replicateM)
|
||||
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
||||
import Data.Aeson.Types (Value (Object))
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Map.Lazy as M
|
||||
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)
|
||||
@@ -72,6 +73,7 @@ spec = describe "Mtlstats.Types" $ do
|
||||
gmsPointsSpec
|
||||
addGameStatsSpec
|
||||
playerSearchSpec
|
||||
activePlayerSearchSpec
|
||||
playerSearchExactSpec
|
||||
modifyPlayerSpec
|
||||
playerSummarySpec
|
||||
@@ -79,6 +81,7 @@ spec = describe "Mtlstats.Types" $ do
|
||||
psPointsSpec
|
||||
addPlayerStatsSpec
|
||||
goalieSearchSpec
|
||||
activeGoalieSearchSpec
|
||||
goalieSearchExactSpec
|
||||
goalieSummarySpec
|
||||
goalieIsActiveSpec
|
||||
@@ -646,6 +649,19 @@ playerSearchSpec = describe "playerSearch" $ mapM_
|
||||
, ( "x", [] )
|
||||
]
|
||||
|
||||
activePlayerSearchSpec :: Spec
|
||||
activePlayerSearchSpec = describe "activePlayerSearch" $ mapM_
|
||||
(\(sStr, expected) -> context sStr $
|
||||
it ("should return " ++ show expected) $ let
|
||||
ps = [joe, bob, steve & pActive .~ False]
|
||||
in activePlayerSearch sStr ps `shouldBe` expected)
|
||||
-- search, result
|
||||
[ ( "joe", [(0, joe)] )
|
||||
, ( "o", [(0, joe), (1, bob)] )
|
||||
, ( "e", [(0, joe)] )
|
||||
, ( "x", [] )
|
||||
]
|
||||
|
||||
playerSearchExactSpec :: Spec
|
||||
playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
||||
(\(sStr, expected) -> context sStr $
|
||||
@@ -777,6 +793,28 @@ goalieSearchSpec = describe "goalieSearch" $ do
|
||||
it "should return Bob" $
|
||||
goalieSearch "bob" goalies `shouldBe` [result 1]
|
||||
|
||||
activeGoalieSearchSpec :: Spec
|
||||
activeGoalieSearchSpec = describe "activeGoalieSearch" $ do
|
||||
let
|
||||
goalies =
|
||||
[ newGoalie 2 "Joe"
|
||||
, newGoalie 3 "Bob"
|
||||
, newGoalie 5 "Steve" & gActive .~ False
|
||||
]
|
||||
result n = (n, goalies!!n)
|
||||
|
||||
context "partial match" $
|
||||
it "should return Joe" $
|
||||
activeGoalieSearch "e" goalies `shouldBe` [result 0]
|
||||
|
||||
context "no match" $
|
||||
it "should return an empty list" $
|
||||
activeGoalieSearch "x" goalies `shouldBe` []
|
||||
|
||||
context "exact match" $
|
||||
it "should return Bob" $
|
||||
activeGoalieSearch "bob" goalies `shouldBe` [result 1]
|
||||
|
||||
goalieSearchExactSpec :: Spec
|
||||
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
||||
let
|
||||
@@ -1005,3 +1043,48 @@ instance Comparable EditStandingsMode where
|
||||
compareTest actual expected =
|
||||
it ("should be " ++ show expected) $
|
||||
actual `shouldBe` expected
|
||||
|
||||
instance Comparable Goalie where
|
||||
compareTest actual expected = do
|
||||
|
||||
describe "gNumber" $
|
||||
it ("should be " ++ show (expected^.gNumber)) $
|
||||
actual^.gNumber `shouldBe` expected^.gNumber
|
||||
|
||||
describe "gName" $
|
||||
it ("should be " ++ show (expected^.gName)) $
|
||||
actual^.gName `shouldBe` expected^.gName
|
||||
|
||||
describe "gRookie" $
|
||||
it ("should be " ++ show (expected^.gRookie)) $
|
||||
actual^.gRookie `shouldBe` expected^.gRookie
|
||||
|
||||
describe "gActive" $
|
||||
it ("should be " ++ show (expected^.gActive)) $
|
||||
actual^.gActive `shouldBe` expected^.gActive
|
||||
|
||||
describe "gYtd" $
|
||||
(actual^.gYtd) `compareTest` (expected^.gYtd)
|
||||
|
||||
describe "gLifetime" $
|
||||
(actual^.gLifetime) `compareTest` (expected^.gLifetime)
|
||||
|
||||
instance Comparable (M.Map Int GoalieStats) where
|
||||
compareTest actual expected = do
|
||||
|
||||
let
|
||||
aList = M.toList actual
|
||||
eList = M.toList expected
|
||||
|
||||
it "should have the correct number of elements" $
|
||||
length aList `shouldBe` length eList
|
||||
|
||||
mapM_
|
||||
(\(n, (ka, va), (ke, ve)) -> context ("element " ++ show n) $ do
|
||||
|
||||
context "key" $
|
||||
it ("should be " ++ show ke) $
|
||||
ka `shouldBe` ke
|
||||
|
||||
context "value" $ va `compareTest` ve)
|
||||
(zip3 ([0..] :: [Int]) aList eList)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
Copyright (C) Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -26,10 +26,13 @@ import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Util
|
||||
|
||||
import SpecHelpers
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Util" $ do
|
||||
nthSpec
|
||||
modifyNthSpec
|
||||
dropNthSpec
|
||||
updateMapSpec
|
||||
sliceSpec
|
||||
capitalizeNameSpec
|
||||
@@ -64,6 +67,20 @@ modifyNthSpec = describe "modifyNth" $ do
|
||||
it "should not modify the value" $
|
||||
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
||||
|
||||
dropNthSpec :: Spec
|
||||
dropNthSpec = describe "dropNth" $ mapM_
|
||||
|
||||
(\(label, n, expected) ->
|
||||
context label $
|
||||
it ("should be " ++ show expected) $
|
||||
dropNth n list `shouldBe` expected)
|
||||
|
||||
[ ( "out of bounds", 1, ["foo", "baz"] )
|
||||
, ( "in bounds", 3, list )
|
||||
]
|
||||
|
||||
where list = ["foo", "bar", "baz"]
|
||||
|
||||
updateMapSpec :: Spec
|
||||
updateMapSpec = describe "updateMap" $ do
|
||||
let
|
||||
@@ -99,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" )
|
||||
|
||||
Reference in New Issue
Block a user