Merge pull request #23 from mtlstats/game-stats

Show game statistics in report

package.yaml

@@ -22,6 +22,7 @@ description:         Please see the README on GitHub at <https://github.com/jlam
 dependencies:
 - base >= 4.7 && < 5
 - aeson >= 1.4.4.0 && < 1.5
+- containers >= 0.6.0.1 && < 0.7
 - easy-file >= 0.2.2 && < 0.3
 - extra >= 1.6.17 && < 1.7
 - microlens-th >= 0.4.2.3 && < 0.5

src/Mtlstats/Actions.hs

@@ -39,6 +39,7 @@ module Mtlstats.Actions
   ) where
 
 import Control.Monad.Trans.State (modify)
+import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Data.Time.Calendar (fromGregorianValid)
 import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
@@ -174,8 +175,11 @@ awardGoal
   -> ProgState
   -> ProgState
 awardGoal n ps = ps
-  &  database.dbPlayers
+  & progMode.gameStateL.gamePlayerStats %~
-  %~ map
+    (\m -> let
+      stats = M.findWithDefault newPlayerStats n m
+      in M.insert n (stats & psGoals %~ succ) m)
+  & database.dbPlayers %~ map
     (\(i, p) -> if i == n
       then p
         & pYtd.psGoals      %~ succ
@@ -189,8 +193,11 @@ awardAssist
   -> ProgState
   -> ProgState
 awardAssist n ps = ps
-  &  database.dbPlayers
+  & progMode.gameStateL.gamePlayerStats %~
-  %~ map
+    (\m -> let
+      stats = M.findWithDefault newPlayerStats n m
+      in M.insert n (stats & psAssists %~ succ) m)
+  & database.dbPlayers %~ map
     (\(i, p) -> if i == n
       then p
         & pYtd.psAssists      %~ succ

src/Mtlstats/Report.hs

@@ -21,12 +21,14 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Report (report, gameDate) where
 
+import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Lens.Micro ((^.))
 
 import Mtlstats.Config
 import Mtlstats.Format
 import Mtlstats.Types
+import Mtlstats.Util
 
 -- | Generates the report
 report
@@ -46,9 +48,15 @@ report width s = unlines $ fromMaybe [] $ do
     hStats  = db^.dbHomeGameStats
     aStats  = db^.dbAwayGameStats
     tStats  = addGameStats hStats aStats
+    players = db^.dbPlayers
   hScore <- gs^.homeScore
   aScore <- gs^.awayScore
-  Just
+  pStats <- mapM
+    (\(n, stats) -> do
+      player <- nth n players
+      Just (player, stats))
+    (M.toList $ gs^.gamePlayerStats)
+  Just $
     [ overlay
       ("GAME NUMBER " ++ padNum 2 gNum)
       (centre width
@@ -78,7 +86,26 @@ report width s = unlines $ fromMaybe [] $ do
     , centre width
       $  left 11 "TOTALS"
       ++ showStats tStats
-    ]
+    , ""
+    , centre width "GAME STATISTICS"
+    , ""
+    , centre width
+      $  "NO. "
+      ++ left 20 "PLAYER"
+      ++ right 3 "G"
+      ++ right 6 "A"
+      ++ right 6 "P"
+      ++ right 6 "PM"
+    ] ++ map
+      (\(p, stats) -> centre width
+        $  right 2 (show $ p^.pNumber)
+        ++ "  "
+        ++ left 20 (p^.pName)
+        ++ right 3 (show $ stats^.psGoals)
+        ++ right 6 (show $ stats^.psAssists)
+        ++ right 6 (show $ pPoints stats)
+        ++ right 6 (show $ stats^.psPMin))
+      pStats
 
 gameDate :: GameState -> String
 gameDate gs = fromMaybe "" $ do

src/Mtlstats/Types.hs

@@ -58,6 +58,7 @@ module Mtlstats.Types (
   pointsAccounted,
   goalBy,
   assistsBy,
+  gamePlayerStats,
   confirmGoalDataFlag,
   -- ** CreatePlayerState Lenses
   cpsNumber,
@@ -146,6 +147,7 @@ import Data.Aeson
   , (.=)
   )
 import Data.List (isInfixOf)
+import qualified Data.Map as M
 import Data.Maybe (listToMaybe)
 import Lens.Micro (Lens', lens, (&), (^.), (.~))
 import Lens.Micro.TH (makeLenses)
@@ -215,7 +217,10 @@ data GameState = GameState
   , _assistsBy           :: [Int]
   -- ^ The index numbers of the players who have assisted the most
   -- recently entered goal
+  , _gamePlayerStats     :: M.Map Int PlayerStats
+  -- ^ The player stats accumulated over the game
   , _confirmGoalDataFlag :: Bool
+  -- ^ Set when the user confirms the goal data
   } deriving (Eq, Show)
 
 -- | The type of game
@@ -514,6 +519,7 @@ newGameState = GameState
   , _pointsAccounted     = 0
   , _goalBy              = Nothing
   , _assistsBy           = []
+  , _gamePlayerStats     = M.empty
   , _confirmGoalDataFlag = False
   }
 

test/ActionsSpec.hs

@@ -22,6 +22,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module ActionsSpec (spec) where
 
 import Control.Monad (replicateM)
+import qualified Data.Map as M
 import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import System.Random (randomRIO)
 import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe)
@@ -368,9 +369,10 @@ recordGoalAssistsSpec = describe "recordGoalAssists" $ do
     bob   = newPlayer 2 "Bob"   "defense"
     steve = newPlayer 3 "Steve" "forward"
     dave  = newPlayer 4 "Dave"  "somewhere"
+    frank = newPlayer 5 "Frank" "elsewhere"
     ps
       = newProgState
-      & database.dbPlayers .~ [joe, bob, steve, dave]
+      & database.dbPlayers .~ [joe, bob, steve, dave, frank]
       & progMode.gameStateL
         %~ (goalBy              ?~ 0)
         .  (assistsBy           .~ [1, 2])
@@ -378,26 +380,35 @@ recordGoalAssistsSpec = describe "recordGoalAssists" $ do
       & recordGoalAssists
 
   mapM_
-    (\(name, n, ytdg, ltg, ytda, lta) -> context name $ do
+    (\(name, n, goals, assists) -> context name $ do
-      let player = (ps^.database.dbPlayers) !! n
+      let
+        player = (ps^.database.dbPlayers) !! n
+        stats  = M.findWithDefault newPlayerStats n $
+          ps^.progMode.gameStateL.gamePlayerStats
 
-      it ("should set the year-to-date goals to " ++ show ytdg) $
+      it ("should set the year-to-date goals to " ++ show goals) $
-        player^.pYtd.psGoals `shouldBe` ytdg
+        player^.pYtd.psGoals `shouldBe` goals
 
-      it ("should set the lifetime goals to " ++ show ltg) $
+      it ("should set the lifetime goals to " ++ show goals) $
-        player^.pLifetime.psGoals `shouldBe` ltg
+        player^.pLifetime.psGoals `shouldBe` goals
 
-      it ("should set the year-to-date assists to " ++ show ytda) $
+      it ("should set the game goals to " ++ show goals) $
-        player^.pYtd.psAssists `shouldBe` ytda
+        stats^.psAssists `shouldBe` assists
 
-      it ("should set the lifetime assists to " ++ show lta) $
+      it ("should set the year-to-date assists to " ++ show assists) $
-        player^.pLifetime.psAssists `shouldBe` lta)
+        player^.pYtd.psAssists `shouldBe` assists
 
-    --  name,    index, ytd goals, lt goals, ytd assists, lt assists
+      it ("should set the lifetime assists to " ++ show assists) $
-    [ ( "Joe",   0,     1,         1,        0,           0          )
+        player^.pLifetime.psAssists `shouldBe` assists
-    , ( "Bob",   1,     0,         0,        1,           1          )
+
-    , ( "Steve", 2,     0,         0,        1,           1          )
+      it ("should set the game assists to " ++ show assists) $
-    , ( "Dave",  3,     0,         0,        0,           0          )
+        stats^.psAssists `shouldBe` assists)
+
+    --  name,    index, goals, assists
+    [ ( "Joe",   0,     1,     0       )
+    , ( "Bob",   1,     0,     1       )
+    , ( "Steve", 2,     0,     1       )
+    , ( "Dave",  3,     0,     0       )
     ]
 
   it "should clear the goalBy value" $
@@ -426,31 +437,34 @@ awardGoalSpec = describe "awardGoal" $ do
     db
       = newDatabase
       & dbPlayers .~ [joe, bob]
+    joeStats
+      = newPlayerStats
+      & psGoals .~ 1
     ps
       = newProgState
+      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
       & database .~ db
 
-  context "Joe" $ do
+  mapM_
+    (\(pName, pid, ytd, lt, game) ->
+      context pName $ do
         let
-      ps'    = awardGoal 0 ps
+          ps'    = awardGoal pid ps
-      player = head $ ps'^.database.dbPlayers
+          player = (ps'^.database.dbPlayers) !! pid
+          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
 
-    it "should increment Joe's year-to-date goals" $
+        it ("should increment " ++ pName ++ "'s year-to-date goals") $
-      player^.pYtd.psGoals `shouldBe` 2
+          player^.pYtd.psGoals `shouldBe` ytd
 
-    it "should increment Joe's lifetime goals" $
+        it ("should increment " ++ pName ++ "'s lifetime goals") $
-      player^.pLifetime.psGoals `shouldBe` 3
+          player^.pLifetime.psGoals `shouldBe` lt
 
-  context "Bob" $ do
+        it ("should increment " ++ pName ++ "'s game goals") $
-    let
+          gStats^.psGoals `shouldBe` game)
-      ps' = awardGoal 1 ps
+    --  player name, player id, ytd goals, lifetime goals, game goals
-      player = last $ ps'^.database.dbPlayers
+    [ ( "Joe",       0,         2,         3,              2          )
-
+    , ( "Bob",       1,         4,         5,              1          )
-    it "should increment Bob's year-to-data goals" $
+    ]
-      player^.pYtd.psGoals `shouldBe` 4
-
-    it "should increment Bob's lifetime goals" $
-      player^.pLifetime.psGoals `shouldBe` 5
 
   context "invalid index" $ let
     ps' = awardGoal 2 ps
@@ -473,45 +487,34 @@ awardAssistSpec = describe "awardAssist" $ do
       = newPlayer 2 "Bob" "defense"
       & pYtd.psAssists      .~ 3
       & pLifetime.psAssists .~ 4
+    joeStats
+      = newPlayerStats
+      & psAssists .~ 1
     ps
       = newProgState
+      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
       & database.dbPlayers .~ [joe, bob]
 
-  context "Joe" $ do
+  mapM_
+    (\(pName, pid, ytd, lt, game) ->
+      context pName $ do
         let
-      ps'  = awardAssist 0 ps
+          ps' = awardAssist pid ps
-      joe' = head $ ps'^.database.dbPlayers
+          player = (ps'^.database.dbPlayers) !! pid
-      bob' = last $ ps'^.database.dbPlayers
+          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
 
-    it "should increment Joe's year-to-date assists" $
+        it ("should increment " ++ pName ++ "'s year-to-date assists") $
-      joe'^.pYtd.psAssists `shouldBe` 2
+          player^.pYtd.psAssists `shouldBe` ytd
 
-    it "should increment Joe's lifetime assists" $
+        it ("should increment " ++ pName ++ "'s lifetime assists") $
-      joe'^.pLifetime.psAssists `shouldBe` 3
+          player^.pLifetime.psAssists `shouldBe` lt
 
-    it "should leave Bob's year-to-date assists alone" $
+        it ("should increment " ++ pName ++ "'s game assists") $
-      bob'^.pYtd.psAssists `shouldBe` 3
+          gStats^.psAssists `shouldBe` game)
-
+    --  player name, player id, ytd assists, lifetime assists, game assists
-    it "should leave Bob's lifetime assists alone" $
+    [ ( "Joe",       0,         2,           3,                2            )
-      bob^.pLifetime.psAssists `shouldBe` 4
+    , ( "Bob",       1,         4,           5,                1            )
-
+    ]
-  context "Bob" $ do
-    let
-      ps'  = awardAssist 1 ps
-      joe' = head $ ps'^.database.dbPlayers
-      bob' = last $ ps'^.database.dbPlayers
-
-    it "should leave Joe's year-to-date assists alone" $
-      joe'^.pYtd.psAssists `shouldBe` 1
-
-    it "should leave Joe's lifetime assists alone" $
-      joe'^.pLifetime.psAssists `shouldBe` 2
-
-    it "should increment Bob's year-to-date assists" $
-      bob'^.pYtd.psAssists `shouldBe` 4
-
-    it "should increment Bob's lifetime assists" $
-      bob'^.pLifetime.psAssists `shouldBe` 5
 
   context "invalid index" $ let
     ps' = awardAssist (-1) ps