fingerprint/mtlstats
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge pull request #10 from mtlstats/game-stats 

Generate game stats report
This commit is contained in:
Jonathan Lamothe 2019-09-04 01:08:22 -04:00 committed by GitHub
parent c72ccf80bf 5b6ecc8c40
commit 1e2f65234b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
14 changed files with 1244 additions and 345 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
package.yaml
View File

@ -26,7 +26,7 @@ dependencies:
- microlens-th >= 0.4.2.3 && < 0.5
- ncurses >= 0.2.16 && < 0.3
- random >= 1.1 && < 1.2
- raw-strings-qq >= 1.1 && < 1.2
- time >= 1.8.0.2 && < 1.9
- transformers >= 0.5.6.2 && < 0.6
- bytestring
- microlens
@ -56,3 +56,4 @@ tests:
dependencies:
- mtlstats
- hspec >= 2.7.1 && < 2.8
- unordered-containers

55
src/Mtlstats/Actions.hs
View File

@ -27,9 +27,14 @@ module Mtlstats.Actions
, startNewGame
, addChar
, removeChar
, overtimeCheck
, updateGameStats
, validateGameDate
) where
import Lens.Micro (over, (&), (.~), (?~), (%~))
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (fromGregorianValid)
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
import Mtlstats.Types
@ -58,3 +63,51 @@ removeChar :: ProgState -> ProgState
removeChar = inputBuffer %~ \case
"" -> ""
str -> init str
-- | Determines whether or not to perform a check for overtime
overtimeCheck :: ProgState -> ProgState
overtimeCheck s
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
s & progMode.gameStateL
%~ (homeScore .~ Nothing)
. (awayScore .~ Nothing)
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
s & progMode.gameStateL.overtimeFlag ?~ False
| otherwise = s
-- | Adjusts the game stats based on the results of the current game
updateGameStats :: ProgState -> ProgState
updateGameStats s = fromMaybe s $ do
gType <- s^.progMode.gameStateL.gameType
won <- gameWon $ s^.progMode.gameStateL
lost <- gameLost $ s^.progMode.gameStateL
ot <- s^.progMode.gameStateL.overtimeFlag
let
hw = if gType == HomeGame && won then 1 else 0
hl = if gType == HomeGame && lost then 1 else 0
hot = if gType == HomeGame && ot then 1 else 0
aw = if gType == AwayGame && won then 1 else 0
al = if gType == AwayGame && lost then 1 else 0
aot = if gType == AwayGame && ot then 1 else 0
Just $ s
& database.dbHomeGameStats
%~ (gmsWins +~ hw)
. (gmsLosses +~ hl)
. (gmsOvertime +~ hot)
& database.dbAwayGameStats
%~ (gmsWins +~ aw)
. (gmsLosses +~ al)
. (gmsOvertime +~ aot)
-- | Validates the game date
validateGameDate :: ProgState -> ProgState
validateGameDate s = fromMaybe s $ do
y <- toInteger <$> s^.progMode.gameStateL.gameYear
m <- s^.progMode.gameStateL.gameMonth
d <- s^.progMode.gameStateL.gameDay
Just $ if null $ fromGregorianValid y m d
then s & progMode.gameStateL
%~ (gameYear .~ Nothing)
. (gameMonth .~ Nothing)
. (gameDay .~ Nothing)
else s

26
src/Mtlstats/Config.hs Normal file
View File

@ -0,0 +1,26 @@
{- |
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.Config where
-- | The name of the team whose stats we're tracking
myTeam :: String
myTeam = "MONTREAL"

42
src/Mtlstats/Events.hs
View File

@ -23,7 +23,9 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Events (handleEvent) where
import Control.Monad (when)
import Control.Monad.Trans.State (gets, modify)
import Data.Char (toUpper)
import Lens.Micro ((^.), (.~))
import Lens.Micro.Extras (view)
import qualified UI.NCurses as C
@ -42,16 +44,46 @@ handleEvent e = gets (view progMode) >>= \case
MainMenu -> menuHandler mainMenu e
NewSeason -> menuHandler newSeasonMenu e >> return True
NewGame gs
| null $ gs ^. gameType -> do
| null $ gs^.gameYear -> do
promptHandler gameYearPrompt e
return True
| null $ gs^.gameMonth -> do
menuHandler gameMonthMenu e
return True
| null $ gs^.gameDay -> do
promptHandler gameDayPrompt e
modify validateGameDate
return True
| null $ gs^.gameType -> do
menuHandler gameTypeMenu e
return True
| null $ gs ^. otherTeam -> do
| null $ gs^.otherTeam -> do
promptHandler otherTeamPrompt e
return True
| null $ gs ^. homeScore -> do
| null $ gs^.homeScore -> do
promptHandler homeScorePrompt e
return True
| null $ gs ^. awayScore -> do
| null $ gs^.awayScore -> do
promptHandler awayScorePrompt e
modify overtimeCheck
modify updateGameStats
return True
| otherwise -> undefined
| null $ gs^.overtimeFlag -> do
overtimePrompt e
>>= modify . (progMode.gameStateL.overtimeFlag .~)
modify updateGameStats
return True
| otherwise -> do
when
(case e of
C.EventCharacter _ -> True
C.EventSpecialKey _ -> True
_ -> False) $
modify $ progMode .~ MainMenu
return True
overtimePrompt :: C.Event -> Action (Maybe Bool)
overtimePrompt (C.EventCharacter c) = case toUpper c of
'Y' -> return (Just True)
'N' -> return (Just False)
_ -> return Nothing

103
src/Mtlstats/Format.hs Normal file
View File

@ -0,0 +1,103 @@
{- |
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.Format
( padNum
, left
, right
, centre
, overlay
, month
) where
-- | Pad an 'Int' with leading zeroes to fit a certain character width
padNum
:: Int
-- ^ The width in characters
-> Int
-- ^ The value to format
-> String
padNum size n
| n < 0 = '-' : padNum (pred size) (-n)
| otherwise = let
str = show n
sLen = length str
pLen = size - sLen
pad = replicate pLen '0'
in pad ++ str
-- | Aligns text to the left within a field (clipping if necessary)
left
:: Int
-- ^ The width of the field
-> String
-- ^ The text to align
-> String
left n str = take n $ str ++ repeat ' '
-- | Aligns text to the right within a field (clipping if necessary)
right
:: Int
-- ^ The width of the field
-> String
-- ^ The text to align
-> String
right n str = reverse $ left n $ reverse str
-- | Aligns text to the centre within a field (clipping if necessary)
centre
:: Int
-- ^ The width of the field
-> String
-- ^ The text to align
-> String
centre n str = let
sLen = length str
pLen = (n - sLen) `div` 2
pad = replicate pLen ' '
in take n $ pad ++ str ++ repeat ' '
-- | Overlays one string on top of another
overlay
:: String
-- ^ The string on the top
-> String
-- ^ The string on the bottom
-> String
overlay (x:xs) (_:ys) = x : overlay xs ys
overlay xs [] = xs
overlay [] ys = ys
-- | Converts a number to a three character month (e.g. @"JAN"@)
month :: Int -> String
month 1 = "JAN"
month 2 = "FEB"
month 3 = "MAR"
month 4 = "APR"
month 5 = "MAY"
month 6 = "JUN"
month 7 = "JUL"
month 8 = "AUG"
month 9 = "SEP"
month 10 = "OCT"
month 11 = "NOV"
month 12 = "DEC"
month _ = ""

36
src/Mtlstats/Menu.hs
View File

@ -26,10 +26,12 @@ module Mtlstats.Menu (
-- * Menus
mainMenu,
newSeasonMenu,
gameMonthMenu,
gameTypeMenu
) where
import Control.Monad.Trans.State (modify)
import Data.Char (toUpper)
import Lens.Micro ((^.), (.~), (?~))
import qualified UI.NCurses as C
@ -46,10 +48,10 @@ drawMenu m = do
-- | The event handler for a 'Menu'
menuHandler :: Menu a -> C.Event -> Action a
menuHandler m (C.EventCharacter c) =
case filter (\i -> i ^. miKey == c) $ m ^. menuItems of
i:_ -> i ^. miAction
[] -> return $ m ^. menuDefault
menuHandler m _ = return $ m ^. menuDefault
case filter (\i -> i^.miKey == toUpper c) $ m^.menuItems of
i:_ -> i^.miAction
[] -> return $ m^.menuDefault
menuHandler m _ = return $ m^.menuDefault
-- | The main menu
mainMenu :: Menu Bool
@ -71,11 +73,31 @@ newSeasonMenu = Menu "*** SEASON TYPE ***" ()
modify startNewGame
]
-- | Requests the month in which the game took place
gameMonthMenu :: Menu ()
gameMonthMenu = Menu "Month:" () $ map
(\(ch, name, val) ->
MenuItem ch name $
modify $ progMode.gameStateL.gameMonth ?~ val)
[ ( 'A', "January", 1 )
, ( 'B', "February", 2 )
, ( 'C', "March", 3 )
, ( 'D', "April", 4 )
, ( 'E', "May", 5 )
, ( 'F', "June", 6 )
, ( 'G', "July", 7 )
, ( 'H', "August", 8 )
, ( 'I', "September", 9 )
, ( 'J', "October", 10 )
, ( 'K', "November", 11 )
, ( 'L', "December", 12 )
]
-- | The game type menu (home/away)
gameTypeMenu :: Menu ()
gameTypeMenu = Menu "*** GAME TYPE ***" ()
gameTypeMenu = Menu "Game type:" ()
[ MenuItem '1' "Home Game" $
modify $ progMode . gameTypeL ?~ HomeGame
modify $ progMode.gameStateL.gameType ?~ HomeGame
, MenuItem '2' "Away Game" $
modify $ progMode . gameTypeL ?~ AwayGame
modify $ progMode.gameStateL.gameType ?~ AwayGame
]

23
src/Mtlstats/Prompt.hs
View File

@ -26,6 +26,8 @@ module Mtlstats.Prompt (
strPrompt,
numPrompt,
-- * Individual prompts
gameYearPrompt,
gameDayPrompt,
otherTeamPrompt,
homeScorePrompt,
awayScorePrompt
@ -93,17 +95,30 @@ numPrompt pStr act = Prompt
, promptFunctionKey = const $ return ()
}
-- | Prompts for the game year
gameYearPrompt :: Prompt
gameYearPrompt = numPrompt "Game year: " $
modify . (progMode.gameStateL.gameYear ?~)
-- | Prompts for the day of the month the game took place
gameDayPrompt :: Prompt
gameDayPrompt = numPrompt "Day of month: " $
modify . (progMode.gameStateL.gameDay ?~)
-- | Prompts for the other team name
otherTeamPrompt :: Prompt
otherTeamPrompt = strPrompt "Other team: " $
modify . (progMode . otherTeamL .~)
modify . (progMode.gameStateL.otherTeam .~)
-- | Prompts for the home score
homeScorePrompt :: Prompt
homeScorePrompt = numPrompt "Home score: " $
modify . (progMode . homeScoreL ?~)
modify . (progMode.gameStateL.homeScore ?~)
-- | Prompts for the away score
awayScorePrompt :: Prompt
awayScorePrompt = numPrompt "Away score: " $
modify . (progMode . awayScoreL ?~)
modify . (progMode.gameStateL.awayScore ?~)
drawSimplePrompt :: String -> ProgState -> C.Update ()
drawSimplePrompt pStr s = C.drawString $ pStr ++ s ^. inputBuffer
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

90
src/Mtlstats/Report.hs Normal file
View File

@ -0,0 +1,90 @@
{- |
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.Report (report) where
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Types
-- | Generates the report
report
:: Int
-- ^ The number of columns for the report
-> ProgState
-- ^ The program state
-> String
report width s = unlines $ fromMaybe [] $ do
let
db = s^.database
gs = s^.progMode.gameStateL
gNum = db^.dbGames
hTeam = homeTeam gs
aTeam = awayTeam gs
hStats = db^.dbHomeGameStats
aStats = db^.dbAwayGameStats
tStats = addGameStats hStats aStats
hScore <- gs^.homeScore
aScore <- gs^.awayScore
month <- month <$> gs^.gameMonth
day <- padNum 2 <$> gs^.gameDay
year <- show <$> gs^.gameYear
let date = month ++ " " ++ day ++ " " ++ year
Just
[ overlay
("GAME NUMBER " ++ padNum 2 gNum)
(centre width
$ aTeam ++ " " ++ show aScore ++ " AT "
++ hTeam ++ " " ++ show hScore)
, date
, centre width "STANDINGS"
, ""
, centre width
$ left 11 myTeam
++ right 2 "G"
++ right 4 "W"
++ right 4 "L"
++ right 4 "OT"
++ right 4 "P"
, centre width
$ left 11 "HOME"
++ showStats hStats
, centre width
$ left 11 "ROAD"
++ showStats aStats
, centre width
$ replicate 11 ' '
++ replicate (2 + 4 * 4) '-'
, centre width
$ left 11 "TOTALS"
++ showStats tStats
]
showStats :: GameStats -> String
showStats gs
= right 2 (show $ gmsGames gs)
++ right 4 (show $ gs^.gmsWins)
++ right 4 (show $ gs^.gmsLosses)
++ right 4 (show $ gs^.gmsOvertime)
++ right 4 (show $ gmsPoints gs)

203
src/Mtlstats/Types.hs
View File

@ -33,26 +33,30 @@ module Mtlstats.Types (
PlayerStats (..),
Goalie (..),
GoalieStats (..),
GameStats (..),
Prompt (..),
-- * Lenses
-- ** ProgState Lenses
database,
progMode,
inputBuffer,
-- ** ProgMode Lenses
gameStateL,
-- ** GameState Lenses
gameYear,
gameMonth,
gameDay,
gameType,
otherTeam,
homeScore,
awayScore,
-- ** ProgMode Lenses
gameTypeL,
otherTeamL,
homeScoreL,
awayScoreL,
overtimeFlag,
-- ** Database Lenses
dbPlayers,
dbGoalies,
dbGames,
dbHomeGameStats,
dbAwayGameStats,
-- ** Player Lenses
pNumber,
pName,
@ -76,6 +80,10 @@ module Mtlstats.Types (
gsWins,
gsLosses,
gsTies,
-- ** GameStats Lenses
gmsWins,
gmsLosses,
gmsOvertime,
-- * Constructors
newProgState,
newGameState,
@ -84,9 +92,20 @@ module Mtlstats.Types (
newPlayerStats,
newGoalie,
newGoalieStats,
newGameStats,
-- * Helper Functions
-- ** ProgState Helpers
-- ** GameState Helpers
teamScore,
otherScore,
homeTeam,
awayTeam,
gameWon,
gameLost,
gameTied,
-- ** GameStats Helpers
gmsGames,
gmsPoints,
addGameStats,
-- ** Player Helpers
pPoints
) where
@ -108,6 +127,8 @@ import Lens.Micro (Lens', lens, (&), (^.), (.~))
import Lens.Micro.TH (makeLenses)
import UI.NCurses (Curses, Update)
import Mtlstats.Config
-- | Action which maintains program state
type Action a = StateT ProgState Curses a
@ -123,7 +144,13 @@ data ProgState = ProgState
-- | The game state
data GameState = GameState
{ _gameType :: Maybe GameType
{ _gameYear :: Maybe Int
-- ^ The year the game took place
, _gameMonth :: Maybe Int
-- ^ The month the game took place
, _gameDay :: Maybe Int
-- ^ The day of the month the game took place
, _gameType :: Maybe GameType
-- ^ The type of game (home/away)
, _otherTeam :: String
-- ^ The name of the other team
@ -131,6 +158,8 @@ data GameState = GameState
-- ^ The home team's score
, _awayScore :: Maybe Int
-- ^ The away team's score
, _overtimeFlag :: Maybe Bool
-- ^ Indicates whether or not the game went into overtime
} deriving (Eq, Show)
-- | The program mode
@ -154,6 +183,10 @@ data Database = Database
-- ^ The list of goalies
, _dbGames :: Int
-- ^ The number of games recorded
, _dbHomeGameStats :: GameStats
-- ^ Statistics for home games
, _dbAwayGameStats :: GameStats
-- ^ Statistics for away games
} deriving (Eq, Show)
instance FromJSON Database where
@ -161,17 +194,23 @@ instance FromJSON Database where
<$> v .: "players"
<*> v .: "goalies"
<*> v .: "games"
<*> v .: "home_game_stats"
<*> v .: "away_game_stats"
instance ToJSON Database where
toJSON (Database players goalies games) = object
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) = pairs $
toEncoding (Database players goalies games hgs ags) = pairs $
"players" .= players <>
"goalies" .= goalies <>
"games" .= games
"games" .= games <>
"home_game_stats" .= hgs <>
"away_game_stats" .= ags
-- | Represents a (non-goalie) player
data Player = Player
@ -316,6 +355,33 @@ instance ToJSON GoalieStats where
"losses" .= l <>
"ties" .= t
-- | Game statistics
data GameStats = GameStats
{ _gmsWins :: Int
-- ^ Games won
, _gmsLosses :: Int
-- ^ Games lost
, _gmsOvertime :: Int
-- ^ Games lost in overtime
} deriving (Eq, Show)
instance FromJSON GameStats where
parseJSON = withObject "GameStats" $ \v -> GameStats
<$> v .: "wins"
<*> v .: "losses"
<*> v .: "overtime"
instance ToJSON GameStats where
toJSON (GameStats w l ot) = object
[ "wins" .= w
, "losses" .= l
, "overtime" .= ot
]
toEncoding (GameStats w l ot) = pairs $
"wins" .= w <>
"losses" .= l <>
"overtime" .= ot
-- | Defines a user prompt
data Prompt = Prompt
{ promptDrawer :: ProgState -> Update ()
@ -335,42 +401,14 @@ makeLenses ''Player
makeLenses ''PlayerStats
makeLenses ''Goalie
makeLenses ''GoalieStats
makeLenses ''GameStats
gameTypeL :: Lens' ProgMode (Maybe GameType)
gameTypeL = lens
gameStateL :: Lens' ProgMode GameState
gameStateL = lens
(\case
NewGame gs -> gs ^. gameType
_ -> Nothing)
(\m gt -> case m of
NewGame gs -> NewGame $ gs & gameType .~ gt
_ -> NewGame $ newGameState & gameType .~ gt)
otherTeamL :: Lens' ProgMode String
otherTeamL = lens
(\case
NewGame gs -> gs ^. otherTeam
_ -> "")
(\m ot -> case m of
NewGame gs -> NewGame $ gs & otherTeam .~ ot
_ -> NewGame $ newGameState & otherTeam .~ ot)
homeScoreL :: Lens' ProgMode (Maybe Int)
homeScoreL = lens
(\case
NewGame gs -> gs ^. homeScore
_ -> Nothing)
(\m hs -> case m of
NewGame gs -> NewGame $ gs & homeScore .~ hs
_ -> NewGame $ newGameState & homeScore .~ hs)
awayScoreL :: Lens' ProgMode (Maybe Int)
awayScoreL = lens
(\case
NewGame gs -> gs ^. awayScore
_ -> Nothing)
(\m as -> case m of
NewGame gs -> NewGame $ gs & awayScore .~ as
_ -> NewGame $ newGameState & awayScore .~ as)
NewGame gs -> gs
_ -> newGameState)
(\_ gs -> NewGame gs)
-- | Constructor for a 'ProgState'
newProgState :: ProgState
@ -383,10 +421,14 @@ newProgState = ProgState
-- | Constructor for a 'GameState'
newGameState :: GameState
newGameState = GameState
{ _gameType = Nothing
{ _gameYear = Nothing
, _gameMonth = Nothing
, _gameDay = Nothing
, _gameType = Nothing
, _otherTeam = ""
, _homeScore = Nothing
, _awayScore = Nothing
, _overtimeFlag = Nothing
}
-- | Constructor for a 'Database'
@ -395,6 +437,8 @@ newDatabase = Database
{ _dbPlayers = []
, _dbGoalies = []
, _dbGames = 0
, _dbHomeGameStats = newGameStats
, _dbAwayGameStats = newGameStats
}
-- | Constructor for a 'Player'
@ -448,13 +492,72 @@ newGoalieStats = GoalieStats
, _gsTies = 0
}
-- | Determines the team's points
teamScore :: ProgState -> Maybe Int
teamScore s = case s ^. progMode . gameTypeL of
Just HomeGame -> s ^. progMode . homeScoreL
Just AwayGame -> s ^. progMode . awayScoreL
-- | Constructor for a 'GameStats' value
newGameStats :: GameStats
newGameStats = GameStats
{ _gmsWins = 0
, _gmsLosses = 0
, _gmsOvertime = 0
}
-- | Determines the team's score
teamScore :: GameState -> Maybe Int
teamScore s = case s ^. gameType of
Just HomeGame -> s ^. homeScore
Just AwayGame -> s ^. awayScore
Nothing -> Nothing
-- | Determines the other team's score
otherScore :: GameState -> Maybe Int
otherScore s = case s ^. gameType of
Just HomeGame -> s ^. awayScore
Just AwayGame -> s ^. homeScore
Nothing -> Nothing
-- | Returns the name of the home team (or an empty string if
-- unavailable)
homeTeam :: GameState -> String
homeTeam gs = case gs^.gameType of
Just HomeGame -> myTeam
Just AwayGame -> gs^.otherTeam
Nothing -> ""
-- | Returns the name of the visiting team (or an empty string if
-- unavailable)
awayTeam :: GameState -> String
awayTeam gs = case gs^.gameType of
Just HomeGame -> gs^.otherTeam
Just AwayGame -> myTeam
Nothing -> ""
-- | Checks if the game was won
gameWon :: GameState -> Maybe Bool
gameWon gs = (>) <$> teamScore gs <*> otherScore gs
-- | Checks if the game was lost
gameLost :: GameState -> Maybe Bool
gameLost gs = (<) <$> teamScore gs <*> otherScore gs
-- | Checks if the game has tied
gameTied :: GameState -> Maybe Bool
gameTied gs = (==) <$> gs^.homeScore <*> gs^.awayScore
-- | Calculates the number of games played
gmsGames :: GameStats -> Int
gmsGames gs = gs^.gmsWins + gs^.gmsLosses
-- | Calculates the number of points
gmsPoints :: GameStats -> Int
gmsPoints gs = 2 * gs^.gmsWins + gs^. gmsOvertime
-- | Adds two 'GameStats' values together
addGameStats :: GameStats -> GameStats -> GameStats
addGameStats s1 s2 = GameStats
{ _gmsWins = s1^.gmsWins + s2^.gmsWins
, _gmsLosses = s1^.gmsLosses + s2^.gmsLosses
, _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime
}
-- | Calculates a player's points
pPoints :: PlayerStats -> Int
pPoints s = s^.psGoals + s^.psAssists

30
src/Mtlstats/UI.hs
View File

@ -25,8 +25,10 @@ import Control.Monad (void)
import Lens.Micro ((^.))
import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Report
import Mtlstats.Types
-- | Drawing function
@ -40,10 +42,28 @@ draw s = do
MainMenu -> drawMenu mainMenu
NewSeason -> drawMenu newSeasonMenu
NewGame gs
| null $ gs ^. gameType -> drawMenu gameTypeMenu
| null $ gs ^. otherTeam -> drawPrompt otherTeamPrompt s
| null $ gs ^. homeScore -> drawPrompt homeScorePrompt s
| null $ gs ^. awayScore -> drawPrompt awayScorePrompt s
| otherwise -> undefined
| null $ gs^.gameYear -> header s >> drawPrompt gameYearPrompt s
| null $ gs^.gameMonth -> header s >> drawMenu gameMonthMenu
| null $ gs^.gameDay -> header s >> drawPrompt gameDayPrompt s
| null $ gs^.gameType -> header s >> drawMenu gameTypeMenu
| null $ gs^.otherTeam -> header s >> drawPrompt otherTeamPrompt s
| null $ gs^.homeScore -> header s >> drawPrompt homeScorePrompt s
| null $ gs^.awayScore -> header s >> drawPrompt awayScorePrompt s
| null $ gs^.overtimeFlag -> header s >> overtimePrompt
| otherwise -> showReport s
C.render
void $ C.setCursorMode cm
header :: ProgState -> C.Update ()
header s = C.drawString $
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
overtimePrompt :: C.Update C.CursorMode
overtimePrompt = do
C.drawString "Did the game go into overtime? (Y/N)"
return C.CursorInvisible
showReport :: ProgState -> C.Update C.CursorMode
showReport s = do
C.drawString $ report 72 s
return C.CursorInvisible

191
test/ActionsSpec.hs
View File

@ -22,7 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ActionsSpec (spec) where
import Control.Monad (replicateM)
import Lens.Micro ((&), (.~), (?~), (^.))
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import System.Random (randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldNotBe)
@ -36,6 +36,9 @@ spec = describe "Mtlstats.Actions" $ do
resetYtdSpec
addCharSpec
removeCharSpec
overtimeCheckSpec
updateGameStatsSpec
validateGameDateSpec
startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do
@ -126,6 +129,192 @@ removeCharSpec = describe "removeChar" $ do
& removeChar
in s ^. inputBuffer `shouldBe` "fo"
overtimeCheckSpec = describe "overtimeCheck" $ do
context "tie game" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 1)
& overtimeCheck
it "should clear the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
it "should clear the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
it "should leave the overtimeFlag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
context "game won" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 2)
. (awayScore ?~ 1)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
it "should set the overtimeCheck flag to False" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
context "game lost" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 2)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
it "should leave the overtimeCheck flag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
updateGameStatsSpec :: Spec
updateGameStatsSpec = describe "updateGameStats" $ do
let
baseStats = newGameStats
& gmsWins .~ 1
& gmsLosses .~ 1
& gmsOvertime .~ 1
s t h a o = newProgState
& progMode.gameStateL
%~ (gameType .~ t)
. (homeScore .~ h)
. (awayScore .~ a)
. (overtimeFlag .~ o)
& database
%~ (dbHomeGameStats .~ baseStats)
. (dbAwayGameStats .~ baseStats)
db hw hl ho aw al ao = newDatabase
& dbHomeGameStats
%~ (gmsWins .~ hw)
. (gmsLosses .~ hl)
. (gmsOvertime .~ ho)
& dbAwayGameStats
%~ (gmsWins .~ aw)
. (gmsLosses .~ al)
. (gmsOvertime .~ ao)
context "home win" $
it "should record a home win" $ let
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 2 1 1 1 1 1
context "home loss" $
it "should record a home loss" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 2 1 1 1 1
context "home overtime loss" $
it "should record a home loss and overtime" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 2 2 1 1 1
context "away win" $
it "should record an away win" $ let
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 2 1 1
context "away loss" $
it "should record an away loss" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 2 1
context "away overtime loss" $
it "should record an away loss and overtime" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 2 2
context "missing game type" $
it "should not change anything" $ let
s' = s Nothing (Just 1) (Just 2) (Just True)
in updateGameStats s' `shouldBe` s'
context "missing home score" $
it "should not change anything" $ let
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
in updateGameStats s' `shouldBe` s'
context "missing away score" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
in updateGameStats s' `shouldBe` s'
context "missing overtime flag" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
in updateGameStats s' `shouldBe` s'
validateGameDateSpec :: Spec
validateGameDateSpec = describe "validateGameDate" $ do
context "valid date" $
it "should leave the date unchanged" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 6)
. (gameDay ?~ 25)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
context "invalid date" $
it "should clear the date" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 2)
. (gameDay ?~ 30)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
context "missing day" $
it "should not change anything" $ do
let
gs = newGameState
& gameYear ?~ 2019
& gameMonth ?~ 6
s = newProgState
& progMode.gameStateL .~ gs
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
makePlayer :: IO Player
makePlayer = Player
<$> makeNum

113
test/FormatSpec.hs Normal file
View File

@ -0,0 +1,113 @@
{-
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 FormatSpec (spec) where
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Format
spec :: Spec
spec = describe "Mtlstats.Format" $ do
padNumSpec
leftSpec
rightSpec
centreSpec
overlaySpec
monthSpec
padNumSpec :: Spec
padNumSpec = describe "padNum" $ do
context "zero, four digits" $
it "should be 0000" $
padNum 4 0 `shouldBe` "0000"
context "123, four digits" $
it "should be 0123" $
padNum 4 123 `shouldBe` "0123"
context "12345, four digits" $
it "should be 12345" $
padNum 4 12345 `shouldBe` "12345"
context "-12, four digits" $
it "should be -012" $
padNum 4 (-12) `shouldBe` "-012"
context "-1234, four digits" $
it "should be -1234" $
padNum 4 (-1234) `shouldBe` "-1234"
leftSpec :: Spec
leftSpec = describe "left" $ do
context "fit" $
it "should pad the text" $
left 5 "foo" `shouldBe` "foo "
context "overflow" $
it "should truncate the text" $
left 2 "foo" `shouldBe` "fo"
rightSpec :: Spec
rightSpec = describe "right" $ do
context "fit" $
it "should pad the text" $
right 5 "foo" `shouldBe` " foo"
context "overflow" $
it "should truncate the text" $
right 2 "foo" `shouldBe` "oo"
centreSpec :: Spec
centreSpec = describe "centre" $ do
context "fit" $
it "should pad the text" $
centre 5 "foo" `shouldBe` " foo "
context "overflow" $
it "should truncate the text" $
centre 2 "foo" `shouldBe` "fo"
overlaySpec :: Spec
overlaySpec = describe "overlay" $ do
context "first string shorter" $
it "should overlay" $
overlay "foo" "abc123" `shouldBe` "foo123"
context "first string longer" $
it "should overlay" $
overlay "abc123" "foo" `shouldBe` "abc123"
monthSpec :: Spec
monthSpec = describe "month" $ do
context "January" $
it "should return \"JAN\"" $
month 1 `shouldBe` "JAN"
context "invalid" $
it "should return an empty string" $
month 0 `shouldBe` ""

2
test/Spec.hs
View File

@ -22,9 +22,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
import Test.Hspec (hspec)
import qualified ActionsSpec as Actions
import qualified FormatSpec as Format
import qualified TypesSpec as Types
main :: IO ()
main = hspec $ do
Types.spec
Actions.spec
Format.spec

638
test/TypesSpec.hs
View File

@ -19,15 +19,18 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module TypesSpec (spec) where
import Data.Aeson (decode, encode)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
import Data.ByteString.Lazy (ByteString)
import Lens.Micro ((&), (^.), (.~), (?~))
import qualified Data.HashMap.Strict as HM
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.RawString.QQ (r)
import Mtlstats.Config
import Mtlstats.Types
import qualified Types.MenuSpec as Menu
@ -35,26 +38,394 @@ import qualified Types.MenuSpec as Menu
spec :: Spec
spec = describe "Mtlstats.Types" $ do
playerSpec
pPointsSpec
goalieSpec
gameStatsSpec
databaseSpec
gameTypeLSpec
otherTeamLSpec
homeScoreLSpec
awayScoreLSpec
gameStateLSpec
teamScoreSpec
otherScoreSpec
homeTeamSpec
awayTeamSpec
gameWonSpec
gameLostSpec
gameTiedSpec
gmsGamesSpec
gmsPointsSpec
addGameStatsSpec
pPointsSpec
Menu.spec
playerSpec :: Spec
playerSpec = describe "Player" $ do
playerSpec = describe "Player" $ jsonSpec player playerJSON
goalieSpec :: Spec
goalieSpec = describe "Goalie" $ jsonSpec goalie goalieJSON
gameStatsSpec :: Spec
gameStatsSpec = describe "GameStats" $
jsonSpec (gameStats 1) (gameStatsJSON 1)
databaseSpec :: Spec
databaseSpec = describe "Database" $ jsonSpec db dbJSON
gameStateLSpec :: Spec
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
-- getters
[ ( MainMenu, newGameState )
, ( NewGame $ gs HomeGame, gs HomeGame )
]
-- setters
[ ( MainMenu, gs HomeGame )
, ( NewGame $ gs HomeGame, gs AwayGame )
, ( NewGame $ gs HomeGame, newGameState )
]
where gs t = newGameState & gameType ?~ t
teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do
let
s t = newGameState
& gameType ?~ t
& homeScore ?~ 1
& awayScore ?~ 2
context "unknown game type" $
it "should return Nothing" $
teamScore newGameState `shouldBe` Nothing
context "HomeGame" $
it "should return 1" $
teamScore (s HomeGame) `shouldBe` Just 1
context "AwayGame" $
it "should return 2" $
teamScore (s AwayGame) `shouldBe` Just 2
otherScoreSpec :: Spec
otherScoreSpec = describe "otherScore" $ do
let
s t = newGameState
& gameType ?~ t
& homeScore ?~ 1
& awayScore ?~ 2
context "unknown game type" $
it "should return Nothing" $
otherScore newGameState `shouldBe` Nothing
context "HomeGame" $
it "should return 2" $
otherScore (s HomeGame) `shouldBe` Just 2
context "AwayGame" $
it "should return 1" $
otherScore (s AwayGame) `shouldBe` Just 1
jsonSpec
:: (Eq a, Show a, FromJSON a, ToJSON a)
=> a
-> Value
-> Spec
jsonSpec x j = do
describe "decode" $
it "should decode" $
decode playerJSON `shouldBe` Just player
decode (encode j) `shouldBe` Just x
describe "encode" $
describe "toJSON" $
it "should encode" $
decode (encode player) `shouldBe` Just player
decode (encode $ toJSON x) `shouldBe` Just x
describe "toEncoding" $
it "should encode" $
decode (encode x) `shouldBe` Just x
lensSpec
:: (Eq a, Show s, Show a)
=> Lens' s a
-> [(s, a)]
-> [(s, a)]
-> Spec
lensSpec l gs ss = do
context "getters" $ mapM_
(\(s, x) -> context (show s) $
it ("should be " ++ show x) $
s ^. l `shouldBe` x)
gs
context "setters" $ mapM_
(\(s, x) -> context (show s) $
it ("should set to " ++ show x) $
(s & l .~ x) ^. l `shouldBe` x)
ss
player :: Player
player = newPlayer 1 "Joe" "centre"
& pYtd .~ playerStats 1
& pLifetime .~ playerStats 2
playerJSON :: Value
playerJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String) )
, ( "position", toJSON ("centre" :: String) )
, ( "ytd", playerStatsJSON 1 )
, ( "lifetime", playerStatsJSON 2 )
]
playerStats :: Int -> PlayerStats
playerStats n = newPlayerStats
& psGoals .~ n
& psAssists .~ n + 1
& psPMin .~ n + 2
playerStatsJSON :: Int -> Value
playerStatsJSON n = Object $ HM.fromList
[ ( "goals", toJSON n )
, ( "assists", toJSON $ n + 1 )
, ( "penalty_mins", toJSON $ n + 2 )
]
goalie :: Goalie
goalie = newGoalie 1 "Joe"
& gYtd .~ goalieStats 1
& gLifetime .~ goalieStats 2
goalieJSON :: Value
goalieJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String ) )
, ( "ytd", goalieStatsJSON 1 )
, ( "lifetime", goalieStatsJSON 2 )
]
goalieStats :: Int -> GoalieStats
goalieStats n = newGoalieStats
& gsGames .~ n
& gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2
& gsGoalsAgainst .~ n + 3
& gsWins .~ n + 4
& gsLosses .~ n + 5
& gsTies .~ n + 6
goalieStatsJSON :: Int -> Value
goalieStatsJSON n = Object $ HM.fromList
[ ( "games", toJSON n )
, ( "mins_played", toJSON $ n + 1 )
, ( "goals_allowed", toJSON $ n + 2 )
, ( "goals_against", toJSON $ n + 3 )
, ( "wins", toJSON $ n + 4 )
, ( "losses", toJSON $ n + 5 )
, ( "ties", toJSON $ n + 6 )
]
gameStats :: Int -> GameStats
gameStats n = GameStats
{ _gmsWins = n
, _gmsLosses = n + 1
, _gmsOvertime = n + 2
}
gameStatsJSON :: Int -> Value
gameStatsJSON n = Object $ HM.fromList
[ ( "wins", toJSON n )
, ( "losses", toJSON $ n + 1 )
, ( "overtime", toJSON $ n + 2 )
]
db :: Database
db = newDatabase
& dbPlayers .~ [player]
& dbGoalies .~ [goalie]
& dbGames .~ 1
& dbHomeGameStats .~ gameStats 1
& dbAwayGameStats .~ gameStats 2
dbJSON :: Value
dbJSON = Object $ HM.fromList
[ ( "players", toJSON [playerJSON] )
, ( "goalies", toJSON [goalieJSON] )
, ( "games", toJSON (1 :: Int) )
, ( "home_game_stats", gameStatsJSON 1 )
, ( "away_game_stats", gameStatsJSON 2 )
]
homeTeamSpec :: Spec
homeTeamSpec = describe "homeTeam" $ do
let
gs gt = newGameState
& gameType .~ gt
& otherTeam .~ "foo"
context "unknown game type" $
it "should return an empty string" $
homeTeam (gs Nothing) `shouldBe` ""
context "home game" $
it ("should return " ++ show myTeam) $
homeTeam (gs $ Just HomeGame) `shouldBe` myTeam
context "away game" $
it "should return \"foo\"" $
homeTeam (gs $ Just AwayGame) `shouldBe` "foo"
awayTeamSpec :: Spec
awayTeamSpec = describe "awayTeam" $ do
let
gs gt = newGameState
& gameType .~ gt
& otherTeam .~ "foo"
context "unknown game type" $
it "should return an empty string" $
awayTeam (gs Nothing) `shouldBe` ""
context "home game" $
it "should return \"foo\"" $
awayTeam (gs $ Just HomeGame) `shouldBe` "foo"
context "away game" $
it ("should return " ++ show myTeam) $
awayTeam (gs $ Just AwayGame) `shouldBe` myTeam
gameWonSpec :: Spec
gameWonSpec = describe "gameWon" $ mapM_
(\(t, h, a, expected) -> let
desc = "game type: " ++ show t ++
", home score: " ++ show h ++
", away score: " ++ show a
gs = newGameState
& gameType .~ t
& homeScore .~ h
& awayScore .~ a
in context desc $
it ("should be " ++ show expected) $
gameWon gs `shouldBe` expected)
-- gameType, homeScore, awayScore, expected
[ ( Just HomeGame, Just 1, Just 1, Just False )
, ( Just HomeGame, Just 1, Just 2, Just False )
, ( Just HomeGame, Just 2, Just 1, Just True )
, ( Just AwayGame, Just 1, Just 1, Just False )
, ( Just AwayGame, Just 1, Just 2, Just True )
, ( Just AwayGame, Just 2, Just 1, Just False )
, ( Nothing, Just 1, Just 2, Nothing )
, ( Just HomeGame, Nothing, Just 1, Nothing )
, ( Just AwayGame, Nothing, Just 1, Nothing )
, ( Just HomeGame, Just 1, Nothing, Nothing )
, ( Just AwayGame, Just 1, Nothing, Nothing )
, ( Nothing, Nothing, Nothing, Nothing )
]
gameLostSpec :: Spec
gameLostSpec = describe "gameLost" $ mapM_
(\(t, h, a, expected) -> let
desc = "game type: " ++ show t ++
", home score: " ++ show h ++
", away score: " ++ show a
gs = newGameState
& gameType .~ t
& homeScore .~ h
& awayScore .~ a
in context desc $
it ("should be " ++ show expected) $
gameLost gs `shouldBe` expected)
-- gameType, homeScore, awayScore, expected
[ ( Just HomeGame, Just 1, Just 1, Just False )
, ( Just HomeGame, Just 1, Just 2, Just True )
, ( Just HomeGame, Just 2, Just 1, Just False )
, ( Just AwayGame, Just 1, Just 1, Just False )
, ( Just AwayGame, Just 1, Just 2, Just False )
, ( Just AwayGame, Just 2, Just 1, Just True )
, ( Nothing, Just 1, Just 2, Nothing )
, ( Just HomeGame, Nothing, Just 1, Nothing )
, ( Just AwayGame, Nothing, Just 1, Nothing )
, ( Just HomeGame, Just 1, Nothing, Nothing )
, ( Just AwayGame, Just 1, Nothing, Nothing )
, ( Nothing, Nothing, Nothing, Nothing )
]
gameTiedSpec :: Spec
gameTiedSpec = describe "gameTied" $ mapM_
(\(home, away, expected) -> let
desc = "home score: " ++ show home ++
", away score: " ++ show away
gs = newGameState
& homeScore .~ home
& awayScore .~ away
in context desc $
it ("should be " ++ show expected) $
gameTied gs `shouldBe` expected)
[ ( Nothing, Nothing, Nothing )
, ( Nothing, Just 1, Nothing )
, ( Just 1, Nothing, Nothing )
, ( Just 1, Just 1, Just True )
, ( Just 1, Just 2, Just False )
]
gmsGamesSpec :: Spec
gmsGamesSpec = describe "gmsGames" $ mapM_
(\(w, l, expected) -> let
desc = "wins: " ++ show w ++
", losses: " ++ show l
gs = newGameStats
& gmsWins .~ w
& gmsLosses .~ l
in context desc $
it ("should be " ++ show expected) $
gmsGames gs `shouldBe` expected)
-- wins, losses, expected
[ ( 0, 0, 0 )
, ( 1, 0, 1 )
, ( 0, 1, 1 )
, ( 1, 1, 2 )
, ( 2, 3, 5 )
]
gmsPointsSpec :: Spec
gmsPointsSpec = describe "gmsPoints" $ mapM_
(\(w, l, ot, expected) -> let
gs = GameStats
{ _gmsWins = w
, _gmsLosses = l
, _gmsOvertime = ot
}
in context (show gs) $
it ("should be " ++ show expected) $
gmsPoints gs `shouldBe` expected)
-- wins, losses, overtime, expected
[ ( 0, 0, 0, 0 )
, ( 1, 0, 0, 2 )
, ( 0, 1, 0, 0 )
, ( 0, 1, 1, 1 )
, ( 1, 1, 1, 3 )
, ( 2, 4, 3, 7 )
]
addGameStatsSpec :: Spec
addGameStatsSpec = describe "addGameStats" $
it "should add the values" $ let
s1 = GameStats
{ _gmsWins = 1
, _gmsLosses = 3
, _gmsOvertime = 2
}
s2 = GameStats
{ _gmsWins = 4
, _gmsLosses = 6
, _gmsOvertime = 5
}
expected = GameStats
{ _gmsWins = 5
, _gmsLosses = 9
, _gmsOvertime = 7
}
in addGameStats s1 s2 `shouldBe` expected
pPointsSpec :: Spec
pPointsSpec = describe "pPoints" $ mapM_
@ -73,244 +444,3 @@ pPointsSpec = describe "pPoints" $ mapM_
, ( 0, 1, 1 )
, ( 2, 3, 5 )
]
goalieSpec :: Spec
goalieSpec = describe "Goalie" $ do
describe "decode" $
it "should decode" $
decode goalieJSON `shouldBe` Just goalie
describe "encode" $
it "should encode" $
decode (encode goalie) `shouldBe` Just goalie
databaseSpec :: Spec
databaseSpec = describe "Database" $ do
describe "decode" $
it "should decode" $
decode dbJSON `shouldBe` Just db
describe "encode" $
it "should encode" $
decode (encode db) `shouldBe` Just db
gameTypeLSpec :: Spec
gameTypeLSpec = describe "gameTypeL" $ do
context "getter" $ do
context "unexpected mode" $
it "should return Nothing" $
MainMenu ^. gameTypeL `shouldBe` Nothing
mapM_
(\t -> context (show t) $
it ("should return " ++ show t) $ let
gs = newGameState & gameType ?~ t
m = NewGame gs
in m ^. gameTypeL `shouldBe` Just t)
[HomeGame, AwayGame]
context "setter" $ do
context "unexpected mode" $
mapM_
(\t -> context (show t) $
it ("should set to " ++ show t) $ let
m = MainMenu & gameTypeL ?~ t
in m ^. gameTypeL `shouldBe` Just t)
[HomeGame, AwayGame]
context "expected mode" $
mapM_
(\t -> context (show t) $
it ("should set to " ++ show t) $ let
m = NewGame newGameState & gameTypeL ?~ t
in m ^. gameTypeL `shouldBe` Just t)
[HomeGame, AwayGame]
otherTeamLSpec :: Spec
otherTeamLSpec = describe "otherTeamL" $ do
context "getter" $ do
context "unexpected mode" $
it "should return an empty string" $
MainMenu ^. otherTeamL `shouldBe` ""
context "expected mode" $
it "should return \"foo\"" $ let
m = NewGame $ newGameState & otherTeam .~ "foo"
in m ^. otherTeamL `shouldBe` "foo"
context "setter" $ do
context "unexpected mode" $
it "should set the value" $ let
m = MainMenu & otherTeamL .~ "foo"
in m ^. otherTeamL `shouldBe` "foo"
context "expected mode" $
it "should set the value" $ let
m = NewGame newGameState & otherTeamL .~ "foo"
in m ^. otherTeamL `shouldBe` "foo"
homeScoreLSpec :: Spec
homeScoreLSpec = describe "homeScoreL" $ do
context "getter" $ do
context "unexpected mode" $
it "should return Nothing" $
MainMenu ^. homeScoreL `shouldBe` Nothing
context "expected mode" $
it "should return 0" $ let
gs = newGameState & homeScore ?~ 0
m = NewGame gs
in m ^. homeScoreL `shouldBe` Just 0
context "setter" $ do
context "unexpected mode" $
it "should set home score" $ let
m = MainMenu & homeScoreL ?~ 0
in m ^. homeScoreL `shouldBe` Just 0
context "expected mode" $
it "should set home score" $ let
m = NewGame newGameState & homeScoreL ?~ 0
in m ^. homeScoreL `shouldBe` Just 0
awayScoreLSpec :: Spec
awayScoreLSpec = describe "awayScoreL" $ do
context "getter" $ do
context "unexpected mode" $
it "should return Nothing" $
MainMenu ^. awayScoreL `shouldBe` Nothing
context "expected mode" $
it "should return 0" $ let
gs = newGameState & awayScore ?~ 0
m = NewGame gs
in m ^. awayScoreL `shouldBe` Just 0
context "setter" $ do
context "unexpected mode" $
it "should set the away score" $ let
m = MainMenu & awayScoreL ?~ 0
in m ^. awayScoreL `shouldBe` Just 0
context "expected mode" $
it "should set the away score" $ let
m = NewGame newGameState & awayScoreL ?~ 0
in m ^. awayScoreL `shouldBe` Just 0
teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do
let
m t = NewGame $ newGameState
& gameType ?~ t
& homeScore ?~ 1
& awayScore ?~ 2
s t = newProgState
& progMode .~ m t
context "unexpected state" $
it "should return Nothing" $
teamScore newProgState `shouldBe` Nothing
context "HomeGame" $
it "should return 1" $
teamScore (s HomeGame) `shouldBe` Just 1
context "AwayGame" $
it "should return 2" $
teamScore (s AwayGame) `shouldBe` Just 2
player :: Player
player = newPlayer 1 "Joe" "centre"
& pYtd . psGoals .~ 2
& pYtd . psAssists .~ 3
& pYtd . psPMin .~ 4
& pLifetime . psGoals .~ 5
& pLifetime . psAssists .~ 6
& pLifetime . psPMin .~ 7
goalie :: Goalie
goalie = newGoalie 1 "Joe"
& gYtd . gsGames .~ 2
& gYtd . gsMinsPlayed .~ 3
& gYtd . gsGoalsAllowed .~ 4
& gYtd . gsGoalsAgainst .~ 5
& gYtd . gsWins .~ 6
& gYtd . gsLosses .~ 7
& gYtd . gsTies .~ 8
& gLifetime . gsGames .~ 9
& gLifetime . gsMinsPlayed .~ 10
& gLifetime . gsGoalsAllowed .~ 11
& gLifetime . gsGoalsAgainst .~ 12
& gLifetime . gsWins .~ 13
& gLifetime . gsLosses .~ 14
& gLifetime . gsTies .~ 15
db :: Database
db = newDatabase
& dbPlayers .~ [player]
& dbGoalies .~ [goalie]
& dbGames .~ 1
playerJSON :: ByteString
playerJSON = [r|
{ "number": 1
, "name": "Joe"
, "position": "centre"
, "ytd":
{ "goals": 2
, "assists": 3
, "penalty_mins": 4
}
, "lifetime":
{ "goals": 5
, "assists": 6
, "penalty_mins": 7
}
}|]
goalieJSON :: ByteString
goalieJSON = [r|
{ "number": 1
, "name": "Joe"
, "ytd":
{ "games": 2
, "mins_played": 3
, "goals_allowed": 4
, "goals_against": 5
, "wins": 6
, "losses": 7
, "ties": 8
}
, "lifetime":
{ "games": 9
, "mins_played": 10
, "goals_allowed": 11
, "goals_against": 12
, "wins": 13
, "losses": 14
, "ties": 15
}
}|]
dbJSON :: ByteString
dbJSON = [r|
{ "players":
[ |] <> playerJSON <> [r| ]
, "goalies":
[ |] <> goalieJSON <> [r| ]
, "games": 1
}|]