Merge pull request #10 from mtlstats/game-stats
Generate game stats report
This commit is contained in:
commit
1e2f65234b
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
|
@ -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
|
||||
|
|
|
@ -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 _ = ""
|
|
@ -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
|
||||
]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
|
@ -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,14 +144,22 @@ 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
|
||||
, _otherTeam :: String
|
||||
-- ^ The name of the other team
|
||||
, _homeScore :: Maybe Int
|
||||
, _homeScore :: Maybe Int
|
||||
-- ^ The home team's score
|
||||
, _awayScore :: Maybe Int
|
||||
, _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
|
||||
|
@ -148,12 +177,16 @@ data GameType
|
|||
|
||||
-- | Represents the database
|
||||
data Database = Database
|
||||
{ _dbPlayers :: [Player]
|
||||
{ _dbPlayers :: [Player]
|
||||
-- ^ The list of players
|
||||
, _dbGoalies :: [Goalie]
|
||||
, _dbGoalies :: [Goalie]
|
||||
-- ^ The list of goalies
|
||||
, _dbGames :: Int
|
||||
, _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
|
||||
[ "players" .= players
|
||||
, "goalies" .= goalies
|
||||
, "games" .= games
|
||||
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 $
|
||||
"players" .= players <>
|
||||
"goalies" .= goalies <>
|
||||
"games" .= games
|
||||
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
|
||||
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,18 +421,24 @@ newProgState = ProgState
|
|||
-- | Constructor for a 'GameState'
|
||||
newGameState :: GameState
|
||||
newGameState = GameState
|
||||
{ _gameType = Nothing
|
||||
, _otherTeam = ""
|
||||
, _homeScore = Nothing
|
||||
, _awayScore = Nothing
|
||||
{ _gameYear = Nothing
|
||||
, _gameMonth = Nothing
|
||||
, _gameDay = Nothing
|
||||
, _gameType = Nothing
|
||||
, _otherTeam = ""
|
||||
, _homeScore = Nothing
|
||||
, _awayScore = Nothing
|
||||
, _overtimeFlag = Nothing
|
||||
}
|
||||
|
||||
-- | Constructor for a 'Database'
|
||||
newDatabase :: Database
|
||||
newDatabase = Database
|
||||
{ _dbPlayers = []
|
||||
, _dbGoalies = []
|
||||
, _dbGames = 0
|
||||
{ _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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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` ""
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}|]
|
||||
|
|
Loading…
Reference in New Issue
Block a user