Compare commits
25 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
c7849d3558 | ||
|
|
756d0997a8 | ||
|
|
569f009dcd | ||
|
|
cfe2969106 | ||
|
|
19e0242135 | ||
|
|
32f61ccc89 | ||
|
|
bfe568492d | ||
|
|
277ba9a9dd | ||
|
|
d338930800 | ||
|
|
363d0cb2d3 | ||
|
|
a91ed5afb3 | ||
|
|
db8bbd9786 | ||
|
|
c4f68bb29c | ||
|
|
e2c3b57749 | ||
|
|
3d1f6170f6 | ||
|
|
1a481ab49d | ||
|
|
afd2bac7b5 | ||
|
|
ffe9b7f87f | ||
|
|
e1a48afc5c | ||
|
|
1810434716 | ||
|
|
146e2e42a1 | ||
|
|
a9c036f876 | ||
|
|
0b249bcdae | ||
|
|
74fd4fe2fb | ||
|
|
5f53413ef7 |
@@ -1,5 +1,11 @@
|
||||
# Changelog for mtlstats
|
||||
|
||||
## v0.4.0
|
||||
|
||||
- Record penalty minutes
|
||||
- Calculate total game statistics
|
||||
- Generate year-to-date statistics report
|
||||
|
||||
## v0.3.0
|
||||
|
||||
- Record goals and assists
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
name: mtlstats
|
||||
version: 0.3.0
|
||||
version: 0.4.0
|
||||
github: "mtlstats/mtlstats"
|
||||
license: GPL-3
|
||||
author: "Jonathan Lamothe"
|
||||
|
||||
@@ -36,6 +36,10 @@ module Mtlstats.Actions
|
||||
, awardGoal
|
||||
, awardAssist
|
||||
, resetGoalData
|
||||
, assignPMins
|
||||
, backHome
|
||||
, scrollUp
|
||||
, scrollDown
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
@@ -45,6 +49,7 @@ import Data.Time.Calendar (fromGregorianValid)
|
||||
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Starts a new season
|
||||
startNewSeason :: ProgState -> ProgState
|
||||
@@ -210,3 +215,35 @@ resetGoalData ps = ps & progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Adds penalty minutes to a player
|
||||
assignPMins
|
||||
:: Int
|
||||
-- ^ The number of minutes to add
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
assignPMins mins s = fromMaybe s $ do
|
||||
n <- s^.progMode.gameStateL.selectedPlayer
|
||||
Just $ s
|
||||
& database.dbPlayers %~ modifyNth n
|
||||
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
||||
& progMode.gameStateL
|
||||
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
||||
(psPMin +~ mins)
|
||||
)
|
||||
. (selectedPlayer .~ Nothing)
|
||||
|
||||
-- | Resets the program state back to the main menu
|
||||
backHome :: ProgState -> ProgState
|
||||
backHome
|
||||
= (progMode .~ MainMenu)
|
||||
. (inputBuffer .~ "")
|
||||
. (scrollOffset .~ 0)
|
||||
|
||||
-- | Scrolls the display up
|
||||
scrollUp :: ProgState -> ProgState
|
||||
scrollUp = scrollOffset %~ max 0 . pred
|
||||
|
||||
-- | Scrolls the display down
|
||||
scrollDown :: ProgState -> ProgState
|
||||
scrollDown = scrollOffset %~ succ
|
||||
|
||||
@@ -24,8 +24,8 @@ module Mtlstats.Control (dispatch) where
|
||||
import Control.Monad (join, when)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Char (toUpper)
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (.~))
|
||||
import Data.Maybe (fromJust, fromMaybe, isJust)
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
@@ -55,6 +55,8 @@ dispatch s = case s^.progMode of
|
||||
| null $ gs^.overtimeFlag -> overtimeFlagC
|
||||
| not $ gs^.dataVerified -> verifyDataC
|
||||
| fromJust (unaccountedPoints gs) -> goalInput gs
|
||||
| isJust $ gs^.selectedPlayer -> getPMinsC
|
||||
| not $ gs^.pMinsRecorded -> pMinPlayerC
|
||||
| otherwise -> reportC
|
||||
CreatePlayer cps
|
||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||
@@ -241,19 +243,47 @@ confirmGoalDataC = Controller
|
||||
return True
|
||||
}
|
||||
|
||||
pMinPlayerC :: Controller
|
||||
pMinPlayerC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt pMinPlayerPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler pMinPlayerPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
getPMinsC :: Controller
|
||||
getPMinsC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.gameStateL.selectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerSummary player ++ "\n"
|
||||
drawPrompt assignPMinsPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler assignPMinsPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
reportC :: Controller
|
||||
reportC = Controller
|
||||
{ drawController = \s -> do
|
||||
(_, cols) <- C.windowSize
|
||||
C.drawString $ report (fromInteger $ pred cols) s
|
||||
(rows, cols) <- C.windowSize
|
||||
C.drawString $ unlines $ slice
|
||||
(s^.scrollOffset)
|
||||
(fromInteger $ pred rows)
|
||||
(report (fromInteger $ pred cols) s)
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
when
|
||||
(case e of
|
||||
C.EventCharacter _ -> True
|
||||
C.EventSpecialKey _ -> True
|
||||
_ -> False) $
|
||||
modify $ progMode .~ MainMenu
|
||||
case e of
|
||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||
C.EventSpecialKey _ -> modify backHome
|
||||
C.EventCharacter _ -> modify backHome
|
||||
_ -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
|
||||
@@ -38,7 +38,9 @@ module Mtlstats.Prompt (
|
||||
playerPosPrompt,
|
||||
selectPlayerPrompt,
|
||||
recordGoalPrompt,
|
||||
recordAssistPrompt
|
||||
recordAssistPrompt,
|
||||
pMinPlayerPrompt,
|
||||
assignPMinsPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
@@ -234,5 +236,16 @@ recordAssistPrompt game goal assist = selectPlayerPrompt
|
||||
when (nAssists >= maxAssists) $
|
||||
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||
|
||||
pMinPlayerPrompt :: Prompt
|
||||
pMinPlayerPrompt = selectPlayerPrompt
|
||||
"Assign penalty minutes to: " $
|
||||
\case
|
||||
Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True
|
||||
Just n -> modify $ progMode.gameStateL.selectedPlayer ?~ n
|
||||
|
||||
assignPMinsPrompt :: Prompt
|
||||
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
||||
modify . assignPMins
|
||||
|
||||
drawSimplePrompt :: String -> ProgState -> C.Update ()
|
||||
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
|
||||
|
||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Report (report, gameDate) where
|
||||
module Mtlstats.Report (report, gameDate, playerNameColWidth) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
@@ -36,8 +36,16 @@ report
|
||||
-- ^ The number of columns for the report
|
||||
-> ProgState
|
||||
-- ^ The program state
|
||||
-> String
|
||||
report width s = unlines $ fromMaybe [] $ do
|
||||
-> [String]
|
||||
report width s
|
||||
= standingsReport width s
|
||||
++ [""]
|
||||
++ gameStatsReport width s
|
||||
++ [""]
|
||||
++ yearToDateStatsReport width s
|
||||
|
||||
standingsReport :: Int -> ProgState -> [String]
|
||||
standingsReport width s = fromMaybe [] $ do
|
||||
let
|
||||
db = s^.database
|
||||
gs = s^.progMode.gameStateL
|
||||
@@ -48,15 +56,9 @@ report width s = unlines $ fromMaybe [] $ do
|
||||
hStats = db^.dbHomeGameStats
|
||||
aStats = db^.dbAwayGameStats
|
||||
tStats = addGameStats hStats aStats
|
||||
players = db^.dbPlayers
|
||||
hScore <- gs^.homeScore
|
||||
aScore <- gs^.awayScore
|
||||
pStats <- mapM
|
||||
(\(n, stats) -> do
|
||||
player <- nth n players
|
||||
Just (player, stats))
|
||||
(M.toList $ gs^.gamePlayerStats)
|
||||
Just $
|
||||
Just
|
||||
[ overlay
|
||||
("GAME NUMBER " ++ padNum 2 gNum)
|
||||
(centre width
|
||||
@@ -86,12 +88,38 @@ report width s = unlines $ fromMaybe [] $ do
|
||||
, centre width
|
||||
$ left 11 "TOTALS"
|
||||
++ showStats tStats
|
||||
, ""
|
||||
, centre width "GAME STATISTICS"
|
||||
]
|
||||
|
||||
gameStatsReport :: Int -> ProgState -> [String]
|
||||
gameStatsReport width s = playerReport width "GAME" $
|
||||
fromMaybe [] $ mapM
|
||||
(\(pid, stats) -> do
|
||||
p <- nth pid $ s^.database.dbPlayers
|
||||
Just (p, stats))
|
||||
(M.toList $ s^.progMode.gameStateL.gamePlayerStats)
|
||||
|
||||
yearToDateStatsReport :: Int -> ProgState -> [String]
|
||||
yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
|
||||
map (\p -> (p, p^.pYtd)) $
|
||||
filter playerIsActive $ s^.database.dbPlayers
|
||||
|
||||
gameDate :: GameState -> String
|
||||
gameDate gs = fromMaybe "" $ do
|
||||
year <- show <$> gs^.gameYear
|
||||
month <- month <$> gs^.gameMonth
|
||||
day <- padNum 2 <$> gs^.gameDay
|
||||
Just $ month ++ " " ++ day ++ " " ++ year
|
||||
|
||||
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
||||
playerReport width label ps = let
|
||||
nameWidth = playerNameColWidth $ map fst ps
|
||||
tStats = foldr (addPlayerStats . snd) newPlayerStats ps
|
||||
in
|
||||
[ centre width (label ++ " STATISTICS")
|
||||
, ""
|
||||
, centre width
|
||||
$ "NO. "
|
||||
++ left 20 "PLAYER"
|
||||
++ left nameWidth "PLAYER"
|
||||
++ right 3 "G"
|
||||
++ right 6 "A"
|
||||
++ right 6 "P"
|
||||
@@ -100,19 +128,30 @@ report width s = unlines $ fromMaybe [] $ do
|
||||
(\(p, stats) -> centre width
|
||||
$ right 2 (show $ p^.pNumber)
|
||||
++ " "
|
||||
++ left 20 (p^.pName)
|
||||
++ left nameWidth (p^.pName)
|
||||
++ right 3 (show $ stats^.psGoals)
|
||||
++ right 6 (show $ stats^.psAssists)
|
||||
++ right 6 (show $ pPoints stats)
|
||||
++ right 6 (show $ psPoints stats)
|
||||
++ right 6 (show $ stats^.psPMin))
|
||||
pStats
|
||||
ps ++
|
||||
[ centre width
|
||||
$ replicate (4 + nameWidth) ' '
|
||||
++ replicate (3 + 3 * 6) '-'
|
||||
, overlay
|
||||
(label ++ " TOTALS")
|
||||
( centre width
|
||||
$ replicate (4 + nameWidth) ' '
|
||||
++ right 3 (show $ tStats^.psGoals)
|
||||
++ right 6 (show $ tStats^.psAssists)
|
||||
++ right 6 (show $ psPoints tStats)
|
||||
++ right 6 (show $ tStats^.psPMin)
|
||||
)
|
||||
]
|
||||
|
||||
gameDate :: GameState -> String
|
||||
gameDate gs = fromMaybe "" $ do
|
||||
year <- show <$> gs^.gameYear
|
||||
month <- month <$> gs^.gameMonth
|
||||
day <- padNum 2 <$> gs^.gameDay
|
||||
Just $ month ++ " " ++ day ++ " " ++ year
|
||||
playerNameColWidth :: [Player] -> Int
|
||||
playerNameColWidth = foldr
|
||||
(\player current -> max current $ succ $ length $ player^.pName)
|
||||
10
|
||||
|
||||
showStats :: GameStats -> String
|
||||
showStats gs
|
||||
|
||||
@@ -42,6 +42,7 @@ module Mtlstats.Types (
|
||||
database,
|
||||
progMode,
|
||||
inputBuffer,
|
||||
scrollOffset,
|
||||
-- ** ProgMode Lenses
|
||||
gameStateL,
|
||||
createPlayerStateL,
|
||||
@@ -60,6 +61,8 @@ module Mtlstats.Types (
|
||||
assistsBy,
|
||||
gamePlayerStats,
|
||||
confirmGoalDataFlag,
|
||||
selectedPlayer,
|
||||
pMinsRecorded,
|
||||
-- ** CreatePlayerState Lenses
|
||||
cpsNumber,
|
||||
cpsName,
|
||||
@@ -126,11 +129,14 @@ module Mtlstats.Types (
|
||||
gmsPoints,
|
||||
addGameStats,
|
||||
-- ** Player Helpers
|
||||
pPoints,
|
||||
playerSearch,
|
||||
playerSearchExact,
|
||||
modifyPlayer,
|
||||
playerSummary
|
||||
playerSummary,
|
||||
playerIsActive,
|
||||
-- ** PlayerStats Helpers
|
||||
psPoints,
|
||||
addPlayerStats
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (StateT)
|
||||
@@ -174,6 +180,8 @@ data ProgState = ProgState
|
||||
-- ^ The program's mode
|
||||
, _inputBuffer :: String
|
||||
-- ^ Buffer for user input
|
||||
, _scrollOffset :: Int
|
||||
-- ^ The scrolling offset for the display
|
||||
}
|
||||
|
||||
-- | The program mode
|
||||
@@ -221,6 +229,10 @@ data GameState = GameState
|
||||
-- ^ The player stats accumulated over the game
|
||||
, _confirmGoalDataFlag :: Bool
|
||||
-- ^ Set when the user confirms the goal data
|
||||
, _selectedPlayer :: Maybe Int
|
||||
-- ^ Index number of the selected 'Player'
|
||||
, _pMinsRecorded :: Bool
|
||||
-- ^ Set when the penalty mintes have been recorded
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | The type of game
|
||||
@@ -502,6 +514,7 @@ newProgState = ProgState
|
||||
{ _database = newDatabase
|
||||
, _progMode = MainMenu
|
||||
, _inputBuffer = ""
|
||||
, _scrollOffset = 0
|
||||
}
|
||||
|
||||
-- | Constructor for a 'GameState'
|
||||
@@ -521,6 +534,8 @@ newGameState = GameState
|
||||
, _assistsBy = []
|
||||
, _gamePlayerStats = M.empty
|
||||
, _confirmGoalDataFlag = False
|
||||
, _selectedPlayer = Nothing
|
||||
, _pMinsRecorded = False
|
||||
}
|
||||
|
||||
-- | Constructor for a 'CreatePlayerState'
|
||||
@@ -675,10 +690,6 @@ addGameStats s1 s2 = GameStats
|
||||
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
|
||||
}
|
||||
|
||||
-- | Calculates a player's points
|
||||
pPoints :: PlayerStats -> Int
|
||||
pPoints s = s^.psGoals + s^.psAssists
|
||||
|
||||
-- | Searches through a list of players
|
||||
playerSearch
|
||||
:: String
|
||||
@@ -725,3 +736,24 @@ modifyPlayer f n = map
|
||||
playerSummary :: Player -> String
|
||||
playerSummary p =
|
||||
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
|
||||
|
||||
-- | Determines whether or not a player has been active in the current
|
||||
-- season/year
|
||||
playerIsActive :: Player -> Bool
|
||||
playerIsActive = do
|
||||
stats <- (^.pYtd)
|
||||
return
|
||||
$ stats^.psGoals /= 0
|
||||
|| stats^.psAssists /= 0
|
||||
|| stats^.psPMin /= 0
|
||||
|
||||
-- | Calculates a player's points
|
||||
psPoints :: PlayerStats -> Int
|
||||
psPoints s = s^.psGoals + s^.psAssists
|
||||
|
||||
-- | Adds two 'PlayerStats' together
|
||||
addPlayerStats :: PlayerStats -> PlayerStats -> PlayerStats
|
||||
addPlayerStats s1 s2 = newPlayerStats
|
||||
& psGoals .~ s1^.psGoals + s2^.psGoals
|
||||
& psAssists .~ s1^.psAssists + s2^.psAssists
|
||||
& psPMin .~ s1^.psPMin + s2^.psPMin
|
||||
|
||||
@@ -19,11 +19,59 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Util (nth) where
|
||||
module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
|
||||
|
||||
nth :: Int -> [a] -> Maybe a
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- | Attempt to select the element from a list at a given index
|
||||
nth
|
||||
:: Int
|
||||
-- ^ The index
|
||||
-> [a]
|
||||
-- ^ The list
|
||||
-> Maybe a
|
||||
nth _ [] = Nothing
|
||||
nth n (x:xs)
|
||||
| n == 0 = Just x
|
||||
| n < 0 = Nothing
|
||||
| otherwise = nth (pred n) xs
|
||||
|
||||
-- | Attempt to modify the index at a given index in a list
|
||||
modifyNth
|
||||
:: Int
|
||||
-- ^ The index
|
||||
-> (a -> a)
|
||||
-- ^ The modification function
|
||||
-> [a]
|
||||
-- ^ The list
|
||||
-> [a]
|
||||
modifyNth n f = map (\(i, x) -> if i == n then f x else x)
|
||||
. zip [0..]
|
||||
|
||||
-- | Modify a value indexed by a given key in a map using a default
|
||||
-- initial value if not present
|
||||
updateMap
|
||||
:: Ord k
|
||||
=> k
|
||||
-- ^ The key
|
||||
-> a
|
||||
-- ^ The default initial value
|
||||
-> (a -> a)
|
||||
-- ^ The modification function
|
||||
-> M.Map k a
|
||||
-- ^ The map
|
||||
-> M.Map k a
|
||||
updateMap k def f m = let
|
||||
x = M.findWithDefault def k m
|
||||
in M.insert k (f x) m
|
||||
|
||||
-- | Selects a section of a list
|
||||
slice
|
||||
:: Int
|
||||
-- ^ The index to start at
|
||||
-> Int
|
||||
-- ^ The number of elements to take
|
||||
-> [a]
|
||||
-- ^ The list to take a subset of
|
||||
-> [a]
|
||||
slice offset len = take len . drop offset
|
||||
|
||||
@@ -19,16 +19,29 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module ActionsSpec (spec) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import System.Random (randomRIO)
|
||||
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe)
|
||||
import Test.Hspec
|
||||
( Spec
|
||||
, context
|
||||
, describe
|
||||
, it
|
||||
, runIO
|
||||
, shouldBe
|
||||
, shouldNotBe
|
||||
, shouldSatisfy
|
||||
)
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Actions" $ do
|
||||
@@ -46,6 +59,10 @@ spec = describe "Mtlstats.Actions" $ do
|
||||
awardGoalSpec
|
||||
awardAssistSpec
|
||||
resetGoalDataSpec
|
||||
assignPMinsSpec
|
||||
backHomeSpec
|
||||
scrollUpSpec
|
||||
scrollDownSpec
|
||||
|
||||
startNewSeasonSpec :: Spec
|
||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||
@@ -545,6 +562,62 @@ resetGoalDataSpec = describe "resetGoalData" $ do
|
||||
it "should clear confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
assignPMinsSpec :: Spec
|
||||
assignPMinsSpec = describe "assignPMins" $ let
|
||||
|
||||
bob = newPlayer 2 "Bob" "centre"
|
||||
& pYtd.psPMin .~ 3
|
||||
& pLifetime.psPMin .~ 4
|
||||
|
||||
joe = newPlayer 3 "Joe" "defense"
|
||||
& pYtd.psPMin .~ 5
|
||||
& pLifetime.psPMin .~ 6
|
||||
|
||||
ps pid = newProgState
|
||||
& database.dbPlayers .~ [bob, joe]
|
||||
& progMode.gameStateL
|
||||
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
|
||||
. (selectedPlayer .~ pid)
|
||||
|
||||
in mapM_
|
||||
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
|
||||
context ("selectedPlayer = " ++ show pid) $ do
|
||||
let ps' = assignPMins 2 $ ps pid
|
||||
|
||||
mapM_
|
||||
(\(name, pid', lt, ytd, game) -> context name $ do
|
||||
let
|
||||
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
|
||||
gStats = ps'^.progMode.gameStateL.gamePlayerStats
|
||||
pStats = M.findWithDefault newPlayerStats pid' gStats
|
||||
|
||||
context "lifetime penalty minutes" $
|
||||
it ("should be " ++ show lt) $
|
||||
player^.pLifetime.psPMin `shouldBe` lt
|
||||
|
||||
context "year-to-date penalty minutes" $
|
||||
it ("should be " ++ show ytd) $
|
||||
player^.pYtd.psPMin `shouldBe` ytd
|
||||
|
||||
context "game penalty minutes" $
|
||||
it ("should be " ++ show game) $
|
||||
pStats^.psPMin `shouldBe` game)
|
||||
|
||||
-- name, index, lifetime, ytd, game
|
||||
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
|
||||
, ( "Joe", 1, joeLt, joeYtd, joeGame )
|
||||
]
|
||||
|
||||
it "should set selectedPlayer to Nothing" $
|
||||
ps'^.progMode.gameStateL.selectedPlayer `shouldBe` Nothing)
|
||||
|
||||
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
|
||||
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
|
||||
, ( Just 1, 4, 3, 2, 8, 7, 2 )
|
||||
, ( Just 2, 4, 3, 2, 6, 5, 0 )
|
||||
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
||||
]
|
||||
|
||||
makePlayer :: IO Player
|
||||
makePlayer = Player
|
||||
<$> makeNum
|
||||
@@ -581,3 +654,49 @@ makeNum = randomRIO (1, 10)
|
||||
|
||||
makeName :: IO String
|
||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||
|
||||
backHomeSpec :: Spec
|
||||
backHomeSpec = describe "backHome" $ do
|
||||
let
|
||||
input = newProgState
|
||||
& progMode.gameStateL .~ newGameState
|
||||
& inputBuffer .~ "foo"
|
||||
& scrollOffset .~ 123
|
||||
result = backHome input
|
||||
|
||||
it "should set the program mode back to MainMenu" $
|
||||
result^.progMode `shouldSatisfy` \case
|
||||
MainMenu -> True
|
||||
_ -> False
|
||||
|
||||
it "should clear the input buffer" $
|
||||
result^.inputBuffer `shouldBe` ""
|
||||
|
||||
it "should reset the scroll offset" $
|
||||
result^.scrollOffset `shouldBe` 0
|
||||
|
||||
scrollUpSpec :: Spec
|
||||
scrollUpSpec = describe "scrollUp" $ do
|
||||
|
||||
context "scrolled down" $
|
||||
it "should decrease the scroll offset by one" $ let
|
||||
ps = newProgState & scrollOffset .~ 10
|
||||
ps' = scrollUp ps
|
||||
in ps'^.scrollOffset `shouldBe` 9
|
||||
|
||||
context "at top" $
|
||||
it "should keep the scroll offset at zero" $ let
|
||||
ps = scrollUp newProgState
|
||||
in ps^.scrollOffset `shouldBe` 0
|
||||
|
||||
context "above top" $
|
||||
it "should return the scroll offset to zero" $ let
|
||||
ps = newProgState & scrollOffset .~ (-10)
|
||||
ps' = scrollUp ps
|
||||
in ps'^.scrollOffset `shouldBe` 0
|
||||
|
||||
scrollDownSpec = describe "scrollDown" $
|
||||
it "should increase the scroll offset" $ let
|
||||
ps = newProgState & scrollOffset .~ 10
|
||||
ps' = scrollDown ps
|
||||
in ps'^.scrollOffset `shouldBe` 11
|
||||
|
||||
@@ -28,8 +28,9 @@ import Mtlstats.Report
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Report"
|
||||
spec = describe "Mtlstats.Report" $ do
|
||||
gameDateSpec
|
||||
playerNameColWidthSpec
|
||||
|
||||
gameDateSpec :: Spec
|
||||
gameDateSpec = describe "gameDate" $ do
|
||||
@@ -45,3 +46,20 @@ gameDateSpec = describe "gameDate" $ do
|
||||
context "invalid date" $
|
||||
it "should return an empty string" $
|
||||
gameDate newGameState `shouldBe` ""
|
||||
|
||||
playerNameColWidthSpec :: Spec
|
||||
playerNameColWidthSpec = describe "playerNameColWidth" $ do
|
||||
let
|
||||
short1 = newPlayer 1 "short" "foo"
|
||||
short2 = newPlayer 2 "shorty" "bar"
|
||||
long = newPlayer 3 "123456789012345" "baz"
|
||||
|
||||
mapM_
|
||||
(\(label, players, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
playerNameColWidth players `shouldBe` expected)
|
||||
-- label, players, expected
|
||||
[ ( "empty list", [], 10 )
|
||||
, ( "short names", [short1, short2], 10 )
|
||||
, ( "long name", [short1, long], 16 )
|
||||
]
|
||||
|
||||
@@ -54,11 +54,13 @@ spec = describe "Mtlstats.Types" $ do
|
||||
gmsGamesSpec
|
||||
gmsPointsSpec
|
||||
addGameStatsSpec
|
||||
pPointsSpec
|
||||
playerSearchSpec
|
||||
playerSearchExactSpec
|
||||
modifyPlayerSpec
|
||||
playerSummarySpec
|
||||
playerIsActiveSpec
|
||||
psPointsSpec
|
||||
addPlayerStatsSpec
|
||||
Menu.spec
|
||||
|
||||
playerSpec :: Spec
|
||||
@@ -509,24 +511,6 @@ addGameStatsSpec = describe "addGameStats" $
|
||||
|
||||
in addGameStats s1 s2 `shouldBe` expected
|
||||
|
||||
pPointsSpec :: Spec
|
||||
pPointsSpec = describe "pPoints" $ mapM_
|
||||
(\(goals, assists, points) -> let
|
||||
desc = "goals: " ++ show goals ++
|
||||
", assists: " ++ show assists
|
||||
stats = newPlayerStats &
|
||||
psGoals .~ goals &
|
||||
psAssists .~ assists
|
||||
in context desc $
|
||||
it ("should be " ++ show points) $
|
||||
pPoints stats `shouldBe` points)
|
||||
-- goals, assists, points
|
||||
[ ( 0, 0, 0 )
|
||||
, ( 1, 0, 1 )
|
||||
, ( 0, 1, 1 )
|
||||
, ( 2, 3, 5 )
|
||||
]
|
||||
|
||||
playerSearchSpec :: Spec
|
||||
playerSearchSpec = describe "playerSearch" $ mapM_
|
||||
(\(sStr, expected) -> context sStr $
|
||||
@@ -584,6 +568,71 @@ playerSummarySpec = describe "playerSummary" $
|
||||
it "should be \"Joe (2) center\"" $
|
||||
playerSummary joe `shouldBe` "Joe (2) center"
|
||||
|
||||
playerIsActiveSpec :: Spec
|
||||
playerIsActiveSpec = describe "playerIsActive" $ do
|
||||
let
|
||||
pState = newPlayerStats
|
||||
& psGoals .~ 10
|
||||
& psAssists .~ 11
|
||||
& psPMin .~ 12
|
||||
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
|
||||
|
||||
mapM_
|
||||
(\(label, player', expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
playerIsActive player' `shouldBe` expected)
|
||||
-- label, player, expected
|
||||
[ ( "not active", player, False )
|
||||
, ( "has goal", player & pYtd.psGoals .~ 1, True )
|
||||
, ( "has assist", player & pYtd.psAssists .~ 1, True )
|
||||
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True )
|
||||
]
|
||||
|
||||
psPointsSpec :: Spec
|
||||
psPointsSpec = describe "psPoints" $ mapM_
|
||||
(\(goals, assists, points) -> let
|
||||
desc = "goals: " ++ show goals ++
|
||||
", assists: " ++ show assists
|
||||
stats = newPlayerStats &
|
||||
psGoals .~ goals &
|
||||
psAssists .~ assists
|
||||
in context desc $
|
||||
it ("should be " ++ show points) $
|
||||
psPoints stats `shouldBe` points)
|
||||
-- goals, assists, points
|
||||
[ ( 0, 0, 0 )
|
||||
, ( 1, 0, 1 )
|
||||
, ( 0, 1, 1 )
|
||||
, ( 2, 3, 5 )
|
||||
]
|
||||
|
||||
addPlayerStatsSpec :: Spec
|
||||
addPlayerStatsSpec = describe "addPlayerStats" $ do
|
||||
let
|
||||
s1
|
||||
= newPlayerStats
|
||||
& psGoals .~ 1
|
||||
& psAssists .~ 2
|
||||
& psPMin .~ 3
|
||||
s2
|
||||
= newPlayerStats
|
||||
& psGoals .~ 4
|
||||
& psAssists .~ 5
|
||||
& psPMin .~ 6
|
||||
s3 = addPlayerStats s1 s2
|
||||
|
||||
describe "psGoals" $
|
||||
it "should be 5" $
|
||||
s3^.psGoals `shouldBe` 5
|
||||
|
||||
describe "psAssists" $
|
||||
it "should be 7" $
|
||||
s3^.psAssists `shouldBe` 7
|
||||
|
||||
describe "psPMin" $
|
||||
it "should be 9" $
|
||||
s3^.psPMin `shouldBe` 9
|
||||
|
||||
joe :: Player
|
||||
joe = newPlayer 2 "Joe" "center"
|
||||
|
||||
|
||||
@@ -21,13 +21,17 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module UtilSpec (spec) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Util
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Util"
|
||||
spec = describe "Mtlstats.Util" $ do
|
||||
nthSpec
|
||||
modifyNthSpec
|
||||
updateMapSpec
|
||||
sliceSpec
|
||||
|
||||
nthSpec :: Spec
|
||||
nthSpec = describe "nth" $ mapM_
|
||||
@@ -42,3 +46,49 @@ nthSpec = describe "nth" $ mapM_
|
||||
, ( 3, Nothing )
|
||||
, ( -1, Nothing )
|
||||
]
|
||||
|
||||
modifyNthSpec :: Spec
|
||||
modifyNthSpec = describe "modifyNth" $ do
|
||||
|
||||
context "in bounds" $
|
||||
it "should modify the value" $
|
||||
modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
|
||||
|
||||
context "out of bounds" $
|
||||
it "should not modify the value" $
|
||||
modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
||||
|
||||
context "negative index" $
|
||||
it "should not modify the value" $
|
||||
modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
||||
|
||||
updateMapSpec :: Spec
|
||||
updateMapSpec = describe "updateMap" $ do
|
||||
let
|
||||
input = M.fromList [(1, 2), (3, 5)]
|
||||
|
||||
context "key found" $ let
|
||||
expected = M.fromList [(1, 3), (3, 5)]
|
||||
in it "should update the value" $
|
||||
updateMap 1 10 succ input `shouldBe` expected
|
||||
|
||||
context "key not found" $ let
|
||||
expected = M.fromList [(1, 2), (3, 5), (10, 11)]
|
||||
in it "should create a new value and update the default" $
|
||||
updateMap 10 10 succ input `shouldBe` expected
|
||||
|
||||
sliceSpec :: Spec
|
||||
sliceSpec = describe "slice" $ do
|
||||
let list = [2, 4, 6, 8]
|
||||
|
||||
context "sublist" $
|
||||
it "should return the sublist" $
|
||||
slice 1 2 list `shouldBe` [4, 6]
|
||||
|
||||
context "too large" $
|
||||
it "should return as much of the list as possible" $
|
||||
slice 1 100 list `shouldBe` [4, 6, 8]
|
||||
|
||||
context "negative offset" $
|
||||
it "should return the correct number of elements from the beginning" $
|
||||
slice (-10) 2 list `shouldBe` [2, 4]
|
||||
|
||||
Reference in New Issue
Block a user