From 2768934c7c437bd3d743b0e84672d474b89c4171 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 3 Jan 2020 21:33:39 -0500 Subject: [PATCH 01/12] added rookie field to Player and Goalie values --- src/Mtlstats/Types.hs | 284 ++++++++++++++++++++++-------------------- test/TypesSpec.hs | 11 +- 2 files changed, 159 insertions(+), 136 deletions(-) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index c996e42..376b634 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -106,6 +106,7 @@ module Mtlstats.Types ( pNumber, pName, pPosition, + pRookie, pYtd, pLifetime, -- ** PlayerStats Lenses @@ -115,6 +116,7 @@ module Mtlstats.Types ( -- ** Goalie Lenses gNumber, gName, + gRookie, gYtd, gLifetime, -- ** GoalieStats Lenses @@ -399,29 +401,6 @@ data Database = Database -- ^ Statistics for away games } deriving (Eq, Show) -instance FromJSON Database where - parseJSON = withObject "Database" $ \v -> Database - <$> v .: "players" - <*> v .: "goalies" - <*> v .: "games" - <*> v .: "home_game_stats" - <*> v .: "away_game_stats" - -instance ToJSON Database where - toJSON (Database players goalies games hgs ags) = object - [ "players" .= players - , "goalies" .= goalies - , "games" .= games - , "home_game_stats" .= hgs - , "away_game_stats" .= ags - ] - toEncoding (Database players goalies games hgs ags) = pairs $ - "players" .= players <> - "goalies" .= goalies <> - "games" .= games <> - "home_game_stats" .= hgs <> - "away_game_stats" .= ags - -- | Represents a (non-goalie) player data Player = Player { _pNumber :: Int @@ -430,35 +409,14 @@ data Player = Player -- ^ The player's name , _pPosition :: String -- ^ The player's position + , _pRookie :: Bool + -- ^ Indicates that the player is a rookie , _pYtd :: PlayerStats -- ^ The Player's year-to-date stats , _pLifetime :: PlayerStats -- ^ The player's lifetime stats } deriving (Eq, Show) -instance FromJSON Player where - parseJSON = withObject "Player" $ \v -> Player - <$> v .: "number" - <*> v .: "name" - <*> v .: "position" - <*> v .: "ytd" - <*> v .: "lifetime" - -instance ToJSON Player where - toJSON (Player num name pos ytd lt) = object - [ "number" .= num - , "name" .= name - , "position" .= pos - , "ytd" .= ytd - , "lifetime" .= lt - ] - toEncoding (Player num name pos ytd lt) = pairs $ - "number" .= num <> - "name" .= name <> - "position" .= pos <> - "ytd" .= ytd <> - "lifetime" .= lt - -- | Represents a (non-goalie) player's stats data PlayerStats = PlayerStats { _psGoals :: Int @@ -469,55 +427,20 @@ data PlayerStats = PlayerStats -- ^ The number of penalty minutes } deriving (Eq, Show) -instance FromJSON PlayerStats where - parseJSON = withObject "PlayerStats" $ \v -> PlayerStats - <$> v .: "goals" - <*> v .: "assists" - <*> v .: "penalty_mins" - -instance ToJSON PlayerStats where - toJSON (PlayerStats g a pm) = object - [ "goals" .= g - , "assists" .= a - , "penalty_mins" .= pm - ] - toEncoding (PlayerStats g a pm) = pairs $ - "goals" .= g <> - "assists" .= a <> - "penalty_mins" .= pm - -- | Represents a goalie data Goalie = Goalie { _gNumber :: Int -- ^ The goalie's number , _gName :: String -- ^ The goalie's name + , _gRookie :: Bool + -- ^ Indicates that the goalie is a rookie , _gYtd :: GoalieStats -- ^ The goalie's year-to-date stats , _gLifetime :: GoalieStats -- ^ The goalie's lifetime stats } deriving (Eq, Show) -instance FromJSON Goalie where - parseJSON = withObject "Goalie" $ \v -> Goalie - <$> v .: "number" - <*> v .: "name" - <*> v .: "ytd" - <*> v .: "lifetime" - -instance ToJSON Goalie where - toJSON (Goalie num name ytd lt) = object - [ "number" .= num - , "name" .= name - , "ytd" .= ytd - , "lifetime" .= lt - ] - toEncoding (Goalie num name ytd lt) = pairs $ - "number" .= num <> - "name" .= name <> - "ytd" .= ytd <> - "lifetime" .= lt - -- | Represents a goalie's stats data GoalieStats = GoalieStats { _gsGames :: Int @@ -536,35 +459,6 @@ data GoalieStats = GoalieStats -- ^ The number of ties } deriving (Eq, Show) -instance FromJSON GoalieStats where - parseJSON = withObject "GoalieStats" $ \v -> GoalieStats - <$> v .:? "games" .!= 0 - <*> v .:? "mins_played" .!= 0 - <*> v .:? "goals_allowed" .!= 0 - <*> v .:? "shutouts" .!= 0 - <*> v .:? "wins" .!= 0 - <*> v .:? "losses" .!= 0 - <*> v .:? "ties" .!= 0 - -instance ToJSON GoalieStats where - toJSON (GoalieStats g m a s w l t) = object - [ "games" .= g - , "mins_played" .= m - , "goals_allowed" .= a - , "shutouts" .= s - , "wins" .= w - , "losses" .= l - , "ties" .= t - ] - toEncoding (GoalieStats g m a s w l t) = pairs $ - "games" .= g <> - "mins_played" .= m <> - "goals_allowed" .= a <> - "shutouts" .= s <> - "wins" .= w <> - "losses" .= l <> - "ties" .= t - -- | Game statistics data GameStats = GameStats { _gmsWins :: Int @@ -579,29 +473,6 @@ data GameStats = GameStats -- ^ Goals against the team } deriving (Eq, Show) -instance FromJSON GameStats where - parseJSON = withObject "GameStats" $ \v -> GameStats - <$> v .: "wins" - <*> v .: "losses" - <*> v .: "overtime" - <*> v .: "goals_for" - <*> v .: "goals_against" - -instance ToJSON GameStats where - toJSON (GameStats w l ot gf ga) = object - [ "wins" .= w - , "losses" .= l - , "overtime" .= ot - , "goals_for" .= gf - , "goals_against" .= ga - ] - toEncoding (GameStats w l ot gf ga) = pairs $ - "wins" .= w <> - "losses" .= l <> - "overtime" .= ot <> - "goals_for" .= gf <> - "goals_against" .= ga - -- | Defines a user prompt data Prompt = Prompt { promptDrawer :: ProgState -> C.Update () @@ -655,6 +526,147 @@ makeLenses ''Goalie makeLenses ''GoalieStats makeLenses ''GameStats +instance FromJSON Database where + parseJSON = withObject "Database" $ \v -> Database + <$> v .: "players" + <*> v .: "goalies" + <*> v .: "games" + <*> v .: "home_game_stats" + <*> v .: "away_game_stats" + +instance ToJSON Database where + toJSON (Database players goalies games hgs ags) = object + [ "players" .= players + , "goalies" .= goalies + , "games" .= games + , "home_game_stats" .= hgs + , "away_game_stats" .= ags + ] + toEncoding (Database players goalies games hgs ags) = pairs $ + "players" .= players <> + "goalies" .= goalies <> + "games" .= games <> + "home_game_stats" .= hgs <> + "away_game_stats" .= ags + +instance FromJSON Player where + parseJSON = withObject "Player" $ \v -> Player + <$> v .: "number" + <*> v .: "name" + <*> v .: "position" + <*> v .:? "rookie" .!= False + <*> v .:? "ytd" .!= newPlayerStats + <*> v .:? "lifetime" .!= newPlayerStats + +instance ToJSON Player where + toJSON (Player num name pos rk ytd lt) = object + [ "number" .= num + , "name" .= name + , "position" .= pos + , "rookie" .= rk + , "ytd" .= ytd + , "lifetime" .= lt + ] + toEncoding (Player num name pos rk ytd lt) = pairs $ + "number" .= num <> + "name" .= name <> + "position" .= pos <> + "rookie" .= rk <> + "ytd" .= ytd <> + "lifetime" .= lt + +instance FromJSON PlayerStats where + parseJSON = withObject "PlayerStats" $ \v -> PlayerStats + <$> v .:? "goals" .!= 0 + <*> v .:? "assists" .!= 0 + <*> v .:? "penalty_mins" .!= 0 + +instance ToJSON PlayerStats where + toJSON (PlayerStats g a pm) = object + [ "goals" .= g + , "assists" .= a + , "penalty_mins" .= pm + ] + toEncoding (PlayerStats g a pm) = pairs $ + "goals" .= g <> + "assists" .= a <> + "penalty_mins" .= pm + +instance FromJSON Goalie where + parseJSON = withObject "Goalie" $ \v -> Goalie + <$> v .: "number" + <*> v .: "name" + <*> v .:? "rookie" .!= False + <*> v .:? "ytd" .!= newGoalieStats + <*> v .:? "lifetime" .!= newGoalieStats + +instance ToJSON Goalie where + toJSON (Goalie num name rk ytd lt) = object + [ "number" .= num + , "name" .= name + , "ytd" .= ytd + , "rookie" .= rk + , "lifetime" .= lt + ] + toEncoding (Goalie num name rk ytd lt) = pairs $ + "number" .= num <> + "name" .= name <> + "rookie" .= rk <> + "ytd" .= ytd <> + "lifetime" .= lt + +instance FromJSON GoalieStats where + parseJSON = withObject "GoalieStats" $ \v -> GoalieStats + <$> v .:? "games" .!= 0 + <*> v .:? "mins_played" .!= 0 + <*> v .:? "goals_allowed" .!= 0 + <*> v .:? "shutouts" .!= 0 + <*> v .:? "wins" .!= 0 + <*> v .:? "losses" .!= 0 + <*> v .:? "ties" .!= 0 + +instance ToJSON GoalieStats where + toJSON (GoalieStats g m a s w l t) = object + [ "games" .= g + , "mins_played" .= m + , "goals_allowed" .= a + , "shutouts" .= s + , "wins" .= w + , "losses" .= l + , "ties" .= t + ] + toEncoding (GoalieStats g m a s w l t) = pairs $ + "games" .= g <> + "mins_played" .= m <> + "goals_allowed" .= a <> + "shutouts" .= s <> + "wins" .= w <> + "losses" .= l <> + "ties" .= t + +instance FromJSON GameStats where + parseJSON = withObject "GameStats" $ \v -> GameStats + <$> v .: "wins" + <*> v .: "losses" + <*> v .: "overtime" + <*> v .: "goals_for" + <*> v .: "goals_against" + +instance ToJSON GameStats where + toJSON (GameStats w l ot gf ga) = object + [ "wins" .= w + , "losses" .= l + , "overtime" .= ot + , "goals_for" .= gf + , "goals_against" .= ga + ] + toEncoding (GameStats w l ot gf ga) = pairs $ + "wins" .= w <> + "losses" .= l <> + "overtime" .= ot <> + "goals_for" .= gf <> + "goals_against" .= ga + gameStateL :: Lens' ProgMode GameState gameStateL = lens (\case @@ -782,6 +794,7 @@ newPlayer num name pos = Player { _pNumber = num , _pName = name , _pPosition = pos + , _pRookie = True , _pYtd = newPlayerStats , _pLifetime = newPlayerStats } @@ -804,6 +817,7 @@ newGoalie newGoalie num name = Goalie { _gNumber = num , _gName = name + , _gRookie = True , _gYtd = newGoalieStats , _gLifetime = newGoalieStats } diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 4237fd8..3a75d1a 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -36,7 +36,7 @@ import Data.Aeson.Types (Value (Object)) import qualified Data.HashMap.Strict as HM import Data.Ratio ((%)) import Lens.Micro (Lens', (&), (^.), (.~), (?~)) -import System.Random (randomRIO) +import System.Random (randomIO, randomRIO) import Test.Hspec (Spec, context, describe, it, shouldBe) import Mtlstats.Config @@ -271,6 +271,7 @@ lensSpec lens getters setters = do player :: Player player = newPlayer 1 "Joe" "centre" + & pRookie .~ False & pYtd .~ playerStats 1 & pLifetime .~ playerStats 2 @@ -279,6 +280,7 @@ playerJSON = Object $ HM.fromList [ ( "number", toJSON (1 :: Int) ) , ( "name", toJSON ("Joe" :: String) ) , ( "position", toJSON ("centre" :: String) ) + , ( "rookie", toJSON False ) , ( "ytd", playerStatsJSON 1 ) , ( "lifetime", playerStatsJSON 2 ) ] @@ -298,6 +300,7 @@ playerStatsJSON n = Object $ HM.fromList goalie :: Goalie goalie = newGoalie 1 "Joe" + & gRookie .~ False & gYtd .~ goalieStats 1 & gLifetime .~ goalieStats 2 @@ -305,6 +308,7 @@ goalieJSON :: Value goalieJSON = Object $ HM.fromList [ ( "number", toJSON (1 :: Int) ) , ( "name", toJSON ("Joe" :: String ) ) + , ( "rookie", toJSON False ) , ( "ytd", goalieStatsJSON 1 ) , ( "lifetime", goalieStatsJSON 2 ) ] @@ -843,6 +847,7 @@ makePlayer = Player <$> makeNum <*> makeName <*> makeName + <*> makeBool <*> makePlayerStats <*> makePlayerStats @@ -851,6 +856,7 @@ makeGoalie :: IO Goalie makeGoalie = Goalie <$> makeNum <*> makeName + <*> makeBool <*> makeGoalieStats <*> makeGoalieStats @@ -875,6 +881,9 @@ makeGoalieStats = GoalieStats makeNum :: IO Int makeNum = randomRIO (1, 10) +makeBool :: IO Bool +makeBool = randomIO + makeName :: IO String makeName = replicateM 10 $ randomRIO ('A', 'Z') From 3ee97406f13cc4f05deaa0b8c33fda37f0425d99 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 3 Jan 2020 21:37:33 -0500 Subject: [PATCH 02/12] make database less brittle when something's wrong with the JSON file --- src/Mtlstats/Types.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 376b634..c0424b8 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -528,11 +528,11 @@ makeLenses ''GameStats instance FromJSON Database where parseJSON = withObject "Database" $ \v -> Database - <$> v .: "players" - <*> v .: "goalies" - <*> v .: "games" - <*> v .: "home_game_stats" - <*> v .: "away_game_stats" + <$> v .:? "players" .!= [] + <*> v .:? "goalies" .!= [] + <*> v .:? "games" .!= 0 + <*> v .:? "home_game_stats" .!= newGameStats + <*> v .:? "away_game_stats" .!= newGameStats instance ToJSON Database where toJSON (Database players goalies games hgs ags) = object From 8dcef502bece0165634d20615fe556efcc7088b7 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 3 Jan 2020 22:01:09 -0500 Subject: [PATCH 03/12] implemented playerName --- src/Mtlstats/Helpers/Player.hs | 13 ++++++++++++- test/Helpers/PlayerSpec.hs | 21 +++++++++++++++++++-- 2 files changed, 31 insertions(+), 3 deletions(-) diff --git a/src/Mtlstats/Helpers/Player.hs b/src/Mtlstats/Helpers/Player.hs index 6798109..8043957 100644 --- a/src/Mtlstats/Helpers/Player.hs +++ b/src/Mtlstats/Helpers/Player.hs @@ -19,7 +19,7 @@ along with this program. If not, see . -} -module Mtlstats.Helpers.Player (playerDetails) where +module Mtlstats.Helpers.Player (playerDetails, playerName) where import Lens.Micro ((^.)) @@ -43,3 +43,14 @@ playerDetails p = unlines $ top ++ [""] ++ table , ( "Assists", psAssists ) , ( "Penalty mins", psPMin ) ] + +-- | Presents a modified version of the player's name indicating +-- whether or not they're a rookie +playerName :: Player -> String +playerName p = let + + suffix = if p^.pRookie + then "*" + else "" + + in p^.pName ++ suffix diff --git a/test/Helpers/PlayerSpec.hs b/test/Helpers/PlayerSpec.hs index 6bd903a..0861efc 100644 --- a/test/Helpers/PlayerSpec.hs +++ b/test/Helpers/PlayerSpec.hs @@ -22,14 +22,15 @@ along with this program. If not, see . module Helpers.PlayerSpec (spec) where import Lens.Micro ((&), (.~)) -import Test.Hspec (Spec, describe, it, shouldBe) +import Test.Hspec (Spec, context, describe, it, shouldBe) import Mtlstats.Helpers.Player import Mtlstats.Types spec :: Spec -spec = describe "Player" +spec = describe "Player" $ do playerDetailsSpec + playerNameSpec playerDetailsSpec :: Spec playerDetailsSpec = describe "playerDetails" $ @@ -59,3 +60,19 @@ playerDetailsSpec = describe "playerDetails" $ ] in playerDetails p `shouldBe` expected + +playerNameSpec :: Spec +playerNameSpec = describe "playerName" $ mapM_ + (\(label, p, expected) -> context label $ + it ("should be " ++ expected) $ + playerName p `shouldBe` expected) + + -- label, player, expected + [ ( "rookie", rookie, "foo*" ) + , ( "non-rookie", nonRookie, "foo" ) + ] + + where + rookie = player True + nonRookie = player False + player r = newPlayer 1 "foo" "centre" & pRookie .~ r From e077c3295690b370babc1731b64f27d0f3ecf78d Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sat, 4 Jan 2020 11:02:58 -0500 Subject: [PATCH 04/12] implemented goalieName --- src/Mtlstats/Helpers/Goalie.hs | 12 +++++++++++- test/Helpers/GoalieSpec.hs | 19 +++++++++++++++++-- 2 files changed, 28 insertions(+), 3 deletions(-) diff --git a/src/Mtlstats/Helpers/Goalie.hs b/src/Mtlstats/Helpers/Goalie.hs index 38a777c..fb5818d 100644 --- a/src/Mtlstats/Helpers/Goalie.hs +++ b/src/Mtlstats/Helpers/Goalie.hs @@ -19,7 +19,7 @@ along with this program. If not, see . -} -module Mtlstats.Helpers.Goalie (goalieDetails) where +module Mtlstats.Helpers.Goalie (goalieDetails, goalieName) where import Lens.Micro ((^.)) @@ -46,3 +46,13 @@ goalieDetails g = let ] in header ++ "\n" ++ body + +-- | Returns the goalie name, modified if they are a rookie +goalieName :: Goalie -> String +goalieName g = let + + suffix = if g^.gRookie + then "*" + else "" + + in g^.gName ++ suffix diff --git a/test/Helpers/GoalieSpec.hs b/test/Helpers/GoalieSpec.hs index 2c8ca25..5c784f1 100644 --- a/test/Helpers/GoalieSpec.hs +++ b/test/Helpers/GoalieSpec.hs @@ -22,14 +22,15 @@ along with this program. If not, see . module Helpers.GoalieSpec (spec) where import Lens.Micro ((&), (.~), (%~)) -import Test.Hspec (Spec, describe, it, shouldBe) +import Test.Hspec (Spec, context, describe, it, shouldBe) import Mtlstats.Helpers.Goalie import Mtlstats.Types spec :: Spec -spec = describe "Goalie" +spec = describe "Goalie" $ do goalieDetailsSpec + goalieNameSpec goalieDetailsSpec :: Spec goalieDetailsSpec = describe "goalieDetails" $ let @@ -67,3 +68,17 @@ goalieDetailsSpec = describe "goalieDetails" $ let in it "should format the output correctly" $ goalieDetails input `shouldBe` expected + +goalieNameSpec :: Spec +goalieNameSpec = describe "goalieName" $ mapM_ + (\(label, g, expected) -> context label $ + it ("should be " ++ expected) $ + goalieName g `shouldBe` expected) + + -- label, goalie, expected + [ ( "rookie", goalie True, "foo*" ) + , ( "non-rookie", goalie False, "foo" ) + ] + + where + goalie r = newGoalie 1 "foo" & gRookie .~ r From 5209c4a296f262b3f1ebe20efd5111ef8f27b538 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sat, 4 Jan 2020 12:10:19 -0500 Subject: [PATCH 05/12] mark rookies in playerSummary --- src/Mtlstats/Helpers/Player.hs | 2 +- test/Helpers/PlayerSpec.hs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Mtlstats/Helpers/Player.hs b/src/Mtlstats/Helpers/Player.hs index 8043957..e5c5fc8 100644 --- a/src/Mtlstats/Helpers/Player.hs +++ b/src/Mtlstats/Helpers/Player.hs @@ -32,7 +32,7 @@ playerDetails p = unlines $ top ++ [""] ++ table where top = labelTable [ ( "Number", show $ p^.pNumber ) - , ( "Name", p^.pName ) + , ( "Name", playerName p ) , ( "Position", p^.pPosition ) ] diff --git a/test/Helpers/PlayerSpec.hs b/test/Helpers/PlayerSpec.hs index 0861efc..34f9169 100644 --- a/test/Helpers/PlayerSpec.hs +++ b/test/Helpers/PlayerSpec.hs @@ -37,6 +37,7 @@ playerDetailsSpec = describe "playerDetails" $ it "should give a detailed description" $ let p = newPlayer 1 "Joe" "centre" + & pRookie .~ True & pYtd .~ PlayerStats { _psGoals = 2 , _psAssists = 3 @@ -50,7 +51,7 @@ playerDetailsSpec = describe "playerDetails" $ expected = unlines [ " Number: 1" - , " Name: Joe" + , " Name: Joe*" , "Position: centre" , "" , " YTD Lifetime" From ee3cea56432e4340b67c001fba1c608376125854 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 8 Jan 2020 23:54:16 -0500 Subject: [PATCH 06/12] mark rookies in goalieSummary --- src/Mtlstats/Helpers/Goalie.hs | 2 +- test/Helpers/GoalieSpec.hs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Mtlstats/Helpers/Goalie.hs b/src/Mtlstats/Helpers/Goalie.hs index fb5818d..9c3f9dd 100644 --- a/src/Mtlstats/Helpers/Goalie.hs +++ b/src/Mtlstats/Helpers/Goalie.hs @@ -31,7 +31,7 @@ goalieDetails :: Goalie -> String goalieDetails g = let header = unlines $ labelTable [ ( "Number", show $ g^.gNumber ) - , ( "Name", g^.gName ) + , ( "Name", goalieName g ) ] body = unlines $ numTable ["YTD", "Lifetime"] $ map diff --git a/test/Helpers/GoalieSpec.hs b/test/Helpers/GoalieSpec.hs index 5c784f1..e63ac7e 100644 --- a/test/Helpers/GoalieSpec.hs +++ b/test/Helpers/GoalieSpec.hs @@ -35,6 +35,7 @@ spec = describe "Goalie" $ do goalieDetailsSpec :: Spec goalieDetailsSpec = describe "goalieDetails" $ let input = newGoalie 1 "Joe" + & gRookie .~ True & gYtd %~ ( gsGames .~ 2 ) . ( gsMinsPlayed .~ 3 ) @@ -54,7 +55,7 @@ goalieDetailsSpec = describe "goalieDetails" $ let expected = unlines [ "Number: 1" - , " Name: Joe" + , " Name: Joe*" , "" , " YTD Lifetime" , " Games played 2 9" From 5b40a5942bf64423cfe933b6fbf11a3c3a11e61b Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 9 Jan 2020 00:00:05 -0500 Subject: [PATCH 07/12] mark rookies in reports --- src/Mtlstats/Report.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index 4894957..9329581 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -29,6 +29,8 @@ import Lens.Micro ((^.)) import Mtlstats.Config import Mtlstats.Format +import Mtlstats.Helpers.Goalie +import Mtlstats.Helpers.Player import Mtlstats.Types import Mtlstats.Util @@ -219,7 +221,7 @@ filteredPlayerReport width label criteria showTotals lineNumbers ps = let body = map (\(p, stats) -> [ CellText $ show (p^.pNumber) ++ " " - , CellText $ p^.pName + , CellText $ playerName p ] ++ statsCells stats) fps @@ -283,7 +285,7 @@ goalieReport width showTotals lineNumbers goalieData = let body = map (\(goalie, stats) -> [ CellText $ show (goalie^.gNumber) ++ " " - , CellText $ goalie^.gName + , CellText $ goalieName goalie ] ++ rowCells stats) goalieData @@ -318,7 +320,7 @@ gameGoalieReport width goalieData = let body = map (\(goalie, stats) -> [ CellText $ show (goalie^.gNumber) ++ " " - , CellText $ goalie^.gName + , CellText $ goalieName goalie , CellText $ show $ stats^.gsMinsPlayed , CellText $ show $ stats^.gsGoalsAllowed , CellText $ showFloating $ gsAverage stats From e2aeb5bfa49ecd46ec7a272e5cb53a9e3bf5c5c6 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 9 Jan 2020 01:01:51 -0500 Subject: [PATCH 08/12] enable toggling of rookie flag for players --- src/Mtlstats/Actions.hs | 15 +++++++++++++++ src/Mtlstats/Menu/EditPlayer.hs | 25 ++++++++++++++----------- test/ActionsSpec.hs | 27 +++++++++++++++++++++++++++ 3 files changed, 56 insertions(+), 11 deletions(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index e5f9fdd..b068296 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -32,6 +32,7 @@ module Mtlstats.Actions , createGoalie , edit , editPlayer + , editSelectedPlayer , editGoalie , addPlayer , addGoalie @@ -47,6 +48,7 @@ import Data.Maybe (fromMaybe) import Lens.Micro ((^.), (&), (.~), (%~)) import Mtlstats.Types +import Mtlstats.Util -- | Starts a new season startNewSeason :: ProgState -> ProgState @@ -106,6 +108,19 @@ edit = progMode .~ EditMenu editPlayer :: ProgState -> ProgState editPlayer = progMode .~ EditPlayer newEditPlayerState +-- | Edits the selected 'Player' +editSelectedPlayer + :: (Player -> Player) + -- ^ The modification to be made to the 'Player' + -> ProgState + -> ProgState +editSelectedPlayer f s = fromMaybe s $ do + n <- s^.progMode.editPlayerStateL.epsSelectedPlayer + let + players = s^.database.dbPlayers + players' = modifyNth n f players + Just $ s & database.dbPlayers .~ players' + -- | Starts the 'Goalie' editing process editGoalie :: ProgState -> ProgState editGoalie = progMode .~ EditGoalie newEditGoalieState diff --git a/src/Mtlstats/Menu/EditPlayer.hs b/src/Mtlstats/Menu/EditPlayer.hs index 2b6312d..777e025 100644 --- a/src/Mtlstats/Menu/EditPlayer.hs +++ b/src/Mtlstats/Menu/EditPlayer.hs @@ -26,7 +26,7 @@ module Mtlstats.Menu.EditPlayer ) where import Control.Monad.Trans.State (modify) -import Lens.Micro ((.~)) +import Lens.Micro ((.~), (%~)) import Mtlstats.Actions import Mtlstats.Types @@ -35,19 +35,22 @@ import Mtlstats.Types.Menu -- | The 'Player' edit menu editPlayerMenu :: Menu () editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map - (\(ch, label, mode) -> MenuItem ch label $ - modify $ case mode of - Nothing -> edit - Just m -> progMode.editPlayerStateL.epsMode .~ m) + (\(ch, label, action) -> MenuItem ch label $ modify action) + -- key, label, value - [ ( '1', "Edit number", Just EPNumber ) - , ( '2', "Edit name", Just EPName ) - , ( '3', "Edit position", Just EPPosition ) - , ( '4', "Edit YTD stats", Just EPYtd ) - , ( '5', "Edit lifetime stats", Just EPLifetime ) - , ( 'R', "Return to Edit Menu", Nothing ) + [ ( '1', "Edit number", set EPNumber ) + , ( '2', "Edit name", set EPName ) + , ( '3', "Edit position", set EPPosition ) + , ( '4', "Toggle rookie flag", toggle ) + , ( '5', "Edit YTD stats", set EPYtd ) + , ( '6', "Edit lifetime stats", set EPLifetime ) + , ( 'R', "Return to Edit Menu", edit ) ] + where + set mode = progMode.editPlayerStateL.epsMode .~ mode + toggle = editSelectedPlayer $ pRookie %~ not + -- | The 'Player' YTD stats edit menu editPlayerYtdMenu :: Menu () editPlayerYtdMenu = editMenu diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index d29fd6a..7a26815 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -53,6 +53,7 @@ spec = describe "Mtlstats.Actions" $ do createGoalieSpec editSpec editPlayerSpec + editSelectedPlayerSpec editGoalieSpec addPlayerSpec addGoalieSpec @@ -209,6 +210,32 @@ editPlayerSpec = describe "editPlayer" $ s = editPlayer newProgState in show (s^.progMode) `shouldBe` "EditPlayer" +editSelectedPlayerSpec :: Spec +editSelectedPlayerSpec = describe "editSelectedPlayer" $ mapM_ + (\(label, pState, expected) -> context label $ + it "should edit the players appropriately" $ let + pState' = editSelectedPlayer (pName .~ "foo") pState + players' = pState'^.database.dbPlayers + in players' `shouldBe` expected) + + -- label, initial state, expected + [ ( "wrong mode", baseState, players ) + , ( "not selected", changePlayer Nothing, players ) + , ( "player 0", changePlayer $ Just 0, changed0 ) + , ( "player 1", changePlayer $ Just 1, changed1 ) + , ( "out of bounds", changePlayer $ Just 2, players ) + ] + + where + baseState = newProgState & database.dbPlayers .~ players + changePlayer n = baseState + & (progMode.editPlayerStateL.epsSelectedPlayer .~ n) + players = [ player 0, player 1 ] + changed0 = [ player' 0, player 1 ] + changed1 = [ player 0, player' 1 ] + player n = newPlayer n ("Player " ++ show n) "pos" + player' n = newPlayer n "foo" "pos" + editGoalieSpec :: Spec editGoalieSpec = describe "editGoalie" $ it "should change the mode appropriately" $ let From 2c561e9807e380822472472e57421e329302cadf Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 9 Jan 2020 01:15:30 -0500 Subject: [PATCH 09/12] use editSelectedPlayer for all player edits --- src/Mtlstats/Prompt/EditPlayer.hs | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/Mtlstats/Prompt/EditPlayer.hs b/src/Mtlstats/Prompt/EditPlayer.hs index 91bb734..08a379e 100644 --- a/src/Mtlstats/Prompt/EditPlayer.hs +++ b/src/Mtlstats/Prompt/EditPlayer.hs @@ -31,13 +31,12 @@ module Mtlstats.Prompt.EditPlayer , editPlayerLtPMinPrompt ) where -import Control.Monad.Extra (whenJustM) -import Control.Monad.Trans.State (gets, modify) -import Lens.Micro ((^.), (.~), (%~)) +import Control.Monad.Trans.State (modify) +import Lens.Micro ((.~)) +import Mtlstats.Actions import Mtlstats.Prompt import Mtlstats.Types -import Mtlstats.Util -- | Prompt to edit a player's number editPlayerNumPrompt :: Prompt @@ -49,14 +48,14 @@ editPlayerNamePrompt :: Prompt editPlayerNamePrompt = namePrompt "Player name: " $ \name -> if null name then goto EPMenu - else editPlayer EPMenu $ pName .~ name + else doEdit EPMenu $ pName .~ name -- | Prompt to edit a player's position editPlayerPosPrompt :: Prompt editPlayerPosPrompt = ucStrPrompt "Player position: " $ \pos -> if null pos then goto EPMenu - else editPlayer EPMenu $ pPosition .~ pos + else doEdit EPMenu $ pPosition .~ pos -- | Prompt to edit a player's year-to-date goals editPlayerYtdGoalsPrompt @@ -115,13 +114,12 @@ editNum -> Prompt editNum pStr mode f = numPromptWithFallback pStr (goto mode) - (editPlayer mode . f) + (doEdit mode . f) -editPlayer :: EditPlayerMode -> (Player -> Player) -> Action () -editPlayer mode f = - whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid -> do - modify $ database.dbPlayers %~ modifyNth pid f - goto mode +doEdit :: EditPlayerMode -> (Player -> Player) -> Action () +doEdit mode f = do + modify $ editSelectedPlayer f + goto mode goto :: EditPlayerMode -> Action () goto = modify . (progMode.editPlayerStateL.epsMode .~) From 52f1e34d49a9b52b76abb217c612a9751c95a9e7 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 9 Jan 2020 01:31:24 -0500 Subject: [PATCH 10/12] implemented rookie flag toggling for goalies --- src/Mtlstats/Actions.hs | 14 ++++++++++++++ src/Mtlstats/Menu/EditGoalie.hs | 23 +++++++++++++---------- test/ActionsSpec.hs | 27 +++++++++++++++++++++++++++ 3 files changed, 54 insertions(+), 10 deletions(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index b068296..ef32a38 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -34,6 +34,7 @@ module Mtlstats.Actions , editPlayer , editSelectedPlayer , editGoalie + , editSelectedGoalie , addPlayer , addGoalie , resetCreatePlayerState @@ -125,6 +126,19 @@ editSelectedPlayer f s = fromMaybe s $ do editGoalie :: ProgState -> ProgState editGoalie = progMode .~ EditGoalie newEditGoalieState +-- | Edits the selected 'Goalie' +editSelectedGoalie + :: (Goalie -> Goalie) + -- ^ The modification to be made to the 'Goalie' + -> ProgState + -> ProgState +editSelectedGoalie f s = fromMaybe s $ do + n <- s^.progMode.editGoalieStateL.egsSelectedGoalie + let + goalies = s^.database.dbGoalies + goalies' = modifyNth n f goalies + Just $ s & database.dbGoalies .~ goalies' + -- | Adds the entered player to the roster addPlayer :: ProgState -> ProgState addPlayer s = fromMaybe s $ do diff --git a/src/Mtlstats/Menu/EditGoalie.hs b/src/Mtlstats/Menu/EditGoalie.hs index 812cf22..5f36606 100644 --- a/src/Mtlstats/Menu/EditGoalie.hs +++ b/src/Mtlstats/Menu/EditGoalie.hs @@ -26,7 +26,7 @@ module Mtlstats.Menu.EditGoalie ) where import Control.Monad.Trans.State (modify) -import Lens.Micro ((.~)) +import Lens.Micro ((.~), (%~)) import Mtlstats.Actions import Mtlstats.Types @@ -35,18 +35,21 @@ import Mtlstats.Types.Menu -- | The 'Goalie' edit menu editGoalieMenu :: Menu () editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map - (\(ch, label, mode) -> MenuItem ch label $ - modify $ case mode of - Nothing -> edit - Just m -> progMode.editGoalieStateL.egsMode .~ m) + (\(ch, label, action) -> MenuItem ch label $ modify action) + -- key, label, value - [ ( '1', "Edit number", Just EGNumber ) - , ( '2', "Edit name", Just EGName ) - , ( '3', "Edit YTD stats", Just EGYtd ) - , ( '4', "Edit Lifetime stats", Just EGLifetime ) - , ( 'R', "Return to Edit Menu", Nothing ) + [ ( '1', "Edit number", set EGNumber ) + , ( '2', "Edit name", set EGName ) + , ( '3', "Toggle rookie flag", toggle ) + , ( '4', "Edit YTD stats", set EGYtd ) + , ( '5', "Edit Lifetime stats", set EGLifetime ) + , ( 'R', "Return to Edit Menu", edit ) ] + where + set mode = progMode.editGoalieStateL.egsMode .~ mode + toggle = editSelectedGoalie (gRookie %~ not) + -- | The 'Goalie' YTD edit menu editGoalieYtdMenu :: Menu () editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***" diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 7a26815..4b4f28a 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -55,6 +55,7 @@ spec = describe "Mtlstats.Actions" $ do editPlayerSpec editSelectedPlayerSpec editGoalieSpec + editSelectedGoalieSpec addPlayerSpec addGoalieSpec resetCreatePlayerStateSpec @@ -242,6 +243,32 @@ editGoalieSpec = describe "editGoalie" $ s = editGoalie newProgState in show (s^.progMode) `shouldBe` "EditGoalie" +editSelectedGoalieSpec :: Spec +editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_ + (\(label, pState, expected) -> context label $ + it "should edit the goalies appropriately" $ let + pState' = editSelectedGoalie (gName .~ "foo") pState + goalies' = pState'^.database.dbGoalies + in goalies' `shouldBe` expected) + + -- label, initial state, expected + [ ( "wrong mode", baseState, goalies ) + , ( "not selected", changeGoalie Nothing, goalies ) + , ( "player 0", changeGoalie $ Just 0, changed0 ) + , ( "player 1", changeGoalie $ Just 1, changed1 ) + , ( "out of bounds", changeGoalie $ Just 2, goalies ) + ] + + where + baseState = newProgState & database.dbGoalies .~ goalies + changeGoalie n = baseState + & (progMode.editGoalieStateL.egsSelectedGoalie .~ n) + goalies = [ goalie 0, goalie 1 ] + changed0 = [ goalie' 0, goalie 1 ] + changed1 = [ goalie 0, goalie' 1 ] + goalie n = newGoalie n ("Player " ++ show n) + goalie' n = newGoalie n "foo" + addPlayerSpec :: Spec addPlayerSpec = describe "addPlayer" $ do let From 59026de07705997ca16ec9b85844df7d566794a8 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 9 Jan 2020 01:35:37 -0500 Subject: [PATCH 11/12] use editSelectedGoalie for all goalie editing --- src/Mtlstats/Prompt/EditGoalie.hs | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/Mtlstats/Prompt/EditGoalie.hs b/src/Mtlstats/Prompt/EditGoalie.hs index 5dbca9c..d81cefa 100644 --- a/src/Mtlstats/Prompt/EditGoalie.hs +++ b/src/Mtlstats/Prompt/EditGoalie.hs @@ -39,13 +39,12 @@ module Mtlstats.Prompt.EditGoalie , editGoalieLtTiesPrompt ) where -import Control.Monad.Extra (whenJustM) -import Control.Monad.Trans.State (gets, modify) -import Lens.Micro ((^.), (.~), (%~)) +import Control.Monad.Trans.State (modify) +import Lens.Micro ((.~)) +import Mtlstats.Actions import Mtlstats.Prompt import Mtlstats.Types -import Mtlstats.Util -- | Prompt to select a 'Goalie' for editing goalieToEditPrompt :: Prompt @@ -62,7 +61,7 @@ editGoalieNamePrompt :: Prompt editGoalieNamePrompt = namePrompt "Goalie name: " $ \name -> if null name then goto EGMenu - else editGoalie EGMenu $ gName .~ name + else doEdit EGMenu $ gName .~ name -- | Prompt to edit a goalie's YTD games played editGoalieYtdGamesPrompt @@ -213,13 +212,12 @@ editNum -> Prompt editNum pStr mode f = numPromptWithFallback pStr (goto mode) - (editGoalie mode . f) + (doEdit mode . f) -editGoalie :: EditGoalieMode -> (Goalie -> Goalie) -> Action () -editGoalie mode f = - whenJustM (gets (^.progMode.editGoalieStateL.egsSelectedGoalie)) $ \gid -> do - modify $ database.dbGoalies %~ modifyNth gid f - goto mode +doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action () +doEdit mode f = do + modify $ editSelectedGoalie f + goto mode goto :: EditGoalieMode -> Action () goto = modify . (progMode.editGoalieStateL.egsMode .~) From b69b3fce7adbe1b331aa973eef31d604bd1afde2 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 9 Jan 2020 01:43:35 -0500 Subject: [PATCH 12/12] fixed editSelectedGoalie test labels --- test/ActionsSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 4b4f28a..a71518e 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -254,8 +254,8 @@ editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_ -- label, initial state, expected [ ( "wrong mode", baseState, goalies ) , ( "not selected", changeGoalie Nothing, goalies ) - , ( "player 0", changeGoalie $ Just 0, changed0 ) - , ( "player 1", changeGoalie $ Just 1, changed1 ) + , ( "goalie 0", changeGoalie $ Just 0, changed0 ) + , ( "goalie 1", changeGoalie $ Just 1, changed1 ) , ( "out of bounds", changeGoalie $ Just 2, goalies ) ]