Compare commits
231 Commits
0.8.0
...
bdbf7daf4e
| Author | SHA1 | Date | |
|---|---|---|---|
| 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 | ||
|
|
29fae81513 | ||
|
|
8a8a550854 | ||
|
|
6227df8e01 | ||
|
|
0676bf4067 | ||
|
|
119032ca80 | ||
|
|
2607fc5ce8 | ||
|
|
d18cb7dd59 | ||
|
|
dff11a8316 | ||
|
|
747bdf8f32 | ||
|
|
9b07c6d249 | ||
|
|
e28ef1ff0e | ||
|
|
960fbb3443 | ||
|
|
439aab99d3 | ||
|
|
8d7a7997b1 | ||
|
|
7e409fdbd4 | ||
|
|
28b1fa0e06 | ||
|
|
7c4b7331e8 | ||
|
|
214710661a | ||
|
|
6bb4601e6b | ||
|
|
e51953650c | ||
|
|
14386f9c7d | ||
|
|
ec10aa7998 | ||
|
|
fe28e96145 | ||
|
|
2941998058 | ||
|
|
c22849bb3b | ||
|
|
4315b40732 | ||
|
|
fefa217df1 | ||
|
|
6d77caaa14 | ||
|
|
a69853858d | ||
|
|
045f2915e1 | ||
|
|
dfd226c7bd | ||
|
|
b9d8b263df | ||
|
|
a2968595d8 | ||
|
|
25e4929f0b | ||
|
|
457298e565 | ||
|
|
a80eaa2a40 | ||
|
|
8a6cf10ad3 | ||
|
|
bd5bc21661 | ||
|
|
accc831bc5 | ||
|
|
2c78a591ca | ||
|
|
77dc89c76d | ||
|
|
607a78ccea | ||
|
|
d7c5f24c26 | ||
|
|
d94c6a588e | ||
|
|
bdbe0131d7 | ||
|
|
b0638b95b8 | ||
|
|
ce2d32407e | ||
|
|
5771091f18 | ||
|
|
13a1949446 | ||
|
|
835cb9582b | ||
|
|
8bc9b48aa2 | ||
|
|
378efea24e | ||
|
|
6418ab0eea | ||
|
|
95e74accd4 | ||
|
|
ffc1390755 | ||
|
|
2f0a3a5c57 | ||
|
|
79d527866f | ||
|
|
994087a0e6 | ||
|
|
7fbeaac933 | ||
|
|
de56f4f94d | ||
|
|
04ba17324e | ||
|
|
d6ae171dc8 | ||
|
|
72b6f05700 | ||
|
|
4c7a756c5e | ||
|
|
ea3ca4e578 | ||
|
|
179a864cfa | ||
|
|
f2b2ff3fef | ||
|
|
9c2e2291c8 | ||
|
|
abad72ce01 | ||
|
|
a9d4d3351f | ||
|
|
45aea607b2 | ||
|
|
be9d7d80bb | ||
|
|
683c36e2b6 | ||
|
|
83c408cea2 | ||
|
|
dcbd68cdda | ||
|
|
717f2d5932 | ||
|
|
d5de834510 | ||
|
|
75a47ca852 | ||
|
|
d4de7c6f8b | ||
|
|
d50d055b0b | ||
|
|
9c7c295a4b | ||
|
|
49963277be | ||
|
|
264d9f81e2 | ||
|
|
6a0d1f7203 | ||
|
|
18683c1c6e | ||
|
|
107ed507e2 | ||
|
|
baf040deea | ||
|
|
c3bac5e624 | ||
|
|
119cb873eb | ||
|
|
82603ba504 | ||
|
|
a909b9ba7a | ||
|
|
802bf7314e | ||
|
|
a3124aca58 | ||
|
|
f113e46564 | ||
|
|
39646f3fa7 | ||
|
|
2bf8d15bd4 | ||
|
|
3009a8f60c | ||
|
|
3b4ce50ae8 | ||
|
|
fcfbcea72f | ||
|
|
d132ebd502 | ||
|
|
75cd253f3f | ||
|
|
063bebfbb5 | ||
|
|
7923827d22 | ||
|
|
461fb5d942 | ||
|
|
e38275aefe | ||
|
|
dd6f604cd7 | ||
|
|
1763f142f1 | ||
|
|
b442b6a360 | ||
|
|
119c28ef18 | ||
|
|
b69b3fce7a | ||
|
|
59026de077 | ||
|
|
52f1e34d49 | ||
|
|
2c561e9807 | ||
|
|
e2aeb5bfa4 | ||
|
|
5b40a5942b | ||
|
|
ee3cea5643 | ||
|
|
5209c4a296 | ||
|
|
e077c32956 | ||
|
|
8dcef502be | ||
|
|
3ee97406f1 | ||
|
|
2768934c7c | ||
|
|
6c8ec21ffe | ||
|
|
ba3f8a5a6c | ||
|
|
3a71dc1e62 | ||
|
|
d14f2ba527 | ||
|
|
acd45229e7 | ||
|
|
aff1d5c255 | ||
|
|
0448a4beee | ||
|
|
ddb9394ab7 | ||
|
|
071aa3bd8e | ||
|
|
ac95601609 | ||
|
|
9606436e9e | ||
|
|
30807b7e2e | ||
|
|
34b743a55b | ||
|
|
63bd9a6de4 | ||
|
|
1f3ff5912c | ||
|
|
7bb0981ed6 | ||
|
|
eb4107365c | ||
|
|
6238e39f69 | ||
|
|
1adf6de990 | ||
|
|
2840298467 | ||
|
|
89fe646d0e | ||
|
|
b35136944c | ||
|
|
4d41c454a1 | ||
|
|
18ba758c0c | ||
|
|
3aedd01b08 | ||
|
|
235dd4e611 | ||
|
|
adf09c2cc4 | ||
|
|
a44ecc5e24 | ||
|
|
9980a095ed | ||
|
|
1d6a4aa7f3 | ||
|
|
8988ad9146 | ||
|
|
59d48ec154 | ||
|
|
be990538bc | ||
|
|
55c8806186 | ||
|
|
0ecf899b56 | ||
|
|
2f06fd221d | ||
|
|
f1227da9ca | ||
|
|
38db3c8d8f | ||
|
|
2b9a21c28b | ||
|
|
84c487dba5 | ||
|
|
6345e3d5d8 | ||
|
|
0ca03b7f21 | ||
|
|
482f42dca7 | ||
|
|
996bad94f1 | ||
|
|
4ca0b54de2 | ||
|
|
3738088dde | ||
|
|
1ec9e93f16 |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -1,3 +1,6 @@
|
|||||||
.stack-work/
|
.stack-work/
|
||||||
mtlstats.cabal
|
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
|
|
||||||
64
ChangeLog.md
64
ChangeLog.md
@@ -1,5 +1,65 @@
|
|||||||
# Changelog for mtlstats
|
# Changelog for mtlstats
|
||||||
|
|
||||||
|
## current
|
||||||
|
- updated code to use brick instead of ncurses
|
||||||
|
|
||||||
|
## 0.16.1
|
||||||
|
- Don't automatically start a new game on new season
|
||||||
|
|
||||||
|
## 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
|
||||||
|
- Ask whether a player/goalie is active on creation
|
||||||
|
- Don't ask which goalie to assign the game to when there's only one
|
||||||
|
|
||||||
|
## 0.12.0
|
||||||
|
- Edit lifetime stats on new player/goalie creation
|
||||||
|
- Sort goalies by minutes played
|
||||||
|
- Subsort players by lifetime points
|
||||||
|
- Changed wording on edit menus
|
||||||
|
|
||||||
|
## 0.11.0
|
||||||
|
- Added active flag to players/goalies
|
||||||
|
- Clear rookie flag on new (regular) season
|
||||||
|
- Save a copy of the database on new season
|
||||||
|
- Implemented game standings editing
|
||||||
|
- Added title screen
|
||||||
|
- Changed sytling of menus
|
||||||
|
|
||||||
|
## 0.10.0
|
||||||
|
- Don't show player number zero in reports
|
||||||
|
- Fixed player/goalie name capitalisation on edit
|
||||||
|
- Return to correct edit menus after editing player stats
|
||||||
|
- Enabled batch editing of player/goalie YTD/lifetime stats
|
||||||
|
- Bugfix: allow user to edit goalie shutouts
|
||||||
|
- Added line numbers to lifetime player/goalie reports
|
||||||
|
- Implemented rookie flag
|
||||||
|
|
||||||
|
## 0.9.0
|
||||||
|
- Bugfix: Display lifetime stats in report, not YTD
|
||||||
|
- Force expected capitalization on player/goalie names
|
||||||
|
- Don't show lifetime totals in report
|
||||||
|
- Sort players in YTD and lifetime reports by points
|
||||||
|
- Moved player/goalie creation/editing to edit submenu
|
||||||
|
|
||||||
## 0.8.0
|
## 0.8.0
|
||||||
- Bugfix: removed quotation marks from goalie names in report
|
- Bugfix: removed quotation marks from goalie names in report
|
||||||
- Allow lower case player names
|
- Allow lower case player names
|
||||||
@@ -17,24 +77,20 @@
|
|||||||
- Reset game standings on new season
|
- Reset game standings on new season
|
||||||
|
|
||||||
## 0.5.0
|
## 0.5.0
|
||||||
|
|
||||||
- Fixed player creation bug
|
- Fixed player creation bug
|
||||||
- Prompt for goalie informaiton on game data entry
|
- Prompt for goalie informaiton on game data entry
|
||||||
- Implemented player editing
|
- Implemented player editing
|
||||||
|
|
||||||
## v0.4.0
|
## v0.4.0
|
||||||
|
|
||||||
- Record penalty minutes
|
- Record penalty minutes
|
||||||
- Calculate total game statistics
|
- Calculate total game statistics
|
||||||
- Generate year-to-date statistics report
|
- Generate year-to-date statistics report
|
||||||
|
|
||||||
## v0.3.0
|
## v0.3.0
|
||||||
|
|
||||||
- Record goals and assists
|
- Record goals and assists
|
||||||
- Track goals for and goals against
|
- Track goals for and goals against
|
||||||
|
|
||||||
## v0.2.0
|
## v0.2.0
|
||||||
|
|
||||||
- Overtime losses don't count in the loss column
|
- Overtime losses don't count in the loss column
|
||||||
- Confirm game data with user before updating stats
|
- Confirm game data with user before updating stats
|
||||||
- Implemented player creation
|
- Implemented player creation
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
module Main where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (evalStateT)
|
import Brick.Main (defaultMain)
|
||||||
import UI.NCurses (runCurses)
|
import Control.Monad (void)
|
||||||
|
|
||||||
import Mtlstats
|
import Mtlstats
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = runCurses $ initState >>= evalStateT mainLoop
|
main = void $ defaultMain app newProgState
|
||||||
|
|||||||
28
package.yaml
28
package.yaml
@@ -1,10 +1,9 @@
|
|||||||
name: mtlstats
|
name: mtlstats
|
||||||
version: 0.8.0
|
version: 0.16.1
|
||||||
github: "mtlstats/mtlstats"
|
license: GPL-3.0-or-later
|
||||||
license: GPL-3
|
|
||||||
author: "Jonathan Lamothe"
|
author: "Jonathan Lamothe"
|
||||||
maintainer: "jlamothe1980@gmail.com"
|
maintainer: "jlamothe1980@gmail.com"
|
||||||
copyright: "Rhéal Lamothe"
|
copyright: "1984, 1985, 2019-2021, 2023 Rhéal Lamothe"
|
||||||
|
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
- README.md
|
- README.md
|
||||||
@@ -21,17 +20,20 @@ description: Please see the README on GitHub at <https://github.com/mtls
|
|||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- 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
|
- containers >= 0.6.0.1 && < 0.7
|
||||||
- easy-file >= 0.2.2 && < 0.3
|
- 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
|
- microlens-th >= 0.4.2.3 && < 0.5
|
||||||
- ncurses >= 0.2.16 && < 0.3
|
- mtl >= 2.2.2 && < 2.3
|
||||||
- random >= 1.1 && < 1.2
|
- random >= 1.2.1.1 && < 1.3
|
||||||
- time >= 1.8.0.2 && < 1.9
|
- text-zipper >= 0.12 && < 0.13
|
||||||
- transformers >= 0.5.6.2 && < 0.6
|
- time >= 1.11.1.1 && < 1.12
|
||||||
- bytestring
|
- vty >= 5.37 && < 5.38
|
||||||
- microlens
|
|
||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -Wall
|
- -Wall
|
||||||
@@ -61,5 +63,5 @@ tests:
|
|||||||
- -with-rtsopts=-N
|
- -with-rtsopts=-N
|
||||||
dependencies:
|
dependencies:
|
||||||
- mtlstats
|
- mtlstats
|
||||||
- hspec >= 2.7.1 && < 2.8
|
- hspec >= 2.9.7 && < 2.10
|
||||||
- unordered-containers
|
- unordered-containers
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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.Control
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
-- | Initializes the progran
|
-- | The main application
|
||||||
initState :: C.Curses ProgState
|
app :: App ProgState () ()
|
||||||
initState = do
|
app = App
|
||||||
C.setEcho False
|
{ appDraw = draw
|
||||||
void $ C.setCursorMode C.CursorInvisible
|
, appChooseCursor = showFirstCursor
|
||||||
db <- liftIO $ do
|
, appHandleEvent = handler
|
||||||
dir <- getAppUserDataDirectory appName
|
, appStartEvent = return ()
|
||||||
let dbFile = dir </> dbFname
|
, appAttrMap = const myAttrMap
|
||||||
fromMaybe newDatabase <$> catch
|
}
|
||||||
(decodeFileStrict dbFile)
|
|
||||||
(\(_ :: IOException) -> return Nothing)
|
|
||||||
return
|
|
||||||
$ newProgState
|
|
||||||
& database .~ db
|
|
||||||
|
|
||||||
-- | Main program loop
|
draw :: ProgState -> [Widget ()]
|
||||||
mainLoop :: Action ()
|
draw s =
|
||||||
mainLoop = do
|
[ drawController (dispatch s) s
|
||||||
|
, fill ' '
|
||||||
|
]
|
||||||
|
|
||||||
|
handler :: Handler ()
|
||||||
|
handler (VtyEvent (EvKey (KChar 'c') [MCtrl])) = halt
|
||||||
|
handler e = do
|
||||||
c <- gets dispatch
|
c <- gets dispatch
|
||||||
get >>= lift . draw . drawController c
|
handleController c e
|
||||||
w <- lift C.defaultWindow
|
|
||||||
whenM (lift (fromJust <$> C.getEvent w Nothing) >>= handleController c)
|
|
||||||
mainLoop
|
|
||||||
|
|
||||||
draw :: C.Update C.CursorMode -> C.Curses ()
|
myAttrMap :: AttrMap
|
||||||
draw u = do
|
myAttrMap = forceAttrMap (white `on` blue)
|
||||||
void $ C.setCursorMode C.CursorInvisible
|
|
||||||
w <- C.defaultWindow
|
|
||||||
cm <- C.updateWindow w $ do
|
|
||||||
C.clear
|
|
||||||
u
|
|
||||||
C.render
|
|
||||||
void $ C.setCursorMode cm
|
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,37 +19,56 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
module Mtlstats.Actions
|
module Mtlstats.Actions
|
||||||
( startNewSeason
|
( startNewSeason
|
||||||
, resetYtd
|
, resetYtd
|
||||||
|
, clearRookies
|
||||||
, resetStandings
|
, resetStandings
|
||||||
, startNewGame
|
, startNewGame
|
||||||
, addChar
|
|
||||||
, removeChar
|
|
||||||
, createPlayer
|
, createPlayer
|
||||||
, createGoalie
|
, createGoalie
|
||||||
|
, edit
|
||||||
, editPlayer
|
, editPlayer
|
||||||
|
, editSelectedPlayer
|
||||||
, editGoalie
|
, editGoalie
|
||||||
|
, editSelectedGoalie
|
||||||
, addPlayer
|
, addPlayer
|
||||||
, addGoalie
|
, addGoalie
|
||||||
, resetCreatePlayerState
|
, resetCreatePlayerState
|
||||||
, resetCreateGoalieState
|
, resetCreateGoalieState
|
||||||
, backHome
|
, backHome
|
||||||
, scrollUp
|
, clearEditor
|
||||||
, scrollDown
|
, loadDatabase
|
||||||
|
, saveDatabase
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Brick.Main (viewportScroll)
|
||||||
|
import Brick.Widgets.Edit (Editor, applyEdit)
|
||||||
|
import Control.Exception (IOException, catch)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Control.Monad.State.Class (modify)
|
||||||
|
import Data.Aeson (decodeFileStrict, encodeFile)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Text.Zipper (gotoBOF, killToEOF)
|
||||||
import Lens.Micro ((^.), (&), (.~), (%~))
|
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||||
|
import Lens.Micro.Mtl ((.=), use)
|
||||||
|
import System.EasyFile
|
||||||
|
( createDirectoryIfMissing
|
||||||
|
, getAppUserDataDirectory
|
||||||
|
, (</>)
|
||||||
|
)
|
||||||
|
|
||||||
|
import Mtlstats.Config
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | Starts a new season
|
-- | Starts a new season
|
||||||
startNewSeason :: ProgState -> ProgState
|
startNewSeason :: ProgState -> ProgState
|
||||||
startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0)
|
startNewSeason
|
||||||
|
= (progMode .~ NewSeason False)
|
||||||
|
. (database.dbGames .~ 0)
|
||||||
|
|
||||||
-- | Resets all players year-to-date stats
|
-- | Resets all players year-to-date stats
|
||||||
resetYtd :: ProgState -> ProgState
|
resetYtd :: ProgState -> ProgState
|
||||||
@@ -57,6 +76,12 @@ resetYtd
|
|||||||
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
||||||
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
||||||
|
|
||||||
|
-- | Clears the rookie flag from all players/goalies
|
||||||
|
clearRookies :: ProgState -> ProgState
|
||||||
|
clearRookies = database
|
||||||
|
%~ (dbPlayers %~ map (pRookie .~ False))
|
||||||
|
. (dbGoalies %~ map (gRookie .~ False))
|
||||||
|
|
||||||
-- | Resets game standings
|
-- | Resets game standings
|
||||||
resetStandings :: ProgState -> ProgState
|
resetStandings :: ProgState -> ProgState
|
||||||
resetStandings = database
|
resetStandings = database
|
||||||
@@ -69,20 +94,10 @@ startNewGame
|
|||||||
= (progMode .~ NewGame newGameState)
|
= (progMode .~ NewGame newGameState)
|
||||||
. (database . dbGames %~ succ)
|
. (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
|
-- | Starts player creation mode
|
||||||
createPlayer :: ProgState -> ProgState
|
createPlayer :: ProgState -> ProgState
|
||||||
createPlayer = let
|
createPlayer = let
|
||||||
callback = modify $ progMode .~ MainMenu
|
callback = modify edit
|
||||||
cps = newCreatePlayerState
|
cps = newCreatePlayerState
|
||||||
& cpsSuccessCallback .~ callback
|
& cpsSuccessCallback .~ callback
|
||||||
& cpsFailureCallback .~ callback
|
& cpsFailureCallback .~ callback
|
||||||
@@ -91,29 +106,63 @@ createPlayer = let
|
|||||||
-- | Starts goalie creation mode
|
-- | Starts goalie creation mode
|
||||||
createGoalie :: ProgState -> ProgState
|
createGoalie :: ProgState -> ProgState
|
||||||
createGoalie = let
|
createGoalie = let
|
||||||
callback = modify $ progMode .~ MainMenu
|
callback = modify edit
|
||||||
cgs = newCreateGoalieState
|
cgs = newCreateGoalieState
|
||||||
& cgsSuccessCallback .~ callback
|
& cgsSuccessCallback .~ callback
|
||||||
& cgsFailureCallback .~ callback
|
& cgsFailureCallback .~ callback
|
||||||
in progMode .~ CreateGoalie cgs
|
in progMode .~ CreateGoalie cgs
|
||||||
|
|
||||||
|
-- | Launches the edit menu
|
||||||
|
edit :: ProgState -> ProgState
|
||||||
|
edit = progMode .~ EditMenu
|
||||||
|
|
||||||
-- | Starts the player editing process
|
-- | Starts the player editing process
|
||||||
editPlayer :: ProgState -> ProgState
|
editPlayer :: ProgState -> ProgState
|
||||||
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
||||||
|
|
||||||
|
-- | Edits the selected 'Player'
|
||||||
|
editSelectedPlayer
|
||||||
|
:: (Player -> Player)
|
||||||
|
-- ^ The modification to be made to the 'Player'
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editSelectedPlayer f s = fromMaybe s $ do
|
||||||
|
n <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||||
|
let
|
||||||
|
players = s^.database.dbPlayers
|
||||||
|
players' = modifyNth n f players
|
||||||
|
Just $ s & database.dbPlayers .~ players'
|
||||||
|
|
||||||
-- | Starts the 'Goalie' editing process
|
-- | Starts the 'Goalie' editing process
|
||||||
editGoalie :: ProgState -> ProgState
|
editGoalie :: ProgState -> ProgState
|
||||||
editGoalie = progMode .~ EditGoalie newEditGoalieState
|
editGoalie = progMode .~ EditGoalie newEditGoalieState
|
||||||
|
|
||||||
|
-- | Edits the selected 'Goalie'
|
||||||
|
editSelectedGoalie
|
||||||
|
:: (Goalie -> Goalie)
|
||||||
|
-- ^ The modification to be made to the 'Goalie'
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editSelectedGoalie f s = fromMaybe s $ do
|
||||||
|
n <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
|
let
|
||||||
|
goalies = s^.database.dbGoalies
|
||||||
|
goalies' = modifyNth n f goalies
|
||||||
|
Just $ s & database.dbGoalies .~ goalies'
|
||||||
|
|
||||||
-- | Adds the entered player to the roster
|
-- | Adds the entered player to the roster
|
||||||
addPlayer :: ProgState -> ProgState
|
addPlayer :: ProgState -> ProgState
|
||||||
addPlayer s = fromMaybe s $ do
|
addPlayer s = fromMaybe s $ do
|
||||||
let cps = s^.progMode.createPlayerStateL
|
let cps = s^.progMode.createPlayerStateL
|
||||||
num <- cps^.cpsNumber
|
num <- cps^.cpsNumber
|
||||||
|
rFlag <- cps^.cpsRookieFlag
|
||||||
|
aFlag <- cps^.cpsActiveFlag
|
||||||
let
|
let
|
||||||
name = cps^.cpsName
|
name = cps^.cpsName
|
||||||
pos = cps^.cpsPosition
|
pos = cps^.cpsPosition
|
||||||
player = newPlayer num name pos
|
player = newPlayer num name pos
|
||||||
|
& pRookie .~ rFlag
|
||||||
|
& pActive .~ aFlag
|
||||||
Just $ s & database.dbPlayers
|
Just $ s & database.dbPlayers
|
||||||
%~ (++[player])
|
%~ (++[player])
|
||||||
|
|
||||||
@@ -122,9 +171,13 @@ addGoalie :: ProgState -> ProgState
|
|||||||
addGoalie s = fromMaybe s $ do
|
addGoalie s = fromMaybe s $ do
|
||||||
let cgs = s^.progMode.createGoalieStateL
|
let cgs = s^.progMode.createGoalieStateL
|
||||||
num <- cgs^.cgsNumber
|
num <- cgs^.cgsNumber
|
||||||
|
rFlag <- cgs^.cgsRookieFlag
|
||||||
|
aFlag <- cgs^.cgsActiveFlag
|
||||||
let
|
let
|
||||||
name = cgs^.cgsName
|
name = cgs^.cgsName
|
||||||
goalie = newGoalie num name
|
goalie = newGoalie num name
|
||||||
|
& gRookie .~ rFlag
|
||||||
|
& gActive .~ aFlag
|
||||||
Just $ s & database.dbGoalies
|
Just $ s & database.dbGoalies
|
||||||
%~ (++[goalie])
|
%~ (++[goalie])
|
||||||
|
|
||||||
@@ -145,13 +198,34 @@ resetCreateGoalieState = progMode.createGoalieStateL
|
|||||||
backHome :: ProgState -> ProgState
|
backHome :: ProgState -> ProgState
|
||||||
backHome
|
backHome
|
||||||
= (progMode .~ MainMenu)
|
= (progMode .~ MainMenu)
|
||||||
. (inputBuffer .~ "")
|
. (editorW %~ clearEditor)
|
||||||
. (scrollOffset .~ 0)
|
. (scroller .~ viewportScroll ())
|
||||||
|
|
||||||
-- | Scrolls the display up
|
-- | Clears an editor
|
||||||
scrollUp :: ProgState -> ProgState
|
clearEditor :: Editor String () -> Editor String ()
|
||||||
scrollUp = scrollOffset %~ max 0 . pred
|
clearEditor = applyEdit $ killToEOF . gotoBOF
|
||||||
|
|
||||||
-- | Scrolls the display down
|
-- | Loads the database
|
||||||
scrollDown :: ProgState -> ProgState
|
loadDatabase :: Action ()
|
||||||
scrollDown = scrollOffset %~ succ
|
loadDatabase = do
|
||||||
|
dbFile <- dbSetup
|
||||||
|
liftIO
|
||||||
|
(catch
|
||||||
|
(decodeFileStrict dbFile)
|
||||||
|
(\(_ :: IOException) -> return Nothing))
|
||||||
|
>>= mapM_ (database .=)
|
||||||
|
|
||||||
|
-- | Saves the 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
|
||||||
|
createDirectoryIfMissing True dir
|
||||||
|
return $ dir </> fn ++ ".json"
|
||||||
|
|||||||
@@ -1,164 +0,0 @@
|
|||||||
{- |
|
|
||||||
|
|
||||||
mtlstats
|
|
||||||
Copyright (C) 2019 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 Mtlstats.Actions.EditGoalie
|
|
||||||
( editGoalieNumber
|
|
||||||
, editGoalieName
|
|
||||||
, editGoalieYtdGames
|
|
||||||
, editGoalieYtdMins
|
|
||||||
, editGoalieYtdGoals
|
|
||||||
, editGoalieYtdWins
|
|
||||||
, editGoalieYtdLosses
|
|
||||||
, editGoalieYtdTies
|
|
||||||
, editGoalieLtGames
|
|
||||||
, editGoalieLtMins
|
|
||||||
, editGoalieLtGoals
|
|
||||||
, editGoalieLtWins
|
|
||||||
, editGoalieLtLosses
|
|
||||||
, editGoalieLtTies
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Monad (void)
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import Lens.Micro ((^.), (&), (.~), (%~))
|
|
||||||
|
|
||||||
import Mtlstats.Types
|
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
-- | Edits a goalie's number
|
|
||||||
editGoalieNumber
|
|
||||||
:: Int
|
|
||||||
-- ^ New goalie number
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieNumber num = editGoalie (gNumber .~ num) EGMenu
|
|
||||||
|
|
||||||
-- | Edits a goalie's name
|
|
||||||
editGoalieName
|
|
||||||
:: String
|
|
||||||
-- ^ The new name
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieName name = editGoalie (gName .~ name) EGMenu
|
|
||||||
|
|
||||||
-- | Edits a goalie's YTD games
|
|
||||||
editGoalieYtdGames
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of games played
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieYtdGames games = editGoalie (gYtd.gsGames .~ games) EGYtd
|
|
||||||
|
|
||||||
-- | Edits a goalie's YTD minutes
|
|
||||||
editGoalieYtdMins
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of minutes played
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieYtdMins mins = editGoalie (gYtd.gsMinsPlayed .~ mins) EGYtd
|
|
||||||
|
|
||||||
-- | Edits a goalie's YTD goals allowed
|
|
||||||
editGoalieYtdGoals
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of goals
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieYtdGoals goals = editGoalie (gYtd.gsGoalsAllowed .~ goals) EGYtd
|
|
||||||
|
|
||||||
-- | Edits a goalie's YTD wins
|
|
||||||
editGoalieYtdWins
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of wins
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieYtdWins wins = editGoalie (gYtd.gsWins .~ wins) EGYtd
|
|
||||||
|
|
||||||
-- | Edits a goalie's YTD losses
|
|
||||||
editGoalieYtdLosses
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of losses
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieYtdLosses losses = editGoalie (gYtd.gsLosses .~ losses) EGYtd
|
|
||||||
|
|
||||||
-- | Edits a goalie's YTD ties
|
|
||||||
editGoalieYtdTies
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of ties
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieYtdTies ties = editGoalie (gYtd.gsTies .~ ties) EGYtd
|
|
||||||
|
|
||||||
-- | Edits a goalie's lifetime games played
|
|
||||||
editGoalieLtGames
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of games
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieLtGames games = editGoalie (gLifetime.gsGames .~ games) EGLifetime
|
|
||||||
|
|
||||||
-- | Edits a goalie's lifetime minutes played
|
|
||||||
editGoalieLtMins
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of minutes
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieLtMins mins = editGoalie (gLifetime.gsMinsPlayed .~ mins) EGLifetime
|
|
||||||
|
|
||||||
-- | Edits a goalie's lifetime goals allowed
|
|
||||||
editGoalieLtGoals
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of goals
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieLtGoals goals = editGoalie (gLifetime.gsGoalsAllowed .~ goals) EGLifetime
|
|
||||||
|
|
||||||
-- | Edits a goalie's lifetime wins
|
|
||||||
editGoalieLtWins
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of wins
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieLtWins wins = editGoalie (gLifetime.gsWins .~ wins) EGLifetime
|
|
||||||
|
|
||||||
-- | Edits a goalie's lifetime losses
|
|
||||||
editGoalieLtLosses
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of losses
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieLtLosses losses = editGoalie (gLifetime.gsLosses .~ losses) EGLifetime
|
|
||||||
|
|
||||||
-- | Edits a goalie's lifetime ties
|
|
||||||
editGoalieLtTies
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of ties
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
editGoalieLtTies ties = editGoalie (gLifetime.gsTies .~ ties) EGLifetime
|
|
||||||
|
|
||||||
editGoalie :: (Goalie -> Goalie) -> EditGoalieMode -> ProgState -> ProgState
|
|
||||||
editGoalie f mode s = fromMaybe s $ do
|
|
||||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
|
||||||
void $ nth gid $ s^.database.dbGoalies
|
|
||||||
Just $ s
|
|
||||||
& database.dbGoalies %~ modifyNth gid f
|
|
||||||
& progMode.editGoalieStateL.egsMode .~ mode
|
|
||||||
70
src/Mtlstats/Actions/EditStandings.hs
Normal file
70
src/Mtlstats/Actions/EditStandings.hs
Normal file
@@ -0,0 +1,70 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
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 Mtlstats.Actions.EditStandings
|
||||||
|
( editStandings
|
||||||
|
, editHomeStandings
|
||||||
|
, editAwayStandings
|
||||||
|
, editWins
|
||||||
|
, editLosses
|
||||||
|
, editOvertime
|
||||||
|
, editGoalsFor
|
||||||
|
, editGoalsAgainst
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Lens.Micro ((.~))
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
-- | Enters edit standings mode
|
||||||
|
editStandings :: ProgState -> ProgState
|
||||||
|
editStandings = progMode .~ EditStandings ESMMenu
|
||||||
|
|
||||||
|
-- | Edits the home standings
|
||||||
|
editHomeStandings :: ProgState -> ProgState
|
||||||
|
editHomeStandings = progMode .~ EditStandings (ESMHome ESMSubMenu)
|
||||||
|
|
||||||
|
-- | Edits the road standings
|
||||||
|
editAwayStandings :: ProgState -> ProgState
|
||||||
|
editAwayStandings = progMode .~ EditStandings (ESMAway ESMSubMenu)
|
||||||
|
|
||||||
|
-- | Changes to edit wins mode
|
||||||
|
editWins :: ProgState -> ProgState
|
||||||
|
editWins = doEdit ESMEditWins
|
||||||
|
|
||||||
|
-- | Changes to edit losses mode
|
||||||
|
editLosses :: ProgState -> ProgState
|
||||||
|
editLosses = doEdit ESMEditLosses
|
||||||
|
|
||||||
|
-- | Changes to edit overtime mode
|
||||||
|
editOvertime :: ProgState -> ProgState
|
||||||
|
editOvertime = doEdit ESMEditOvertime
|
||||||
|
|
||||||
|
-- | Changes to edit goals for mode
|
||||||
|
editGoalsFor :: ProgState -> ProgState
|
||||||
|
editGoalsFor = doEdit ESMEditGoalsFor
|
||||||
|
|
||||||
|
-- | Changes to edit goals against mode
|
||||||
|
editGoalsAgainst :: ProgState -> ProgState
|
||||||
|
editGoalsAgainst = doEdit ESMEditGoalsAgainst
|
||||||
|
|
||||||
|
doEdit :: ESMSubMode -> ProgState -> ProgState
|
||||||
|
doEdit = (progMode.editStandingsModeL.esmSubModeL .~)
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -43,9 +43,7 @@ import Mtlstats.Util
|
|||||||
overtimeCheck :: ProgState -> ProgState
|
overtimeCheck :: ProgState -> ProgState
|
||||||
overtimeCheck s
|
overtimeCheck s
|
||||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||||
s & progMode.gameStateL
|
s & progMode.gameStateL.overtimeFlag ?~ True
|
||||||
%~ (homeScore .~ Nothing)
|
|
||||||
. (awayScore .~ Nothing)
|
|
||||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||||
| otherwise = s
|
| otherwise = s
|
||||||
@@ -124,12 +122,13 @@ awardGoal n ps = ps
|
|||||||
(\m -> let
|
(\m -> let
|
||||||
stats = M.findWithDefault newPlayerStats n m
|
stats = M.findWithDefault newPlayerStats n m
|
||||||
in M.insert n (stats & psGoals %~ succ) m)
|
in M.insert n (stats & psGoals %~ succ) m)
|
||||||
& database.dbPlayers %~ map
|
& database.dbPlayers %~ zipWith
|
||||||
(\(i, p) -> if i == n
|
(\i p -> if i == n
|
||||||
then p
|
then p
|
||||||
& pYtd.psGoals %~ succ
|
& pYtd.psGoals %~ succ
|
||||||
& pLifetime.psGoals %~ succ
|
& pLifetime.psGoals %~ succ
|
||||||
else p) . zip [0..]
|
else p)
|
||||||
|
[0..]
|
||||||
|
|
||||||
-- | Awards an assist to a player
|
-- | Awards an assist to a player
|
||||||
awardAssist
|
awardAssist
|
||||||
@@ -142,12 +141,13 @@ awardAssist n ps = ps
|
|||||||
(\m -> let
|
(\m -> let
|
||||||
stats = M.findWithDefault newPlayerStats n m
|
stats = M.findWithDefault newPlayerStats n m
|
||||||
in M.insert n (stats & psAssists %~ succ) m)
|
in M.insert n (stats & psAssists %~ succ) m)
|
||||||
& database.dbPlayers %~ map
|
& database.dbPlayers %~ zipWith
|
||||||
(\(i, p) -> if i == n
|
(\i p -> if i == n
|
||||||
then p
|
then p
|
||||||
& pYtd.psAssists %~ succ
|
& pYtd.psAssists %~ succ
|
||||||
& pLifetime.psAssists %~ succ
|
& pLifetime.psAssists %~ succ
|
||||||
else p) . zip [0..]
|
else p)
|
||||||
|
[0..]
|
||||||
|
|
||||||
-- | Resets the entered data for the current goal
|
-- | Resets the entered data for the current goal
|
||||||
resetGoalData :: ProgState -> ProgState
|
resetGoalData :: ProgState -> ProgState
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -36,8 +36,12 @@ import Mtlstats.Util
|
|||||||
|
|
||||||
-- | Attempts to finish game goalie entry
|
-- | Attempts to finish game goalie entry
|
||||||
finishGoalieEntry :: ProgState -> ProgState
|
finishGoalieEntry :: ProgState -> ProgState
|
||||||
finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
|
finishGoalieEntry s = case M.toList $ s^.progMode.gameStateL.gameGoalieStats of
|
||||||
.~ not (null $ s^.progMode.gameStateL.gameGoalieStats)
|
[] -> s
|
||||||
|
[(gid, _)] -> setGameGoalie gid s'
|
||||||
|
_ -> s'
|
||||||
|
where
|
||||||
|
s' = s & progMode.gameStateL.gameGoaliesRecorded .~ True
|
||||||
|
|
||||||
-- | Records the goalie's game stats
|
-- | Records the goalie's game stats
|
||||||
recordGoalieStats :: ProgState -> ProgState
|
recordGoalieStats :: ProgState -> ProgState
|
||||||
@@ -86,15 +90,19 @@ setGameGoalie gid s = fromMaybe s $ do
|
|||||||
won <- gameWon gs
|
won <- gameWon gs
|
||||||
lost <- gameLost gs
|
lost <- gameLost gs
|
||||||
tied <- gs^.overtimeFlag
|
tied <- gs^.overtimeFlag
|
||||||
|
shutout <- (==0) <$> otherScore gs
|
||||||
|
|
||||||
let
|
let
|
||||||
w = if won then 1 else 0
|
w = if won then 1 else 0
|
||||||
l = if lost then 1 else 0
|
l = if lost then 1 else 0
|
||||||
t = if tied then 1 else 0
|
t = if tied then 1 else 0
|
||||||
|
so = if shutout then 1 else 0
|
||||||
|
|
||||||
updateStats
|
updateStats
|
||||||
= (gsWins +~ w)
|
= (gsWins +~ w)
|
||||||
. (gsLosses +~ l)
|
. (gsLosses +~ l)
|
||||||
. (gsTies +~ t)
|
. (gsTies +~ t)
|
||||||
|
. (gsShutouts +~ so)
|
||||||
|
|
||||||
updateGoalie
|
updateGoalie
|
||||||
= (gYtd %~ updateStats)
|
= (gYtd %~ updateStats)
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -33,10 +33,6 @@ maxFunKeys = 9
|
|||||||
appName :: String
|
appName :: String
|
||||||
appName = "mtlstats"
|
appName = "mtlstats"
|
||||||
|
|
||||||
-- | The database filename
|
|
||||||
dbFname :: String
|
|
||||||
dbFname = "database.json"
|
|
||||||
|
|
||||||
-- | The maximum number of assists
|
-- | The maximum number of assists
|
||||||
maxAssists :: Int
|
maxAssists :: Int
|
||||||
maxAssists = 2
|
maxAssists = 2
|
||||||
@@ -44,3 +40,11 @@ maxAssists = 2
|
|||||||
-- | The length of a typical game (in minutes)
|
-- | The length of a typical game (in minutes)
|
||||||
gameLength :: Int
|
gameLength :: Int
|
||||||
gameLength = 60
|
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
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -21,18 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module Mtlstats.Control (dispatch) where
|
module Mtlstats.Control (dispatch) where
|
||||||
|
|
||||||
import Control.Monad (join)
|
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
import Lens.Micro.Extras (view)
|
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Control.CreateGoalie
|
||||||
|
import Mtlstats.Control.CreatePlayer
|
||||||
import Mtlstats.Control.EditGoalie
|
import Mtlstats.Control.EditGoalie
|
||||||
import Mtlstats.Control.EditPlayer
|
import Mtlstats.Control.EditPlayer
|
||||||
|
import Mtlstats.Control.EditStandings
|
||||||
import Mtlstats.Control.NewGame
|
import Mtlstats.Control.NewGame
|
||||||
import Mtlstats.Handlers
|
import Mtlstats.Control.TitleScreen
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
@@ -41,113 +38,28 @@ import Mtlstats.Types
|
|||||||
-- run
|
-- run
|
||||||
dispatch :: ProgState -> Controller
|
dispatch :: ProgState -> Controller
|
||||||
dispatch s = case s^.progMode of
|
dispatch s = case s^.progMode of
|
||||||
MainMenu -> mainMenuC
|
TitleScreen -> titleScreenC
|
||||||
NewSeason -> newSeasonC
|
MainMenu -> mainMenuC s
|
||||||
|
NewSeason flag -> newSeasonC flag
|
||||||
NewGame gs -> newGameC gs
|
NewGame gs -> newGameC gs
|
||||||
CreatePlayer cps
|
EditMenu -> editMenuC
|
||||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
CreatePlayer cps -> createPlayerC cps
|
||||||
| null $ cps^.cpsName -> getPlayerNameC
|
CreateGoalie cgs -> createGoalieC cgs
|
||||||
| null $ cps^.cpsPosition -> getPlayerPosC
|
|
||||||
| otherwise -> confirmCreatePlayerC
|
|
||||||
CreateGoalie cgs
|
|
||||||
| null $ cgs^.cgsNumber -> getGoalieNumC
|
|
||||||
| null $ cgs^.cgsName -> getGoalieNameC
|
|
||||||
| otherwise -> confirmCreateGoalieC
|
|
||||||
EditPlayer eps -> editPlayerC eps
|
EditPlayer eps -> editPlayerC eps
|
||||||
EditGoalie egs -> editGoalieC egs
|
EditGoalie egs -> editGoalieC egs
|
||||||
|
(EditStandings esm) -> editStandingsC esm
|
||||||
|
|
||||||
mainMenuC :: Controller
|
mainMenuC :: ProgState -> Controller
|
||||||
mainMenuC = Controller
|
mainMenuC s = if null $ s^.dbName
|
||||||
|
then promptController getDBPrompt
|
||||||
|
else Controller
|
||||||
{ drawController = const $ drawMenu mainMenu
|
{ drawController = const $ drawMenu mainMenu
|
||||||
, handleController = menuHandler mainMenu
|
, handleController = menuHandler mainMenu
|
||||||
}
|
}
|
||||||
|
|
||||||
newSeasonC :: Controller
|
newSeasonC :: Bool -> Controller
|
||||||
newSeasonC = Controller
|
newSeasonC False = promptController newSeasonPrompt
|
||||||
{ drawController = const $ drawMenu newSeasonMenu
|
newSeasonC True = menuController newSeasonMenu
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler newSeasonMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getPlayerNumC :: Controller
|
editMenuC :: Controller
|
||||||
getPlayerNumC = Controller
|
editMenuC = menuController editMenu
|
||||||
{ drawController = drawPrompt playerNumPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler playerNumPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getPlayerNameC :: Controller
|
|
||||||
getPlayerNameC = Controller
|
|
||||||
{ drawController = drawPrompt playerNamePrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler playerNamePrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getPlayerPosC :: Controller
|
|
||||||
getPlayerPosC = Controller
|
|
||||||
{ drawController = drawPrompt playerPosPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler playerPosPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
confirmCreatePlayerC :: Controller
|
|
||||||
confirmCreatePlayerC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let cps = s^.progMode.createPlayerStateL
|
|
||||||
C.drawString $ " Player number: " ++ show (fromJust $ cps^.cpsNumber) ++ "\n"
|
|
||||||
C.drawString $ " Player name: " ++ cps^.cpsName ++ "\n"
|
|
||||||
C.drawString $ "Player position: " ++ cps^.cpsPosition ++ "\n\n"
|
|
||||||
C.drawString "Create player: are you sure? (Y/N)"
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> do
|
|
||||||
modify addPlayer
|
|
||||||
join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
|
|
||||||
Just False ->
|
|
||||||
join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback
|
|
||||||
Nothing -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getGoalieNumC :: Controller
|
|
||||||
getGoalieNumC = Controller
|
|
||||||
{ drawController = drawPrompt goalieNumPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler goalieNumPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getGoalieNameC :: Controller
|
|
||||||
getGoalieNameC = Controller
|
|
||||||
{ drawController = drawPrompt goalieNamePrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler goalieNamePrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
confirmCreateGoalieC :: Controller
|
|
||||||
confirmCreateGoalieC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let cgs = s^.progMode.createGoalieStateL
|
|
||||||
C.drawString $ unlines
|
|
||||||
[ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
|
|
||||||
, " Goalie name: " ++ cgs^.cgsName
|
|
||||||
, ""
|
|
||||||
, "Create goalie: are you sure? (Y/N)"
|
|
||||||
]
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> do
|
|
||||||
modify addGoalie
|
|
||||||
join $ gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
|
|
||||||
Just False ->
|
|
||||||
join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
|
|
||||||
Nothing -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|||||||
102
src/Mtlstats/Control/CreateGoalie.hs
Normal file
102
src/Mtlstats/Control/CreateGoalie.hs
Normal file
@@ -0,0 +1,102 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
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 Mtlstats.Control.CreateGoalie (createGoalieC) where
|
||||||
|
|
||||||
|
import Brick.Widgets.Core (str)
|
||||||
|
import Control.Monad.State.Class (gets, modify)
|
||||||
|
import Lens.Micro ((^.), (.~), (?~), (%~), to)
|
||||||
|
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
|
||||||
|
createGoalieC cgs
|
||||||
|
| null $ cgs^.cgsNumber = getGoalieNumC
|
||||||
|
| null $ cgs^.cgsName = getGoalieNameC
|
||||||
|
| null $ cgs^.cgsRookieFlag = getRookieFlagC
|
||||||
|
| null $ cgs^.cgsActiveFlag = getActiveFlagC
|
||||||
|
| otherwise = confirmCreateGoalieC
|
||||||
|
|
||||||
|
getGoalieNumC :: Controller
|
||||||
|
getGoalieNumC = promptController goalieNumPrompt
|
||||||
|
|
||||||
|
getGoalieNameC :: Controller
|
||||||
|
getGoalieNameC = promptController goalieNamePrompt
|
||||||
|
|
||||||
|
getRookieFlagC :: Controller
|
||||||
|
getRookieFlagC = Controller
|
||||||
|
{ 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
|
||||||
|
}
|
||||||
|
|
||||||
|
getActiveFlagC :: Controller
|
||||||
|
getActiveFlagC = Controller
|
||||||
|
{ drawController = const $ str "Is this goalie active? (Y/N)"
|
||||||
|
, handleController = \e ->
|
||||||
|
progMode.createGoalieStateL.cgsActiveFlag .= ynHandler e
|
||||||
|
}
|
||||||
|
|
||||||
|
confirmCreateGoalieC :: Controller
|
||||||
|
confirmCreateGoalieC = Controller
|
||||||
|
{ drawController = \s -> let
|
||||||
|
cgs = s^.progMode.createGoalieStateL
|
||||||
|
in linesToWidget
|
||||||
|
$ labelTable
|
||||||
|
[ ( "Goalie number", maybe "?" show $ cgs^.cgsNumber )
|
||||||
|
, ( "Goalie name", cgs^.cgsName )
|
||||||
|
, ( "Rookie", maybe "?" show $ cgs^.cgsRookieFlag )
|
||||||
|
, ( "Active", maybe "?" show $ cgs^.cgsActiveFlag )
|
||||||
|
]
|
||||||
|
++ [ ""
|
||||||
|
, "Create goalie: are you sure? (Y/N)"
|
||||||
|
]
|
||||||
|
, handleController = \e -> do
|
||||||
|
cgs <- gets (^.progMode.createGoalieStateL)
|
||||||
|
let
|
||||||
|
success = cgs^.cgsSuccessCallback
|
||||||
|
failure = cgs^.cgsFailureCallback
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> do
|
||||||
|
gid <- gets (^.database.dbGoalies.to length)
|
||||||
|
let rookie = cgs^.cgsRookieFlag == Just True
|
||||||
|
modify addGoalie
|
||||||
|
if rookie
|
||||||
|
then success
|
||||||
|
else modify $ progMode.editGoalieStateL
|
||||||
|
%~ (egsSelectedGoalie ?~ gid)
|
||||||
|
. (egsMode .~ EGLtGames True)
|
||||||
|
. (egsCallback .~ success)
|
||||||
|
Just False -> failure
|
||||||
|
Nothing -> return ()
|
||||||
|
}
|
||||||
105
src/Mtlstats/Control/CreatePlayer.hs
Normal file
105
src/Mtlstats/Control/CreatePlayer.hs
Normal file
@@ -0,0 +1,105 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
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 Mtlstats.Control.CreatePlayer (createPlayerC) where
|
||||||
|
|
||||||
|
import Brick.Widgets.Core (str)
|
||||||
|
import Control.Monad.State.Class (gets, modify)
|
||||||
|
import Lens.Micro ((^.), (.~), (?~), (%~), to)
|
||||||
|
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
|
||||||
|
createPlayerC cps
|
||||||
|
| null $ cps^.cpsNumber = getPlayerNumC
|
||||||
|
| null $ cps^.cpsName = getPlayerNameC
|
||||||
|
| null $ cps^.cpsPosition = getPlayerPosC
|
||||||
|
| null $ cps^.cpsRookieFlag = getRookieFlagC
|
||||||
|
| null $ cps^.cpsActiveFlag = getActiveFlagC
|
||||||
|
| otherwise = confirmCreatePlayerC
|
||||||
|
|
||||||
|
getPlayerNumC :: Controller
|
||||||
|
getPlayerNumC = promptController playerNumPrompt
|
||||||
|
|
||||||
|
getPlayerNameC :: Controller
|
||||||
|
getPlayerNameC = promptController playerNamePrompt
|
||||||
|
|
||||||
|
getPlayerPosC :: Controller
|
||||||
|
getPlayerPosC = promptController playerPosPrompt
|
||||||
|
|
||||||
|
getRookieFlagC :: Controller
|
||||||
|
getRookieFlagC = Controller
|
||||||
|
{ 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
|
||||||
|
}
|
||||||
|
|
||||||
|
getActiveFlagC :: Controller
|
||||||
|
getActiveFlagC = Controller
|
||||||
|
{ drawController = const $ str "Is the player active? (Y/N)"
|
||||||
|
, handleController = \e ->
|
||||||
|
progMode.createPlayerStateL.cpsActiveFlag .= ynHandler e
|
||||||
|
}
|
||||||
|
|
||||||
|
confirmCreatePlayerC :: Controller
|
||||||
|
confirmCreatePlayerC = Controller
|
||||||
|
{ drawController = \s -> let cps = s^.progMode.createPlayerStateL
|
||||||
|
in linesToWidget
|
||||||
|
$ labelTable
|
||||||
|
[ ( "Player number", maybe "?" show $ cps^.cpsNumber )
|
||||||
|
, ( "Player name", cps^.cpsName )
|
||||||
|
, ( "Player position", cps^.cpsPosition )
|
||||||
|
, ( "Rookie", maybe "?" show $ cps^.cpsRookieFlag )
|
||||||
|
, ( "Active", maybe "?" show $ cps^.cpsActiveFlag )
|
||||||
|
]
|
||||||
|
++ [ ""
|
||||||
|
, "Create player: are you sure? (Y/N)"
|
||||||
|
]
|
||||||
|
, handleController = \e -> do
|
||||||
|
cps <- use $ progMode.createPlayerStateL
|
||||||
|
let
|
||||||
|
success = cps^.cpsSuccessCallback
|
||||||
|
failure = cps^.cpsFailureCallback
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> do
|
||||||
|
pid <- gets (^.database.dbPlayers.to length)
|
||||||
|
let rookie = cps^.cpsRookieFlag == Just True
|
||||||
|
modify addPlayer
|
||||||
|
if rookie
|
||||||
|
then success
|
||||||
|
else modify $ progMode.editPlayerStateL
|
||||||
|
%~ (epsSelectedPlayer ?~ pid)
|
||||||
|
. (epsMode .~ EPLtGoals True)
|
||||||
|
. (epsCallback .~ success)
|
||||||
|
Just False -> failure
|
||||||
|
Nothing -> return ()
|
||||||
|
}
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
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 Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.))
|
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.Helpers.Goalie
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Menu.EditGoalie
|
import Mtlstats.Menu.EditGoalie
|
||||||
@@ -39,84 +44,128 @@ import Mtlstats.Util
|
|||||||
editGoalieC :: EditGoalieState -> Controller
|
editGoalieC :: EditGoalieState -> Controller
|
||||||
editGoalieC egs
|
editGoalieC egs
|
||||||
| null $ egs^.egsSelectedGoalie = selectC
|
| null $ egs^.egsSelectedGoalie = selectC
|
||||||
| otherwise = editC $ egs^.egsMode
|
| otherwise = editC (egs^.egsCallback) (egs^.egsMode)
|
||||||
|
|
||||||
selectC :: Controller
|
selectC :: Controller
|
||||||
selectC = promptController goalieToEditPrompt
|
selectC = promptController goalieToEditPrompt
|
||||||
|
|
||||||
editC :: EditGoalieMode -> Controller
|
editC :: Action () -> EditGoalieMode -> Controller
|
||||||
editC = \case
|
editC cb =
|
||||||
|
( \case
|
||||||
EGMenu -> menuC
|
EGMenu -> menuC
|
||||||
EGNumber -> numberC
|
EGNumber -> numberC
|
||||||
EGName -> nameC
|
EGName -> nameC
|
||||||
EGYtd -> ytdMenuC
|
EGYtd -> ytdMenuC
|
||||||
EGLifetime -> lifetimeMenuC
|
EGLifetime -> lifetimeMenuC
|
||||||
EGYtdGames -> ytdGamesC
|
EGDelete -> deleteC
|
||||||
EGYtdMins -> ytdMinsC
|
EGYtdGames b -> ytdGamesC b
|
||||||
EGYtdGoals -> ytdGoalsC
|
EGYtdMins b -> ytdMinsC b
|
||||||
EGYtdWins -> ytdWinsC
|
EGYtdGoals b -> ytdGoalsC b
|
||||||
EGYtdLosses -> ytdLossesC
|
EGYtdShutouts b -> ytdShutoutsC b
|
||||||
|
EGYtdWins b -> ytdWinsC b
|
||||||
|
EGYtdLosses b -> ytdLossesC b
|
||||||
EGYtdTies -> ytdTiesC
|
EGYtdTies -> ytdTiesC
|
||||||
EGLtGames -> ltGamesC
|
EGLtGames b -> ltGamesC b
|
||||||
EGLtMins -> ltMinsC
|
EGLtMins b -> ltMinsC b
|
||||||
EGLtGoals -> ltGoalsC
|
EGLtGoals b -> ltGoalsC b
|
||||||
EGLtWins -> ltWinsC
|
EGLtShutouts b -> ltShutoutsC b
|
||||||
EGLtLosses -> ltLossesC
|
EGLtWins b -> ltWinsC b
|
||||||
|
EGLtLosses b -> ltLossesC b
|
||||||
EGLtTies -> ltTiesC
|
EGLtTies -> ltTiesC
|
||||||
|
) <*> return cb
|
||||||
|
|
||||||
menuC :: Controller
|
menuC :: Action () -> Controller
|
||||||
menuC = menuControllerWith header editGoalieMenu
|
menuC _ = menuControllerWith header editGoalieMenu
|
||||||
|
|
||||||
numberC :: Controller
|
numberC :: Action () -> Controller
|
||||||
numberC = promptController editGoalieNumberPrompt
|
numberC = promptController . editGoalieNumberPrompt
|
||||||
|
|
||||||
nameC :: Controller
|
nameC :: Action () -> Controller
|
||||||
nameC = promptController editGoalieNamePrompt
|
nameC = promptController . editGoalieNamePrompt
|
||||||
|
|
||||||
ytdMenuC :: Controller
|
ytdMenuC :: Action () -> Controller
|
||||||
ytdMenuC = menuControllerWith header editGoalieYtdMenu
|
ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
|
||||||
|
|
||||||
lifetimeMenuC :: Controller
|
lifetimeMenuC :: Action () -> Controller
|
||||||
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
|
lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
|
||||||
|
|
||||||
ytdGamesC :: Controller
|
deleteC :: Action () -> Controller
|
||||||
ytdGamesC = promptController editGoalieYtdGamesPrompt
|
deleteC _ = Controller
|
||||||
|
|
||||||
ytdMinsC :: Controller
|
{ drawController = \s -> let
|
||||||
ytdMinsC = promptController editGoalieYtdMinsPrompt
|
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 ()
|
||||||
|
}
|
||||||
|
|
||||||
ytdGoalsC :: Controller
|
ytdGamesC :: Bool -> Action () -> Controller
|
||||||
ytdGoalsC = promptController editGoalieYtdGoalsPrompt
|
ytdGamesC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdGamesPrompt
|
||||||
|
|
||||||
ytdWinsC :: Controller
|
ytdMinsC :: Bool -> Action () -> Controller
|
||||||
ytdWinsC = promptController editGoalieYtdWinsPrompt
|
ytdMinsC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdMinsPrompt
|
||||||
|
|
||||||
ytdLossesC :: Controller
|
ytdGoalsC :: Bool -> Action () -> Controller
|
||||||
ytdLossesC = promptController editGoalieYtdLossesPrompt
|
ytdGoalsC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdGoalsPrompt
|
||||||
|
|
||||||
ytdTiesC :: Controller
|
ytdShutoutsC :: Bool -> Action () -> Controller
|
||||||
ytdTiesC = promptController editGoalieYtdTiesPrompt
|
ytdShutoutsC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdShutoutsPrompt
|
||||||
|
|
||||||
ltGamesC :: Controller
|
ytdWinsC :: Bool -> Action () -> Controller
|
||||||
ltGamesC = promptController editGoalieLtGamesPrompt
|
ytdWinsC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdWinsPrompt
|
||||||
|
|
||||||
ltMinsC :: Controller
|
ytdLossesC :: Bool -> Action () -> Controller
|
||||||
ltMinsC = promptController editGoalieLtMinsPrompt
|
ytdLossesC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdLossesPrompt
|
||||||
|
|
||||||
ltGoalsC :: Controller
|
ytdTiesC :: Action () -> Controller
|
||||||
ltGoalsC = promptController editGoalieLtGoalsPrompt
|
ytdTiesC = promptController . editGoalieYtdTiesPrompt
|
||||||
|
|
||||||
ltWinsC :: Controller
|
ltGamesC :: Bool -> Action () -> Controller
|
||||||
ltWinsC = promptController editGoalieLtWinsPrompt
|
ltGamesC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtGamesPrompt
|
||||||
|
|
||||||
ltLossesC :: Controller
|
ltMinsC :: Bool -> Action () -> Controller
|
||||||
ltLossesC = promptController editGoalieLtLossesPrompt
|
ltMinsC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtMinsPrompt
|
||||||
|
|
||||||
ltTiesC :: Controller
|
ltGoalsC :: Bool -> Action() -> Controller
|
||||||
ltTiesC = promptController editGoalieLtTiesPrompt
|
ltGoalsC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtGoalsPrompt
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
ltShutoutsC :: Bool -> Action () -> Controller
|
||||||
header s = C.drawString $ fromMaybe "" $ do
|
ltShutoutsC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtShutoutsPrompt
|
||||||
|
|
||||||
|
ltWinsC :: Bool -> Action () -> Controller
|
||||||
|
ltWinsC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtWinsPrompt
|
||||||
|
|
||||||
|
ltLossesC :: Bool -> Action () -> Controller
|
||||||
|
ltLossesC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtLossesPrompt
|
||||||
|
|
||||||
|
ltTiesC :: Action () -> Controller
|
||||||
|
ltTiesC = promptController . editGoalieLtTiesPrompt
|
||||||
|
|
||||||
|
header :: ProgState -> Widget () -> Widget ()
|
||||||
|
header s w = vBox
|
||||||
|
[ str $ fromMaybe "" $ do
|
||||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
g <- nth gid $ s^.database.dbGoalies
|
g <- nth gid $ s^.database.dbGoalies
|
||||||
Just $ goalieDetails g ++ "\n"
|
Just $ goalieDetails g
|
||||||
|
, w
|
||||||
|
]
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
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 Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.))
|
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.Helpers.Player
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Menu.EditPlayer
|
import Mtlstats.Menu.EditPlayer
|
||||||
@@ -37,61 +42,89 @@ import Mtlstats.Util
|
|||||||
editPlayerC :: EditPlayerState -> Controller
|
editPlayerC :: EditPlayerState -> Controller
|
||||||
editPlayerC eps
|
editPlayerC eps
|
||||||
| null $ eps^.epsSelectedPlayer = selectPlayerC
|
| null $ eps^.epsSelectedPlayer = selectPlayerC
|
||||||
| otherwise = case eps^.epsMode of
|
| otherwise =
|
||||||
|
( case eps^.epsMode of
|
||||||
EPMenu -> menuC
|
EPMenu -> menuC
|
||||||
EPNumber -> numberC
|
EPNumber -> numberC
|
||||||
EPName -> nameC
|
EPName -> nameC
|
||||||
EPPosition -> positionC
|
EPPosition -> positionC
|
||||||
EPYtd -> ytdC
|
EPYtd -> ytdC
|
||||||
EPLifetime -> lifetimeC
|
EPLifetime -> lifetimeC
|
||||||
EPYtdGoals -> ytdGoalsC
|
EPDelete -> deleteC
|
||||||
EPYtdAssists -> ytdAssistsC
|
EPYtdGoals b -> ytdGoalsC b
|
||||||
|
EPYtdAssists b -> ytdAssistsC b
|
||||||
EPYtdPMin -> ytdPMinC
|
EPYtdPMin -> ytdPMinC
|
||||||
EPLtGoals -> ltGoalsC
|
EPLtGoals b -> ltGoalsC b
|
||||||
EPLtAssists -> ltAssistsC
|
EPLtAssists b -> ltAssistsC b
|
||||||
EPLtPMin -> ltPMinC
|
EPLtPMin -> ltPMinC
|
||||||
|
) $ eps^.epsCallback
|
||||||
|
|
||||||
selectPlayerC :: Controller
|
selectPlayerC :: Controller
|
||||||
selectPlayerC = promptController playerToEditPrompt
|
selectPlayerC = promptController playerToEditPrompt
|
||||||
|
|
||||||
menuC :: Controller
|
menuC :: Action () -> Controller
|
||||||
menuC = menuControllerWith header editPlayerMenu
|
menuC _ = menuControllerWith header editPlayerMenu
|
||||||
|
|
||||||
numberC :: Controller
|
numberC :: Action () -> Controller
|
||||||
numberC = promptController editPlayerNumPrompt
|
numberC = promptController . editPlayerNumPrompt
|
||||||
|
|
||||||
nameC :: Controller
|
nameC :: Action () -> Controller
|
||||||
nameC = promptController editPlayerNamePrompt
|
nameC = promptController . editPlayerNamePrompt
|
||||||
|
|
||||||
positionC :: Controller
|
positionC :: Action () -> Controller
|
||||||
positionC = promptController editPlayerPosPrompt
|
positionC = promptController . editPlayerPosPrompt
|
||||||
|
|
||||||
ytdC :: Controller
|
ytdC :: Action () -> Controller
|
||||||
ytdC = menuControllerWith header editPlayerYtdMenu
|
ytdC _ = menuControllerWith header editPlayerYtdMenu
|
||||||
|
|
||||||
lifetimeC :: Controller
|
lifetimeC :: Action () -> Controller
|
||||||
lifetimeC = menuControllerWith header editPlayerLtMenu
|
lifetimeC _ = menuControllerWith header editPlayerLtMenu
|
||||||
|
|
||||||
ytdGoalsC :: Controller
|
deleteC :: Action () -> Controller
|
||||||
ytdGoalsC = promptController editPlayerYtdGoalsPrompt
|
deleteC _ = Controller
|
||||||
|
|
||||||
ytdAssistsC :: Controller
|
{ drawController = \s -> let
|
||||||
ytdAssistsC = promptController editPlayerYtdAssistsPrompt
|
hdr = fromMaybe [] $ do
|
||||||
|
|
||||||
ytdPMinC :: Controller
|
|
||||||
ytdPMinC = promptController editPlayerYtdPMinPrompt
|
|
||||||
|
|
||||||
ltGoalsC :: Controller
|
|
||||||
ltGoalsC = promptController editPlayerLtGoalsPrompt
|
|
||||||
|
|
||||||
ltAssistsC :: Controller
|
|
||||||
ltAssistsC = promptController editPlayerLtAssistsPrompt
|
|
||||||
|
|
||||||
ltPMinC :: Controller
|
|
||||||
ltPMinC = promptController editPlayerLtPMinPrompt
|
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
|
||||||
header s = C.drawString $ fromMaybe "" $ do
|
|
||||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||||
player <- nth pid $ s^.database.dbPlayers
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
Just $ playerDetails player ++ "\n"
|
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
|
||||||
|
|
||||||
|
ytdAssistsC :: Bool -> Action () -> Controller
|
||||||
|
ytdAssistsC batchMode callback = promptController $
|
||||||
|
editPlayerYtdAssistsPrompt batchMode callback
|
||||||
|
|
||||||
|
ytdPMinC :: Action () -> Controller
|
||||||
|
ytdPMinC = promptController . editPlayerYtdPMinPrompt
|
||||||
|
|
||||||
|
ltGoalsC :: Bool -> Action () -> Controller
|
||||||
|
ltGoalsC batchMode callback = promptController $
|
||||||
|
editPlayerLtGoalsPrompt batchMode callback
|
||||||
|
|
||||||
|
ltAssistsC :: Bool -> Action () -> Controller
|
||||||
|
ltAssistsC batchMode callback = promptController $
|
||||||
|
editPlayerLtAssistsPrompt batchMode callback
|
||||||
|
|
||||||
|
ltPMinC :: Action () -> Controller
|
||||||
|
ltPMinC = promptController . editPlayerLtPMinPrompt
|
||||||
|
|
||||||
|
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
|
||||||
|
]
|
||||||
|
|||||||
91
src/Mtlstats/Control/EditStandings.hs
Normal file
91
src/Mtlstats/Control/EditStandings.hs
Normal file
@@ -0,0 +1,91 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
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/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Mtlstats.Control.EditStandings (editStandingsC) where
|
||||||
|
|
||||||
|
import Brick.Types (Widget)
|
||||||
|
import Brick.Widgets.Core (vBox)
|
||||||
|
import Lens.Micro ((^.))
|
||||||
|
|
||||||
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Menu
|
||||||
|
import Mtlstats.Menu.EditStandings
|
||||||
|
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
|
||||||
|
editStandingsC = \case
|
||||||
|
ESMMenu -> menuControllerWith header editStandingsMenu
|
||||||
|
ESMHome m -> editHomeStandingsC m
|
||||||
|
ESMAway m -> editAwayStandingsC m
|
||||||
|
|
||||||
|
editHomeStandingsC :: ESMSubMode -> Controller
|
||||||
|
editHomeStandingsC = \case
|
||||||
|
ESMSubMenu -> menuC editHomeStandingsMenu
|
||||||
|
ESMEditWins -> promptC editHomeWinsPrompt
|
||||||
|
ESMEditLosses -> promptC editHomeLossesPrompt
|
||||||
|
ESMEditOvertime -> promptC editHomeOvertimePrompt
|
||||||
|
ESMEditGoalsFor -> promptC editHomeGoalsForPrompt
|
||||||
|
ESMEditGoalsAgainst -> promptC editHomeGoalsAgainstPrompt
|
||||||
|
|
||||||
|
editAwayStandingsC :: ESMSubMode -> Controller
|
||||||
|
editAwayStandingsC = \case
|
||||||
|
ESMSubMenu -> menuC editAwayStandingsMenu
|
||||||
|
ESMEditWins -> promptC editAwayWinsPrompt
|
||||||
|
ESMEditLosses -> promptC editAwayLossesPrompt
|
||||||
|
ESMEditOvertime -> promptC editAwayOvertimePrompt
|
||||||
|
ESMEditGoalsFor -> promptC editAwayGoalsForPrompt
|
||||||
|
ESMEditGoalsAgainst -> promptC editAwayGoalsAgainstPrompt
|
||||||
|
|
||||||
|
menuC :: Menu () -> Controller
|
||||||
|
menuC = menuControllerWith header
|
||||||
|
|
||||||
|
promptC :: Prompt -> Controller
|
||||||
|
promptC = promptControllerWith header
|
||||||
|
|
||||||
|
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 )
|
||||||
|
]
|
||||||
|
in vBox
|
||||||
|
[ linesToWidget $ table ++ [""]
|
||||||
|
, w
|
||||||
|
]
|
||||||
|
|
||||||
|
valsFor :: GameStats -> [Int]
|
||||||
|
valsFor gs =
|
||||||
|
[ gs^.gmsWins
|
||||||
|
, gs^.gmsLosses
|
||||||
|
, gs^.gmsOvertime
|
||||||
|
, gs^.gmsGoalsFor
|
||||||
|
, gs^.gmsGoalsAgainst
|
||||||
|
]
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
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 Data.Maybe (fromJust, fromMaybe, isJust)
|
||||||
|
import Graphics.Vty.Input.Events
|
||||||
|
( Event (EvKey)
|
||||||
|
, Key (KDown, KHome, KEnter, KUp)
|
||||||
|
)
|
||||||
import Lens.Micro ((^.), (.~))
|
import Lens.Micro ((^.), (.~))
|
||||||
import qualified UI.NCurses as C
|
import Lens.Micro.Mtl ((.=), use)
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Actions.NewGame
|
import Mtlstats.Actions.NewGame
|
||||||
|
import Mtlstats.Config
|
||||||
import Mtlstats.Control.NewGame.GoalieInput
|
import Mtlstats.Control.NewGame.GoalieInput
|
||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
import Mtlstats.Handlers
|
import Mtlstats.Handlers
|
||||||
@@ -60,7 +74,7 @@ gameYearC :: Controller
|
|||||||
gameYearC = promptControllerWith header gameYearPrompt
|
gameYearC = promptControllerWith header gameYearPrompt
|
||||||
|
|
||||||
gameMonthC :: Controller
|
gameMonthC :: Controller
|
||||||
gameMonthC = menuControllerWith header gameMonthMenu
|
gameMonthC = promptControllerWith monthHeader gameMonthPrompt
|
||||||
|
|
||||||
gameDayC :: Controller
|
gameDayC :: Controller
|
||||||
gameDayC = promptControllerWith header gameDayPrompt
|
gameDayC = promptControllerWith header gameDayPrompt
|
||||||
@@ -79,32 +93,30 @@ awayScoreC = promptControllerWith header awayScorePrompt
|
|||||||
|
|
||||||
overtimeFlagC :: Controller
|
overtimeFlagC :: Controller
|
||||||
overtimeFlagC = Controller
|
overtimeFlagC = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> header s $
|
||||||
header s
|
str "Did the game go into overtime? (Y/N)"
|
||||||
C.drawString "Did the game go into overtime? (Y/N)"
|
, handleController = \e ->
|
||||||
return C.CursorInvisible
|
progMode.gameStateL.overtimeFlag .= ynHandler e
|
||||||
, handleController = \e -> do
|
|
||||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
verifyDataC :: Controller
|
verifyDataC :: Controller
|
||||||
verifyDataC = Controller
|
verifyDataC = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> let
|
||||||
let gs = s^.progMode.gameStateL
|
gs = s^.progMode.gameStateL
|
||||||
header s
|
in header s $ linesToWidget $
|
||||||
C.drawString "\n"
|
[""] ++
|
||||||
C.drawString $ unlines $ labelTable
|
labelTable
|
||||||
[ ( "Date", gameDate gs )
|
[ ( "Date", gameDate gs )
|
||||||
, ( "Game type", show $ fromJust $ gs^.gameType )
|
, ( "Game type", show $ fromJust $ gs^.gameType )
|
||||||
, ( "Other team", gs^.otherTeam )
|
, ( "Other team", gs^.otherTeam )
|
||||||
, ( "Home score", show $ fromJust $ gs^.homeScore )
|
, ( "Home score", show $ fromJust $ gs^.homeScore )
|
||||||
, ( "Away score", show $ fromJust $ gs^.awayScore )
|
, ( "Away score", show $ fromJust $ gs^.awayScore )
|
||||||
, ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
|
, ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
|
||||||
|
] ++
|
||||||
|
[ ""
|
||||||
|
, "Is the above information correct? (Y/N)"
|
||||||
]
|
]
|
||||||
C.drawString "\nIs the above information correct? (Y/N)"
|
, handleController = \e ->
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
case ynHandler e of
|
||||||
Just True -> modify
|
Just True -> modify
|
||||||
$ (progMode.gameStateL.dataVerified .~ True)
|
$ (progMode.gameStateL.dataVerified .~ True)
|
||||||
@@ -112,7 +124,6 @@ verifyDataC = Controller
|
|||||||
. awardShutouts
|
. awardShutouts
|
||||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
goalInput :: GameState -> Controller
|
goalInput :: GameState -> Controller
|
||||||
@@ -129,7 +140,6 @@ recordGoalC = Controller
|
|||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
(game, goal) <- gets gameGoal
|
(game, goal) <- gets gameGoal
|
||||||
promptHandler (recordGoalPrompt game goal) e
|
promptHandler (recordGoalPrompt game goal) e
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
recordAssistC :: Controller
|
recordAssistC :: Controller
|
||||||
@@ -140,86 +150,100 @@ recordAssistC = Controller
|
|||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
(game, goal, assist) <- gets gameGoalAssist
|
(game, goal, assist) <- gets gameGoalAssist
|
||||||
promptHandler (recordAssistPrompt game goal assist) e
|
promptHandler (recordAssistPrompt game goal assist) e
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
confirmGoalDataC :: Controller
|
confirmGoalDataC :: Controller
|
||||||
confirmGoalDataC = Controller
|
confirmGoalDataC = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> let
|
||||||
let
|
|
||||||
(game, goal) = gameGoal s
|
(game, goal) = gameGoal s
|
||||||
gs = s^.progMode.gameStateL
|
gs = s^.progMode.gameStateL
|
||||||
players = s^.database.dbPlayers
|
players = s^.database.dbPlayers
|
||||||
msg = unlines $
|
msg =
|
||||||
[ " Game: " ++ padNum 2 game
|
[ " Game: " ++ padNum 2 game
|
||||||
, " Goal: " ++ show goal
|
, " Goal: " ++ show goal
|
||||||
, "Goal scored by: " ++
|
, "Goal scored by: " ++
|
||||||
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
||||||
] ++
|
] ++
|
||||||
map
|
map
|
||||||
(\pid -> " Assisted by: " ++
|
( \pid -> " Assisted by: " ++
|
||||||
playerSummary (fromJust $ nth pid players))
|
playerSummary (fromJust $ nth pid players)
|
||||||
|
)
|
||||||
(gs^.assistsBy) ++
|
(gs^.assistsBy) ++
|
||||||
[ ""
|
[ ""
|
||||||
, "Is the above information correct? (Y/N)"
|
, "Is the above information correct? (Y/N)"
|
||||||
]
|
]
|
||||||
C.drawString msg
|
in linesToWidget msg
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
case ynHandler e of
|
case ynHandler e of
|
||||||
Just True -> modify recordGoalAssists
|
Just True -> modify recordGoalAssists
|
||||||
Just False -> modify resetGoalData
|
Just False -> modify resetGoalData
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
pMinPlayerC :: Controller
|
pMinPlayerC :: Controller
|
||||||
pMinPlayerC = Controller
|
pMinPlayerC = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> header s $
|
||||||
header s
|
|
||||||
drawPrompt pMinPlayerPrompt s
|
drawPrompt pMinPlayerPrompt s
|
||||||
, handleController = \e -> do
|
, handleController = promptHandler pMinPlayerPrompt
|
||||||
promptHandler pMinPlayerPrompt e
|
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
getPMinsC :: Controller
|
getPMinsC :: Controller
|
||||||
getPMinsC = Controller
|
getPMinsC = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> header s $ vBox
|
||||||
header s
|
[ str $ fromMaybe "" $ do
|
||||||
C.drawString $ fromMaybe "" $ do
|
|
||||||
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||||
player <- nth pid $ s^.database.dbPlayers
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
Just $ playerSummary player ++ "\n"
|
Just $ playerSummary player
|
||||||
drawPrompt assignPMinsPrompt s
|
, drawPrompt assignPMinsPrompt s
|
||||||
, handleController = \e -> do
|
]
|
||||||
promptHandler assignPMinsPrompt e
|
, handleController = promptHandler assignPMinsPrompt
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
reportC :: Controller
|
reportC :: Controller
|
||||||
reportC = Controller
|
reportC = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = viewport () Vertical . hCenter . linesToWidget .
|
||||||
(rows, cols) <- C.windowSize
|
displayReport reportCols
|
||||||
C.drawString $ unlines $ slice
|
|
||||||
(s^.scrollOffset)
|
|
||||||
(fromInteger $ pred rows)
|
|
||||||
(report (fromInteger $ pred cols) s)
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
|
scr <- use scroller
|
||||||
case e of
|
case e of
|
||||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
VtyEvent (EvKey k []) -> case k of
|
||||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
KUp -> vScrollBy scr (-1)
|
||||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
KDown -> vScrollBy scr 1
|
||||||
C.EventSpecialKey _ -> modify backHome
|
KHome -> vScrollToBeginning scr
|
||||||
C.EventCharacter _ -> modify backHome
|
KEnter -> do
|
||||||
|
get >>= liftIO . writeFile reportFilename . exportReport reportCols
|
||||||
|
modify backHome
|
||||||
|
_ -> return ()
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
header :: ProgState -> Widget () -> Widget ()
|
||||||
header s = C.drawString $
|
header s w = vBox
|
||||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
[ 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 :: ProgState -> (Int, Int)
|
||||||
gameGoal s =
|
gameGoal s =
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
|
||||||
|
|
||||||
|
import Brick.Types (Widget)
|
||||||
|
import Brick.Widgets.Core (str, vBox)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
@@ -52,11 +53,11 @@ goalsAllowedC = promptControllerWith header goalsAllowedPrompt
|
|||||||
selectGameGoalieC :: Controller
|
selectGameGoalieC :: Controller
|
||||||
selectGameGoalieC = menuStateController gameGoalieMenu
|
selectGameGoalieC = menuStateController gameGoalieMenu
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
header :: ProgState -> Widget () -> Widget ()
|
||||||
header s = C.drawString $ unlines
|
header s w = vBox $ map str
|
||||||
[ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
|
[ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
|
||||||
, fromMaybe "" $ do
|
, fromMaybe "" $ do
|
||||||
n <- s^.progMode.gameStateL.gameSelectedGoalie
|
n <- s^.progMode.gameStateL.gameSelectedGoalie
|
||||||
g <- nth n $ s^.database.dbGoalies
|
g <- nth n $ s^.database.dbGoalies
|
||||||
Just $ goalieSummary g
|
Just $ goalieSummary g
|
||||||
]
|
] ++ [w]
|
||||||
|
|||||||
139
src/Mtlstats/Control/TitleScreen.hs
Normal file
139
src/Mtlstats/Control/TitleScreen.hs
Normal file
@@ -0,0 +1,139 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
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/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Mtlstats.Control.TitleScreen (titleScreenC) where
|
||||||
|
|
||||||
|
import Brick.Types (BrickEvent (VtyEvent))
|
||||||
|
import Control.Monad.State.Class (modify)
|
||||||
|
import Data.Char (chr)
|
||||||
|
import Graphics.Vty.Input.Events (Event (EvKey))
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
titleScreenC :: Controller
|
||||||
|
titleScreenC = Controller
|
||||||
|
{ 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
|
||||||
|
VtyEvent (EvKey _ _) -> modify backHome
|
||||||
|
_ -> return ()
|
||||||
|
}
|
||||||
|
|
||||||
|
titleText :: [String]
|
||||||
|
titleText = box $ map (map blockify) $ foldl joinBlocks (repeat "")
|
||||||
|
[chM, chT, chL, chS, chT, chA, chT, chS]
|
||||||
|
|
||||||
|
box :: [String] -> [String]
|
||||||
|
box strs
|
||||||
|
= [[tl] ++ replicate width horiz ++ [tr]]
|
||||||
|
++ map (\s -> [vert] ++ s ++ [vert]) strs
|
||||||
|
++ [[bl] ++ replicate width horiz ++ [br]]
|
||||||
|
where
|
||||||
|
width = length $ head strs
|
||||||
|
tl = chr 0x2554
|
||||||
|
tr = chr 0x2557
|
||||||
|
bl = chr 0x255a
|
||||||
|
br = chr 0x255d
|
||||||
|
horiz = chr 0x2550
|
||||||
|
vert = chr 0x2551
|
||||||
|
|
||||||
|
blockify :: Char -> Char
|
||||||
|
blockify = \case
|
||||||
|
'#' -> chr 0x2588
|
||||||
|
'>' -> chr 0x2590
|
||||||
|
'<' -> chr 0x258c
|
||||||
|
ch -> ch
|
||||||
|
|
||||||
|
joinBlocks :: [String] -> [String] -> [String]
|
||||||
|
joinBlocks = zipWith (++)
|
||||||
|
|
||||||
|
chM :: [String]
|
||||||
|
chM =
|
||||||
|
[ "##< >##"
|
||||||
|
, ">## ##<"
|
||||||
|
, ">##< >##<"
|
||||||
|
, ">### ###<"
|
||||||
|
, ">#######<"
|
||||||
|
, ">#<###>#<"
|
||||||
|
, ">#<>#<>#<"
|
||||||
|
, "##< >##"
|
||||||
|
]
|
||||||
|
|
||||||
|
chT :: [String]
|
||||||
|
chT =
|
||||||
|
[ ">########<"
|
||||||
|
, ">## ## ##<"
|
||||||
|
, ">#< ## >#<"
|
||||||
|
, " ## "
|
||||||
|
, " ## "
|
||||||
|
, " ## "
|
||||||
|
, " ## "
|
||||||
|
, " >##< "
|
||||||
|
]
|
||||||
|
|
||||||
|
chL :: [String]
|
||||||
|
chL =
|
||||||
|
[ "### "
|
||||||
|
, ">#< "
|
||||||
|
, ">#< "
|
||||||
|
, ">#< "
|
||||||
|
, ">#< "
|
||||||
|
, ">#< ##"
|
||||||
|
, ">#< >##"
|
||||||
|
, "#######"
|
||||||
|
]
|
||||||
|
|
||||||
|
chS :: [String]
|
||||||
|
chS =
|
||||||
|
[ " #####< "
|
||||||
|
, ">#< ## "
|
||||||
|
, "## "
|
||||||
|
, " #####< "
|
||||||
|
, " >#<"
|
||||||
|
, " ##"
|
||||||
|
, ">#< >#<"
|
||||||
|
, " ###### "
|
||||||
|
]
|
||||||
|
|
||||||
|
chA :: [String]
|
||||||
|
chA =
|
||||||
|
[ " >##< "
|
||||||
|
, " ## "
|
||||||
|
, " >##< "
|
||||||
|
, " #### "
|
||||||
|
, " >#<>#< "
|
||||||
|
, " ###### "
|
||||||
|
, ">#< >#<"
|
||||||
|
, "### ###"
|
||||||
|
]
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -26,6 +26,7 @@ module Mtlstats.Format
|
|||||||
, left
|
, left
|
||||||
, right
|
, right
|
||||||
, centre
|
, centre
|
||||||
|
, padRight
|
||||||
, overlay
|
, overlay
|
||||||
, month
|
, month
|
||||||
, labelTable
|
, labelTable
|
||||||
@@ -87,6 +88,16 @@ centre n str = let
|
|||||||
pad = replicate pLen ' '
|
pad = replicate pLen ' '
|
||||||
in take n $ pad ++ str ++ repeat ' '
|
in take n $ pad ++ str ++ repeat ' '
|
||||||
|
|
||||||
|
-- | Pads text on the right with spaces to fit a minimum width
|
||||||
|
padRight
|
||||||
|
:: Int
|
||||||
|
-- ^ The width to pad to
|
||||||
|
-> String
|
||||||
|
-- ^ The text to pad
|
||||||
|
-> String
|
||||||
|
padRight width str =
|
||||||
|
overlay str $ replicate width ' '
|
||||||
|
|
||||||
-- | Overlays one string on top of another
|
-- | Overlays one string on top of another
|
||||||
overlay
|
overlay
|
||||||
:: String
|
:: String
|
||||||
@@ -118,9 +129,14 @@ month _ = ""
|
|||||||
labelTable :: [(String, String)] -> [String]
|
labelTable :: [(String, String)] -> [String]
|
||||||
labelTable xs = let
|
labelTable xs = let
|
||||||
labelWidth = maximum $ map (length . fst) xs
|
labelWidth = maximum $ map (length . fst) xs
|
||||||
|
valWidth = maximum $ map (length . snd) xs
|
||||||
|
|
||||||
in map
|
in map
|
||||||
(\(label, val) -> right labelWidth label ++ ": " ++ val)
|
( \(label, val)
|
||||||
xs
|
-> right labelWidth label
|
||||||
|
++ ": "
|
||||||
|
++ left valWidth val
|
||||||
|
) xs
|
||||||
|
|
||||||
-- | Creates a variable column table of numbers with two axes
|
-- | Creates a variable column table of numbers with two axes
|
||||||
numTable
|
numTable
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
module Mtlstats.Handlers (ynHandler) where
|
||||||
|
|
||||||
|
import Brick.Types (BrickEvent (VtyEvent))
|
||||||
import Data.Char (toUpper)
|
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
|
-- | Handler for a yes/no prompt
|
||||||
ynHandler :: C.Event -> Maybe Bool
|
ynHandler :: BrickEvent () () -> Maybe Bool
|
||||||
ynHandler (C.EventCharacter c) = case toUpper c of
|
ynHandler (VtyEvent (EvKey (KChar c) [])) = case toUpper c of
|
||||||
'Y' -> Just True
|
'Y' -> Just True
|
||||||
'N' -> Just False
|
'N' -> Just False
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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.Helpers.Goalie (goalieDetails) where
|
module Mtlstats.Helpers.Goalie (goalieDetails, goalieName) where
|
||||||
|
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
|
|
||||||
@@ -31,7 +31,7 @@ goalieDetails :: Goalie -> String
|
|||||||
goalieDetails g = let
|
goalieDetails g = let
|
||||||
header = unlines $ labelTable
|
header = unlines $ labelTable
|
||||||
[ ( "Number", show $ g^.gNumber )
|
[ ( "Number", show $ g^.gNumber )
|
||||||
, ( "Name", g^.gName )
|
, ( "Name", goalieName g )
|
||||||
]
|
]
|
||||||
|
|
||||||
body = unlines $ numTable ["YTD", "Lifetime"] $ map
|
body = unlines $ numTable ["YTD", "Lifetime"] $ map
|
||||||
@@ -39,9 +39,24 @@ goalieDetails g = let
|
|||||||
[ ( "Games played", gsGames )
|
[ ( "Games played", gsGames )
|
||||||
, ( "Mins played", gsMinsPlayed )
|
, ( "Mins played", gsMinsPlayed )
|
||||||
, ( "Goals allowed", gsGoalsAllowed )
|
, ( "Goals allowed", gsGoalsAllowed )
|
||||||
|
, ( "Shutouts", gsShutouts )
|
||||||
, ( "Wins", gsWins )
|
, ( "Wins", gsWins )
|
||||||
, ( "Losses", gsLosses )
|
, ( "Losses", gsLosses )
|
||||||
, ( "Ties", gsTies )
|
, ( "Ties", gsTies )
|
||||||
]
|
]
|
||||||
|
|
||||||
in header ++ "\n" ++ body
|
in header ++ "\n" ++ body
|
||||||
|
|
||||||
|
-- | Returns the goalie name, modified if they are a rookie
|
||||||
|
goalieName :: Goalie -> String
|
||||||
|
goalieName g = let
|
||||||
|
|
||||||
|
prefix = if g^.gActive
|
||||||
|
then ""
|
||||||
|
else "*"
|
||||||
|
|
||||||
|
suffix = if g^.gRookie
|
||||||
|
then "*"
|
||||||
|
else ""
|
||||||
|
|
||||||
|
in prefix ++ g^.gName ++ suffix
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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.Helpers.Player (playerDetails) where
|
module Mtlstats.Helpers.Player (playerDetails, playerName) where
|
||||||
|
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
|
|
||||||
@@ -32,7 +32,7 @@ playerDetails p = unlines $ top ++ [""] ++ table
|
|||||||
where
|
where
|
||||||
top = labelTable
|
top = labelTable
|
||||||
[ ( "Number", show $ p^.pNumber )
|
[ ( "Number", show $ p^.pNumber )
|
||||||
, ( "Name", p^.pName )
|
, ( "Name", playerName p )
|
||||||
, ( "Position", p^.pPosition )
|
, ( "Position", p^.pPosition )
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -43,3 +43,18 @@ playerDetails p = unlines $ top ++ [""] ++ table
|
|||||||
, ( "Assists", psAssists )
|
, ( "Assists", psAssists )
|
||||||
, ( "Penalty mins", psPMin )
|
, ( "Penalty mins", psPMin )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- | Presents a modified version of the player's name indicating
|
||||||
|
-- whether or not they're a rookie
|
||||||
|
playerName :: Player -> String
|
||||||
|
playerName p = let
|
||||||
|
|
||||||
|
prefix = if p^.pActive
|
||||||
|
then ""
|
||||||
|
else "*"
|
||||||
|
|
||||||
|
suffix = if p^.pRookie
|
||||||
|
then "*"
|
||||||
|
else ""
|
||||||
|
|
||||||
|
in prefix ++ p^.pName ++ suffix
|
||||||
|
|||||||
89
src/Mtlstats/Helpers/Position.hs
Normal file
89
src/Mtlstats/Helpers/Position.hs
Normal file
@@ -0,0 +1,89 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
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/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Mtlstats.Helpers.Position
|
||||||
|
( posSearch
|
||||||
|
, posSearchExact
|
||||||
|
, posCallback
|
||||||
|
, getPositions
|
||||||
|
) where
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
-- | Searches the 'Database' for all the positions used
|
||||||
|
posSearch
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> Database
|
||||||
|
-- ^ The database
|
||||||
|
-> [(Int, String)]
|
||||||
|
-- ^ A list of result indices and their values
|
||||||
|
posSearch sStr db = filter sFunc $ zip [0..] ps
|
||||||
|
where
|
||||||
|
sFunc (_, pos) = map toUpper sStr `isInfixOf` map toUpper pos
|
||||||
|
ps = getPositions db
|
||||||
|
|
||||||
|
-- | Searches the 'Database' for an exact position
|
||||||
|
posSearchExact
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> Database
|
||||||
|
-- ^ The database
|
||||||
|
-> Maybe Int
|
||||||
|
-- ^ The index of the result (or 'Nothing' if not found)
|
||||||
|
posSearchExact sStr db = case filter sFunc $ zip [0..] ps of
|
||||||
|
[] -> Nothing
|
||||||
|
(n,_):_ -> Just n
|
||||||
|
where
|
||||||
|
sFunc (_, pos) = sStr == pos
|
||||||
|
ps = getPositions db
|
||||||
|
|
||||||
|
-- | Builds a callback function for when a 'Player' position is
|
||||||
|
-- selected
|
||||||
|
posCallback
|
||||||
|
:: (String -> Action ())
|
||||||
|
-- ^ The raw callback function
|
||||||
|
-> Maybe Int
|
||||||
|
-- ^ The index number of the position selected or 'Nothing' if blank
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to perform
|
||||||
|
posCallback callback = \case
|
||||||
|
Nothing -> callback ""
|
||||||
|
Just n -> do
|
||||||
|
ps <- use (database.to getPositions)
|
||||||
|
let pos = fromMaybe "" $ nth n ps
|
||||||
|
callback pos
|
||||||
|
|
||||||
|
-- | Extracts a list of positions from a 'Database'
|
||||||
|
getPositions :: Database -> [String]
|
||||||
|
getPositions = do
|
||||||
|
raw <- map (^.pPosition) . (^.dbPlayers)
|
||||||
|
return $ S.toList $ S.fromList raw
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -29,52 +29,42 @@ module Mtlstats.Menu (
|
|||||||
-- * Menus
|
-- * Menus
|
||||||
mainMenu,
|
mainMenu,
|
||||||
newSeasonMenu,
|
newSeasonMenu,
|
||||||
gameMonthMenu,
|
|
||||||
gameTypeMenu,
|
gameTypeMenu,
|
||||||
gameGoalieMenu
|
gameGoalieMenu,
|
||||||
|
editMenu
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Brick.Main (halt)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Brick.Types (BrickEvent (VtyEvent), Widget)
|
||||||
import Data.Aeson (encodeFile)
|
import Control.Monad.State.Class (gets, modify)
|
||||||
import Data.Char (toUpper)
|
import Data.Char (toUpper)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (mapMaybe)
|
import Data.Maybe (mapMaybe)
|
||||||
|
import Graphics.Vty.Input.Events (Event (EvKey), Key (KChar))
|
||||||
import Lens.Micro ((^.), (?~))
|
import Lens.Micro ((^.), (?~))
|
||||||
import Lens.Micro.Extras (view)
|
|
||||||
import System.EasyFile
|
|
||||||
( createDirectoryIfMissing
|
|
||||||
, getAppUserDataDirectory
|
|
||||||
, (</>)
|
|
||||||
)
|
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
||||||
import Mtlstats.Config
|
import Mtlstats.Actions.EditStandings
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Types.Menu
|
import Mtlstats.Types.Menu
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | Generates a simple 'Controller' for a Menu
|
-- | Generates a simple 'Controller' for a Menu
|
||||||
menuController :: Menu () -> Controller
|
menuController :: Menu () -> Controller
|
||||||
menuController = menuControllerWith $ const $ return ()
|
menuController = menuControllerWith $ const id
|
||||||
|
|
||||||
-- | Generate a simple 'Controller' for a 'Menu' with a header
|
-- | Generate a simple 'Controller' for a 'Menu' with a header
|
||||||
menuControllerWith
|
menuControllerWith
|
||||||
:: (ProgState -> C.Update ())
|
:: (ProgState -> Widget () -> Widget())
|
||||||
-- ^ Generates the header
|
-- ^ Function to attach the header
|
||||||
-> Menu ()
|
-> Menu ()
|
||||||
-- ^ The menu
|
-- ^ The menu
|
||||||
-> Controller
|
-> Controller
|
||||||
-- ^ The resulting controller
|
-- ^ The resulting controller
|
||||||
menuControllerWith header menu = Controller
|
menuControllerWith header menu = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> header s $ drawMenu menu
|
||||||
header s
|
, handleController = menuHandler menu
|
||||||
drawMenu menu
|
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler menu e
|
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Generate and create a controller for a menu based on the current
|
-- | Generate and create a controller for a menu based on the current
|
||||||
@@ -89,86 +79,54 @@ menuStateController menuFunc = Controller
|
|||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
menu <- gets menuFunc
|
menu <- gets menuFunc
|
||||||
menuHandler menu e
|
menuHandler menu e
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | The draw function for a 'Menu'
|
-- | The draw function for a 'Menu'
|
||||||
drawMenu :: Menu a -> C.Update C.CursorMode
|
drawMenu :: Menu a -> Widget ()
|
||||||
drawMenu m = do
|
drawMenu m = let
|
||||||
C.drawString $ show m
|
menuLines = lines $ show m
|
||||||
return C.CursorInvisible
|
in linesToWidgetC menuLines
|
||||||
|
|
||||||
-- | The event handler for a 'Menu'
|
-- | The event handler for a 'Menu'
|
||||||
menuHandler :: Menu a -> C.Event -> Action a
|
menuHandler :: Menu a -> Handler a
|
||||||
menuHandler m (C.EventCharacter c) =
|
menuHandler m (VtyEvent (EvKey (KChar c) [])) =
|
||||||
case filter (\i -> i^.miKey == toUpper c) $ m^.menuItems of
|
case filter (\i -> i^.miKey == toUpper c) $ m^.menuItems of
|
||||||
i:_ -> i^.miAction
|
i:_ -> i^.miAction
|
||||||
[] -> return $ m^.menuDefault
|
[] -> return $ m^.menuDefault
|
||||||
menuHandler m _ = return $ m^.menuDefault
|
menuHandler m _ = return $ m^.menuDefault
|
||||||
|
|
||||||
-- | The main menu
|
-- | The main menu
|
||||||
mainMenu :: Menu Bool
|
mainMenu :: Menu ()
|
||||||
mainMenu = Menu "*** MAIN MENU ***" True
|
mainMenu = Menu "MASTER MENU" ()
|
||||||
[ MenuItem '1' "New Season" $
|
[ MenuItem 'A' "NEW SEASON" $
|
||||||
modify startNewSeason >> return True
|
modify startNewSeason
|
||||||
, MenuItem '2' "New Game" $
|
, MenuItem 'B' "NEW GAME" $
|
||||||
modify startNewGame >> return True
|
modify startNewGame
|
||||||
, MenuItem '3' "Create Player" $
|
, MenuItem 'C' "EDIT MENU" $
|
||||||
modify createPlayer >> return True
|
modify edit
|
||||||
, MenuItem '4' "Create Goalie" $
|
, MenuItem 'E' "EXIT" $
|
||||||
modify createGoalie >> return True
|
saveDatabase >> halt
|
||||||
, MenuItem '5' "Edit Player" $
|
|
||||||
modify editPlayer >> return True
|
|
||||||
, MenuItem '6' "Edit Goalie" $
|
|
||||||
modify editGoalie >> return True
|
|
||||||
, MenuItem 'X' "Exit" $ do
|
|
||||||
db <- gets $ view database
|
|
||||||
liftIO $ do
|
|
||||||
dir <- getAppUserDataDirectory appName
|
|
||||||
let dbFile = dir </> dbFname
|
|
||||||
createDirectoryIfMissing True dir
|
|
||||||
encodeFile dbFile db
|
|
||||||
return False
|
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The new season menu
|
-- | The new season menu
|
||||||
newSeasonMenu :: Menu ()
|
newSeasonMenu :: Menu ()
|
||||||
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
|
newSeasonMenu = Menu "SEASON TYPE" ()
|
||||||
[ MenuItem 'R' "Regular Season" $ modify
|
[ MenuItem 'R' "REGULAR SEASON" $ modify
|
||||||
$ resetYtd
|
$ resetYtd
|
||||||
|
. clearRookies
|
||||||
. resetStandings
|
. resetStandings
|
||||||
. startNewGame
|
. backHome
|
||||||
, MenuItem 'P' "Playoffs" $ modify
|
, MenuItem 'P' "PLAYOFFS" $ modify
|
||||||
$ resetStandings
|
$ resetStandings
|
||||||
. startNewGame
|
. backHome
|
||||||
]
|
|
||||||
|
|
||||||
-- | 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 )
|
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The game type menu (home/away)
|
-- | The game type menu (home/away)
|
||||||
gameTypeMenu :: Menu ()
|
gameTypeMenu :: Menu ()
|
||||||
gameTypeMenu = Menu "Game type:" ()
|
gameTypeMenu = Menu "GAME TYPE:" ()
|
||||||
[ MenuItem '1' "Home Game" $
|
[ MenuItem 'H' "HOME GAME" $
|
||||||
modify $ progMode.gameStateL.gameType ?~ HomeGame
|
modify $ progMode.gameStateL.gameType ?~ HomeGame
|
||||||
, MenuItem '2' "Away Game" $
|
, MenuItem 'A' "AWAY GAME" $
|
||||||
modify $ progMode.gameStateL.gameType ?~ AwayGame
|
modify $ progMode.gameStateL.gameType ?~ AwayGame
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -182,7 +140,25 @@ gameGoalieMenu s = let
|
|||||||
goalie <- nth n $ s^.database.dbGoalies
|
goalie <- nth n $ s^.database.dbGoalies
|
||||||
Just (n, goalie))
|
Just (n, goalie))
|
||||||
gids
|
gids
|
||||||
in Menu title () $ map
|
in Menu title () $ zipWith
|
||||||
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
|
(\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $
|
||||||
modify $ GI.setGameGoalie gid) $
|
modify $ GI.setGameGoalie gid)
|
||||||
zip ['1'..] goalies
|
['1'..]
|
||||||
|
goalies
|
||||||
|
|
||||||
|
-- | The edit menu
|
||||||
|
editMenu :: Menu ()
|
||||||
|
editMenu = Menu "EDIT MENU" ()
|
||||||
|
[ MenuItem 'A' "CREATE PLAYER" $
|
||||||
|
modify createPlayer
|
||||||
|
, MenuItem 'B' "CREATE GOALIE" $
|
||||||
|
modify createGoalie
|
||||||
|
, MenuItem 'C' "EDIT PLAYER" $
|
||||||
|
modify editPlayer
|
||||||
|
, MenuItem 'D' "EDIT GOALIE" $
|
||||||
|
modify editGoalie
|
||||||
|
, MenuItem 'E' "EDIT STANDINGS" $
|
||||||
|
modify editStandings
|
||||||
|
, MenuItem 'R' "RETURN TO MAIN MENU" $
|
||||||
|
modify backHome
|
||||||
|
]
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -25,53 +25,63 @@ module Mtlstats.Menu.EditGoalie
|
|||||||
, editGoalieLtMenu
|
, editGoalieLtMenu
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.State.Class (modify)
|
||||||
import Data.Maybe (maybe)
|
import Lens.Micro ((.~), (%~))
|
||||||
import Lens.Micro ((.~))
|
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Types.Menu
|
import Mtlstats.Types.Menu
|
||||||
|
|
||||||
-- | The 'Goalie' edit menu
|
-- | The 'Goalie' edit menu
|
||||||
editGoalieMenu :: Menu ()
|
editGoalieMenu :: Menu ()
|
||||||
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
|
editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
|
||||||
(\(key, label, val) -> MenuItem key label $ modify $ maybe
|
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||||
(progMode .~ MainMenu)
|
|
||||||
(progMode.editGoalieStateL.egsMode .~)
|
|
||||||
val)
|
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( '1', "Edit number", Just EGNumber )
|
[ ( 'A', "NUMBER", set EGNumber )
|
||||||
, ( '2', "Edit name", Just EGName )
|
, ( 'B', "NAME", set EGName )
|
||||||
, ( '3', "Edit YTD stats", Just EGYtd )
|
, ( 'C', "ROOKIE FLAG", toggleRookie )
|
||||||
, ( '4', "Edit Lifetime stats", Just EGLifetime )
|
, ( 'D', "ACTIVE FLAG", toggleActive )
|
||||||
, ( 'R', "Return to Main Menu", Nothing )
|
, ( 'E', "YTD STATS", set EGYtd )
|
||||||
|
, ( 'F', "LIFETIME STATS", set EGLifetime )
|
||||||
|
, ( 'G', "DELETE RECORD", set EGDelete )
|
||||||
|
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
set mode = progMode.editGoalieStateL.egsMode .~ mode
|
||||||
|
toggleRookie = editSelectedGoalie (gRookie %~ not)
|
||||||
|
toggleActive = editSelectedGoalie (gActive %~ not)
|
||||||
|
|
||||||
-- | The 'Goalie' YTD edit menu
|
-- | The 'Goalie' YTD edit menu
|
||||||
editGoalieYtdMenu :: Menu ()
|
editGoalieYtdMenu :: Menu ()
|
||||||
editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***"
|
editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( '1', "Edit YTD games", EGYtdGames )
|
[ ( 'A', "ALL YTD STATS", EGYtdGames True )
|
||||||
, ( '2', "Edit YTD minutes", EGYtdMins )
|
, ( 'B', "YTD GAMES", EGYtdGames False )
|
||||||
, ( '3', "Edit YTD goals", EGYtdGoals )
|
, ( 'C', "YTD MINUTES", EGYtdMins False )
|
||||||
, ( '4', "Edit YTD wins", EGYtdWins )
|
, ( 'D', "YTD GOALS", EGYtdGoals False )
|
||||||
, ( '5', "Edit YTD losses", EGYtdLosses )
|
, ( 'E', "YTD SHUTOUTS", EGYtdShutouts False )
|
||||||
, ( '6', "Edit YTD ties", EGYtdTies )
|
, ( 'F', "YTD WINS", EGYtdWins False )
|
||||||
, ( 'R', "Return to edit menu", EGMenu )
|
, ( 'G', "YTD LOSSES", EGYtdLosses False )
|
||||||
|
, ( 'H', "YTD TIES", EGYtdTies )
|
||||||
|
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The 'Goalie' lifetime edit menu
|
-- | The 'Goalie' lifetime edit menu
|
||||||
editGoalieLtMenu :: Menu ()
|
editGoalieLtMenu :: Menu ()
|
||||||
editGoalieLtMenu = editMenu
|
editGoalieLtMenu = editMenu
|
||||||
"*** EDIT GOALTENDER LIFETIME ***"
|
"EDIT GOALTENDER LIFETIME"
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( '1', "Edit lifetime games", EGLtGames )
|
[ ( 'A', "ALL LIFETIME STATS", EGLtGames True )
|
||||||
, ( '2', "Edit lifetime minutes", EGLtMins )
|
, ( 'B', "LIFETIME GAMES", EGLtGames False )
|
||||||
, ( '3', "Edit lifetime goals", EGLtGoals )
|
, ( 'C', "LIFETIME MINUTES", EGLtMins False )
|
||||||
, ( '4', "Edit lifetime wins", EGLtWins )
|
, ( 'D', "LIFETIME GOALS", EGLtGoals False )
|
||||||
, ( '5', "Edit lifetime losses", EGLtLosses )
|
, ( 'E', "LIFETIME SHUTOUTS", EGLtShutouts False )
|
||||||
, ( '6', "Edit lifetime ties", EGLtTies )
|
, ( 'F', "LIFETIME WINS", EGLtWins False )
|
||||||
, ( 'R', "Return to edit menu", EGMenu )
|
, ( 'G', "LIFETIME LOSSES", EGLtLosses False )
|
||||||
|
, ( 'H', "LIFETIME TIES", EGLtTies )
|
||||||
|
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
|
||||||
]
|
]
|
||||||
|
|
||||||
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
|
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -25,47 +25,57 @@ module Mtlstats.Menu.EditPlayer
|
|||||||
, editPlayerLtMenu
|
, editPlayerLtMenu
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.State.Class (modify)
|
||||||
import Lens.Micro ((.~))
|
import Lens.Micro ((.~), (%~))
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Types.Menu
|
import Mtlstats.Types.Menu
|
||||||
|
|
||||||
-- | The 'Player' edit menu
|
-- | The 'Player' edit menu
|
||||||
editPlayerMenu :: Menu ()
|
editPlayerMenu :: Menu ()
|
||||||
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
|
editPlayerMenu = Menu "EDIT PLAYER" () $ map
|
||||||
(\(ch, label, mode) -> MenuItem ch label $ case mode of
|
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||||
Nothing -> modify $ progMode .~ MainMenu
|
|
||||||
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
|
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( '1', "Edit number", Just EPNumber )
|
[ ( 'A', "NUMBER", set EPNumber )
|
||||||
, ( '2', "Edit name", Just EPName )
|
, ( 'B', "NAME", set EPName )
|
||||||
, ( '3', "Edit position", Just EPPosition )
|
, ( 'C', "POSITION", set EPPosition )
|
||||||
, ( '4', "Edit YTD stats", Just EPYtd )
|
, ( 'D', "ROOKIE FLAG", toggleRookie )
|
||||||
, ( '5', "Edit lifetime stats", Just EPLifetime )
|
, ( 'E', "ACTIVE FLAG", toggleActive )
|
||||||
, ( 'R', "Finished editing", Nothing )
|
, ( 'F', "YTD STATS", set EPYtd )
|
||||||
|
, ( 'G', "LIFETIME STATS", set EPLifetime )
|
||||||
|
, ( 'H', "DELETE RECORD", set EPDelete )
|
||||||
|
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
set mode = progMode.editPlayerStateL.epsMode .~ mode
|
||||||
|
toggleRookie = editSelectedPlayer $ pRookie %~ not
|
||||||
|
toggleActive = editSelectedPlayer $ pActive %~ not
|
||||||
|
|
||||||
-- | The 'Player' YTD stats edit menu
|
-- | The 'Player' YTD stats edit menu
|
||||||
editPlayerYtdMenu :: Menu ()
|
editPlayerYtdMenu :: Menu ()
|
||||||
editPlayerYtdMenu = editMenu
|
editPlayerYtdMenu = editMenu
|
||||||
"*** EDIT PLAYER YEAR-TO-DATE ***"
|
"EDIT PLAYER YEAR-TO-DATE"
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( '1', "Edit YTD goals", EPYtdGoals )
|
[ ( 'A', "ALL YTD STATS", EPYtdGoals True )
|
||||||
, ( '2', "Edit YTD assists", EPYtdAssists )
|
, ( 'B', "YTD GOALS", EPYtdGoals False )
|
||||||
, ( '3', "Edit YTD penalty mins", EPYtdPMin )
|
, ( 'C', "YTD ASSISTS", EPYtdAssists False )
|
||||||
, ( 'R', "Return to player edit menu", EPMenu )
|
, ( 'D', "YTD PENALTY MINS", EPYtdPMin )
|
||||||
|
, ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu )
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The 'Player' lifetime stats edit menu
|
-- | The 'Player' lifetime stats edit menu
|
||||||
editPlayerLtMenu :: Menu ()
|
editPlayerLtMenu :: Menu ()
|
||||||
editPlayerLtMenu = editMenu
|
editPlayerLtMenu = editMenu
|
||||||
"*** EDIT PLAYER LIFETIME ***"
|
"EDIT PLAYER LIFETIME"
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( '1', "Edit lifetime goals", EPLtGoals )
|
[ ( 'A', "ALL LIFETIME STATS", EPLtGoals True )
|
||||||
, ( '2', "Edit lifetime assits", EPLtAssists )
|
, ( 'B', "LIFETIME GOALS", EPLtGoals False )
|
||||||
, ( '3', "Edit lifetime penalty mins", EPLtPMin )
|
, ( 'C', "LIFETIME ASSITS", EPLtAssists False )
|
||||||
, ( 'R', "Return to edit player menu", EPMenu )
|
, ( 'D', "LIFETIME PENALTY MINS", EPLtPMin )
|
||||||
|
, ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu )
|
||||||
]
|
]
|
||||||
|
|
||||||
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()
|
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()
|
||||||
|
|||||||
64
src/Mtlstats/Menu/EditStandings.hs
Normal file
64
src/Mtlstats/Menu/EditStandings.hs
Normal file
@@ -0,0 +1,64 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
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 Mtlstats.Menu.EditStandings
|
||||||
|
( editStandingsMenu
|
||||||
|
, editHomeStandingsMenu
|
||||||
|
, editAwayStandingsMenu
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.State.Class (modify)
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Actions.EditStandings
|
||||||
|
import Mtlstats.Types.Menu
|
||||||
|
|
||||||
|
editStandingsMenu :: Menu ()
|
||||||
|
editStandingsMenu = Menu "EDIT STANDINGS" ()
|
||||||
|
[ MenuItem 'A' "EDIT HOME STANDINGS" $
|
||||||
|
modify editHomeStandings
|
||||||
|
, MenuItem 'B' "EDIT ROAD STANDINGS" $
|
||||||
|
modify editAwayStandings
|
||||||
|
, MenuItem 'R' "RETURN TO MAIN MENU" $
|
||||||
|
modify backHome
|
||||||
|
]
|
||||||
|
|
||||||
|
editHomeStandingsMenu :: Menu ()
|
||||||
|
editHomeStandingsMenu = subMenu "HOME"
|
||||||
|
|
||||||
|
editAwayStandingsMenu :: Menu ()
|
||||||
|
editAwayStandingsMenu = subMenu "ROAD"
|
||||||
|
|
||||||
|
subMenu :: String -> Menu ()
|
||||||
|
subMenu str = Menu (str ++ " STANDINGS") ()
|
||||||
|
[ MenuItem 'W' "EDIT WINS" $
|
||||||
|
modify editWins
|
||||||
|
, MenuItem 'L' "EDIT LOSSES" $
|
||||||
|
modify editLosses
|
||||||
|
, MenuItem 'O' "EDIT OVERTIME GAMES" $
|
||||||
|
modify editOvertime
|
||||||
|
, MenuItem 'F' "EDIT GOALS FOR" $
|
||||||
|
modify editGoalsFor
|
||||||
|
, MenuItem 'A' "EDIT GOALS AGAINST" $
|
||||||
|
modify editGoalsAgainst
|
||||||
|
, MenuItem 'R' "RETURN TO EDIT STANDINGS MENU" $
|
||||||
|
modify editStandings
|
||||||
|
]
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,79 +19,82 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
|
|
||||||
module Mtlstats.Prompt (
|
module Mtlstats.Prompt (
|
||||||
-- * Prompt Functions
|
-- * Prompt Functions
|
||||||
drawPrompt,
|
|
||||||
promptHandler,
|
promptHandler,
|
||||||
promptControllerWith,
|
promptControllerWith,
|
||||||
promptController,
|
promptController,
|
||||||
strPrompt,
|
strPrompt,
|
||||||
ucStrPrompt,
|
ucStrPrompt,
|
||||||
|
namePrompt,
|
||||||
numPrompt,
|
numPrompt,
|
||||||
|
numPromptRange,
|
||||||
|
numPromptWithFallback,
|
||||||
|
dbNamePrompt,
|
||||||
selectPrompt,
|
selectPrompt,
|
||||||
-- * Individual prompts
|
-- * Individual prompts
|
||||||
|
getDBPrompt,
|
||||||
|
newSeasonPrompt,
|
||||||
playerNumPrompt,
|
playerNumPrompt,
|
||||||
playerNamePrompt,
|
playerNamePrompt,
|
||||||
playerPosPrompt,
|
playerPosPrompt,
|
||||||
goalieNumPrompt,
|
goalieNumPrompt,
|
||||||
goalieNamePrompt,
|
goalieNamePrompt,
|
||||||
selectPlayerPrompt,
|
selectPlayerPrompt,
|
||||||
|
selectActivePlayerPrompt,
|
||||||
selectGoaliePrompt,
|
selectGoaliePrompt,
|
||||||
|
selectActiveGoaliePrompt,
|
||||||
|
selectPositionPrompt,
|
||||||
playerToEditPrompt
|
playerToEditPrompt
|
||||||
) where
|
) 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 (when)
|
||||||
import Control.Monad.Extra (whenJust)
|
import Control.Monad.Extra (whenJust)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.State.Class (gets, modify)
|
||||||
import Data.Char (isDigit, toUpper)
|
import Data.Char (isAlphaNum, isDigit, toUpper)
|
||||||
import Data.Foldable (forM_)
|
import Data.Text.Zipper (deletePrevChar, insertChar)
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
import Graphics.Vty.Input.Events
|
||||||
import Lens.Micro.Extras (view)
|
( Event (EvKey)
|
||||||
|
, Key (KBS, KChar, KEnter, KFun)
|
||||||
|
)
|
||||||
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
|
||||||
|
import Lens.Micro.Mtl ((%=), use)
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
|
import Mtlstats.Helpers.Position
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
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
|
-- | Event handler for a prompt
|
||||||
promptHandler :: Prompt -> C.Event -> Action ()
|
promptHandler :: Prompt -> Handler ()
|
||||||
promptHandler p (C.EventCharacter '\n') = do
|
promptHandler p (VtyEvent (EvKey KEnter [])) = do
|
||||||
val <- gets $ view inputBuffer
|
val <- use $ editorW.to userText
|
||||||
modify $ inputBuffer .~ ""
|
editorW %= clearEditor
|
||||||
promptAction p val
|
promptAction p val
|
||||||
promptHandler p (C.EventCharacter c) =
|
promptHandler p (VtyEvent (EvKey (KChar c) [])) =
|
||||||
modify $ inputBuffer %~ promptProcessChar p c
|
editorW %= promptProcessChar p c
|
||||||
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
|
promptHandler _ (VtyEvent (EvKey KBS [])) =
|
||||||
modify removeChar
|
editorW.editContentsL %= deletePrevChar
|
||||||
promptHandler p (C.EventSpecialKey k) =
|
promptHandler p (VtyEvent (EvKey k m)) =
|
||||||
promptSpecialKey p k
|
promptSpecialKey p k m
|
||||||
promptHandler _ _ = return ()
|
promptHandler _ _ = return ()
|
||||||
|
|
||||||
-- | Builds a controller out of a prompt with a header
|
-- | Builds a controller out of a prompt with a header
|
||||||
promptControllerWith
|
promptControllerWith
|
||||||
:: (ProgState -> C.Update ())
|
:: (ProgState -> Widget () -> Widget ())
|
||||||
-- ^ The header
|
-- ^ The header
|
||||||
-> Prompt
|
-> Prompt
|
||||||
-- ^ The prompt to use
|
-- ^ The prompt to use
|
||||||
-> Controller
|
-> Controller
|
||||||
-- ^ The resulting controller
|
-- ^ The resulting controller
|
||||||
promptControllerWith header prompt = Controller
|
promptControllerWith header prompt = Controller
|
||||||
{ drawController = \s -> do
|
{ drawController = \s -> header s $ drawPrompt prompt s
|
||||||
header s
|
, handleController = promptHandler prompt
|
||||||
drawPrompt prompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler prompt e
|
|
||||||
return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Builds a controller out of a prompt
|
-- | Builds a controller out of a prompt
|
||||||
@@ -100,7 +103,7 @@ promptController
|
|||||||
-- ^ The prompt to use
|
-- ^ The prompt to use
|
||||||
-> Controller
|
-> Controller
|
||||||
-- ^ The resulting controller
|
-- ^ The resulting controller
|
||||||
promptController = promptControllerWith (const $ return ())
|
promptController = promptControllerWith $ const id
|
||||||
|
|
||||||
-- | Builds a string prompt
|
-- | Builds a string prompt
|
||||||
strPrompt
|
strPrompt
|
||||||
@@ -110,10 +113,10 @@ strPrompt
|
|||||||
-- ^ The callback function for the result
|
-- ^ The callback function for the result
|
||||||
-> Prompt
|
-> Prompt
|
||||||
strPrompt pStr act = Prompt
|
strPrompt pStr act = Prompt
|
||||||
{ promptDrawer = drawSimplePrompt pStr
|
{ drawPrompt = drawSimplePrompt pStr
|
||||||
, promptProcessChar = \ch -> (++ [ch])
|
, promptProcessChar = \ch -> editContentsL %~ insertChar ch
|
||||||
, promptAction = act
|
, promptAction = act
|
||||||
, promptSpecialKey = const $ return ()
|
, promptSpecialKey = \_ _ -> return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Creates an upper case string prompt
|
-- | Creates an upper case string prompt
|
||||||
@@ -124,7 +127,18 @@ ucStrPrompt
|
|||||||
-- ^ The callback function for the result
|
-- ^ The callback function for the result
|
||||||
-> Prompt
|
-> Prompt
|
||||||
ucStrPrompt pStr act = (strPrompt pStr act)
|
ucStrPrompt pStr act = (strPrompt pStr act)
|
||||||
{ promptProcessChar = \ch -> (++ [toUpper ch]) }
|
{ promptProcessChar = \ch -> editContentsL %~ insertChar ch }
|
||||||
|
|
||||||
|
-- | Creates a prompt which forces capitalization of input to
|
||||||
|
-- accomodate a player or goalie name
|
||||||
|
namePrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (String -> Action ())
|
||||||
|
-- ^ The callback function for the result
|
||||||
|
-> Prompt
|
||||||
|
namePrompt pStr act = (strPrompt pStr act)
|
||||||
|
{ promptProcessChar = capitalizeName }
|
||||||
|
|
||||||
-- | Builds a numeric prompt
|
-- | Builds a numeric prompt
|
||||||
numPrompt
|
numPrompt
|
||||||
@@ -133,31 +147,86 @@ numPrompt
|
|||||||
-> (Int -> Action ())
|
-> (Int -> Action ())
|
||||||
-- ^ The callback function for the result
|
-- ^ The callback function for the result
|
||||||
-> Prompt
|
-> Prompt
|
||||||
numPrompt pStr act = Prompt
|
numPrompt pStr = numPromptWithFallback pStr $ return ()
|
||||||
{ promptDrawer = drawSimplePrompt pStr
|
|
||||||
, promptProcessChar = \ch str -> if isDigit ch
|
-- | Builds a numberic prompt with a range
|
||||||
then str ++ [ch]
|
numPromptRange
|
||||||
else str
|
:: Int
|
||||||
, promptAction = \inStr -> forM_ (readMaybe inStr) act
|
-- ^ The minimum value
|
||||||
, promptSpecialKey = const $ return ()
|
-> 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
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to call on invalid (or blank) input
|
||||||
|
-> (Int -> Action ())
|
||||||
|
-- ^ The callback function for the result
|
||||||
|
-> Prompt
|
||||||
|
numPromptWithFallback pStr fallback act = Prompt
|
||||||
|
{ 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 = 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
|
-- | Builds a selection prompt
|
||||||
selectPrompt :: SelectParams a -> Prompt
|
selectPrompt :: SelectParams a -> Prompt
|
||||||
selectPrompt params = Prompt
|
selectPrompt params = Prompt
|
||||||
{ promptDrawer = \s -> do
|
{ drawPrompt = \s -> let
|
||||||
let sStr = s^.inputBuffer
|
sStr = s^.editorW.to userText
|
||||||
C.drawString $ spPrompt params ++ sStr
|
pStr = spPrompt params
|
||||||
(row, col) <- C.cursorPosition
|
results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
|
||||||
C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
|
fmtRes = map
|
||||||
let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
|
|
||||||
C.drawString $ unlines $ map
|
|
||||||
(\(n, (_, x)) -> let
|
(\(n, (_, x)) -> let
|
||||||
desc = spElemDesc params x
|
desc = spElemDesc params x
|
||||||
in "F" ++ show n ++ ") " ++ desc)
|
in str $ "F" ++ show n ++ ") " ++ desc)
|
||||||
results
|
results
|
||||||
C.moveCursor row col
|
in vBox $
|
||||||
, promptProcessChar = \ch -> (++[ch])
|
[ hBox
|
||||||
|
[ str pStr
|
||||||
|
, renderEditor linesToWidget True (s^.editorW)
|
||||||
|
]
|
||||||
|
, str " "
|
||||||
|
, str $ spSearchHeader params
|
||||||
|
] ++ fmtRes
|
||||||
|
, promptProcessChar = spProcessChar params
|
||||||
, promptAction = \sStr -> if null sStr
|
, promptAction = \sStr -> if null sStr
|
||||||
then spCallback params Nothing
|
then spCallback params Nothing
|
||||||
else do
|
else do
|
||||||
@@ -165,20 +234,26 @@ selectPrompt params = Prompt
|
|||||||
case spSearchExact params sStr db of
|
case spSearchExact params sStr db of
|
||||||
Nothing -> spNotFound params sStr
|
Nothing -> spNotFound params sStr
|
||||||
Just n -> spCallback params $ Just n
|
Just n -> spCallback params $ Just n
|
||||||
, promptSpecialKey = \case
|
, promptSpecialKey = \key _ -> case key of
|
||||||
C.KeyFunction rawK -> do
|
KFun rawK -> do
|
||||||
sStr <- gets (^.inputBuffer)
|
sStr <- use $ editorW . to userText
|
||||||
db <- gets (^.database)
|
db <- use database
|
||||||
let
|
let
|
||||||
n = pred $ fromInteger rawK
|
n = pred rawK
|
||||||
results = spSearch params sStr db
|
results = spSearch params sStr db
|
||||||
when (n < maxFunKeys) $
|
when (n < maxFunKeys) $
|
||||||
whenJust (nth n results) $ \(sel, _) -> do
|
whenJust (nth n results) $ \(sel, _) -> do
|
||||||
modify $ inputBuffer .~ ""
|
editorW %= clearEditor
|
||||||
spCallback params $ Just sel
|
spCallback params $ Just sel
|
||||||
_ -> return ()
|
_ -> 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
|
-- | Prompts for a new player's number
|
||||||
playerNumPrompt :: Prompt
|
playerNumPrompt :: Prompt
|
||||||
playerNumPrompt = numPrompt "Player number: " $
|
playerNumPrompt = numPrompt "Player number: " $
|
||||||
@@ -186,12 +261,12 @@ playerNumPrompt = numPrompt "Player number: " $
|
|||||||
|
|
||||||
-- | Prompts for a new player's name
|
-- | Prompts for a new player's name
|
||||||
playerNamePrompt :: Prompt
|
playerNamePrompt :: Prompt
|
||||||
playerNamePrompt = strPrompt "Player name: " $
|
playerNamePrompt = namePrompt "Player name: " $
|
||||||
modify . (progMode.createPlayerStateL.cpsName .~)
|
modify . (progMode.createPlayerStateL.cpsName .~)
|
||||||
|
|
||||||
-- | Prompts for a new player's position
|
-- | Prompts for a new player's position
|
||||||
playerPosPrompt :: Prompt
|
playerPosPrompt :: Prompt
|
||||||
playerPosPrompt = ucStrPrompt "Player position: " $
|
playerPosPrompt = selectPositionPrompt "Player position: " $
|
||||||
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
||||||
|
|
||||||
-- | Prompts tor the goalie's number
|
-- | Prompts tor the goalie's number
|
||||||
@@ -201,23 +276,27 @@ goalieNumPrompt = numPrompt "Goalie number: " $
|
|||||||
|
|
||||||
-- | Prompts for the goalie's name
|
-- | Prompts for the goalie's name
|
||||||
goalieNamePrompt :: Prompt
|
goalieNamePrompt :: Prompt
|
||||||
goalieNamePrompt = strPrompt "Goalie name: " $
|
goalieNamePrompt = namePrompt "Goalie name: " $
|
||||||
modify . (progMode.createGoalieStateL.cgsName .~)
|
modify . (progMode.createGoalieStateL.cgsName .~)
|
||||||
|
|
||||||
-- | Selects a player (creating one if necessary)
|
-- | Selects a player using a specified search function (creating the
|
||||||
selectPlayerPrompt
|
-- player if necessary)
|
||||||
:: String
|
selectPlayerPromptWith
|
||||||
|
:: (String -> [Player] -> [(Int, Player)])
|
||||||
|
-- ^ The search function
|
||||||
|
-> String
|
||||||
-- ^ The prompt string
|
-- ^ The prompt string
|
||||||
-> (Maybe Int -> Action ())
|
-> (Maybe Int -> Action ())
|
||||||
-- ^ The callback to run (takes the index number of the payer as
|
-- ^ The callback to run (takes the index number of the payer as
|
||||||
-- input)
|
-- input)
|
||||||
-> Prompt
|
-> Prompt
|
||||||
selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
selectPlayerPromptWith sFunc pStr callback = selectPrompt SelectParams
|
||||||
{ spPrompt = pStr
|
{ spPrompt = pStr
|
||||||
, spSearchHeader = "Player select:"
|
, 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)
|
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
||||||
, spElemDesc = playerSummary
|
, spElemDesc = playerSummary
|
||||||
|
, spProcessChar = capitalizeName
|
||||||
, spCallback = callback
|
, spCallback = callback
|
||||||
, spNotFound = \sStr -> do
|
, spNotFound = \sStr -> do
|
||||||
mode <- gets (^.progMode)
|
mode <- gets (^.progMode)
|
||||||
@@ -232,20 +311,44 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
|||||||
modify $ progMode .~ CreatePlayer cps
|
modify $ progMode .~ CreatePlayer cps
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Selects a goalie (creating one if necessary)
|
-- | Selects a player (creating one if necessary)
|
||||||
selectGoaliePrompt
|
selectPlayerPrompt
|
||||||
:: String
|
:: String
|
||||||
-- ^ The prompt string
|
-- ^ The prompt string
|
||||||
-> (Maybe Int -> Action ())
|
-> (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
|
-- ^ The callback to run (takes the index number of the goalie as
|
||||||
-- input)
|
-- input)
|
||||||
-> Prompt
|
-> Prompt
|
||||||
selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
selectGoaliePromptWith criteria pStr callback = selectPrompt SelectParams
|
||||||
{ spPrompt = pStr
|
{ spPrompt = pStr
|
||||||
, spSearchHeader = "Goalie select:"
|
, 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)
|
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
||||||
, spElemDesc = goalieSummary
|
, spElemDesc = goalieSummary
|
||||||
|
, spProcessChar = capitalizeName
|
||||||
, spCallback = callback
|
, spCallback = callback
|
||||||
, spNotFound = \sStr -> do
|
, spNotFound = \sStr -> do
|
||||||
mode <- gets (^.progMode)
|
mode <- gets (^.progMode)
|
||||||
@@ -260,9 +363,50 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
|||||||
modify $ progMode .~ CreateGoalie cgs
|
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
|
||||||
|
-- ^ The 'Prompt' string
|
||||||
|
-> (String -> Action ())
|
||||||
|
-- ^ The action to perform when a value is entered
|
||||||
|
-> Prompt
|
||||||
|
selectPositionPrompt pStr callback = selectPrompt SelectParams
|
||||||
|
{ spPrompt = pStr
|
||||||
|
, spSearchHeader = "Positions:"
|
||||||
|
, spSearch = posSearch
|
||||||
|
, spSearchExact = posSearchExact
|
||||||
|
, spElemDesc = id
|
||||||
|
, spProcessChar = \c -> editContentsL %~ insertChar (toUpper c)
|
||||||
|
, spCallback = posCallback callback
|
||||||
|
, spNotFound = callback
|
||||||
|
}
|
||||||
|
|
||||||
playerToEditPrompt :: Prompt
|
playerToEditPrompt :: Prompt
|
||||||
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
||||||
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
||||||
|
|
||||||
drawSimplePrompt :: String -> ProgState -> C.Update ()
|
drawSimplePrompt :: String -> Renderer
|
||||||
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
|
drawSimplePrompt pStr s = hBox
|
||||||
|
[ str pStr
|
||||||
|
, renderEditor linesToWidget True (s^.editorW)
|
||||||
|
]
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -26,21 +26,23 @@ module Mtlstats.Prompt.EditGoalie
|
|||||||
, editGoalieYtdGamesPrompt
|
, editGoalieYtdGamesPrompt
|
||||||
, editGoalieYtdMinsPrompt
|
, editGoalieYtdMinsPrompt
|
||||||
, editGoalieYtdGoalsPrompt
|
, editGoalieYtdGoalsPrompt
|
||||||
|
, editGoalieYtdShutoutsPrompt
|
||||||
, editGoalieYtdWinsPrompt
|
, editGoalieYtdWinsPrompt
|
||||||
, editGoalieYtdLossesPrompt
|
, editGoalieYtdLossesPrompt
|
||||||
, editGoalieYtdTiesPrompt
|
, editGoalieYtdTiesPrompt
|
||||||
, editGoalieLtGamesPrompt
|
, editGoalieLtGamesPrompt
|
||||||
, editGoalieLtMinsPrompt
|
, editGoalieLtMinsPrompt
|
||||||
, editGoalieLtGoalsPrompt
|
, editGoalieLtGoalsPrompt
|
||||||
|
, editGoalieLtShutoutsPrompt
|
||||||
, editGoalieLtWinsPrompt
|
, editGoalieLtWinsPrompt
|
||||||
, editGoalieLtLossesPrompt
|
, editGoalieLtLossesPrompt
|
||||||
, editGoalieLtTiesPrompt
|
, editGoalieLtTiesPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.State.Class (modify)
|
||||||
import Lens.Micro ((.~))
|
import Lens.Micro ((.~))
|
||||||
|
|
||||||
import Mtlstats.Actions.EditGoalie
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
@@ -50,71 +52,236 @@ goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
|
|||||||
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
|
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's number
|
-- | Prompt to edit a goalie's number
|
||||||
editGoalieNumberPrompt :: Prompt
|
editGoalieNumberPrompt
|
||||||
editGoalieNumberPrompt = numPrompt "Goalie number: " $
|
:: Action ()
|
||||||
modify . editGoalieNumber
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
|
||||||
|
(gNumber .~)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's name
|
-- | Prompt to edit a goalie's name
|
||||||
editGoalieNamePrompt :: Prompt
|
editGoalieNamePrompt
|
||||||
editGoalieNamePrompt = strPrompt "Goalie name: " $
|
:: Action ()
|
||||||
modify . editGoalieName
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieNamePrompt cb = namePrompt "Goalie name: " $ \name -> do
|
||||||
|
if null name
|
||||||
|
then goto EGMenu
|
||||||
|
else doEdit EGMenu $ gName .~ name
|
||||||
|
cb
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD games played
|
-- | Prompt to edit a goalie's YTD games played
|
||||||
editGoalieYtdGamesPrompt :: Prompt
|
editGoalieYtdGamesPrompt
|
||||||
editGoalieYtdGamesPrompt = numPrompt "Year-to-date games played: " $
|
:: Bool
|
||||||
modify . editGoalieYtdGames
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdGamesPrompt batchMode cb =
|
||||||
|
editNum "Year-to-date games played: " mode
|
||||||
|
(gYtd.gsGames .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdMins True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD minutes played
|
-- | Prompt to edit a goalie's YTD minutes played
|
||||||
editGoalieYtdMinsPrompt :: Prompt
|
editGoalieYtdMinsPrompt
|
||||||
editGoalieYtdMinsPrompt = numPrompt "Year-to-date minutes played: " $
|
:: Bool
|
||||||
modify . editGoalieYtdMins
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdMinsPrompt batchMode cb =
|
||||||
|
editNum "Year-to-date minutes played: " mode
|
||||||
|
(gYtd.gsMinsPlayed .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdGoals True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD goales allowed
|
-- | Prompt to edit a goalie's YTD goales allowed
|
||||||
editGoalieYtdGoalsPrompt :: Prompt
|
editGoalieYtdGoalsPrompt
|
||||||
editGoalieYtdGoalsPrompt = numPrompt "Year-to-date goals allowed: " $
|
:: Bool
|
||||||
modify . editGoalieYtdGoals
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdGoalsPrompt batchMode cb =
|
||||||
|
editNum "Year-to-date goals allowed: " mode
|
||||||
|
(gYtd.gsGoalsAllowed .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdShutouts True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD shutouts
|
||||||
|
editGoalieYtdShutoutsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdShutoutsPrompt batchMode cb =
|
||||||
|
editNum "Year-to-date shutouts: " mode
|
||||||
|
(gYtd.gsShutouts .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdWins True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD wins
|
-- | Prompt to edit a goalie's YTD wins
|
||||||
editGoalieYtdWinsPrompt :: Prompt
|
editGoalieYtdWinsPrompt
|
||||||
editGoalieYtdWinsPrompt = numPrompt "Year-to-date wins: " $
|
:: Bool
|
||||||
modify . editGoalieYtdWins
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdWinsPrompt batchMode cb =
|
||||||
|
editNum "Year-to-date wins: " mode
|
||||||
|
(gYtd.gsWins .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdLosses True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD losses
|
-- | Prompt to edit a goalie's YTD losses
|
||||||
editGoalieYtdLossesPrompt :: Prompt
|
editGoalieYtdLossesPrompt
|
||||||
editGoalieYtdLossesPrompt = numPrompt "Year-to-date losses: " $
|
:: Bool
|
||||||
modify . editGoalieYtdLosses
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdLossesPrompt batchMode cb =
|
||||||
|
editNum "Year-to-date losses: " mode
|
||||||
|
(gYtd.gsLosses .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdTies, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD ties
|
-- | Prompt to edit a goalie's YTD ties
|
||||||
editGoalieYtdTiesPrompt :: Prompt
|
editGoalieYtdTiesPrompt
|
||||||
editGoalieYtdTiesPrompt = numPrompt "Year-to-date ties: " $
|
:: Action ()
|
||||||
modify . editGoalieYtdTies
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
|
||||||
|
(gYtd.gsTies .~)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime games played
|
-- | Prompt to edit a goalie's lifetime games played
|
||||||
editGoalieLtGamesPrompt :: Prompt
|
editGoalieLtGamesPrompt
|
||||||
editGoalieLtGamesPrompt = numPrompt "Lifetime games played: " $
|
:: Bool
|
||||||
modify . editGoalieLtGames
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtGamesPrompt batchMode cb =
|
||||||
|
editNum "Lifetime games played: " mode
|
||||||
|
(gLifetime.gsGames .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtMins True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime minutes played
|
-- | Prompt to edit a goalie's lifetime minutes played
|
||||||
editGoalieLtMinsPrompt :: Prompt
|
editGoalieLtMinsPrompt
|
||||||
editGoalieLtMinsPrompt = numPrompt "Lifetime minutes played: " $
|
:: Bool
|
||||||
modify . editGoalieLtMins
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtMinsPrompt batchMode cb =
|
||||||
|
editNum "Lifetime minutes played: " mode
|
||||||
|
(gLifetime.gsMinsPlayed .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtGoals True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime goals allowed
|
-- | Prompt to edit a goalie's lifetime goals allowed
|
||||||
editGoalieLtGoalsPrompt :: Prompt
|
editGoalieLtGoalsPrompt
|
||||||
editGoalieLtGoalsPrompt = numPrompt "Lifetime goals allowed: " $
|
:: Bool
|
||||||
modify . editGoalieLtGoals
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtGoalsPrompt batchMode cb =
|
||||||
|
editNum "Lifetime goals allowed: " mode
|
||||||
|
(gLifetime.gsGoalsAllowed .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtShutouts True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime shutouts
|
||||||
|
editGoalieLtShutoutsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtShutoutsPrompt batchMode cb =
|
||||||
|
editNum "Lifetime shutouts: " mode
|
||||||
|
(gLifetime.gsShutouts .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtWins True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime wins
|
-- | Prompt to edit a goalie's lifetime wins
|
||||||
editGoalieLtWinsPrompt :: Prompt
|
editGoalieLtWinsPrompt
|
||||||
editGoalieLtWinsPrompt = numPrompt "Lifetime wins: " $
|
:: Bool
|
||||||
modify . editGoalieLtWins
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtWinsPrompt batchMode cb =
|
||||||
|
editNum "Lifetime wins: " mode
|
||||||
|
(gLifetime.gsWins .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtLosses True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime losses
|
-- | Prompt to edit a goalie's lifetime losses
|
||||||
editGoalieLtLossesPrompt :: Prompt
|
editGoalieLtLossesPrompt
|
||||||
editGoalieLtLossesPrompt = numPrompt "Lifetime losses: " $
|
:: Bool
|
||||||
modify . editGoalieLtLosses
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtLossesPrompt batchMode cb =
|
||||||
|
editNum "Lifetime losses: " mode
|
||||||
|
(gLifetime.gsLosses .~) cb'
|
||||||
|
where
|
||||||
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtTies, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime ties
|
-- | Prompt to edit a goalie's lifetime ties
|
||||||
editGoalieLtTiesPrompt :: Prompt
|
editGoalieLtTiesPrompt
|
||||||
editGoalieLtTiesPrompt = numPrompt "Lifetime ties: " $
|
:: Action ()
|
||||||
modify . editGoalieLtTies
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
|
||||||
|
(gLifetime.gsTies .~)
|
||||||
|
|
||||||
|
editNum
|
||||||
|
:: String
|
||||||
|
-> EditGoalieMode
|
||||||
|
-> (Int -> Goalie -> Goalie)
|
||||||
|
-> Action ()
|
||||||
|
-> Prompt
|
||||||
|
editNum pStr mode f cb = numPromptWithFallback pStr
|
||||||
|
(goto mode >> cb)
|
||||||
|
(\num -> do
|
||||||
|
doEdit mode $ f num
|
||||||
|
cb)
|
||||||
|
|
||||||
|
doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action ()
|
||||||
|
doEdit mode f = do
|
||||||
|
modify $ editSelectedGoalie f
|
||||||
|
goto mode
|
||||||
|
|
||||||
|
goto :: EditGoalieMode -> Action ()
|
||||||
|
goto = modify . (progMode.editGoalieStateL.egsMode .~)
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -31,62 +31,131 @@ module Mtlstats.Prompt.EditPlayer
|
|||||||
, editPlayerLtPMinPrompt
|
, editPlayerLtPMinPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Extra (whenJustM)
|
import Control.Monad.State.Class (modify)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Lens.Micro ((.~))
|
||||||
import Lens.Micro ((^.), (.~), (%~))
|
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
-- | Prompt to edit a player's number
|
-- | Prompt to edit a player's number
|
||||||
editPlayerNumPrompt :: Prompt
|
editPlayerNumPrompt
|
||||||
editPlayerNumPrompt = numPrompt "Player number: " $
|
:: Action ()
|
||||||
editPlayer . (pNumber .~)
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerNumPrompt = editNum "Player number: " EPMenu
|
||||||
|
(pNumber .~)
|
||||||
|
|
||||||
-- | Prompt to edit a player's name
|
-- | Prompt to edit a player's name
|
||||||
editPlayerNamePrompt :: Prompt
|
editPlayerNamePrompt
|
||||||
editPlayerNamePrompt = strPrompt "Player name: " $
|
:: Action ()
|
||||||
editPlayer . (pName .~)
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerNamePrompt callback = namePrompt "Player name: " $ \name -> do
|
||||||
|
if null name
|
||||||
|
then goto EPMenu
|
||||||
|
else doEdit EPMenu $ pName .~ name
|
||||||
|
callback
|
||||||
|
|
||||||
-- | Prompt to edit a player's position
|
-- | Prompt to edit a player's position
|
||||||
editPlayerPosPrompt :: Prompt
|
editPlayerPosPrompt
|
||||||
editPlayerPosPrompt = ucStrPrompt "Player position: " $
|
:: Action ()
|
||||||
editPlayer . (pPosition .~)
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerPosPrompt callback = selectPositionPrompt "Player position: " $ \pos -> do
|
||||||
|
if null pos
|
||||||
|
then goto EPMenu
|
||||||
|
else doEdit EPMenu $ pPosition .~ pos
|
||||||
|
callback
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date goals
|
-- | Prompt to edit a player's year-to-date goals
|
||||||
editPlayerYtdGoalsPrompt :: Prompt
|
editPlayerYtdGoalsPrompt
|
||||||
editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $
|
:: Bool
|
||||||
editPlayer . (pYtd.psGoals .~)
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerYtdGoalsPrompt batchMode callback = editNum "Year-to-date goals: " mode
|
||||||
|
(pYtd.psGoals .~) callback'
|
||||||
|
where
|
||||||
|
(mode, callback') = if batchMode
|
||||||
|
then (EPYtdAssists True, return ())
|
||||||
|
else (EPYtd, callback)
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date assists
|
-- | Prompt to edit a player's year-to-date assists
|
||||||
editPlayerYtdAssistsPrompt :: Prompt
|
editPlayerYtdAssistsPrompt
|
||||||
editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $
|
:: Bool
|
||||||
editPlayer . (pYtd.psAssists .~)
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerYtdAssistsPrompt batchMode callback = editNum "Year-to-date assists: " mode
|
||||||
|
(pYtd.psAssists .~) callback'
|
||||||
|
where
|
||||||
|
(mode, callback') = if batchMode
|
||||||
|
then (EPYtdPMin, return ())
|
||||||
|
else (EPYtd, callback)
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date penalty minutes
|
-- | Prompt to edit a player's year-to-date penalty minutes
|
||||||
editPlayerYtdPMinPrompt :: Prompt
|
editPlayerYtdPMinPrompt
|
||||||
editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $
|
:: Action ()
|
||||||
editPlayer . (pYtd.psPMin .~)
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
|
||||||
|
(pYtd.psPMin .~)
|
||||||
|
|
||||||
-- | Prompt to edit a player's lifetime goals
|
-- | Prompt to edit a player's lifetime goals
|
||||||
editPlayerLtGoalsPrompt :: Prompt
|
editPlayerLtGoalsPrompt
|
||||||
editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $
|
:: Bool
|
||||||
editPlayer . (pLifetime.psGoals .~)
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerLtGoalsPrompt batchMode callback = editNum "Lifetime goals: " mode
|
||||||
|
(pLifetime.psGoals .~) callback'
|
||||||
|
where
|
||||||
|
(mode, callback') = if batchMode
|
||||||
|
then (EPLtAssists True, return ())
|
||||||
|
else (EPLifetime, callback)
|
||||||
|
|
||||||
-- | Prompt to edit a player's lifetime assists
|
-- | Prompt to edit a player's lifetime assists
|
||||||
editPlayerLtAssistsPrompt :: Prompt
|
editPlayerLtAssistsPrompt
|
||||||
editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $
|
:: Bool
|
||||||
editPlayer . (pLifetime.psAssists .~)
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerLtAssistsPrompt batchMode callback = editNum "Lifetime assists: " mode
|
||||||
|
(pLifetime.psAssists .~) callback'
|
||||||
|
where
|
||||||
|
(mode, callback') = if batchMode
|
||||||
|
then (EPLtPMin, return ())
|
||||||
|
else (EPLifetime, callback)
|
||||||
|
|
||||||
-- | Prompt to edit a player's lifetime penalty minutes
|
-- | Prompt to edit a player's lifetime penalty minutes
|
||||||
editPlayerLtPMinPrompt :: Prompt
|
editPlayerLtPMinPrompt
|
||||||
editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $
|
:: Action ()
|
||||||
editPlayer . (pLifetime.psPMin .~)
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
|
||||||
|
(pLifetime.psPMin .~)
|
||||||
|
|
||||||
editPlayer :: (Player -> Player) -> Action ()
|
editNum
|
||||||
editPlayer f =
|
:: String
|
||||||
whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid ->
|
-> EditPlayerMode
|
||||||
modify
|
-> (Int -> Player -> Player)
|
||||||
$ (database.dbPlayers %~ modifyNth pid f)
|
-> Action ()
|
||||||
. (progMode.editPlayerStateL.epsMode .~ EPMenu)
|
-> Prompt
|
||||||
|
editNum pStr mode f callback = numPromptWithFallback pStr
|
||||||
|
(goto mode >> callback)
|
||||||
|
(\num -> do
|
||||||
|
doEdit mode $ f num
|
||||||
|
callback)
|
||||||
|
|
||||||
|
doEdit :: EditPlayerMode -> (Player -> Player) -> Action ()
|
||||||
|
doEdit mode f = do
|
||||||
|
modify $ editSelectedPlayer f
|
||||||
|
goto mode
|
||||||
|
|
||||||
|
goto :: EditPlayerMode -> Action ()
|
||||||
|
goto = modify . (progMode.editPlayerStateL.epsMode .~)
|
||||||
|
|||||||
89
src/Mtlstats/Prompt/EditStandings.hs
Normal file
89
src/Mtlstats/Prompt/EditStandings.hs
Normal file
@@ -0,0 +1,89 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
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 Mtlstats.Prompt.EditStandings
|
||||||
|
( editHomeWinsPrompt
|
||||||
|
, editHomeLossesPrompt
|
||||||
|
, editHomeOvertimePrompt
|
||||||
|
, editHomeGoalsForPrompt
|
||||||
|
, editHomeGoalsAgainstPrompt
|
||||||
|
, editAwayWinsPrompt
|
||||||
|
, editAwayLossesPrompt
|
||||||
|
, editAwayOvertimePrompt
|
||||||
|
, editAwayGoalsForPrompt
|
||||||
|
, editAwayGoalsAgainstPrompt
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.State.Class (modify)
|
||||||
|
import Lens.Micro ((.~), (%~))
|
||||||
|
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
editHomeWinsPrompt :: Prompt
|
||||||
|
editHomeWinsPrompt =
|
||||||
|
mkPrompt "Home wins: " (dbHomeGameStats.gmsWins .~)
|
||||||
|
|
||||||
|
editHomeLossesPrompt :: Prompt
|
||||||
|
editHomeLossesPrompt =
|
||||||
|
mkPrompt "Home losses: " (dbHomeGameStats.gmsLosses .~)
|
||||||
|
|
||||||
|
editHomeOvertimePrompt :: Prompt
|
||||||
|
editHomeOvertimePrompt =
|
||||||
|
mkPrompt "Home overtime games: " (dbHomeGameStats.gmsOvertime .~)
|
||||||
|
|
||||||
|
editHomeGoalsForPrompt :: Prompt
|
||||||
|
editHomeGoalsForPrompt =
|
||||||
|
mkPrompt "Home goals for: " (dbHomeGameStats.gmsGoalsFor .~)
|
||||||
|
|
||||||
|
editHomeGoalsAgainstPrompt :: Prompt
|
||||||
|
editHomeGoalsAgainstPrompt =
|
||||||
|
mkPrompt "Home goals against: " (dbHomeGameStats.gmsGoalsAgainst .~)
|
||||||
|
|
||||||
|
editAwayWinsPrompt :: Prompt
|
||||||
|
editAwayWinsPrompt =
|
||||||
|
mkPrompt "Road wins: " (dbAwayGameStats.gmsWins .~)
|
||||||
|
|
||||||
|
editAwayLossesPrompt :: Prompt
|
||||||
|
editAwayLossesPrompt =
|
||||||
|
mkPrompt "Road losses: " (dbAwayGameStats.gmsLosses .~)
|
||||||
|
|
||||||
|
editAwayOvertimePrompt :: Prompt
|
||||||
|
editAwayOvertimePrompt =
|
||||||
|
mkPrompt "Road overtime games: " (dbAwayGameStats.gmsOvertime .~)
|
||||||
|
|
||||||
|
editAwayGoalsForPrompt :: Prompt
|
||||||
|
editAwayGoalsForPrompt =
|
||||||
|
mkPrompt "Road goals for: " (dbAwayGameStats.gmsGoalsFor .~)
|
||||||
|
|
||||||
|
editAwayGoalsAgainstPrompt :: Prompt
|
||||||
|
editAwayGoalsAgainstPrompt =
|
||||||
|
mkPrompt "Road goals against: " (dbAwayGameStats.gmsGoalsAgainst .~)
|
||||||
|
|
||||||
|
mkPrompt :: String -> (Int -> Database -> Database) -> Prompt
|
||||||
|
mkPrompt pStr f = numPromptWithFallback pStr
|
||||||
|
(modify subMenu)
|
||||||
|
(\n -> modify
|
||||||
|
$ (database %~ f n)
|
||||||
|
. subMenu)
|
||||||
|
|
||||||
|
subMenu :: ProgState -> ProgState
|
||||||
|
subMenu = progMode.editStandingsModeL.esmSubModeL .~ ESMSubMenu
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
module Mtlstats.Prompt.NewGame
|
||||||
( gameYearPrompt
|
( gameYearPrompt
|
||||||
|
, gameMonthPrompt
|
||||||
, gameDayPrompt
|
, gameDayPrompt
|
||||||
, otherTeamPrompt
|
, otherTeamPrompt
|
||||||
, homeScorePrompt
|
, homeScorePrompt
|
||||||
@@ -34,7 +35,7 @@ module Mtlstats.Prompt.NewGame
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.State.Class (gets, modify)
|
||||||
import Lens.Micro ((^.), (.~), (?~), (%~))
|
import Lens.Micro ((^.), (.~), (?~), (%~))
|
||||||
|
|
||||||
import Mtlstats.Actions.NewGame
|
import Mtlstats.Actions.NewGame
|
||||||
@@ -48,6 +49,11 @@ gameYearPrompt :: Prompt
|
|||||||
gameYearPrompt = numPrompt "Game year: " $
|
gameYearPrompt = numPrompt "Game year: " $
|
||||||
modify . (progMode.gameStateL.gameYear ?~)
|
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
|
-- | Prompts for the day of the month the game took place
|
||||||
gameDayPrompt :: Prompt
|
gameDayPrompt :: Prompt
|
||||||
gameDayPrompt = numPrompt "Day of month: " $
|
gameDayPrompt = numPrompt "Day of month: " $
|
||||||
@@ -76,7 +82,7 @@ recordGoalPrompt
|
|||||||
-> Int
|
-> Int
|
||||||
-- ^ The goal number
|
-- ^ The goal number
|
||||||
-> Prompt
|
-> Prompt
|
||||||
recordGoalPrompt game goal = selectPlayerPrompt
|
recordGoalPrompt game goal = selectActivePlayerPrompt
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||||
++ "Who scored goal number " ++ show goal ++ "? "
|
++ "Who scored goal number " ++ show goal ++ "? "
|
||||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
) $ modify . (progMode.gameStateL.goalBy .~)
|
||||||
@@ -90,7 +96,7 @@ recordAssistPrompt
|
|||||||
-> Int
|
-> Int
|
||||||
-- ^ The assist number
|
-- ^ The assist number
|
||||||
-> Prompt
|
-> Prompt
|
||||||
recordAssistPrompt game goal assist = selectPlayerPrompt
|
recordAssistPrompt game goal assist = selectActivePlayerPrompt
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||||
++ "Goal: " ++ show goal ++ "\n"
|
++ "Goal: " ++ show goal ++ "\n"
|
||||||
++ "Assist #" ++ show assist ++ ": "
|
++ "Assist #" ++ show assist ++ ": "
|
||||||
@@ -104,7 +110,7 @@ recordAssistPrompt game goal assist = selectPlayerPrompt
|
|||||||
|
|
||||||
-- | Prompts for the player to assign penalty minutes to
|
-- | Prompts for the player to assign penalty minutes to
|
||||||
pMinPlayerPrompt :: Prompt
|
pMinPlayerPrompt :: Prompt
|
||||||
pMinPlayerPrompt = selectPlayerPrompt
|
pMinPlayerPrompt = selectActivePlayerPrompt
|
||||||
"Assign penalty minutes to: " $
|
"Assign penalty minutes to: " $
|
||||||
\case
|
\case
|
||||||
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -27,7 +27,7 @@ module Mtlstats.Prompt.NewGame.GoalieInput
|
|||||||
, goalsAllowedPrompt
|
, goalsAllowedPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.State.Class (modify)
|
||||||
import Lens.Micro ((?~))
|
import Lens.Micro ((?~))
|
||||||
|
|
||||||
import Mtlstats.Actions.NewGame.GoalieInput
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
@@ -36,7 +36,8 @@ import Mtlstats.Types
|
|||||||
|
|
||||||
-- | Prompts for a goalie who played in the game
|
-- | Prompts for a goalie who played in the game
|
||||||
selectGameGoaliePrompt :: Prompt
|
selectGameGoaliePrompt :: Prompt
|
||||||
selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
|
selectGameGoaliePrompt = selectActiveGoaliePrompt
|
||||||
|
"Which goalie played this game: " $
|
||||||
\case
|
\case
|
||||||
Nothing -> modify finishGoalieEntry
|
Nothing -> modify finishGoalieEntry
|
||||||
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
|
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,32 +19,52 @@ 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
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe, mapMaybe)
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
|
import Data.Ord (Down (Down))
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
|
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Helpers.Goalie
|
||||||
|
import Mtlstats.Helpers.Player
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | Generates the report
|
-- | Generates the report displayed on screen
|
||||||
report
|
displayReport
|
||||||
:: Int
|
:: Int
|
||||||
-- ^ The number of columns for the report
|
-- ^ The number of columns for the report
|
||||||
-> ProgState
|
-> ProgState
|
||||||
-- ^ The program state
|
-- ^ The program state
|
||||||
-> [String]
|
-> [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
|
report width s
|
||||||
= standingsReport width s
|
= standingsReport width s
|
||||||
++ [""]
|
++ [""]
|
||||||
++ gameStatsReport width s
|
++ gameStatsReport width s
|
||||||
++ [""]
|
++ [""]
|
||||||
++ yearToDateStatsReport width s
|
++ yearToDateStatsReport width s
|
||||||
++ [""]
|
|
||||||
++ lifetimeStatsReport width s
|
|
||||||
|
|
||||||
standingsReport :: Int -> ProgState -> [String]
|
standingsReport :: Int -> ProgState -> [String]
|
||||||
standingsReport width s = fromMaybe [] $ do
|
standingsReport width s = fromMaybe [] $ do
|
||||||
@@ -113,7 +133,7 @@ gameStatsReport width s = let
|
|||||||
gs = s^.progMode.gameStateL
|
gs = s^.progMode.gameStateL
|
||||||
db = s^.database
|
db = s^.database
|
||||||
|
|
||||||
playerStats = mapMaybe
|
playerStats = sortPlayers $ mapMaybe
|
||||||
(\(pid, stats) -> do
|
(\(pid, stats) -> do
|
||||||
p <- nth pid $ db^.dbPlayers
|
p <- nth pid $ db^.dbPlayers
|
||||||
Just (p, stats))
|
Just (p, stats))
|
||||||
@@ -127,7 +147,7 @@ gameStatsReport width s = let
|
|||||||
|
|
||||||
criteria (_, ps) = psPoints ps > 0
|
criteria (_, ps) = psPoints ps > 0
|
||||||
|
|
||||||
in filteredPlayerReport width "GAME" criteria playerStats
|
in filteredPlayerReport width "GAME" criteria True False playerStats
|
||||||
++ [""]
|
++ [""]
|
||||||
++ gameGoalieReport width goalieStats
|
++ gameGoalieReport width goalieStats
|
||||||
|
|
||||||
@@ -135,7 +155,8 @@ yearToDateStatsReport :: Int -> ProgState -> [String]
|
|||||||
yearToDateStatsReport width s = let
|
yearToDateStatsReport width s = let
|
||||||
db = s^.database
|
db = s^.database
|
||||||
|
|
||||||
playerStats = map (\p -> (p, p^.pYtd))
|
playerStats = sortPlayers
|
||||||
|
$ map (\p -> (p, p^.pYtd))
|
||||||
$ filter playerIsActive
|
$ filter playerIsActive
|
||||||
$ db^.dbPlayers
|
$ db^.dbPlayers
|
||||||
|
|
||||||
@@ -143,23 +164,24 @@ yearToDateStatsReport width s = let
|
|||||||
$ filter goalieIsActive
|
$ filter goalieIsActive
|
||||||
$ db^.dbGoalies
|
$ db^.dbGoalies
|
||||||
|
|
||||||
in playerReport width "YEAR TO DATE" playerStats
|
in playerReport width "YEAR TO DATE" True False playerStats
|
||||||
++ [""]
|
++ [""]
|
||||||
++ goalieReport width goalieStats
|
++ goalieReport width True False goalieStats
|
||||||
|
|
||||||
lifetimeStatsReport :: Int -> ProgState -> [String]
|
lifetimeStatsReport :: Int -> ProgState -> [String]
|
||||||
lifetimeStatsReport width s = let
|
lifetimeStatsReport width s = let
|
||||||
db = s^.database
|
db = s^.database
|
||||||
|
|
||||||
playerStats = map (\p -> (p, p^.pYtd))
|
playerStats = sortPlayers
|
||||||
|
$ map (\p -> (p, p^.pLifetime))
|
||||||
$ db^.dbPlayers
|
$ db^.dbPlayers
|
||||||
|
|
||||||
goalieStats = map (\g -> (g, g^.gYtd))
|
goalieStats = map (\g -> (g, g^.gLifetime))
|
||||||
$ db^.dbGoalies
|
$ db^.dbGoalies
|
||||||
|
|
||||||
in playerReport width "LIFETIME" playerStats
|
in playerReport width "LIFETIME" False True playerStats
|
||||||
++ [""]
|
++ [""]
|
||||||
++ goalieReport width goalieStats
|
++ goalieReport width False True goalieStats
|
||||||
|
|
||||||
gameDate :: GameState -> String
|
gameDate :: GameState -> String
|
||||||
gameDate gs = fromMaybe "" $ do
|
gameDate gs = fromMaybe "" $ do
|
||||||
@@ -168,19 +190,28 @@ gameDate gs = fromMaybe "" $ do
|
|||||||
d <- padNum 2 <$> gs^.gameDay
|
d <- padNum 2 <$> gs^.gameDay
|
||||||
Just $ m ++ " " ++ d ++ " " ++ y
|
Just $ m ++ " " ++ d ++ " " ++ y
|
||||||
|
|
||||||
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
playerReport
|
||||||
playerReport width label ps =
|
:: Int
|
||||||
filteredPlayerReport width label (const True) ps
|
-> String
|
||||||
|
-> Bool
|
||||||
|
-> Bool
|
||||||
|
-> [(Player, PlayerStats)]
|
||||||
|
-> [String]
|
||||||
|
playerReport width label =
|
||||||
|
filteredPlayerReport width label (const True)
|
||||||
|
|
||||||
filteredPlayerReport
|
filteredPlayerReport
|
||||||
:: Int
|
:: Int
|
||||||
-> String
|
-> String
|
||||||
-> ((Player, PlayerStats) -> Bool)
|
-> ((Player, PlayerStats) -> Bool)
|
||||||
|
-> Bool
|
||||||
|
-> Bool
|
||||||
-> [(Player, PlayerStats)]
|
-> [(Player, PlayerStats)]
|
||||||
-> [String]
|
-> [String]
|
||||||
filteredPlayerReport width label criteria ps = let
|
filteredPlayerReport width label criteria showTotals lineNumbers ps = let
|
||||||
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
|
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
|
||||||
fps = filter criteria ps
|
criteria' = (&&) <$> criteria <*> \(p, _) -> p^.pNumber /= 0
|
||||||
|
fps = filter criteria' ps
|
||||||
|
|
||||||
rHeader =
|
rHeader =
|
||||||
[ centre width (label ++ " STATISTICS")
|
[ centre width (label ++ " STATISTICS")
|
||||||
@@ -206,7 +237,7 @@ filteredPlayerReport width label criteria ps = let
|
|||||||
body = map
|
body = map
|
||||||
(\(p, stats) ->
|
(\(p, stats) ->
|
||||||
[ CellText $ show (p^.pNumber) ++ " "
|
[ CellText $ show (p^.pNumber) ++ " "
|
||||||
, CellText $ p^.pName
|
, CellText $ playerName p
|
||||||
] ++ statsCells stats)
|
] ++ statsCells stats)
|
||||||
fps
|
fps
|
||||||
|
|
||||||
@@ -217,23 +248,42 @@ filteredPlayerReport width label criteria ps = let
|
|||||||
, CellText ""
|
, CellText ""
|
||||||
] ++ statsCells tStats
|
] ++ statsCells tStats
|
||||||
|
|
||||||
table = overlayLast (label ++ " TOTALS")
|
olayText = if showTotals
|
||||||
$ map (centre width)
|
then label ++ " TOTALS"
|
||||||
|
else ""
|
||||||
|
|
||||||
|
lnOverlay = if lineNumbers
|
||||||
|
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||||
|
else repeat ""
|
||||||
|
|
||||||
|
table = overlayLast olayText
|
||||||
|
$ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
|
||||||
$ complexTable ([right, left] ++ repeat right)
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
$ tHeader : body ++ [separator, totals]
|
$ tHeader : body ++ if showTotals
|
||||||
|
then [separator, totals]
|
||||||
|
else []
|
||||||
|
|
||||||
in rHeader ++ table
|
in rHeader ++ table
|
||||||
|
|
||||||
goalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
goalieReport
|
||||||
goalieReport width goalieData = let
|
:: Int
|
||||||
olayText = "GOALTENDING TOTALS"
|
-> Bool
|
||||||
|
-> Bool
|
||||||
|
-> [(Goalie, GoalieStats)]
|
||||||
|
-> [String]
|
||||||
|
goalieReport width showTotals lineNumbers goalieData = let
|
||||||
|
olayText = if showTotals
|
||||||
|
then "GOALTENDING TOTALS"
|
||||||
|
else ""
|
||||||
|
|
||||||
|
goalieData' = sortGoalies goalieData
|
||||||
|
|
||||||
tData = foldl addGoalieStats newGoalieStats
|
tData = foldl addGoalieStats newGoalieStats
|
||||||
$ map snd goalieData
|
$ map snd goalieData'
|
||||||
|
|
||||||
header =
|
header =
|
||||||
[ CellText "NO."
|
[ CellText "NO."
|
||||||
, CellText $ left (length olayText) "GOALTENDER"
|
, CellText $ padRight (length olayText) "GOALTENDER"
|
||||||
, CellText "GP"
|
, CellText "GP"
|
||||||
, CellText " MIN"
|
, CellText " MIN"
|
||||||
, CellText " GA"
|
, CellText " GA"
|
||||||
@@ -252,9 +302,9 @@ goalieReport width goalieData = let
|
|||||||
body = map
|
body = map
|
||||||
(\(goalie, stats) ->
|
(\(goalie, stats) ->
|
||||||
[ CellText $ show (goalie^.gNumber) ++ " "
|
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||||
, CellText $ goalie^.gName
|
, CellText $ goalieName goalie
|
||||||
] ++ rowCells stats)
|
] ++ rowCells stats)
|
||||||
goalieData
|
goalieData'
|
||||||
|
|
||||||
separator
|
separator
|
||||||
= replicate 2 (CellText "")
|
= replicate 2 (CellText "")
|
||||||
@@ -262,13 +312,21 @@ goalieReport width goalieData = let
|
|||||||
|
|
||||||
summary = replicate 2 (CellText "") ++ rowCells tData
|
summary = replicate 2 (CellText "") ++ rowCells tData
|
||||||
|
|
||||||
in map (centre width)
|
lnOverlay = if lineNumbers
|
||||||
|
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||||
|
else repeat ""
|
||||||
|
|
||||||
|
in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
|
||||||
$ overlayLast olayText
|
$ overlayLast olayText
|
||||||
$ complexTable ([right, left] ++ repeat right)
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
$ header : body ++ [separator, summary]
|
$ header : body ++ if showTotals
|
||||||
|
then [separator, summary]
|
||||||
|
else []
|
||||||
|
|
||||||
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
||||||
gameGoalieReport width goalieData = let
|
gameGoalieReport width goalieData = let
|
||||||
|
goalieData' = sortGoalies goalieData
|
||||||
|
|
||||||
header =
|
header =
|
||||||
[ CellText "NO."
|
[ CellText "NO."
|
||||||
, CellText "GOALTENDER"
|
, CellText "GOALTENDER"
|
||||||
@@ -280,13 +338,21 @@ gameGoalieReport width goalieData = let
|
|||||||
body = map
|
body = map
|
||||||
(\(goalie, stats) ->
|
(\(goalie, stats) ->
|
||||||
[ CellText $ show (goalie^.gNumber) ++ " "
|
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||||
, CellText $ goalie^.gName
|
, CellText $ goalieName goalie
|
||||||
, CellText $ show $ stats^.gsMinsPlayed
|
, CellText $ show $ stats^.gsMinsPlayed
|
||||||
, CellText $ show $ stats^.gsGoalsAllowed
|
, CellText $ show $ stats^.gsGoalsAllowed
|
||||||
, CellText $ showFloating $ gsAverage stats
|
, CellText $ showFloating $ gsAverage stats
|
||||||
])
|
])
|
||||||
goalieData
|
goalieData'
|
||||||
|
|
||||||
in map (centre width)
|
in map (centre width)
|
||||||
$ complexTable ([right, left] ++ repeat right)
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
$ header : body
|
$ header : body
|
||||||
|
|
||||||
|
sortPlayers :: [(Player, PlayerStats)] -> [(Player, PlayerStats)]
|
||||||
|
sortPlayers = sortOn $ Down . \(p, ps) ->
|
||||||
|
(psPoints ps, psPoints $ p^.pLifetime)
|
||||||
|
|
||||||
|
sortGoalies :: [(Goalie, GoalieStats)] -> [(Goalie, GoalieStats)]
|
||||||
|
sortGoalies = sortOn $ Down . \(g, gs) ->
|
||||||
|
(gs^.gsMinsPlayed, g^.gLifetime.gsMinsPlayed)
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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 (
|
module Mtlstats.Types (
|
||||||
-- * Types
|
-- * Types
|
||||||
Controller (..),
|
Controller (..),
|
||||||
|
Renderer,
|
||||||
Action,
|
Action,
|
||||||
|
Handler,
|
||||||
ProgState (..),
|
ProgState (..),
|
||||||
ProgMode (..),
|
ProgMode (..),
|
||||||
GameState (..),
|
GameState (..),
|
||||||
@@ -35,6 +37,8 @@ module Mtlstats.Types (
|
|||||||
EditPlayerMode (..),
|
EditPlayerMode (..),
|
||||||
EditGoalieState (..),
|
EditGoalieState (..),
|
||||||
EditGoalieMode (..),
|
EditGoalieMode (..),
|
||||||
|
EditStandingsMode (..),
|
||||||
|
ESMSubMode (..),
|
||||||
Database (..),
|
Database (..),
|
||||||
Player (..),
|
Player (..),
|
||||||
PlayerStats (..),
|
PlayerStats (..),
|
||||||
@@ -48,14 +52,18 @@ module Mtlstats.Types (
|
|||||||
-- ** ProgState Lenses
|
-- ** ProgState Lenses
|
||||||
database,
|
database,
|
||||||
progMode,
|
progMode,
|
||||||
inputBuffer,
|
dbName,
|
||||||
scrollOffset,
|
editorW,
|
||||||
|
scroller,
|
||||||
-- ** ProgMode Lenses
|
-- ** ProgMode Lenses
|
||||||
gameStateL,
|
gameStateL,
|
||||||
createPlayerStateL,
|
createPlayerStateL,
|
||||||
createGoalieStateL,
|
createGoalieStateL,
|
||||||
editPlayerStateL,
|
editPlayerStateL,
|
||||||
editGoalieStateL,
|
editGoalieStateL,
|
||||||
|
editStandingsModeL,
|
||||||
|
-- ** EditStandingsMode Lenses
|
||||||
|
esmSubModeL,
|
||||||
-- ** GameState Lenses
|
-- ** GameState Lenses
|
||||||
gameYear,
|
gameYear,
|
||||||
gameMonth,
|
gameMonth,
|
||||||
@@ -83,19 +91,25 @@ module Mtlstats.Types (
|
|||||||
cpsNumber,
|
cpsNumber,
|
||||||
cpsName,
|
cpsName,
|
||||||
cpsPosition,
|
cpsPosition,
|
||||||
|
cpsRookieFlag,
|
||||||
|
cpsActiveFlag,
|
||||||
cpsSuccessCallback,
|
cpsSuccessCallback,
|
||||||
cpsFailureCallback,
|
cpsFailureCallback,
|
||||||
-- ** CreateGoalieState Lenses
|
-- ** CreateGoalieState Lenses
|
||||||
cgsNumber,
|
cgsNumber,
|
||||||
cgsName,
|
cgsName,
|
||||||
|
cgsRookieFlag,
|
||||||
|
cgsActiveFlag,
|
||||||
cgsSuccessCallback,
|
cgsSuccessCallback,
|
||||||
cgsFailureCallback,
|
cgsFailureCallback,
|
||||||
-- ** EditPlayerState Lenses
|
-- ** EditPlayerState Lenses
|
||||||
epsSelectedPlayer,
|
epsSelectedPlayer,
|
||||||
epsMode,
|
epsMode,
|
||||||
|
epsCallback,
|
||||||
-- ** EditGoalieState Lenses
|
-- ** EditGoalieState Lenses
|
||||||
egsSelectedGoalie,
|
egsSelectedGoalie,
|
||||||
egsMode,
|
egsMode,
|
||||||
|
egsCallback,
|
||||||
-- ** Database Lenses
|
-- ** Database Lenses
|
||||||
dbPlayers,
|
dbPlayers,
|
||||||
dbGoalies,
|
dbGoalies,
|
||||||
@@ -106,6 +120,8 @@ module Mtlstats.Types (
|
|||||||
pNumber,
|
pNumber,
|
||||||
pName,
|
pName,
|
||||||
pPosition,
|
pPosition,
|
||||||
|
pRookie,
|
||||||
|
pActive,
|
||||||
pYtd,
|
pYtd,
|
||||||
pLifetime,
|
pLifetime,
|
||||||
-- ** PlayerStats Lenses
|
-- ** PlayerStats Lenses
|
||||||
@@ -115,6 +131,8 @@ module Mtlstats.Types (
|
|||||||
-- ** Goalie Lenses
|
-- ** Goalie Lenses
|
||||||
gNumber,
|
gNumber,
|
||||||
gName,
|
gName,
|
||||||
|
gRookie,
|
||||||
|
gActive,
|
||||||
gYtd,
|
gYtd,
|
||||||
gLifetime,
|
gLifetime,
|
||||||
-- ** GoalieStats Lenses
|
-- ** GoalieStats Lenses
|
||||||
@@ -160,6 +178,7 @@ module Mtlstats.Types (
|
|||||||
addGameStats,
|
addGameStats,
|
||||||
-- ** Player Helpers
|
-- ** Player Helpers
|
||||||
playerSearch,
|
playerSearch,
|
||||||
|
activePlayerSearch,
|
||||||
playerSearchExact,
|
playerSearchExact,
|
||||||
modifyPlayer,
|
modifyPlayer,
|
||||||
playerSummary,
|
playerSummary,
|
||||||
@@ -169,6 +188,7 @@ module Mtlstats.Types (
|
|||||||
addPlayerStats,
|
addPlayerStats,
|
||||||
-- ** Goalie Helpers
|
-- ** Goalie Helpers
|
||||||
goalieSearch,
|
goalieSearch,
|
||||||
|
activeGoalieSearch,
|
||||||
goalieSearchExact,
|
goalieSearchExact,
|
||||||
goalieSummary,
|
goalieSummary,
|
||||||
goalieIsActive,
|
goalieIsActive,
|
||||||
@@ -177,7 +197,9 @@ module Mtlstats.Types (
|
|||||||
gsAverage
|
gsAverage
|
||||||
) where
|
) 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
|
import Data.Aeson
|
||||||
( FromJSON
|
( FromJSON
|
||||||
, ToJSON
|
, ToJSON
|
||||||
@@ -193,25 +215,30 @@ import Data.Aeson
|
|||||||
, (.=)
|
, (.=)
|
||||||
)
|
)
|
||||||
import Data.Char (toUpper)
|
import Data.Char (toUpper)
|
||||||
import Data.List (isInfixOf)
|
import Data.List (find, isInfixOf)
|
||||||
import qualified Data.Map as M
|
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 (Lens', lens, (&), (^.), (.~))
|
||||||
import Lens.Micro.TH (makeLenses)
|
import Lens.Micro.TH (makeLenses)
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
|
|
||||||
-- | Controls the program flow
|
-- | Controls the program flow
|
||||||
data Controller = Controller
|
data Controller = Controller
|
||||||
{ drawController :: ProgState -> C.Update C.CursorMode
|
{ drawController :: Renderer
|
||||||
-- ^ The drawing phase
|
-- ^ The drawing routine
|
||||||
, handleController :: C.Event -> Action Bool
|
, handleController :: Handler ()
|
||||||
-- ^ The event handler
|
-- ^ The event handler
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Renders a view based on a "ProgState"
|
||||||
|
type Renderer = ProgState -> Widget ()
|
||||||
|
|
||||||
-- | Action which maintains program state
|
-- | 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
|
-- | Represents the program state
|
||||||
data ProgState = ProgState
|
data ProgState = ProgState
|
||||||
@@ -219,30 +246,38 @@ data ProgState = ProgState
|
|||||||
-- ^ The data to be saved
|
-- ^ The data to be saved
|
||||||
, _progMode :: ProgMode
|
, _progMode :: ProgMode
|
||||||
-- ^ The program's mode
|
-- ^ The program's mode
|
||||||
, _inputBuffer :: String
|
, _dbName :: String
|
||||||
-- ^ Buffer for user input
|
-- ^ The name of the database file
|
||||||
, _scrollOffset :: Int
|
, _editorW :: Editor String ()
|
||||||
-- ^ The scrolling offset for the display
|
-- ^ Editor widget
|
||||||
|
, _scroller :: ViewportScroll ()
|
||||||
|
-- ^ Scroller for the reports
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | The program mode
|
-- | The program mode
|
||||||
data ProgMode
|
data ProgMode
|
||||||
= MainMenu
|
= TitleScreen
|
||||||
| NewSeason
|
| MainMenu
|
||||||
|
| NewSeason Bool
|
||||||
| NewGame GameState
|
| NewGame GameState
|
||||||
|
| EditMenu
|
||||||
| CreatePlayer CreatePlayerState
|
| CreatePlayer CreatePlayerState
|
||||||
| CreateGoalie CreateGoalieState
|
| CreateGoalie CreateGoalieState
|
||||||
| EditPlayer EditPlayerState
|
| EditPlayer EditPlayerState
|
||||||
| EditGoalie EditGoalieState
|
| EditGoalie EditGoalieState
|
||||||
|
| EditStandings EditStandingsMode
|
||||||
|
|
||||||
instance Show ProgMode where
|
instance Show ProgMode where
|
||||||
|
show TitleScreen = "TitleScreen"
|
||||||
show MainMenu = "MainMenu"
|
show MainMenu = "MainMenu"
|
||||||
show NewSeason = "NewSeason"
|
show (NewSeason _) = "NewSeason"
|
||||||
show (NewGame _) = "NewGame"
|
show (NewGame _) = "NewGame"
|
||||||
|
show EditMenu = "EditMenu"
|
||||||
show (CreatePlayer _) = "CreatePlayer"
|
show (CreatePlayer _) = "CreatePlayer"
|
||||||
show (CreateGoalie _) = "CreateGoalie"
|
show (CreateGoalie _) = "CreateGoalie"
|
||||||
show (EditPlayer _) = "EditPlayer"
|
show (EditPlayer _) = "EditPlayer"
|
||||||
show (EditGoalie _) = "EditGoalie"
|
show (EditGoalie _) = "EditGoalie"
|
||||||
|
show (EditStandings _) = "EditStandings"
|
||||||
|
|
||||||
-- | The game state
|
-- | The game state
|
||||||
data GameState = GameState
|
data GameState = GameState
|
||||||
@@ -311,6 +346,10 @@ data CreatePlayerState = CreatePlayerState
|
|||||||
-- ^ The player's name
|
-- ^ The player's name
|
||||||
, _cpsPosition :: String
|
, _cpsPosition :: String
|
||||||
-- ^ The player's position
|
-- ^ The player's position
|
||||||
|
, _cpsRookieFlag :: Maybe Bool
|
||||||
|
-- ^ Indicates whether or not the player is a rookie
|
||||||
|
, _cpsActiveFlag :: Maybe Bool
|
||||||
|
-- ^ Indicates whether or not the plauer is active
|
||||||
, _cpsSuccessCallback :: Action ()
|
, _cpsSuccessCallback :: Action ()
|
||||||
-- ^ The function to call on success
|
-- ^ The function to call on success
|
||||||
, _cpsFailureCallback :: Action ()
|
, _cpsFailureCallback :: Action ()
|
||||||
@@ -323,6 +362,10 @@ data CreateGoalieState = CreateGoalieState
|
|||||||
-- ^ The goalie's number
|
-- ^ The goalie's number
|
||||||
, _cgsName :: String
|
, _cgsName :: String
|
||||||
-- ^ The goalie's name
|
-- ^ The goalie's name
|
||||||
|
, _cgsRookieFlag :: Maybe Bool
|
||||||
|
-- ^ Indicates whether or not the goalie is a rookie
|
||||||
|
, _cgsActiveFlag :: Maybe Bool
|
||||||
|
-- ^ Indicates whether or not the goalie is active
|
||||||
, _cgsSuccessCallback :: Action ()
|
, _cgsSuccessCallback :: Action ()
|
||||||
-- ^ The function to call on success
|
-- ^ The function to call on success
|
||||||
, _cgsFailureCallback :: Action ()
|
, _cgsFailureCallback :: Action ()
|
||||||
@@ -335,6 +378,8 @@ data EditPlayerState = EditPlayerState
|
|||||||
-- ^ The index number of the player being edited
|
-- ^ The index number of the player being edited
|
||||||
, _epsMode :: EditPlayerMode
|
, _epsMode :: EditPlayerMode
|
||||||
-- ^ The editing mode
|
-- ^ The editing mode
|
||||||
|
, _epsCallback :: Action ()
|
||||||
|
-- ^ The action to perform when the edit is complete
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Player editing mode
|
-- | Player editing mode
|
||||||
@@ -345,11 +390,12 @@ data EditPlayerMode
|
|||||||
| EPPosition
|
| EPPosition
|
||||||
| EPYtd
|
| EPYtd
|
||||||
| EPLifetime
|
| EPLifetime
|
||||||
| EPYtdGoals
|
| EPDelete
|
||||||
| EPYtdAssists
|
| EPYtdGoals Bool
|
||||||
|
| EPYtdAssists Bool
|
||||||
| EPYtdPMin
|
| EPYtdPMin
|
||||||
| EPLtGoals
|
| EPLtGoals Bool
|
||||||
| EPLtAssists
|
| EPLtAssists Bool
|
||||||
| EPLtPMin
|
| EPLtPMin
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
@@ -358,6 +404,9 @@ data EditGoalieState = EditGoalieState
|
|||||||
{ _egsSelectedGoalie :: Maybe Int
|
{ _egsSelectedGoalie :: Maybe Int
|
||||||
-- ^ The index number of the 'Goalie' being edited
|
-- ^ The index number of the 'Goalie' being edited
|
||||||
, _egsMode :: EditGoalieMode
|
, _egsMode :: EditGoalieMode
|
||||||
|
-- ^ The editing mode
|
||||||
|
, _egsCallback :: Action ()
|
||||||
|
-- ^ The action to perform when the edit is complete
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | 'Goalie' editing mode
|
-- | 'Goalie' editing mode
|
||||||
@@ -367,20 +416,40 @@ data EditGoalieMode
|
|||||||
| EGName
|
| EGName
|
||||||
| EGYtd
|
| EGYtd
|
||||||
| EGLifetime
|
| EGLifetime
|
||||||
| EGYtdGames
|
| EGDelete
|
||||||
| EGYtdMins
|
| EGYtdGames Bool
|
||||||
| EGYtdGoals
|
| EGYtdMins Bool
|
||||||
| EGYtdWins
|
| EGYtdGoals Bool
|
||||||
| EGYtdLosses
|
| EGYtdShutouts Bool
|
||||||
|
| EGYtdWins Bool
|
||||||
|
| EGYtdLosses Bool
|
||||||
| EGYtdTies
|
| EGYtdTies
|
||||||
| EGLtGames
|
| EGLtGames Bool
|
||||||
| EGLtMins
|
| EGLtMins Bool
|
||||||
| EGLtGoals
|
| EGLtGoals Bool
|
||||||
| EGLtWins
|
| EGLtShutouts Bool
|
||||||
| EGLtLosses
|
| EGLtWins Bool
|
||||||
|
| EGLtLosses Bool
|
||||||
| EGLtTies
|
| EGLtTies
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Represents the standings edit mode
|
||||||
|
data EditStandingsMode
|
||||||
|
= ESMMenu
|
||||||
|
| ESMHome ESMSubMode
|
||||||
|
| ESMAway ESMSubMode
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Represents the standings edit sub-mode
|
||||||
|
data ESMSubMode
|
||||||
|
= ESMSubMenu
|
||||||
|
| ESMEditWins
|
||||||
|
| ESMEditLosses
|
||||||
|
| ESMEditOvertime
|
||||||
|
| ESMEditGoalsFor
|
||||||
|
| ESMEditGoalsAgainst
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- | Represents the database
|
-- | Represents the database
|
||||||
data Database = Database
|
data Database = Database
|
||||||
{ _dbPlayers :: [Player]
|
{ _dbPlayers :: [Player]
|
||||||
@@ -395,29 +464,6 @@ data Database = Database
|
|||||||
-- ^ Statistics for away games
|
-- ^ Statistics for away games
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
instance FromJSON Database where
|
|
||||||
parseJSON = withObject "Database" $ \v -> Database
|
|
||||||
<$> v .: "players"
|
|
||||||
<*> v .: "goalies"
|
|
||||||
<*> v .: "games"
|
|
||||||
<*> v .: "home_game_stats"
|
|
||||||
<*> v .: "away_game_stats"
|
|
||||||
|
|
||||||
instance ToJSON Database where
|
|
||||||
toJSON (Database players goalies games hgs ags) = object
|
|
||||||
[ "players" .= players
|
|
||||||
, "goalies" .= goalies
|
|
||||||
, "games" .= games
|
|
||||||
, "home_game_stats" .= hgs
|
|
||||||
, "away_game_stats" .= ags
|
|
||||||
]
|
|
||||||
toEncoding (Database players goalies games hgs ags) = pairs $
|
|
||||||
"players" .= players <>
|
|
||||||
"goalies" .= goalies <>
|
|
||||||
"games" .= games <>
|
|
||||||
"home_game_stats" .= hgs <>
|
|
||||||
"away_game_stats" .= ags
|
|
||||||
|
|
||||||
-- | Represents a (non-goalie) player
|
-- | Represents a (non-goalie) player
|
||||||
data Player = Player
|
data Player = Player
|
||||||
{ _pNumber :: Int
|
{ _pNumber :: Int
|
||||||
@@ -426,35 +472,16 @@ data Player = Player
|
|||||||
-- ^ The player's name
|
-- ^ The player's name
|
||||||
, _pPosition :: String
|
, _pPosition :: String
|
||||||
-- ^ The player's position
|
-- ^ The player's position
|
||||||
|
, _pRookie :: Bool
|
||||||
|
-- ^ Indicates that the player is a rookie
|
||||||
|
, _pActive :: Bool
|
||||||
|
-- ^ Indicates that the player is active
|
||||||
, _pYtd :: PlayerStats
|
, _pYtd :: PlayerStats
|
||||||
-- ^ The Player's year-to-date stats
|
-- ^ The Player's year-to-date stats
|
||||||
, _pLifetime :: PlayerStats
|
, _pLifetime :: PlayerStats
|
||||||
-- ^ The player's lifetime stats
|
-- ^ The player's lifetime stats
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
instance FromJSON Player where
|
|
||||||
parseJSON = withObject "Player" $ \v -> Player
|
|
||||||
<$> v .: "number"
|
|
||||||
<*> v .: "name"
|
|
||||||
<*> v .: "position"
|
|
||||||
<*> v .: "ytd"
|
|
||||||
<*> v .: "lifetime"
|
|
||||||
|
|
||||||
instance ToJSON Player where
|
|
||||||
toJSON (Player num name pos ytd lt) = object
|
|
||||||
[ "number" .= num
|
|
||||||
, "name" .= name
|
|
||||||
, "position" .= pos
|
|
||||||
, "ytd" .= ytd
|
|
||||||
, "lifetime" .= lt
|
|
||||||
]
|
|
||||||
toEncoding (Player num name pos ytd lt) = pairs $
|
|
||||||
"number" .= num <>
|
|
||||||
"name" .= name <>
|
|
||||||
"position" .= pos <>
|
|
||||||
"ytd" .= ytd <>
|
|
||||||
"lifetime" .= lt
|
|
||||||
|
|
||||||
-- | Represents a (non-goalie) player's stats
|
-- | Represents a (non-goalie) player's stats
|
||||||
data PlayerStats = PlayerStats
|
data PlayerStats = PlayerStats
|
||||||
{ _psGoals :: Int
|
{ _psGoals :: Int
|
||||||
@@ -465,55 +492,22 @@ data PlayerStats = PlayerStats
|
|||||||
-- ^ The number of penalty minutes
|
-- ^ The number of penalty minutes
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
instance FromJSON PlayerStats where
|
|
||||||
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
|
|
||||||
<$> v .: "goals"
|
|
||||||
<*> v .: "assists"
|
|
||||||
<*> v .: "penalty_mins"
|
|
||||||
|
|
||||||
instance ToJSON PlayerStats where
|
|
||||||
toJSON (PlayerStats g a pm) = object
|
|
||||||
[ "goals" .= g
|
|
||||||
, "assists" .= a
|
|
||||||
, "penalty_mins" .= pm
|
|
||||||
]
|
|
||||||
toEncoding (PlayerStats g a pm) = pairs $
|
|
||||||
"goals" .= g <>
|
|
||||||
"assists" .= a <>
|
|
||||||
"penalty_mins" .= pm
|
|
||||||
|
|
||||||
-- | Represents a goalie
|
-- | Represents a goalie
|
||||||
data Goalie = Goalie
|
data Goalie = Goalie
|
||||||
{ _gNumber :: Int
|
{ _gNumber :: Int
|
||||||
-- ^ The goalie's number
|
-- ^ The goalie's number
|
||||||
, _gName :: String
|
, _gName :: String
|
||||||
-- ^ The goalie's name
|
-- ^ The goalie's name
|
||||||
|
, _gRookie :: Bool
|
||||||
|
-- ^ Indicates that the goalie is a rookie
|
||||||
|
, _gActive :: Bool
|
||||||
|
-- ^ Indicates that the goalie is active
|
||||||
, _gYtd :: GoalieStats
|
, _gYtd :: GoalieStats
|
||||||
-- ^ The goalie's year-to-date stats
|
-- ^ The goalie's year-to-date stats
|
||||||
, _gLifetime :: GoalieStats
|
, _gLifetime :: GoalieStats
|
||||||
-- ^ The goalie's lifetime stats
|
-- ^ The goalie's lifetime stats
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
instance FromJSON Goalie where
|
|
||||||
parseJSON = withObject "Goalie" $ \v -> Goalie
|
|
||||||
<$> v .: "number"
|
|
||||||
<*> v .: "name"
|
|
||||||
<*> v .: "ytd"
|
|
||||||
<*> v .: "lifetime"
|
|
||||||
|
|
||||||
instance ToJSON Goalie where
|
|
||||||
toJSON (Goalie num name ytd lt) = object
|
|
||||||
[ "number" .= num
|
|
||||||
, "name" .= name
|
|
||||||
, "ytd" .= ytd
|
|
||||||
, "lifetime" .= lt
|
|
||||||
]
|
|
||||||
toEncoding (Goalie num name ytd lt) = pairs $
|
|
||||||
"number" .= num <>
|
|
||||||
"name" .= name <>
|
|
||||||
"ytd" .= ytd <>
|
|
||||||
"lifetime" .= lt
|
|
||||||
|
|
||||||
-- | Represents a goalie's stats
|
-- | Represents a goalie's stats
|
||||||
data GoalieStats = GoalieStats
|
data GoalieStats = GoalieStats
|
||||||
{ _gsGames :: Int
|
{ _gsGames :: Int
|
||||||
@@ -532,6 +526,168 @@ data GoalieStats = GoalieStats
|
|||||||
-- ^ The number of ties
|
-- ^ The number of ties
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Game statistics
|
||||||
|
data GameStats = GameStats
|
||||||
|
{ _gmsWins :: Int
|
||||||
|
-- ^ Games won
|
||||||
|
, _gmsLosses :: Int
|
||||||
|
-- ^ Games lost
|
||||||
|
, _gmsOvertime :: Int
|
||||||
|
-- ^ Games lost in overtime
|
||||||
|
, _gmsGoalsFor :: Int
|
||||||
|
-- ^ Goals for the team
|
||||||
|
, _gmsGoalsAgainst :: Int
|
||||||
|
-- ^ Goals against the team
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Defines a user prompt
|
||||||
|
data Prompt = Prompt
|
||||||
|
{ drawPrompt :: ProgState -> Widget ()
|
||||||
|
-- ^ Draws the prompt to the screen
|
||||||
|
, promptProcessChar :: Char -> Editor String () -> Editor String ()
|
||||||
|
-- ^ Modifies an editor based on the character entered
|
||||||
|
, promptAction :: String -> Action ()
|
||||||
|
-- ^ Action to perform when the value is entered
|
||||||
|
, promptSpecialKey :: Key -> [Modifier] -> Action ()
|
||||||
|
-- ^ Action to perform when a special key is pressed
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Parameters for a search prompt
|
||||||
|
data SelectParams a = SelectParams
|
||||||
|
{ spPrompt :: String
|
||||||
|
-- ^ The search prompt
|
||||||
|
, spSearchHeader :: String
|
||||||
|
-- ^ The header to display at the top of the search list
|
||||||
|
, spSearch :: String -> Database -> [(Int, a)]
|
||||||
|
-- ^ The search function
|
||||||
|
, spSearchExact :: String -> Database -> Maybe Int
|
||||||
|
-- ^ Search function looking for an exact match
|
||||||
|
, spElemDesc :: a -> String
|
||||||
|
-- ^ Provides a string description of an element
|
||||||
|
, spProcessChar :: Char -> Editor String () -> Editor String ()
|
||||||
|
-- ^ Processes a character entered by the user
|
||||||
|
, spCallback :: Maybe Int -> Action ()
|
||||||
|
-- ^ The function when the selection is made
|
||||||
|
, spNotFound :: String -> Action ()
|
||||||
|
-- ^ The function to call when the selection doesn't exist
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Describes a table cell
|
||||||
|
data TableCell
|
||||||
|
= CellText String
|
||||||
|
-- ^ A cell with text
|
||||||
|
| CellFill Char
|
||||||
|
-- ^ A cell filled with the given character
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
makeLenses ''ProgState
|
||||||
|
makeLenses ''GameState
|
||||||
|
makeLenses ''CreatePlayerState
|
||||||
|
makeLenses ''CreateGoalieState
|
||||||
|
makeLenses ''EditPlayerState
|
||||||
|
makeLenses ''EditGoalieState
|
||||||
|
makeLenses ''Database
|
||||||
|
makeLenses ''Player
|
||||||
|
makeLenses ''PlayerStats
|
||||||
|
makeLenses ''Goalie
|
||||||
|
makeLenses ''GoalieStats
|
||||||
|
makeLenses ''GameStats
|
||||||
|
|
||||||
|
instance FromJSON Database where
|
||||||
|
parseJSON = withObject "Database" $ \v -> Database
|
||||||
|
<$> v .:? "players" .!= []
|
||||||
|
<*> v .:? "goalies" .!= []
|
||||||
|
<*> v .:? "games" .!= 0
|
||||||
|
<*> v .:? "home_game_stats" .!= newGameStats
|
||||||
|
<*> v .:? "away_game_stats" .!= newGameStats
|
||||||
|
|
||||||
|
instance ToJSON Database where
|
||||||
|
toJSON (Database players goalies games hgs ags) = object
|
||||||
|
[ "players" .= players
|
||||||
|
, "goalies" .= goalies
|
||||||
|
, "games" .= games
|
||||||
|
, "home_game_stats" .= hgs
|
||||||
|
, "away_game_stats" .= ags
|
||||||
|
]
|
||||||
|
toEncoding (Database players goalies games hgs ags) = pairs $
|
||||||
|
"players" .= players <>
|
||||||
|
"goalies" .= goalies <>
|
||||||
|
"games" .= games <>
|
||||||
|
"home_game_stats" .= hgs <>
|
||||||
|
"away_game_stats" .= ags
|
||||||
|
|
||||||
|
instance FromJSON Player where
|
||||||
|
parseJSON = withObject "Player" $ \v -> Player
|
||||||
|
<$> v .: "number"
|
||||||
|
<*> v .: "name"
|
||||||
|
<*> v .: "position"
|
||||||
|
<*> v .:? "rookie" .!= False
|
||||||
|
<*> v .:? "active" .!= True
|
||||||
|
<*> v .:? "ytd" .!= newPlayerStats
|
||||||
|
<*> v .:? "lifetime" .!= newPlayerStats
|
||||||
|
|
||||||
|
instance ToJSON Player where
|
||||||
|
toJSON (Player num name pos rk act ytd lt) = object
|
||||||
|
[ "number" .= num
|
||||||
|
, "name" .= name
|
||||||
|
, "position" .= pos
|
||||||
|
, "rookie" .= rk
|
||||||
|
, "active" .= act
|
||||||
|
, "ytd" .= ytd
|
||||||
|
, "lifetime" .= lt
|
||||||
|
]
|
||||||
|
toEncoding (Player num name pos rk act ytd lt) = pairs $
|
||||||
|
"number" .= num <>
|
||||||
|
"name" .= name <>
|
||||||
|
"position" .= pos <>
|
||||||
|
"rookie" .= rk <>
|
||||||
|
"active" .= act <>
|
||||||
|
"ytd" .= ytd <>
|
||||||
|
"lifetime" .= lt
|
||||||
|
|
||||||
|
instance FromJSON PlayerStats where
|
||||||
|
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
|
||||||
|
<$> v .:? "goals" .!= 0
|
||||||
|
<*> v .:? "assists" .!= 0
|
||||||
|
<*> v .:? "penalty_mins" .!= 0
|
||||||
|
|
||||||
|
instance ToJSON PlayerStats where
|
||||||
|
toJSON (PlayerStats g a pm) = object
|
||||||
|
[ "goals" .= g
|
||||||
|
, "assists" .= a
|
||||||
|
, "penalty_mins" .= pm
|
||||||
|
]
|
||||||
|
toEncoding (PlayerStats g a pm) = pairs $
|
||||||
|
"goals" .= g <>
|
||||||
|
"assists" .= a <>
|
||||||
|
"penalty_mins" .= pm
|
||||||
|
|
||||||
|
instance FromJSON Goalie where
|
||||||
|
parseJSON = withObject "Goalie" $ \v -> Goalie
|
||||||
|
<$> v .: "number"
|
||||||
|
<*> v .: "name"
|
||||||
|
<*> v .:? "rookie" .!= False
|
||||||
|
<*> v .:? "active" .!= True
|
||||||
|
<*> v .:? "ytd" .!= newGoalieStats
|
||||||
|
<*> v .:? "lifetime" .!= newGoalieStats
|
||||||
|
|
||||||
|
instance ToJSON Goalie where
|
||||||
|
toJSON (Goalie num name rk act ytd lt) = object
|
||||||
|
[ "number" .= num
|
||||||
|
, "name" .= name
|
||||||
|
, "ytd" .= ytd
|
||||||
|
, "rookie" .= rk
|
||||||
|
, "active" .= act
|
||||||
|
, "lifetime" .= lt
|
||||||
|
]
|
||||||
|
toEncoding (Goalie num name rk act ytd lt) = pairs $
|
||||||
|
"number" .= num <>
|
||||||
|
"name" .= name <>
|
||||||
|
"rookie" .= rk <>
|
||||||
|
"active" .= act <>
|
||||||
|
"ytd" .= ytd <>
|
||||||
|
"lifetime" .= lt
|
||||||
|
|
||||||
instance FromJSON GoalieStats where
|
instance FromJSON GoalieStats where
|
||||||
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
|
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
|
||||||
<$> v .:? "games" .!= 0
|
<$> v .:? "games" .!= 0
|
||||||
@@ -561,20 +717,6 @@ instance ToJSON GoalieStats where
|
|||||||
"losses" .= l <>
|
"losses" .= l <>
|
||||||
"ties" .= t
|
"ties" .= t
|
||||||
|
|
||||||
-- | Game statistics
|
|
||||||
data GameStats = GameStats
|
|
||||||
{ _gmsWins :: Int
|
|
||||||
-- ^ Games won
|
|
||||||
, _gmsLosses :: Int
|
|
||||||
-- ^ Games lost
|
|
||||||
, _gmsOvertime :: Int
|
|
||||||
-- ^ Games lost in overtime
|
|
||||||
, _gmsGoalsFor :: Int
|
|
||||||
-- ^ Goals for the team
|
|
||||||
, _gmsGoalsAgainst :: Int
|
|
||||||
-- ^ Goals against the team
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
instance FromJSON GameStats where
|
instance FromJSON GameStats where
|
||||||
parseJSON = withObject "GameStats" $ \v -> GameStats
|
parseJSON = withObject "GameStats" $ \v -> GameStats
|
||||||
<$> v .: "wins"
|
<$> v .: "wins"
|
||||||
@@ -598,57 +740,6 @@ instance ToJSON GameStats where
|
|||||||
"goals_for" .= gf <>
|
"goals_for" .= gf <>
|
||||||
"goals_against" .= ga
|
"goals_against" .= ga
|
||||||
|
|
||||||
-- | Defines a user prompt
|
|
||||||
data Prompt = Prompt
|
|
||||||
{ promptDrawer :: ProgState -> C.Update ()
|
|
||||||
-- ^ Draws the prompt to the screen
|
|
||||||
, promptProcessChar :: Char -> String -> String
|
|
||||||
-- ^ Modifies the string based on the character entered
|
|
||||||
, promptAction :: String -> Action ()
|
|
||||||
-- ^ Action to perform when the value is entered
|
|
||||||
, promptSpecialKey :: C.Key -> Action ()
|
|
||||||
-- ^ Action to perform when a special key is pressed
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Parameters for a search prompt
|
|
||||||
data SelectParams a = SelectParams
|
|
||||||
{ spPrompt :: String
|
|
||||||
-- ^ The search prompt
|
|
||||||
, spSearchHeader :: String
|
|
||||||
-- ^ The header to display at the top of the search list
|
|
||||||
, spSearch :: String -> Database -> [(Int, a)]
|
|
||||||
-- ^ The search function
|
|
||||||
, spSearchExact :: String -> Database -> Maybe Int
|
|
||||||
-- ^ Search function looking for an exact match
|
|
||||||
, spElemDesc :: a -> String
|
|
||||||
-- ^ Provides a string description of an element
|
|
||||||
, spCallback :: Maybe Int -> Action ()
|
|
||||||
-- ^ The function when the selection is made
|
|
||||||
, spNotFound :: String -> Action ()
|
|
||||||
-- ^ The function to call when the selection doesn't exist
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Describes a table cell
|
|
||||||
data TableCell
|
|
||||||
= CellText String
|
|
||||||
-- ^ A cell with text
|
|
||||||
| CellFill Char
|
|
||||||
-- ^ A cell filled with the given character
|
|
||||||
deriving (Eq, Show)
|
|
||||||
|
|
||||||
makeLenses ''ProgState
|
|
||||||
makeLenses ''GameState
|
|
||||||
makeLenses ''CreatePlayerState
|
|
||||||
makeLenses ''CreateGoalieState
|
|
||||||
makeLenses ''EditPlayerState
|
|
||||||
makeLenses ''EditGoalieState
|
|
||||||
makeLenses ''Database
|
|
||||||
makeLenses ''Player
|
|
||||||
makeLenses ''PlayerStats
|
|
||||||
makeLenses ''Goalie
|
|
||||||
makeLenses ''GoalieStats
|
|
||||||
makeLenses ''GameStats
|
|
||||||
|
|
||||||
gameStateL :: Lens' ProgMode GameState
|
gameStateL :: Lens' ProgMode GameState
|
||||||
gameStateL = lens
|
gameStateL = lens
|
||||||
(\case
|
(\case
|
||||||
@@ -684,13 +775,32 @@ editGoalieStateL = lens
|
|||||||
_ -> newEditGoalieState)
|
_ -> newEditGoalieState)
|
||||||
(\_ egs -> EditGoalie egs)
|
(\_ egs -> EditGoalie egs)
|
||||||
|
|
||||||
|
editStandingsModeL :: Lens' ProgMode EditStandingsMode
|
||||||
|
editStandingsModeL = lens
|
||||||
|
(\case
|
||||||
|
EditStandings esm -> esm
|
||||||
|
_ -> ESMMenu)
|
||||||
|
(\_ esm -> EditStandings esm)
|
||||||
|
|
||||||
|
esmSubModeL :: Lens' EditStandingsMode ESMSubMode
|
||||||
|
esmSubModeL = lens
|
||||||
|
(\case
|
||||||
|
ESMMenu -> ESMSubMenu
|
||||||
|
ESMHome m -> m
|
||||||
|
ESMAway m -> m)
|
||||||
|
(\mode subMode -> case mode of
|
||||||
|
ESMMenu -> ESMMenu
|
||||||
|
ESMHome _ -> ESMHome subMode
|
||||||
|
ESMAway _ -> ESMAway subMode)
|
||||||
|
|
||||||
-- | Constructor for a 'ProgState'
|
-- | Constructor for a 'ProgState'
|
||||||
newProgState :: ProgState
|
newProgState :: ProgState
|
||||||
newProgState = ProgState
|
newProgState = ProgState
|
||||||
{ _database = newDatabase
|
{ _database = newDatabase
|
||||||
, _progMode = MainMenu
|
, _progMode = TitleScreen
|
||||||
, _inputBuffer = ""
|
, _dbName = ""
|
||||||
, _scrollOffset = 0
|
, _editorW = editor () (Just 1) ""
|
||||||
|
, _scroller = viewportScroll ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'GameState'
|
-- | Constructor for a 'GameState'
|
||||||
@@ -726,6 +836,8 @@ newCreatePlayerState = CreatePlayerState
|
|||||||
{ _cpsNumber = Nothing
|
{ _cpsNumber = Nothing
|
||||||
, _cpsName = ""
|
, _cpsName = ""
|
||||||
, _cpsPosition = ""
|
, _cpsPosition = ""
|
||||||
|
, _cpsRookieFlag = Nothing
|
||||||
|
, _cpsActiveFlag = Nothing
|
||||||
, _cpsSuccessCallback = return ()
|
, _cpsSuccessCallback = return ()
|
||||||
, _cpsFailureCallback = return ()
|
, _cpsFailureCallback = return ()
|
||||||
}
|
}
|
||||||
@@ -735,6 +847,8 @@ newCreateGoalieState :: CreateGoalieState
|
|||||||
newCreateGoalieState = CreateGoalieState
|
newCreateGoalieState = CreateGoalieState
|
||||||
{ _cgsNumber = Nothing
|
{ _cgsNumber = Nothing
|
||||||
, _cgsName = ""
|
, _cgsName = ""
|
||||||
|
, _cgsRookieFlag = Nothing
|
||||||
|
, _cgsActiveFlag = Nothing
|
||||||
, _cgsSuccessCallback = return ()
|
, _cgsSuccessCallback = return ()
|
||||||
, _cgsFailureCallback = return ()
|
, _cgsFailureCallback = return ()
|
||||||
}
|
}
|
||||||
@@ -744,6 +858,7 @@ newEditPlayerState :: EditPlayerState
|
|||||||
newEditPlayerState = EditPlayerState
|
newEditPlayerState = EditPlayerState
|
||||||
{ _epsSelectedPlayer = Nothing
|
{ _epsSelectedPlayer = Nothing
|
||||||
, _epsMode = EPMenu
|
, _epsMode = EPMenu
|
||||||
|
, _epsCallback = return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for an 'EditGoalieState' value
|
-- | Constructor for an 'EditGoalieState' value
|
||||||
@@ -751,6 +866,7 @@ newEditGoalieState :: EditGoalieState
|
|||||||
newEditGoalieState = EditGoalieState
|
newEditGoalieState = EditGoalieState
|
||||||
{ _egsSelectedGoalie = Nothing
|
{ _egsSelectedGoalie = Nothing
|
||||||
, _egsMode = EGMenu
|
, _egsMode = EGMenu
|
||||||
|
, _egsCallback = return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'Database'
|
-- | Constructor for a 'Database'
|
||||||
@@ -776,6 +892,8 @@ newPlayer num name pos = Player
|
|||||||
{ _pNumber = num
|
{ _pNumber = num
|
||||||
, _pName = name
|
, _pName = name
|
||||||
, _pPosition = pos
|
, _pPosition = pos
|
||||||
|
, _pRookie = True
|
||||||
|
, _pActive = True
|
||||||
, _pYtd = newPlayerStats
|
, _pYtd = newPlayerStats
|
||||||
, _pLifetime = newPlayerStats
|
, _pLifetime = newPlayerStats
|
||||||
}
|
}
|
||||||
@@ -798,6 +916,8 @@ newGoalie
|
|||||||
newGoalie num name = Goalie
|
newGoalie num name = Goalie
|
||||||
{ _gNumber = num
|
{ _gNumber = num
|
||||||
, _gName = name
|
, _gName = name
|
||||||
|
, _gRookie = True
|
||||||
|
, _gActive = True
|
||||||
, _gYtd = newGoalieStats
|
, _gYtd = newGoalieStats
|
||||||
, _gLifetime = newGoalieStats
|
, _gLifetime = newGoalieStats
|
||||||
}
|
}
|
||||||
@@ -895,6 +1015,23 @@ addGameStats s1 s2 = GameStats
|
|||||||
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
|
, _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
|
-- | Searches through a list of players
|
||||||
playerSearch
|
playerSearch
|
||||||
:: String
|
:: String
|
||||||
@@ -903,9 +1040,17 @@ playerSearch
|
|||||||
-- ^ The list of players to search
|
-- ^ The list of players to search
|
||||||
-> [(Int, Player)]
|
-> [(Int, Player)]
|
||||||
-- ^ The matching players with their index numbers
|
-- ^ The matching players with their index numbers
|
||||||
playerSearch sStr =
|
playerSearch = playerSearchWith $ const True
|
||||||
filter match . zip [0..]
|
|
||||||
where match (_, p) = map toUpper sStr `isInfixOf` map toUpper (p^.pName)
|
-- | 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
|
-- | Searches for a player by exact match on name
|
||||||
playerSearchExact
|
playerSearchExact
|
||||||
@@ -916,7 +1061,7 @@ playerSearchExact
|
|||||||
-> Maybe (Int, Player)
|
-> Maybe (Int, Player)
|
||||||
-- ^ The player's index and value
|
-- ^ The player's index and value
|
||||||
playerSearchExact sStr =
|
playerSearchExact sStr =
|
||||||
listToMaybe . filter match . zip [0..]
|
find match . zip [0..]
|
||||||
where match (_, p) = p^.pName == sStr
|
where match (_, p) = p^.pName == sStr
|
||||||
|
|
||||||
-- | Modifies a player with a given name
|
-- | Modifies a player with a given name
|
||||||
@@ -960,6 +1105,23 @@ addPlayerStats s1 s2 = newPlayerStats
|
|||||||
& psAssists .~ s1^.psAssists + s2^.psAssists
|
& psAssists .~ s1^.psAssists + s2^.psAssists
|
||||||
& psPMin .~ s1^.psPMin + s2^.psPMin
|
& 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
|
-- | Searches a list of goalies
|
||||||
goalieSearch
|
goalieSearch
|
||||||
:: String
|
:: String
|
||||||
@@ -968,9 +1130,17 @@ goalieSearch
|
|||||||
-- ^ The list to search
|
-- ^ The list to search
|
||||||
-> [(Int, Goalie)]
|
-> [(Int, Goalie)]
|
||||||
-- ^ The search results with their corresponding index numbers
|
-- ^ The search results with their corresponding index numbers
|
||||||
goalieSearch sStr =
|
goalieSearch = goalieSearchWith $ const True
|
||||||
filter match . zip [0..]
|
|
||||||
where match (_, g) = map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
-- | 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
|
-- | Searches a list of goalies for an exact match
|
||||||
goalieSearchExact
|
goalieSearchExact
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -39,6 +39,7 @@ module Mtlstats.Types.Menu (
|
|||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
import Lens.Micro.TH (makeLenses)
|
import Lens.Micro.TH (makeLenses)
|
||||||
|
|
||||||
|
import Mtlstats.Format
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
-- | Defines a menu
|
-- | Defines a menu
|
||||||
@@ -65,8 +66,15 @@ makeLenses ''Menu
|
|||||||
makeLenses ''MenuItem
|
makeLenses ''MenuItem
|
||||||
|
|
||||||
instance Show (Menu a) where
|
instance Show (Menu a) where
|
||||||
show m = m ^. menuTitle ++ "\n" ++ items
|
show m = unlines
|
||||||
where items = unlines $ map show $ m ^. menuItems
|
$ [ m^.menuTitle
|
||||||
|
, ""
|
||||||
|
]
|
||||||
|
++ body
|
||||||
|
where
|
||||||
|
body = map (left width) items
|
||||||
|
width = maximum $ map length items
|
||||||
|
items = map show $ m^.menuItems
|
||||||
|
|
||||||
instance Show (MenuItem a) where
|
instance Show (MenuItem a) where
|
||||||
show i = [i ^. miKey] ++ ") " ++ i ^. miDescription
|
show i = [i ^. miKey] ++ ": " ++ i ^. miDescription
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,9 +19,26 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
|
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 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
|
-- | Attempt to select the element from a list at a given index
|
||||||
nth
|
nth
|
||||||
@@ -45,8 +62,21 @@ modifyNth
|
|||||||
-> [a]
|
-> [a]
|
||||||
-- ^ The list
|
-- ^ The list
|
||||||
-> [a]
|
-> [a]
|
||||||
modifyNth n f = map (\(i, x) -> if i == n then f x else x)
|
modifyNth n f = zipWith
|
||||||
. zip [0..]
|
(\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
|
-- | Modify a value indexed by a given key in a map using a default
|
||||||
-- initial value if not present
|
-- initial value if not present
|
||||||
@@ -75,3 +105,45 @@ slice
|
|||||||
-- ^ The list to take a subset of
|
-- ^ The list to take a subset of
|
||||||
-> [a]
|
-> [a]
|
||||||
slice offset len = take len . drop offset
|
slice offset len = take len . drop offset
|
||||||
|
|
||||||
|
-- | Name capitalization function for a player
|
||||||
|
capitalizeName
|
||||||
|
:: Char
|
||||||
|
-- ^ The character being input
|
||||||
|
-> Editor String ()
|
||||||
|
-- ^ The current string
|
||||||
|
-> Editor String ()
|
||||||
|
-- ^ The resulting string
|
||||||
|
capitalizeName ch e = e & editContentsL %~ insertChar ch'
|
||||||
|
where
|
||||||
|
s = e^.to userText
|
||||||
|
ch' = if lockFlag s
|
||||||
|
then toUpper ch
|
||||||
|
else ch
|
||||||
|
lockFlag "" = True
|
||||||
|
lockFlag (c:cs)
|
||||||
|
| c == ',' = lockFlag' cs
|
||||||
|
| otherwise = lockFlag cs
|
||||||
|
lockFlag' "" = True
|
||||||
|
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: ./custom-snapshot.yaml
|
||||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||||
resolver: lts-14.0
|
resolver: lts-20.22
|
||||||
|
|
||||||
# User packages to be built.
|
# User packages to be built.
|
||||||
# Various formats can be used as shown in the example below.
|
# Various formats can be used as shown in the example below.
|
||||||
|
|||||||
@@ -7,13 +7,13 @@ packages:
|
|||||||
- completed:
|
- completed:
|
||||||
hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
|
hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
|
||||||
pantry-tree:
|
pantry-tree:
|
||||||
size: 674
|
|
||||||
sha256: 093bdc85ed518c81724f5b6b81c24ab4ebdd231551861f4feaa43361136f70b7
|
sha256: 093bdc85ed518c81724f5b6b81c24ab4ebdd231551861f4feaa43361136f70b7
|
||||||
|
size: 674
|
||||||
original:
|
original:
|
||||||
hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
|
hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
|
||||||
snapshots:
|
snapshots:
|
||||||
- completed:
|
- completed:
|
||||||
size: 523443
|
sha256: dcf4fc28f12d805480ddbe8eb8c370e11db12f0461d0110a4240af27ac88d725
|
||||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/0.yaml
|
size: 650255
|
||||||
sha256: 283773e7120f5446d961eab35ea95c9af9c24187cc178537bd29273200a05171
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/22.yaml
|
||||||
original: lts-14.0
|
original: lts-20.22
|
||||||
|
|||||||
@@ -1,537 +0,0 @@
|
|||||||
{-
|
|
||||||
|
|
||||||
mtlstats
|
|
||||||
Copyright (C) 2019 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 Actions.EditGoalieSpec (spec) where
|
|
||||||
|
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Lens.Micro ((^.), (&), (.~))
|
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
|
||||||
|
|
||||||
import Mtlstats.Actions.EditGoalie
|
|
||||||
import Mtlstats.Types
|
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec = describe "EditGoalie" $ do
|
|
||||||
editGoalieNumberSpec
|
|
||||||
editGoalieNameSpec
|
|
||||||
editGoalieYtdGamesSpec
|
|
||||||
editGoalieYtdMinsSpec
|
|
||||||
editGoalieYtdGoalsSpec
|
|
||||||
editGoalieYtdWinsSpec
|
|
||||||
editGoalieYtdLossesSpec
|
|
||||||
editGoalieYtdTiesSpec
|
|
||||||
editGoalieLtGamesSpec
|
|
||||||
editGoalieLtMinsSpec
|
|
||||||
editGoalieLtGoalsSpec
|
|
||||||
editGoalieLtWinsSpec
|
|
||||||
editGoalieLtLossesSpec
|
|
||||||
editGoalieLtTiesSpec
|
|
||||||
|
|
||||||
editGoalieNumberSpec :: Spec
|
|
||||||
editGoalieNumberSpec = describe "editGoalieNumber" $ editTest
|
|
||||||
(editGoalieNumber 5)
|
|
||||||
EGNumber
|
|
||||||
(uncurry newGoalie)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, (5, "Joe")
|
|
||||||
, (3, "Bob")
|
|
||||||
, EGMenu
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, (2, "Joe")
|
|
||||||
, (5, "Bob")
|
|
||||||
, EGMenu
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, (2, "Joe")
|
|
||||||
, (3, "Bob")
|
|
||||||
, EGNumber
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, (2, "Joe")
|
|
||||||
, (3, "Bob")
|
|
||||||
, EGNumber
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieNameSpec :: Spec
|
|
||||||
editGoalieNameSpec = describe "editGoalieName" $ editTest
|
|
||||||
(editGoalieName "foo")
|
|
||||||
EGName
|
|
||||||
(uncurry newGoalie)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "foo" )
|
|
||||||
, ( 3, "Bob" )
|
|
||||||
, EGMenu
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe" )
|
|
||||||
, ( 3, "foo" )
|
|
||||||
, EGMenu
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe" )
|
|
||||||
, ( 3, "Bob" )
|
|
||||||
, EGName
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe" )
|
|
||||||
, ( 3, "Bob" )
|
|
||||||
, EGName
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieYtdGamesSpec :: Spec
|
|
||||||
editGoalieYtdGamesSpec = describe "editGoalieYtdGames" $ editTest
|
|
||||||
(editGoalieYtdGames 1)
|
|
||||||
EGYtdGames
|
|
||||||
(\(num, name, games) -> newGoalie num name & gYtd.gsGames .~ games)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdGames
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdGames
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieYtdMinsSpec :: Spec
|
|
||||||
editGoalieYtdMinsSpec = describe "editGoalieYtdMins" $ editTest
|
|
||||||
(editGoalieYtdMins 1)
|
|
||||||
EGYtdMins
|
|
||||||
(\(num, name, mins) -> newGoalie num name & gYtd.gsMinsPlayed .~ mins)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, (2, "Joe", 0 )
|
|
||||||
, (3, "Bob", 1 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdMins
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdMins
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieYtdGoalsSpec :: Spec
|
|
||||||
editGoalieYtdGoalsSpec = describe "editGoalieYtdGoals" $ editTest
|
|
||||||
(editGoalieYtdGoals 1)
|
|
||||||
EGYtdGoals
|
|
||||||
(\(num, name, goals) -> newGoalie num name & gYtd.gsGoalsAllowed .~ goals)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdGoals
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdGoals
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieYtdWinsSpec :: Spec
|
|
||||||
editGoalieYtdWinsSpec = describe "editGoalieYtdWins" $ editTest
|
|
||||||
(editGoalieYtdWins 1)
|
|
||||||
EGYtdWins
|
|
||||||
(\(num, name, wins) -> newGoalie num name & gYtd.gsWins .~ wins)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdWins
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdWins
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieYtdLossesSpec :: Spec
|
|
||||||
editGoalieYtdLossesSpec = describe "editGoalieYtdLosses" $ editTest
|
|
||||||
(editGoalieYtdLosses 1)
|
|
||||||
EGYtdLosses
|
|
||||||
(\(num, name, losses) -> newGoalie num name & gYtd.gsLosses .~ losses)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdLosses
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdLosses
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieYtdTiesSpec :: Spec
|
|
||||||
editGoalieYtdTiesSpec = describe "editGoalieYtdTies" $ editTest
|
|
||||||
(editGoalieYtdTies 1)
|
|
||||||
EGYtdTies
|
|
||||||
(\(num, name, ties) -> newGoalie num name & gYtd.gsTies .~ ties)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGYtd
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdTies
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGYtdTies
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieLtGamesSpec :: Spec
|
|
||||||
editGoalieLtGamesSpec = describe "editGoalieLtGames" $ editTest
|
|
||||||
(editGoalieLtGames 1)
|
|
||||||
EGLtGames
|
|
||||||
(\(num, name, games) -> newGoalie num name & gLifetime.gsGames .~ games)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtGames
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtGames
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieLtMinsSpec :: Spec
|
|
||||||
editGoalieLtMinsSpec = describe "editGoalieLtMins" $ editTest
|
|
||||||
(editGoalieLtMins 1)
|
|
||||||
EGLtMins
|
|
||||||
(\(num, name, mins) -> newGoalie num name & gLifetime.gsMinsPlayed .~ mins)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtMins
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtMins
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieLtGoalsSpec :: Spec
|
|
||||||
editGoalieLtGoalsSpec = describe "editGoalieLtGoals" $ editTest
|
|
||||||
(editGoalieLtGoals 1)
|
|
||||||
EGLtGoals
|
|
||||||
(\(num, name, goals) -> newGoalie num name & gLifetime.gsGoalsAllowed .~ goals)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtGoals
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtGoals
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieLtWinsSpec :: Spec
|
|
||||||
editGoalieLtWinsSpec = describe "editGoalieLtWins" $ editTest
|
|
||||||
(editGoalieLtWins 1)
|
|
||||||
EGLtWins
|
|
||||||
(\(num, name, wins) -> newGoalie num name & gLifetime.gsWins .~ wins)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtWins
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtWins
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieLtLossesSpec :: Spec
|
|
||||||
editGoalieLtLossesSpec = describe "editGoalieLtLosses" $ editTest
|
|
||||||
(editGoalieLtLosses 1)
|
|
||||||
EGLtLosses
|
|
||||||
(\(num, name, losses) -> newGoalie num name & gLifetime.gsLosses .~ losses)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtLosses
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtLosses
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editGoalieLtTiesSpec :: Spec
|
|
||||||
editGoalieLtTiesSpec = describe "editGoalieLtTies" $ editTest
|
|
||||||
(editGoalieLtTies 1)
|
|
||||||
EGLtTies
|
|
||||||
(\(num, name, ties) -> newGoalie num name & gLifetime.gsTies .~ ties)
|
|
||||||
[ ( "set Joe"
|
|
||||||
, Just 0
|
|
||||||
, ( 2, "Joe", 1 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "set Bob"
|
|
||||||
, Just 1
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 1 )
|
|
||||||
, EGLifetime
|
|
||||||
)
|
|
||||||
, ( "out of bounds"
|
|
||||||
, Just 2
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtTies
|
|
||||||
)
|
|
||||||
, ( "no goalie selected"
|
|
||||||
, Nothing
|
|
||||||
, ( 2, "Joe", 0 )
|
|
||||||
, ( 3, "Bob", 0 )
|
|
||||||
, EGLtTies
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
editTest
|
|
||||||
:: (ProgState -> ProgState)
|
|
||||||
-> EditGoalieMode
|
|
||||||
-> (a -> Goalie)
|
|
||||||
-> [(String, Maybe Int, a, a, EditGoalieMode)]
|
|
||||||
-> Spec
|
|
||||||
editTest func setMode mkGoalie params = do
|
|
||||||
mapM_
|
|
||||||
(\(setLabel, setGid, joeData, bobData, expectMode) -> context setLabel $ do
|
|
||||||
let
|
|
||||||
egs = newEditGoalieState
|
|
||||||
& egsSelectedGoalie .~ setGid
|
|
||||||
& egsMode .~ setMode
|
|
||||||
|
|
||||||
ps = func $ progState $ EditGoalie egs
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(chkLabel, chkGid, goalieData) -> context chkLabel $ let
|
|
||||||
actual = fromJust $ nth chkGid $ ps^.database.dbGoalies
|
|
||||||
expected = mkGoalie goalieData
|
|
||||||
in it ("should be " ++ show expected) $
|
|
||||||
actual `shouldBe` expected)
|
|
||||||
-- label, goalie ID, goalie data
|
|
||||||
[ ( "check Joe", 0, joeData )
|
|
||||||
, ( "check Bob", 1, bobData )
|
|
||||||
]
|
|
||||||
|
|
||||||
context "check mode" $
|
|
||||||
it ("should be " ++ show expectMode) $
|
|
||||||
ps^.progMode.editGoalieStateL.egsMode `shouldBe` expectMode)
|
|
||||||
|
|
||||||
params
|
|
||||||
|
|
||||||
context "wrong progMode" $ do
|
|
||||||
let ps = func $ progState MainMenu
|
|
||||||
|
|
||||||
it "should not change the database" $
|
|
||||||
ps^.database `shouldBe` db
|
|
||||||
|
|
||||||
it "should not change the progMode" $
|
|
||||||
show (ps^.progMode) `shouldBe` "MainMenu"
|
|
||||||
|
|
||||||
joe :: Goalie
|
|
||||||
joe = newGoalie 2 "Joe"
|
|
||||||
|
|
||||||
bob :: Goalie
|
|
||||||
bob = newGoalie 3 "Bob"
|
|
||||||
|
|
||||||
db :: Database
|
|
||||||
db = newDatabase & dbGoalies .~ [joe, bob]
|
|
||||||
|
|
||||||
progState :: ProgMode -> ProgState
|
|
||||||
progState mode = newProgState
|
|
||||||
& progMode .~ mode
|
|
||||||
& database .~ db
|
|
||||||
83
test/Actions/EditStandingsSpec.hs
Normal file
83
test/Actions/EditStandingsSpec.hs
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
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/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Actions.EditStandingsSpec (spec) where
|
||||||
|
|
||||||
|
import Lens.Micro ((^.), (&), (.~))
|
||||||
|
import Test.Hspec
|
||||||
|
( Spec
|
||||||
|
, context
|
||||||
|
, describe
|
||||||
|
, it
|
||||||
|
, shouldBe
|
||||||
|
, shouldSatisfy
|
||||||
|
)
|
||||||
|
|
||||||
|
import Mtlstats.Actions.EditStandings
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "EditStandings" $ do
|
||||||
|
mapM_
|
||||||
|
(\(label, f, expected) -> describe label $ do
|
||||||
|
let
|
||||||
|
ps = newProgState
|
||||||
|
ps' = f ps
|
||||||
|
|
||||||
|
it "should set progMode to EditStandings" $
|
||||||
|
ps'^.progMode `shouldSatisfy` \case
|
||||||
|
(EditStandings _) -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
it ("should set editStandingsMode to " ++ show expected) $
|
||||||
|
ps'^.progMode.editStandingsModeL `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, function, expected mode
|
||||||
|
[ ( "editStandings", editStandings, ESMMenu )
|
||||||
|
, ( "editHomeStandings", editHomeStandings, ESMHome ESMSubMenu )
|
||||||
|
, ( "editAwayStandings", editAwayStandings, ESMAway ESMSubMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(label, f, expected) -> describe label $ do
|
||||||
|
mapM_
|
||||||
|
(\prefix -> context ("mode: " ++ show (prefix ESMSubMenu)) $ let
|
||||||
|
ps = newProgState & progMode.editStandingsModeL .~ prefix ESMSubMenu
|
||||||
|
ps' = f ps
|
||||||
|
in it ("should set the mode to " ++ show expected) $
|
||||||
|
ps'^.progMode.editStandingsModeL `shouldBe` prefix expected)
|
||||||
|
[ESMHome, ESMAway]
|
||||||
|
|
||||||
|
context "mode: ESMMenu" $ let
|
||||||
|
ps = newProgState & progMode.editStandingsModeL .~ ESMMenu
|
||||||
|
ps' = f ps
|
||||||
|
in it "should not change the mode" $
|
||||||
|
ps'^.progMode.editStandingsModeL `shouldBe` ESMMenu)
|
||||||
|
|
||||||
|
-- label, function, expected
|
||||||
|
[ ( "editWins", editWins, ESMEditWins )
|
||||||
|
, ( "editLosses", editLosses, ESMEditLosses )
|
||||||
|
, ( "editOvertime", editOvertime, ESMEditOvertime )
|
||||||
|
, ( "editGoalsFor", editGoalsFor, ESMEditGoalsFor )
|
||||||
|
, ( "editGoalsAgainst", editGoalsAgainst, ESMEditGoalsAgainst )
|
||||||
|
]
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -23,7 +23,7 @@ module Actions.NewGame.GoalieInputSpec (spec) where
|
|||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Actions.NewGame.GoalieInput
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
@@ -33,27 +33,50 @@ import Mtlstats.Util
|
|||||||
import qualified TypesSpec as TS
|
import qualified TypesSpec as TS
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Actions.GoalieInput" $ do
|
spec = describe "GoalieInput" $ do
|
||||||
finishGoalieEntrySpec
|
finishGoalieEntrySpec
|
||||||
recordGoalieStatsSpec
|
recordGoalieStatsSpec
|
||||||
setGameGoalieSpec
|
setGameGoalieSpec
|
||||||
|
|
||||||
finishGoalieEntrySpec :: Spec
|
finishGoalieEntrySpec :: Spec
|
||||||
finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
|
finishGoalieEntrySpec = describe "finishGoalieEntry" $ mapM_
|
||||||
|
(\(label, stats, grFlag, gaFlag) -> context label $ do
|
||||||
let
|
let
|
||||||
progState stats = newProgState
|
ps = newProgState
|
||||||
& progMode.gameStateL.gameGoalieStats .~ stats
|
& progMode.gameStateL
|
||||||
& finishGoalieEntry
|
%~ (gameGoalieStats .~ stats)
|
||||||
|
. (gameType ?~ HomeGame)
|
||||||
|
. (homeScore ?~ 1)
|
||||||
|
. (awayScore ?~ 0)
|
||||||
|
. (overtimeFlag ?~ False)
|
||||||
|
& database.dbGoalies .~ goalies
|
||||||
|
|
||||||
context "no goalie data" $
|
ps' = finishGoalieEntry ps
|
||||||
it "should not set goaliesRecorded" $ let
|
gs = ps'^.progMode.gameStateL
|
||||||
s = progState M.empty
|
|
||||||
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
|
|
||||||
|
|
||||||
context "goalie data" $
|
describe "gameGoaliesRecorded" $
|
||||||
it "should set goaliesRecorded" $ let
|
it ("should be " ++ show grFlag) $
|
||||||
s = progState $ M.fromList [(1, newGoalieStats)]
|
gs^.gameGoaliesRecorded `shouldBe` grFlag
|
||||||
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
|
|
||||||
|
describe "gameGoalieAssigned" $
|
||||||
|
it ("should be " ++ show gaFlag) $
|
||||||
|
gs^.gameGoalieAssigned `shouldBe` gaFlag)
|
||||||
|
|
||||||
|
-- label, initial stats, goalies recorded, goalie assigned
|
||||||
|
[ ( "no goalies", noGoalies, False, False )
|
||||||
|
, ( "one goalie", oneGoalie, True, True )
|
||||||
|
, ( "two goalies", twoGoalies, True, False )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
goalies = [joe, bob]
|
||||||
|
joe = newGoalie 2 "Joe"
|
||||||
|
bob = newGoalie 3 "Bob"
|
||||||
|
noGoalies = M.empty
|
||||||
|
oneGoalie = M.fromList [joeStats]
|
||||||
|
twoGoalies = M.fromList [joeStats, bobStats]
|
||||||
|
joeStats = (0, newGoalieStats)
|
||||||
|
bobStats = (1, newGoalieStats)
|
||||||
|
|
||||||
recordGoalieStatsSpec :: Spec
|
recordGoalieStatsSpec :: Spec
|
||||||
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||||
@@ -185,107 +208,179 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
|||||||
]
|
]
|
||||||
|
|
||||||
setGameGoalieSpec :: Spec
|
setGameGoalieSpec :: Spec
|
||||||
setGameGoalieSpec = describe "setGameGoalie" $ let
|
setGameGoalieSpec = describe "setGameGoalie" $ mapM_
|
||||||
|
|
||||||
goalieStats w l t = newGoalieStats
|
(\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
|
||||||
& gsWins .~ w
|
context label $ do
|
||||||
& gsLosses .~ l
|
|
||||||
& gsTies .~ t
|
|
||||||
|
|
||||||
bob = newGoalie 2 "Bob"
|
|
||||||
& gYtd .~ goalieStats 10 11 12
|
|
||||||
& gLifetime .~ goalieStats 20 21 22
|
|
||||||
|
|
||||||
joe = newGoalie 3 "Joe"
|
|
||||||
& gYtd .~ goalieStats 30 31 32
|
|
||||||
& gLifetime .~ goalieStats 40 41 42
|
|
||||||
|
|
||||||
gameState h a ot = newGameState
|
|
||||||
& gameType ?~ HomeGame
|
|
||||||
& homeScore ?~ h
|
|
||||||
& awayScore ?~ a
|
|
||||||
& overtimeFlag ?~ ot
|
|
||||||
|
|
||||||
winningGame = gameState 1 0 False
|
|
||||||
losingGame = gameState 0 1 False
|
|
||||||
tiedGame = gameState 0 1 True
|
|
||||||
|
|
||||||
in mapM_
|
|
||||||
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
|
|
||||||
|
|
||||||
progState = newProgState
|
|
||||||
& database.dbGoalies .~ [bob, joe]
|
|
||||||
& progMode.gameStateL .~ gs
|
|
||||||
& setGameGoalie setGid
|
|
||||||
|
|
||||||
in mapM_
|
|
||||||
(\( chkLabel
|
|
||||||
, chkGid
|
|
||||||
, ( gWins
|
|
||||||
, gLosses
|
|
||||||
, gTies
|
|
||||||
, ytdWins
|
|
||||||
, ytdLosses
|
|
||||||
, ytdTies
|
|
||||||
, ltWins
|
|
||||||
, ltLosses
|
|
||||||
, ltTies
|
|
||||||
)
|
|
||||||
) -> context chkLabel $ do
|
|
||||||
let
|
let
|
||||||
goalie = (progState^.database.dbGoalies) !! chkGid
|
ps' = setGameGoalie goalieId ps
|
||||||
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
(joe', bob') = getFirstTwo $ ps'^.database.dbGoalies
|
||||||
game = M.findWithDefault newGoalieStats chkGid gameStats
|
gStats' = ps'^.progMode.gameStateL.gameGoalieStats
|
||||||
ytd = goalie^.gYtd
|
|
||||||
lifetime = goalie^.gLifetime
|
|
||||||
|
|
||||||
mapM_
|
context "Joe" $ joe' `TS.compareTest` expectedJoe
|
||||||
(\(label', expected, actual) -> context label' $
|
context "Bob" $ bob' `TS.compareTest` expectedBob
|
||||||
expected `TS.compareTest` actual)
|
context "game stats" $ gStats' `TS.compareTest` expectedGStats)
|
||||||
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
|
||||||
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
|
||||||
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
|
|
||||||
]
|
|
||||||
|
|
||||||
it "should set the gameGoalieAssigned flag" $
|
[ ( "Joe wins - no shutout"
|
||||||
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
|
|
||||||
[ ( "checking Bob", 0, bobData )
|
|
||||||
, ( "checking Joe", 1, joeData )
|
|
||||||
])
|
|
||||||
[ ( "Bob wins"
|
|
||||||
, winningGame
|
|
||||||
, 0
|
, 0
|
||||||
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
|
, psWin
|
||||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
, joeWin
|
||||||
|
, bob
|
||||||
|
, gsJoeWin
|
||||||
)
|
)
|
||||||
, ( "Bob loses"
|
|
||||||
, losingGame
|
, ( "Bob wins - no shutout"
|
||||||
, 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
|
, 1
|
||||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
, psWin
|
||||||
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
|
, joe
|
||||||
|
, bobWin
|
||||||
|
, gsBobWin
|
||||||
)
|
)
|
||||||
|
|
||||||
|
, ( "Joe wins - shutout"
|
||||||
|
, 0
|
||||||
|
, psWinSO
|
||||||
|
, joeWinSO
|
||||||
|
, bob
|
||||||
|
, gsJoeWinSO
|
||||||
|
)
|
||||||
|
|
||||||
|
, ( "Bob wins - shutout"
|
||||||
|
, 1
|
||||||
|
, psWinSO
|
||||||
|
, joe
|
||||||
|
, bobWinSO
|
||||||
|
, gsBobWinSO
|
||||||
|
)
|
||||||
|
|
||||||
, ( "Joe loses"
|
, ( "Joe loses"
|
||||||
, losingGame
|
, 0
|
||||||
, 1
|
, psLose
|
||||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
, joeLose
|
||||||
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
|
, bob
|
||||||
|
, gsJoeLose
|
||||||
)
|
)
|
||||||
, ( "Joe ties"
|
|
||||||
, tiedGame
|
, ( "Bob loses"
|
||||||
, 1
|
, 1
|
||||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
, psLose
|
||||||
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
|
, joe
|
||||||
|
, bobLose
|
||||||
|
, gsBobLose
|
||||||
|
)
|
||||||
|
|
||||||
|
, ( "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
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -48,61 +48,31 @@ spec = describe "NewGame" $ do
|
|||||||
GoalieInput.spec
|
GoalieInput.spec
|
||||||
|
|
||||||
overtimeCheckSpec :: 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
|
ps' = overtimeCheck ps
|
||||||
let
|
in ps'^.progMode.gameStateL.overtimeFlag `shouldBe` otf)
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 1)
|
|
||||||
. (awayScore ?~ 1)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should clear the home score" $
|
-- label, expectation, type, home, away, ot flag
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
[ ( "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" $
|
where
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
clearFlag = "should set the overtimeFlag to True"
|
||||||
|
setFlag = "should set the overtimeFlag to False"
|
||||||
it "should leave the overtimeFlag blank" $
|
leaveFlag = "should leave the overtimeFlag as Nothing"
|
||||||
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
|
|
||||||
|
|
||||||
updateGameStatsSpec :: Spec
|
updateGameStatsSpec :: Spec
|
||||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
updateGameStatsSpec = describe "updateGameStats" $ do
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
module ActionsSpec (spec) where
|
||||||
|
|
||||||
import Control.Monad (replicateM)
|
import Control.Monad (replicateM)
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
( Spec
|
( Spec
|
||||||
, context
|
, context
|
||||||
@@ -37,9 +37,11 @@ import Test.Hspec
|
|||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
import qualified Actions.EditGoalieSpec as EditGoalie
|
|
||||||
import qualified Actions.NewGameSpec as NewGame
|
import qualified Actions.NewGameSpec as NewGame
|
||||||
|
import qualified Actions.EditStandingsSpec as EditStandings
|
||||||
|
import SpecHelpers
|
||||||
import qualified TypesSpec as TS
|
import qualified TypesSpec as TS
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
@@ -47,22 +49,22 @@ spec = describe "Mtlstats.Actions" $ do
|
|||||||
startNewSeasonSpec
|
startNewSeasonSpec
|
||||||
startNewGameSpec
|
startNewGameSpec
|
||||||
resetYtdSpec
|
resetYtdSpec
|
||||||
|
clearRookiesSpec
|
||||||
resetStandingsSpec
|
resetStandingsSpec
|
||||||
addCharSpec
|
|
||||||
removeCharSpec
|
|
||||||
createPlayerSpec
|
createPlayerSpec
|
||||||
createGoalieSpec
|
createGoalieSpec
|
||||||
|
editSpec
|
||||||
editPlayerSpec
|
editPlayerSpec
|
||||||
|
editSelectedPlayerSpec
|
||||||
editGoalieSpec
|
editGoalieSpec
|
||||||
|
editSelectedGoalieSpec
|
||||||
addPlayerSpec
|
addPlayerSpec
|
||||||
addGoalieSpec
|
addGoalieSpec
|
||||||
resetCreatePlayerStateSpec
|
resetCreatePlayerStateSpec
|
||||||
resetCreateGoalieStateSpec
|
resetCreateGoalieStateSpec
|
||||||
backHomeSpec
|
backHomeSpec
|
||||||
scrollUpSpec
|
|
||||||
scrollDownSpec
|
|
||||||
NewGame.spec
|
NewGame.spec
|
||||||
EditGoalie.spec
|
EditStandings.spec
|
||||||
|
|
||||||
startNewSeasonSpec :: Spec
|
startNewSeasonSpec :: Spec
|
||||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
@@ -128,6 +130,45 @@ resetYtdSpec = describe "resetYtd" $
|
|||||||
lt ^. gsTies `shouldNotBe` 0) $
|
lt ^. gsTies `shouldNotBe` 0) $
|
||||||
s ^. database . dbGoalies
|
s ^. database . dbGoalies
|
||||||
|
|
||||||
|
clearRookiesSpec :: Spec
|
||||||
|
clearRookiesSpec = describe "clearRookies" $ do
|
||||||
|
let
|
||||||
|
|
||||||
|
players =
|
||||||
|
[ newPlayer 1 "Joe" "centre" & pRookie .~ True
|
||||||
|
, newPlayer 2 "Bob" "centre" & pRookie .~ False
|
||||||
|
]
|
||||||
|
|
||||||
|
goalies =
|
||||||
|
[ newGoalie 3 "Bill" & gRookie .~ True
|
||||||
|
, newGoalie 4 "Doug" & gRookie .~ False
|
||||||
|
]
|
||||||
|
|
||||||
|
ps = newProgState
|
||||||
|
& database
|
||||||
|
%~ (dbPlayers .~ players)
|
||||||
|
. (dbGoalies .~ goalies)
|
||||||
|
|
||||||
|
ps' = clearRookies ps
|
||||||
|
|
||||||
|
context "Players" $ mapM_
|
||||||
|
(\p -> let
|
||||||
|
name = p^.pName
|
||||||
|
rFlag = p^.pRookie
|
||||||
|
in context name $
|
||||||
|
it "should not be a rookie" $
|
||||||
|
rFlag `shouldBe` False)
|
||||||
|
(ps'^.database.dbPlayers)
|
||||||
|
|
||||||
|
context "Goalies" $ mapM_
|
||||||
|
(\g -> let
|
||||||
|
name = g^.gName
|
||||||
|
rFlag = g^.gRookie
|
||||||
|
in context name $
|
||||||
|
it "should not be a rookie" $
|
||||||
|
rFlag `shouldBe` False)
|
||||||
|
(ps'^.database.dbGoalies)
|
||||||
|
|
||||||
resetStandingsSpec :: Spec
|
resetStandingsSpec :: Spec
|
||||||
resetStandingsSpec = describe "resetStandings" $ do
|
resetStandingsSpec = describe "resetStandings" $ do
|
||||||
let
|
let
|
||||||
@@ -163,29 +204,6 @@ resetStandingsSpec = describe "resetStandings" $ do
|
|||||||
it "should be reset" $
|
it "should be reset" $
|
||||||
ps^.database.dbAwayGameStats `shouldBe` newGameStats
|
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 :: Spec
|
||||||
createPlayerSpec = describe "createPlayer" $
|
createPlayerSpec = describe "createPlayer" $
|
||||||
it "should change the mode appropriately" $ let
|
it "should change the mode appropriately" $ let
|
||||||
@@ -198,64 +216,164 @@ createGoalieSpec = describe "createGoalie" $
|
|||||||
s = createGoalie newProgState
|
s = createGoalie newProgState
|
||||||
in show (s^.progMode) `shouldBe` "CreateGoalie"
|
in show (s^.progMode) `shouldBe` "CreateGoalie"
|
||||||
|
|
||||||
|
editSpec :: Spec
|
||||||
|
editSpec = describe "edit" $
|
||||||
|
it "should change the mode to EditMenu" $ let
|
||||||
|
ps = edit newProgState
|
||||||
|
in show (ps^.progMode) `shouldBe` "EditMenu"
|
||||||
|
|
||||||
editPlayerSpec :: Spec
|
editPlayerSpec :: Spec
|
||||||
editPlayerSpec = describe "editPlayer" $
|
editPlayerSpec = describe "editPlayer" $
|
||||||
it "should change the mode appropriately" $ let
|
it "should change the mode appropriately" $ let
|
||||||
s = editPlayer newProgState
|
s = editPlayer newProgState
|
||||||
in show (s^.progMode) `shouldBe` "EditPlayer"
|
in show (s^.progMode) `shouldBe` "EditPlayer"
|
||||||
|
|
||||||
|
editSelectedPlayerSpec :: Spec
|
||||||
|
editSelectedPlayerSpec = describe "editSelectedPlayer" $ mapM_
|
||||||
|
(\(label, pState, expected) -> context label $
|
||||||
|
it "should edit the players appropriately" $ let
|
||||||
|
pState' = editSelectedPlayer (pName .~ "foo") pState
|
||||||
|
players' = pState'^.database.dbPlayers
|
||||||
|
in players' `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, initial state, expected
|
||||||
|
[ ( "wrong mode", baseState, players )
|
||||||
|
, ( "not selected", changePlayer Nothing, players )
|
||||||
|
, ( "player 0", changePlayer $ Just 0, changed0 )
|
||||||
|
, ( "player 1", changePlayer $ Just 1, changed1 )
|
||||||
|
, ( "out of bounds", changePlayer $ Just 2, players )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
baseState = newProgState & database.dbPlayers .~ players
|
||||||
|
changePlayer n = baseState
|
||||||
|
& (progMode.editPlayerStateL.epsSelectedPlayer .~ n)
|
||||||
|
players = [ player 0, player 1 ]
|
||||||
|
changed0 = [ player' 0, player 1 ]
|
||||||
|
changed1 = [ player 0, player' 1 ]
|
||||||
|
player n = newPlayer n ("Player " ++ show n) "pos"
|
||||||
|
player' n = newPlayer n "foo" "pos"
|
||||||
|
|
||||||
editGoalieSpec :: Spec
|
editGoalieSpec :: Spec
|
||||||
editGoalieSpec = describe "editGoalie" $
|
editGoalieSpec = describe "editGoalie" $
|
||||||
it "should change the mode appropriately" $ let
|
it "should change the mode appropriately" $ let
|
||||||
s = editGoalie newProgState
|
s = editGoalie newProgState
|
||||||
in show (s^.progMode) `shouldBe` "EditGoalie"
|
in show (s^.progMode) `shouldBe` "EditGoalie"
|
||||||
|
|
||||||
addPlayerSpec :: Spec
|
editSelectedGoalieSpec :: Spec
|
||||||
addPlayerSpec = describe "addPlayer" $ do
|
editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
|
||||||
let
|
(\(label, pState, expected) -> context label $
|
||||||
p1 = newPlayer 1 "Joe" "centre"
|
it "should edit the goalies appropriately" $ let
|
||||||
p2 = newPlayer 2 "Bob" "defense"
|
pState' = editSelectedGoalie (gName .~ "foo") pState
|
||||||
db = newDatabase
|
goalies' = pState'^.database.dbGoalies
|
||||||
& dbPlayers .~ [p1]
|
in goalies' `shouldBe` expected)
|
||||||
s pm = newProgState
|
|
||||||
& progMode .~ pm
|
|
||||||
& database .~ db
|
|
||||||
|
|
||||||
context "data available" $
|
-- label, initial state, expected
|
||||||
it "should create the player" $ let
|
[ ( "wrong mode", baseState, goalies )
|
||||||
s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
|
, ( "not selected", changeGoalie Nothing, goalies )
|
||||||
& cpsNumber ?~ 2
|
, ( "goalie 0", changeGoalie $ Just 0, changed0 )
|
||||||
|
, ( "goalie 1", changeGoalie $ Just 1, changed1 )
|
||||||
|
, ( "out of bounds", changeGoalie $ Just 2, goalies )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
baseState = newProgState & database.dbGoalies .~ goalies
|
||||||
|
changeGoalie n = baseState
|
||||||
|
& (progMode.editGoalieStateL.egsSelectedGoalie .~ n)
|
||||||
|
goalies = [ goalie 0, goalie 1 ]
|
||||||
|
changed0 = [ goalie' 0, goalie 1 ]
|
||||||
|
changed1 = [ goalie 0, goalie' 1 ]
|
||||||
|
goalie n = newGoalie n ("Player " ++ show n)
|
||||||
|
goalie' n = newGoalie n "foo"
|
||||||
|
|
||||||
|
addPlayerSpec :: Spec
|
||||||
|
addPlayerSpec = describe "addPlayer" $ mapM_
|
||||||
|
(\(label, expectation, pm, players) -> context label $
|
||||||
|
it expectation $ let
|
||||||
|
ps = newProgState
|
||||||
|
& progMode .~ pm
|
||||||
|
& database.dbPlayers .~ [joe]
|
||||||
|
ps' = addPlayer ps
|
||||||
|
in ps'^.database.dbPlayers `shouldBe` players)
|
||||||
|
|
||||||
|
-- label, expectation, progMode, players
|
||||||
|
[ ( "wrong mode", failure, MainMenu, [joe] )
|
||||||
|
, ( "missing number", failure, noNum, [joe] )
|
||||||
|
, ( "missing rookie flag", failure, noRookie, [joe] )
|
||||||
|
, ( "missing active flag", failure, noActive, [joe] )
|
||||||
|
, ( "rookie", success, mkRookie, [joe, rookie] )
|
||||||
|
, ( "retired", success, mkRetired, [joe, retired] )
|
||||||
|
, ( "normal player", success, mkNormal, [joe, normal] )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
failure = "should not create the player"
|
||||||
|
success = "should create the player"
|
||||||
|
noNum = mkpm Nothing (Just False) (Just True)
|
||||||
|
noRookie = mkpm (Just 3) Nothing (Just True)
|
||||||
|
noActive = mkpm (Just 3) (Just False) Nothing
|
||||||
|
mkRookie = mkpm (Just 3) (Just True) (Just True)
|
||||||
|
mkRetired = mkpm (Just 3) (Just False) (Just False)
|
||||||
|
mkNormal = mkpm (Just 3) (Just False) (Just True)
|
||||||
|
joe = newPlayer 2 "Joe" "centre"
|
||||||
|
rookie = player True True
|
||||||
|
retired = player False False
|
||||||
|
normal = player False True
|
||||||
|
|
||||||
|
player r a = newPlayer 3 "Bob" "defense"
|
||||||
|
& pRookie .~ r
|
||||||
|
& pActive .~ a
|
||||||
|
|
||||||
|
mkpm n r a = CreatePlayer $ newCreatePlayerState
|
||||||
|
& cpsNumber .~ n
|
||||||
& cpsName .~ "Bob"
|
& cpsName .~ "Bob"
|
||||||
& cpsPosition .~ "defense"
|
& cpsPosition .~ "defense"
|
||||||
in s'^.database.dbPlayers `shouldBe` [p1, p2]
|
& cpsRookieFlag .~ r
|
||||||
|
& cpsActiveFlag .~ a
|
||||||
context "data unavailable" $
|
|
||||||
it "should not create the player" $ let
|
|
||||||
s' = addPlayer $ s MainMenu
|
|
||||||
in s'^.database.dbPlayers `shouldBe` [p1]
|
|
||||||
|
|
||||||
addGoalieSpec :: Spec
|
addGoalieSpec :: Spec
|
||||||
addGoalieSpec = describe "addGoalie" $ do
|
addGoalieSpec = describe "addGoalie" $ mapM_
|
||||||
let
|
(\(label, expectation, pm, goalies) -> context label $
|
||||||
g1 = newGoalie 2 "Joe"
|
it expectation $ let
|
||||||
g2 = newGoalie 3 "Bob"
|
ps = newProgState
|
||||||
db = newDatabase
|
|
||||||
& dbGoalies .~ [g1]
|
|
||||||
s pm = newProgState
|
|
||||||
& database .~ db
|
|
||||||
& progMode .~ pm
|
& progMode .~ pm
|
||||||
|
& database.dbGoalies .~ [joe]
|
||||||
|
ps' = addGoalie ps
|
||||||
|
in ps'^.database.dbGoalies `shouldBe` goalies)
|
||||||
|
|
||||||
context "data available" $
|
-- label, expectation, progMode, expected goalies
|
||||||
it "should create the goalie" $ let
|
[ ( "wrong mode", failure, MainMenu, [joe] )
|
||||||
s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
|
, ( "no number", failure, noNum, [joe] )
|
||||||
& cgsNumber ?~ 3
|
, ( "no rookie flag", failure, noRookie, [joe] )
|
||||||
|
, ( "no active flag", failure, noActive, [joe] )
|
||||||
|
, ( "rookie", success, mkRookie, [joe, rookie] )
|
||||||
|
, ( "retired", success, mkRetired, [joe, retired] )
|
||||||
|
, ( "normal goalie", success, mkNormal, [joe, normal] )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
failure = "should not create the goalie"
|
||||||
|
success = "should create the goalie"
|
||||||
|
noNum = cgs Nothing (Just False) (Just True)
|
||||||
|
noRookie = cgs (Just 3) Nothing (Just True)
|
||||||
|
noActive = cgs (Just 3) (Just False) Nothing
|
||||||
|
mkRookie = cgs (Just 3) (Just True) (Just True)
|
||||||
|
mkRetired = cgs (Just 3) (Just False) (Just False)
|
||||||
|
mkNormal = cgs (Just 3) (Just False) (Just True)
|
||||||
|
joe = newGoalie 2 "Joe"
|
||||||
|
rookie = goalie True True
|
||||||
|
retired = goalie False False
|
||||||
|
normal = goalie False True
|
||||||
|
|
||||||
|
goalie r a = newGoalie 3 "Bob"
|
||||||
|
& gRookie .~ r
|
||||||
|
& gActive .~ a
|
||||||
|
|
||||||
|
cgs n r a = CreateGoalie $ newCreateGoalieState
|
||||||
|
& cgsNumber .~ n
|
||||||
& cgsName .~ "Bob"
|
& cgsName .~ "Bob"
|
||||||
in s'^.database.dbGoalies `shouldBe` [g1, g2]
|
& cgsRookieFlag .~ r
|
||||||
|
& cgsActiveFlag .~ a
|
||||||
context "data unavailable" $
|
|
||||||
it "should not create the goalie" $ let
|
|
||||||
s' = addGoalie $ s MainMenu
|
|
||||||
in s'^.database.dbGoalies `shouldBe` [g1]
|
|
||||||
|
|
||||||
resetCreatePlayerStateSpec :: Spec
|
resetCreatePlayerStateSpec :: Spec
|
||||||
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
|
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
|
||||||
@@ -281,8 +399,7 @@ backHomeSpec = describe "backHome" $ do
|
|||||||
let
|
let
|
||||||
input = newProgState
|
input = newProgState
|
||||||
& progMode.gameStateL .~ newGameState
|
& progMode.gameStateL .~ newGameState
|
||||||
& inputBuffer .~ "foo"
|
& editorW .~ mkEditor "foo"
|
||||||
& scrollOffset .~ 123
|
|
||||||
result = backHome input
|
result = backHome input
|
||||||
|
|
||||||
it "should set the program mode back to MainMenu" $
|
it "should set the program mode back to MainMenu" $
|
||||||
@@ -291,34 +408,4 @@ backHomeSpec = describe "backHome" $ do
|
|||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
it "should clear the input buffer" $
|
it "should clear the input buffer" $
|
||||||
result^.inputBuffer `shouldBe` ""
|
result^.editorW.to userText `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
|
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -33,6 +33,7 @@ spec = describe "Mtlstats.Format" $ do
|
|||||||
leftSpec
|
leftSpec
|
||||||
rightSpec
|
rightSpec
|
||||||
centreSpec
|
centreSpec
|
||||||
|
padRightSpec
|
||||||
overlaySpec
|
overlaySpec
|
||||||
monthSpec
|
monthSpec
|
||||||
labelTableSpec
|
labelTableSpec
|
||||||
@@ -98,6 +99,16 @@ centreSpec = describe "centre" $ do
|
|||||||
it "should truncate the text" $
|
it "should truncate the text" $
|
||||||
centre 2 "foo" `shouldBe` "fo"
|
centre 2 "foo" `shouldBe` "fo"
|
||||||
|
|
||||||
|
padRightSpec :: Spec
|
||||||
|
padRightSpec = describe "padRight" $ mapM_
|
||||||
|
(\(label, width, str, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
padRight width str `shouldBe` expected)
|
||||||
|
-- label, width, input string, expected
|
||||||
|
[ ( "text shorter", 5, "foo", "foo " )
|
||||||
|
, ( "text longer", 3, "foobar", "foobar" )
|
||||||
|
]
|
||||||
|
|
||||||
overlaySpec :: Spec
|
overlaySpec :: Spec
|
||||||
overlaySpec = describe "overlay" $ do
|
overlaySpec = describe "overlay" $ do
|
||||||
|
|
||||||
@@ -130,9 +141,9 @@ labelTableSpec = describe "labelTable" $
|
|||||||
]
|
]
|
||||||
|
|
||||||
expected =
|
expected =
|
||||||
[ " foo: bar"
|
[ " foo: bar "
|
||||||
, " baz: quux"
|
, " baz: quux"
|
||||||
, "longer: x"
|
, "longer: x "
|
||||||
]
|
]
|
||||||
|
|
||||||
in labelTable input `shouldBe` expected
|
in labelTable input `shouldBe` expected
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
module HandlersSpec (spec) where
|
||||||
|
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
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
|
import Mtlstats.Handlers
|
||||||
|
|
||||||
@@ -37,10 +39,18 @@ ynHandlerSpec = describe "ynHandler" $ mapM_
|
|||||||
it ("should be " ++ show expected) $
|
it ("should be " ++ show expected) $
|
||||||
ynHandler event `shouldBe` expected)
|
ynHandler event `shouldBe` expected)
|
||||||
-- description, event, expected
|
-- description, event, expected
|
||||||
[ ( "Y pressed", C.EventCharacter 'Y', Just True )
|
[ ( "Y pressed", capitalY, Just True )
|
||||||
, ( "y pressed", C.EventCharacter 'y', Just True )
|
, ( "y pressed", lowerY, Just True )
|
||||||
, ( "N pressed", C.EventCharacter 'N', Just False )
|
, ( "N pressed", capitalN, Just False )
|
||||||
, ( "n pressed", C.EventCharacter 'n', Just False )
|
, ( "n pressed", lowerN, Just False )
|
||||||
, ( "x pressed", C.EventCharacter 'x', Nothing )
|
, ( "x pressed", lowerX, Nothing )
|
||||||
, ( "other event", C.EventResized, 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
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -22,45 +22,70 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Helpers.GoalieSpec (spec) where
|
module Helpers.GoalieSpec (spec) where
|
||||||
|
|
||||||
import Lens.Micro ((&), (.~), (%~))
|
import Lens.Micro ((&), (.~), (%~))
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Helpers.Goalie
|
import Mtlstats.Helpers.Goalie
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Goalie"
|
spec = describe "Goalie" $ do
|
||||||
goalieDetailsSpec
|
goalieDetailsSpec
|
||||||
|
goalieNameSpec
|
||||||
|
|
||||||
goalieDetailsSpec :: Spec
|
goalieDetailsSpec :: Spec
|
||||||
goalieDetailsSpec = describe "goalieDetails" $ let
|
goalieDetailsSpec = describe "goalieDetails" $ let
|
||||||
input = newGoalie 1 "Joe"
|
input = newGoalie 1 "Joe"
|
||||||
|
& gRookie .~ True
|
||||||
& gYtd
|
& gYtd
|
||||||
%~ ( gsGames .~ 2 )
|
%~ ( gsGames .~ 2 )
|
||||||
. ( gsMinsPlayed .~ 3 )
|
. ( gsMinsPlayed .~ 3 )
|
||||||
. ( gsGoalsAllowed .~ 4 )
|
. ( gsGoalsAllowed .~ 4 )
|
||||||
. ( gsWins .~ 5 )
|
. ( gsShutouts .~ 5 )
|
||||||
. ( gsLosses .~ 6 )
|
. ( gsWins .~ 6 )
|
||||||
. ( gsTies .~ 7 )
|
. ( gsLosses .~ 7 )
|
||||||
|
. ( gsTies .~ 8 )
|
||||||
& gLifetime
|
& gLifetime
|
||||||
%~ ( gsGames .~ 8 )
|
%~ ( gsGames .~ 9 )
|
||||||
. ( gsMinsPlayed .~ 9 )
|
. ( gsMinsPlayed .~ 10 )
|
||||||
. ( gsGoalsAllowed .~ 10 )
|
. ( gsGoalsAllowed .~ 11 )
|
||||||
. ( gsWins .~ 11 )
|
. ( gsShutouts .~ 12 )
|
||||||
. ( gsLosses .~ 12 )
|
. ( gsWins .~ 13 )
|
||||||
. ( gsTies .~ 13 )
|
. ( gsLosses .~ 14 )
|
||||||
|
. ( gsTies .~ 15 )
|
||||||
|
|
||||||
expected = unlines
|
expected = unlines
|
||||||
[ "Number: 1"
|
[ "Number: 1 "
|
||||||
, " Name: Joe"
|
, " Name: Joe*"
|
||||||
, ""
|
, ""
|
||||||
, " YTD Lifetime"
|
, " YTD Lifetime"
|
||||||
, " Games played 2 8"
|
, " Games played 2 9"
|
||||||
, " Mins played 3 9"
|
, " Mins played 3 10"
|
||||||
, "Goals allowed 4 10"
|
, "Goals allowed 4 11"
|
||||||
, " Wins 5 11"
|
, " Shutouts 5 12"
|
||||||
, " Losses 6 12"
|
, " Wins 6 13"
|
||||||
, " Ties 7 13"
|
, " Losses 7 14"
|
||||||
|
, " Ties 8 15"
|
||||||
]
|
]
|
||||||
|
|
||||||
in it "should format the output correctly" $
|
in it "should format the output correctly" $
|
||||||
goalieDetails input `shouldBe` expected
|
goalieDetails input `shouldBe` expected
|
||||||
|
|
||||||
|
goalieNameSpec :: Spec
|
||||||
|
goalieNameSpec = describe "goalieName" $ mapM_
|
||||||
|
(\(label, g, expected) -> context label $
|
||||||
|
it ("should be " ++ expected) $
|
||||||
|
goalieName g `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, goalie, expected
|
||||||
|
[ ( "rookie", rookie, "foo*" )
|
||||||
|
, ( "non-rookie", active, "foo" )
|
||||||
|
, ( "retired", retired, "*foo" )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
rookie = goalie True True
|
||||||
|
active = goalie False True
|
||||||
|
retired = goalie False False
|
||||||
|
goalie r a = newGoalie 1 "foo"
|
||||||
|
& gRookie .~ r
|
||||||
|
& gActive .~ a
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -22,20 +22,22 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Helpers.PlayerSpec (spec) where
|
module Helpers.PlayerSpec (spec) where
|
||||||
|
|
||||||
import Lens.Micro ((&), (.~))
|
import Lens.Micro ((&), (.~))
|
||||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Helpers.Player
|
import Mtlstats.Helpers.Player
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Player"
|
spec = describe "Player" $ do
|
||||||
playerDetailsSpec
|
playerDetailsSpec
|
||||||
|
playerNameSpec
|
||||||
|
|
||||||
playerDetailsSpec :: Spec
|
playerDetailsSpec :: Spec
|
||||||
playerDetailsSpec = describe "playerDetails" $
|
playerDetailsSpec = describe "playerDetails" $
|
||||||
it "should give a detailed description" $ let
|
it "should give a detailed description" $ let
|
||||||
|
|
||||||
p = newPlayer 1 "Joe" "centre"
|
p = newPlayer 1 "Joe" "centre"
|
||||||
|
& pRookie .~ True
|
||||||
& pYtd .~ PlayerStats
|
& pYtd .~ PlayerStats
|
||||||
{ _psGoals = 2
|
{ _psGoals = 2
|
||||||
, _psAssists = 3
|
, _psAssists = 3
|
||||||
@@ -48,8 +50,8 @@ playerDetailsSpec = describe "playerDetails" $
|
|||||||
}
|
}
|
||||||
|
|
||||||
expected = unlines
|
expected = unlines
|
||||||
[ " Number: 1"
|
[ " Number: 1 "
|
||||||
, " Name: Joe"
|
, " Name: Joe* "
|
||||||
, "Position: centre"
|
, "Position: centre"
|
||||||
, ""
|
, ""
|
||||||
, " YTD Lifetime"
|
, " YTD Lifetime"
|
||||||
@@ -59,3 +61,23 @@ playerDetailsSpec = describe "playerDetails" $
|
|||||||
]
|
]
|
||||||
|
|
||||||
in playerDetails p `shouldBe` expected
|
in playerDetails p `shouldBe` expected
|
||||||
|
|
||||||
|
playerNameSpec :: Spec
|
||||||
|
playerNameSpec = describe "playerName" $ mapM_
|
||||||
|
(\(label, p, expected) -> context label $
|
||||||
|
it ("should be " ++ expected) $
|
||||||
|
playerName p `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, player, expected
|
||||||
|
[ ( "rookie", rookie, "foo*" )
|
||||||
|
, ( "non-rookie", nonRookie, "foo" )
|
||||||
|
, ( "retired", retired, "*foo" )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
rookie = player True True
|
||||||
|
nonRookie = player False True
|
||||||
|
retired = player False False
|
||||||
|
player r a = newPlayer 1 "foo" "centre"
|
||||||
|
& pRookie .~ r
|
||||||
|
& pActive .~ a
|
||||||
|
|||||||
79
test/Helpers/PositionSpec.hs
Normal file
79
test/Helpers/PositionSpec.hs
Normal file
@@ -0,0 +1,79 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
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 Helpers.PositionSpec (spec) where
|
||||||
|
|
||||||
|
import Lens.Micro ((&), (.~))
|
||||||
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
|
import Mtlstats.Helpers.Position
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Position" $ do
|
||||||
|
posSearchSpec
|
||||||
|
posSearchExactSpec
|
||||||
|
getPositionsSpec
|
||||||
|
|
||||||
|
posSearchSpec :: Spec
|
||||||
|
posSearchSpec = describe "posSearch" $ mapM_
|
||||||
|
(\(sStr, expected) -> context ("search string: " ++ show sStr) $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
posSearch sStr db `shouldBe` expected)
|
||||||
|
[ ( "fOo"
|
||||||
|
, [ ( 2, "foo" )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, ( "A"
|
||||||
|
, [ ( 0, "bar" )
|
||||||
|
, ( 1, "baz" )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
posSearchExactSpec :: Spec
|
||||||
|
posSearchExactSpec = describe "posSearchExact" $ mapM_
|
||||||
|
(\(input, expected) -> context ("input: " ++ show input) $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
posSearchExact input db `shouldBe` expected)
|
||||||
|
|
||||||
|
-- input, expected
|
||||||
|
[ ( "foo", Just 2 )
|
||||||
|
, ( "FOO", Nothing )
|
||||||
|
, ( "bar", Just 0 )
|
||||||
|
, ( "baz", Just 1 )
|
||||||
|
, ( "a", Nothing )
|
||||||
|
, ( "quux", Nothing )
|
||||||
|
]
|
||||||
|
|
||||||
|
getPositionsSpec :: Spec
|
||||||
|
getPositionsSpec = describe "getPositions" $ let
|
||||||
|
expected = ["bar", "baz", "foo"]
|
||||||
|
in it ("should be " ++ show expected) $
|
||||||
|
getPositions db `shouldBe` expected
|
||||||
|
|
||||||
|
db :: Database
|
||||||
|
db = newDatabase & dbPlayers .~
|
||||||
|
[ newPlayer 2 "Joe" "foo"
|
||||||
|
, newPlayer 3 "Bob" "bar"
|
||||||
|
, newPlayer 5 "Bill" "foo"
|
||||||
|
, newPlayer 8 "Ed" "baz"
|
||||||
|
]
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -25,8 +25,10 @@ import Test.Hspec (Spec, describe)
|
|||||||
|
|
||||||
import qualified Helpers.GoalieSpec as Goalie
|
import qualified Helpers.GoalieSpec as Goalie
|
||||||
import qualified Helpers.PlayerSpec as Player
|
import qualified Helpers.PlayerSpec as Player
|
||||||
|
import qualified Helpers.PositionSpec as Position
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Helper" $ do
|
spec = describe "Helper" $ do
|
||||||
Player.spec
|
Player.spec
|
||||||
Goalie.spec
|
Goalie.spec
|
||||||
|
Position.spec
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -37,11 +37,11 @@ showSpec :: Spec
|
|||||||
showSpec = describe "show" $
|
showSpec = describe "show" $
|
||||||
it "should display correctly" $ let
|
it "should display correctly" $ let
|
||||||
menu = Menu "Foo" ()
|
menu = Menu "Foo" ()
|
||||||
[ MenuItem '1' "Item 1" $ return ()
|
[ MenuItem '1' "foo" $ return ()
|
||||||
, MenuItem '2' "Item 2" $ return ()
|
, MenuItem '2' "bar baz" $ return ()
|
||||||
]
|
]
|
||||||
expected =
|
expected =
|
||||||
"Foo\n\
|
"Foo\n\n\
|
||||||
\1) Item 1\n\
|
\1: foo \n\
|
||||||
\2) Item 2\n"
|
\2: bar baz\n"
|
||||||
in show menu `shouldBe` expected
|
in show menu `shouldBe` expected
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
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
|
module TypesSpec
|
||||||
( Comparable (..)
|
( Comparable (..)
|
||||||
@@ -33,10 +33,11 @@ module TypesSpec
|
|||||||
import Control.Monad (replicateM)
|
import Control.Monad (replicateM)
|
||||||
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
||||||
import Data.Aeson.Types (Value (Object))
|
import Data.Aeson.Types (Value (Object))
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.Map.Lazy as M
|
||||||
import Data.Ratio ((%))
|
import Data.Ratio ((%))
|
||||||
|
import qualified GHC.Exts as HM
|
||||||
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
||||||
import System.Random (randomRIO)
|
import System.Random (randomIO, randomRIO)
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
@@ -58,6 +59,8 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
createGoalieStateLSpec
|
createGoalieStateLSpec
|
||||||
editPlayerStateLSpec
|
editPlayerStateLSpec
|
||||||
editGoalieStateLSpec
|
editGoalieStateLSpec
|
||||||
|
editStandingsModeLSpec
|
||||||
|
esmSubModeLSpec
|
||||||
teamScoreSpec
|
teamScoreSpec
|
||||||
otherScoreSpec
|
otherScoreSpec
|
||||||
homeTeamSpec
|
homeTeamSpec
|
||||||
@@ -70,6 +73,7 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
gmsPointsSpec
|
gmsPointsSpec
|
||||||
addGameStatsSpec
|
addGameStatsSpec
|
||||||
playerSearchSpec
|
playerSearchSpec
|
||||||
|
activePlayerSearchSpec
|
||||||
playerSearchExactSpec
|
playerSearchExactSpec
|
||||||
modifyPlayerSpec
|
modifyPlayerSpec
|
||||||
playerSummarySpec
|
playerSummarySpec
|
||||||
@@ -77,6 +81,7 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
psPointsSpec
|
psPointsSpec
|
||||||
addPlayerStatsSpec
|
addPlayerStatsSpec
|
||||||
goalieSearchSpec
|
goalieSearchSpec
|
||||||
|
activeGoalieSearchSpec
|
||||||
goalieSearchExactSpec
|
goalieSearchExactSpec
|
||||||
goalieSummarySpec
|
goalieSummarySpec
|
||||||
goalieIsActiveSpec
|
goalieIsActiveSpec
|
||||||
@@ -191,6 +196,47 @@ editGoalieStateLSpec = describe "editGoalieStateL" $
|
|||||||
egs2 = newEditGoalieState
|
egs2 = newEditGoalieState
|
||||||
& egsSelectedGoalie ?~ 2
|
& egsSelectedGoalie ?~ 2
|
||||||
|
|
||||||
|
editStandingsModeLSpec :: Spec
|
||||||
|
editStandingsModeLSpec = describe "editStandingsModeL" $
|
||||||
|
lensSpec editStandingsModeL
|
||||||
|
-- getters
|
||||||
|
[ ( "missing mode", MainMenu, menu )
|
||||||
|
, ( "with mode", EditStandings home, home )
|
||||||
|
]
|
||||||
|
-- setters
|
||||||
|
[ ( "set mode", MainMenu, home )
|
||||||
|
, ( "change mode", EditStandings home, away )
|
||||||
|
]
|
||||||
|
where
|
||||||
|
menu = ESMMenu
|
||||||
|
home = ESMHome ESMSubMenu
|
||||||
|
away = ESMAway ESMSubMenu
|
||||||
|
|
||||||
|
esmSubModeLSpec :: Spec
|
||||||
|
esmSubModeLSpec = describe "esmSubModeL" $ do
|
||||||
|
|
||||||
|
context "getters" $ mapM_
|
||||||
|
(\(label, mode, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
mode^.esmSubModeL `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, mode, expected
|
||||||
|
[ ( "no state", ESMMenu, ESMSubMenu )
|
||||||
|
, ( "with state", ESMHome ESMEditWins, ESMEditWins )
|
||||||
|
]
|
||||||
|
|
||||||
|
context "setters" $ mapM_
|
||||||
|
(\(label, mode, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $ let
|
||||||
|
mode' = mode & esmSubModeL .~ ESMEditWins
|
||||||
|
in mode' `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, mode, expected
|
||||||
|
[ ( "no state", ESMMenu, ESMMenu )
|
||||||
|
, ( "home mode", ESMHome ESMSubMenu, ESMHome ESMEditWins )
|
||||||
|
, ( "away mode", ESMAway ESMSubMenu, ESMAway ESMEditWins )
|
||||||
|
]
|
||||||
|
|
||||||
teamScoreSpec :: Spec
|
teamScoreSpec :: Spec
|
||||||
teamScoreSpec = describe "teamScore" $ do
|
teamScoreSpec = describe "teamScore" $ do
|
||||||
let
|
let
|
||||||
@@ -271,6 +317,7 @@ lensSpec lens getters setters = do
|
|||||||
|
|
||||||
player :: Player
|
player :: Player
|
||||||
player = newPlayer 1 "Joe" "centre"
|
player = newPlayer 1 "Joe" "centre"
|
||||||
|
& pRookie .~ False
|
||||||
& pYtd .~ playerStats 1
|
& pYtd .~ playerStats 1
|
||||||
& pLifetime .~ playerStats 2
|
& pLifetime .~ playerStats 2
|
||||||
|
|
||||||
@@ -279,6 +326,8 @@ playerJSON = Object $ HM.fromList
|
|||||||
[ ( "number", toJSON (1 :: Int) )
|
[ ( "number", toJSON (1 :: Int) )
|
||||||
, ( "name", toJSON ("Joe" :: String) )
|
, ( "name", toJSON ("Joe" :: String) )
|
||||||
, ( "position", toJSON ("centre" :: String) )
|
, ( "position", toJSON ("centre" :: String) )
|
||||||
|
, ( "rookie", toJSON False )
|
||||||
|
, ( "active", toJSON True )
|
||||||
, ( "ytd", playerStatsJSON 1 )
|
, ( "ytd", playerStatsJSON 1 )
|
||||||
, ( "lifetime", playerStatsJSON 2 )
|
, ( "lifetime", playerStatsJSON 2 )
|
||||||
]
|
]
|
||||||
@@ -298,6 +347,7 @@ playerStatsJSON n = Object $ HM.fromList
|
|||||||
|
|
||||||
goalie :: Goalie
|
goalie :: Goalie
|
||||||
goalie = newGoalie 1 "Joe"
|
goalie = newGoalie 1 "Joe"
|
||||||
|
& gRookie .~ False
|
||||||
& gYtd .~ goalieStats 1
|
& gYtd .~ goalieStats 1
|
||||||
& gLifetime .~ goalieStats 2
|
& gLifetime .~ goalieStats 2
|
||||||
|
|
||||||
@@ -305,6 +355,8 @@ goalieJSON :: Value
|
|||||||
goalieJSON = Object $ HM.fromList
|
goalieJSON = Object $ HM.fromList
|
||||||
[ ( "number", toJSON (1 :: Int) )
|
[ ( "number", toJSON (1 :: Int) )
|
||||||
, ( "name", toJSON ("Joe" :: String ) )
|
, ( "name", toJSON ("Joe" :: String ) )
|
||||||
|
, ( "rookie", toJSON False )
|
||||||
|
, ( "active", toJSON True )
|
||||||
, ( "ytd", goalieStatsJSON 1 )
|
, ( "ytd", goalieStatsJSON 1 )
|
||||||
, ( "lifetime", goalieStatsJSON 2 )
|
, ( "lifetime", goalieStatsJSON 2 )
|
||||||
]
|
]
|
||||||
@@ -597,6 +649,19 @@ playerSearchSpec = describe "playerSearch" $ mapM_
|
|||||||
, ( "x", [] )
|
, ( "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 :: Spec
|
||||||
playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
||||||
(\(sStr, expected) -> context sStr $
|
(\(sStr, expected) -> context sStr $
|
||||||
@@ -728,6 +793,28 @@ goalieSearchSpec = describe "goalieSearch" $ do
|
|||||||
it "should return Bob" $
|
it "should return Bob" $
|
||||||
goalieSearch "bob" goalies `shouldBe` [result 1]
|
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 :: Spec
|
||||||
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
||||||
let
|
let
|
||||||
@@ -843,6 +930,8 @@ makePlayer = Player
|
|||||||
<$> makeNum
|
<$> makeNum
|
||||||
<*> makeName
|
<*> makeName
|
||||||
<*> makeName
|
<*> makeName
|
||||||
|
<*> makeBool
|
||||||
|
<*> makeBool
|
||||||
<*> makePlayerStats
|
<*> makePlayerStats
|
||||||
<*> makePlayerStats
|
<*> makePlayerStats
|
||||||
|
|
||||||
@@ -851,6 +940,8 @@ makeGoalie :: IO Goalie
|
|||||||
makeGoalie = Goalie
|
makeGoalie = Goalie
|
||||||
<$> makeNum
|
<$> makeNum
|
||||||
<*> makeName
|
<*> makeName
|
||||||
|
<*> makeBool
|
||||||
|
<*> makeBool
|
||||||
<*> makeGoalieStats
|
<*> makeGoalieStats
|
||||||
<*> makeGoalieStats
|
<*> makeGoalieStats
|
||||||
|
|
||||||
@@ -875,6 +966,9 @@ makeGoalieStats = GoalieStats
|
|||||||
makeNum :: IO Int
|
makeNum :: IO Int
|
||||||
makeNum = randomRIO (1, 10)
|
makeNum = randomRIO (1, 10)
|
||||||
|
|
||||||
|
makeBool :: IO Bool
|
||||||
|
makeBool = randomIO
|
||||||
|
|
||||||
makeName :: IO String
|
makeName :: IO String
|
||||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||||
|
|
||||||
@@ -944,3 +1038,53 @@ instance Comparable CreateGoalieState where
|
|||||||
describe "cgsName" $
|
describe "cgsName" $
|
||||||
it ("should be " ++ expected^.cgsName) $
|
it ("should be " ++ expected^.cgsName) $
|
||||||
actual^.cgsName `shouldBe` expected^.cgsName
|
actual^.cgsName `shouldBe` expected^.cgsName
|
||||||
|
|
||||||
|
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
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -26,12 +26,16 @@ import Test.Hspec (Spec, context, describe, it, shouldBe)
|
|||||||
|
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
import SpecHelpers
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Util" $ do
|
spec = describe "Mtlstats.Util" $ do
|
||||||
nthSpec
|
nthSpec
|
||||||
modifyNthSpec
|
modifyNthSpec
|
||||||
|
dropNthSpec
|
||||||
updateMapSpec
|
updateMapSpec
|
||||||
sliceSpec
|
sliceSpec
|
||||||
|
capitalizeNameSpec
|
||||||
|
|
||||||
nthSpec :: Spec
|
nthSpec :: Spec
|
||||||
nthSpec = describe "nth" $ mapM_
|
nthSpec = describe "nth" $ mapM_
|
||||||
@@ -63,6 +67,20 @@ modifyNthSpec = describe "modifyNth" $ do
|
|||||||
it "should not modify the value" $
|
it "should not modify the value" $
|
||||||
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
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 :: Spec
|
||||||
updateMapSpec = describe "updateMap" $ do
|
updateMapSpec = describe "updateMap" $ do
|
||||||
let
|
let
|
||||||
@@ -93,3 +111,23 @@ sliceSpec = describe "slice" $ do
|
|||||||
context "negative offset" $
|
context "negative offset" $
|
||||||
it "should return the correct number of elements from the beginning" $
|
it "should return the correct number of elements from the beginning" $
|
||||||
slice (-10) 2 list `shouldBe` [2, 4]
|
slice (-10) 2 list `shouldBe` [2, 4]
|
||||||
|
|
||||||
|
capitalizeNameSpec :: Spec
|
||||||
|
capitalizeNameSpec = describe "capitalizeName" $ mapM_
|
||||||
|
(\(label, ch, str, expected) -> context label $
|
||||||
|
it ("should be " ++ expected) $
|
||||||
|
userText (capitalizeName ch $ mkEditor str) `shouldBe` expected)
|
||||||
|
-- label, character, string, expected
|
||||||
|
[ ( "initial lower", 'a', "", "A" )
|
||||||
|
, ( "initial upper", 'A', "", "A" )
|
||||||
|
, ( "initial non-alpha", '0', "", "0" )
|
||||||
|
, ( "pre-comma lower", 'a', "A", "AA" )
|
||||||
|
, ( "pre-comma upper", 'A', "A", "AA" )
|
||||||
|
, ( "pre-comma non-alpha", '0', "A", "A0" )
|
||||||
|
, ( "post-comma first lower", 'a', "FOO, ", "FOO, A" )
|
||||||
|
, ( "post-comma first upper", 'A', "FOO, ", "FOO, A" )
|
||||||
|
, ( "post-comma first non-alpha", '0', "FOO, ", "FOO, 0" )
|
||||||
|
, ( "unrestricted upper", 'A', "FOO, A", "FOO, AA" )
|
||||||
|
, ( "unrestricted lower", 'a', "FOO, A", "FOO, Aa" )
|
||||||
|
, ( "unrestricted non-alpha", '0', "FOO, A", "FOO, A0" )
|
||||||
|
]
|
||||||
|
|||||||
Reference in New Issue
Block a user