diff --git a/package.yaml b/package.yaml index aeff1f1..9ee7f03 100644 --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 106791f..460e3fd 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -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 diff --git a/src/Mtlstats/Config.hs b/src/Mtlstats/Config.hs new file mode 100644 index 0000000..e02aacc --- /dev/null +++ b/src/Mtlstats/Config.hs @@ -0,0 +1,26 @@ +{- | + +mtlstats +Copyright (C) 2019 Rhéal Lamothe + + +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 . + +-} + +module Mtlstats.Config where + +-- | The name of the team whose stats we're tracking +myTeam :: String +myTeam = "MONTREAL" diff --git a/src/Mtlstats/Events.hs b/src/Mtlstats/Events.hs index feeff2a..2ee2503 100644 --- a/src/Mtlstats/Events.hs +++ b/src/Mtlstats/Events.hs @@ -23,7 +23,9 @@ along with this program. If not, see . 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 diff --git a/src/Mtlstats/Format.hs b/src/Mtlstats/Format.hs new file mode 100644 index 0000000..8ccd4cc --- /dev/null +++ b/src/Mtlstats/Format.hs @@ -0,0 +1,103 @@ +{- | + +mtlstats +Copyright (C) 2019 Rhéal Lamothe + + +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 . + +-} + +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 _ = "" diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index 7385909..712019b 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -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 ] diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index e979ceb..e25e2b3 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -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 diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs new file mode 100644 index 0000000..cf93da5 --- /dev/null +++ b/src/Mtlstats/Report.hs @@ -0,0 +1,90 @@ +{- | + +mtlstats +Copyright (C) 2019 Rhéal Lamothe + + +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 . + +-} + +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) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 547e7be..973b00c 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -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 diff --git a/src/Mtlstats/UI.hs b/src/Mtlstats/UI.hs index 95940f2..0bffbcd 100644 --- a/src/Mtlstats/UI.hs +++ b/src/Mtlstats/UI.hs @@ -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 diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index f1d513e..953db70 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -22,7 +22,7 @@ along with this program. If not, see . 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 diff --git a/test/FormatSpec.hs b/test/FormatSpec.hs new file mode 100644 index 0000000..bcfa781 --- /dev/null +++ b/test/FormatSpec.hs @@ -0,0 +1,113 @@ +{- + +mtlstats +Copyright (C) 2019 Rhéal Lamothe + + +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 . + +-} + +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` "" diff --git a/test/Spec.hs b/test/Spec.hs index aa86ce6..8982a05 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -22,9 +22,11 @@ along with this program. If not, see . 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 diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 3b4f003..b1f7113 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -19,15 +19,18 @@ along with this program. If not, see . -} -{-# 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 - }|]