Merge pull request #26 from mtlstats/ytd-stats

year-to-date statistics

src/Mtlstats/Actions.hs

@@ -37,6 +37,9 @@ module Mtlstats.Actions
   , awardAssist
   , resetGoalData
   , assignPMins
+  , backHome
+  , scrollUp
+  , scrollDown
   ) where
 
 import Control.Monad.Trans.State (modify)
@@ -229,3 +232,18 @@ assignPMins mins s = fromMaybe s $ do
            (psPMin +~ mins)
          )
       .  (selectedPlayer .~ Nothing)
+
+-- | Resets the program state back to the main menu
+backHome :: ProgState -> ProgState
+backHome
+  = (progMode     .~ MainMenu)
+  . (inputBuffer  .~ "")
+  . (scrollOffset .~ 0)
+
+-- | Scrolls the display up
+scrollUp :: ProgState -> ProgState
+scrollUp = scrollOffset %~ max 0 . pred
+
+-- | Scrolls the display down
+scrollDown :: ProgState -> ProgState
+scrollDown = scrollOffset %~ succ

src/Mtlstats/Control.hs

@@ -25,7 +25,7 @@ import Control.Monad (join, when)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (toUpper)
 import Data.Maybe (fromJust, fromMaybe, isJust)
-import Lens.Micro ((^.), (.~))
+import Lens.Micro ((^.), (.~), (%~))
 import Lens.Micro.Extras (view)
 import qualified UI.NCurses as C
 
@@ -270,16 +270,20 @@ getPMinsC = Controller
 reportC :: Controller
 reportC = Controller
   { drawController = \s -> do
-    (_, cols) <- C.windowSize
-    C.drawString $ report (fromInteger $ pred cols) s
+    (rows, cols) <- C.windowSize
+    C.drawString $ unlines $ slice
+      (s^.scrollOffset)
+      (fromInteger $ pred rows)
+      (report (fromInteger $ pred cols) s)
     return C.CursorInvisible
   , handleController = \e -> do
-    when
-      (case e of
-        C.EventCharacter _  -> True
-        C.EventSpecialKey _ -> True
-        _                   -> False) $
-      modify $ progMode .~ MainMenu
+    case e of
+      C.EventSpecialKey C.KeyUpArrow   -> modify scrollUp
+      C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
+      C.EventSpecialKey C.KeyHome      -> modify $ scrollOffset .~ 0
+      C.EventSpecialKey _              -> modify backHome
+      C.EventCharacter _               -> modify backHome
+      _                                -> return ()
     return True
   }
 

src/Mtlstats/Report.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Report (report, gameDate) where
+module Mtlstats.Report (report, gameDate, playerNameColWidth) where
 
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
@@ -36,14 +36,16 @@ report
   -- ^ The number of columns for the report
   -> ProgState
   -- ^ The program state
-  -> String
+  -> [String]
 report width s
   =  standingsReport width s
-  ++ "\n"
+  ++ [""]
   ++ gameStatsReport width s
+  ++ [""]
+  ++ yearToDateStatsReport width s
 
-standingsReport :: Int -> ProgState -> String
-standingsReport width s = unlines $ fromMaybe [] $ do
+standingsReport :: Int -> ProgState -> [String]
+standingsReport width s = fromMaybe [] $ do
   let
     db     = s^.database
     gs     = s^.progMode.gameStateL
@@ -88,20 +90,32 @@ standingsReport width s = unlines $ fromMaybe [] $ do
       ++ showStats tStats
     ]
 
-gameStatsReport :: Int -> ProgState -> String
-gameStatsReport width s = unlines $ fromMaybe [] $ do
-  pStats <- mapM
+gameStatsReport :: Int -> ProgState -> [String]
+gameStatsReport width s = playerReport width "GAME" $
+  fromMaybe [] $ mapM
     (\(pid, stats) -> do
       p <- nth pid $ s^.database.dbPlayers
       Just (p, stats))
     (M.toList $ s^.progMode.gameStateL.gamePlayerStats)
-  let
-    nameWidth = succ $ maximum $ 10 : map
-      (length . (^.pName) . fst)
-      pStats
-    tStats = foldr (addPlayerStats . snd) newPlayerStats pStats
-  Just $
-    [ centre width "GAME STATISTICS"
+
+yearToDateStatsReport :: Int -> ProgState -> [String]
+yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
+  map (\p -> (p, p^.pYtd)) $
+  filter playerIsActive $ s^.database.dbPlayers
+
+gameDate :: GameState -> String
+gameDate gs = fromMaybe "" $ do
+  year  <- show <$> gs^.gameYear
+  month <- month <$> gs^.gameMonth
+  day   <- padNum 2 <$> gs^.gameDay
+  Just $ month ++ " " ++ day ++ " " ++ year
+
+playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
+playerReport width label ps = let
+  nameWidth = playerNameColWidth $ map fst ps
+  tStats    = foldr (addPlayerStats . snd) newPlayerStats ps
+  in
+    [ centre width (label ++ " STATISTICS")
     , ""
     , centre width
       $  "NO. "
@@ -119,12 +133,12 @@ gameStatsReport width s = unlines $ fromMaybe [] $ do
         ++ right 6 (show $ stats^.psAssists)
         ++ right 6 (show $ psPoints stats)
         ++ right 6 (show $ stats^.psPMin))
-      pStats ++
+      ps ++
     [ centre width
       $  replicate (4 + nameWidth) ' '
       ++ replicate (3 + 3 * 6) '-'
     , overlay
-      "GAME TOTALS"
+      (label ++ " TOTALS")
       ( centre width
         $  replicate (4 + nameWidth) ' '
         ++ right 3 (show $ tStats^.psGoals)
@@ -134,12 +148,10 @@ gameStatsReport width s = unlines $ fromMaybe [] $ do
       )
     ]
 
-gameDate :: GameState -> String
-gameDate gs = fromMaybe "" $ do
-  year  <- show <$> gs^.gameYear
-  month <- month <$> gs^.gameMonth
-  day   <- padNum 2 <$> gs^.gameDay
-  Just $ month ++ " " ++ day ++ " " ++ year
+playerNameColWidth :: [Player] -> Int
+playerNameColWidth = foldr
+  (\player current -> max current $ succ $ length $ player^.pName)
+  10
 
 showStats :: GameStats -> String
 showStats gs

src/Mtlstats/Types.hs

@@ -42,6 +42,7 @@ module Mtlstats.Types (
   database,
   progMode,
   inputBuffer,
+  scrollOffset,
   -- ** ProgMode Lenses
   gameStateL,
   createPlayerStateL,
@@ -132,6 +133,7 @@ module Mtlstats.Types (
   playerSearchExact,
   modifyPlayer,
   playerSummary,
+  playerIsActive,
   -- ** PlayerStats Helpers
   psPoints,
   addPlayerStats
@@ -178,6 +180,8 @@ data ProgState = ProgState
   -- ^ The program's mode
   , _inputBuffer  :: String
   -- ^ Buffer for user input
+  , _scrollOffset :: Int
+  -- ^ The scrolling offset for the display
   }
 
 -- | The program mode
@@ -510,6 +514,7 @@ newProgState = ProgState
   { _database     = newDatabase
   , _progMode     = MainMenu
   , _inputBuffer  = ""
+  , _scrollOffset = 0
   }
 
 -- | Constructor for a 'GameState'
@@ -732,6 +737,16 @@ playerSummary :: Player -> String
 playerSummary p =
   p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
 
+-- | Determines whether or not a player has been active in the current
+-- season/year
+playerIsActive :: Player -> Bool
+playerIsActive = do
+  stats <- (^.pYtd)
+  return
+    $  stats^.psGoals   /= 0
+    || stats^.psAssists /= 0
+    || stats^.psPMin    /= 0
+
 -- | Calculates a player's points
 psPoints :: PlayerStats -> Int
 psPoints s = s^.psGoals + s^.psAssists

src/Mtlstats/Util.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Util (nth, modifyNth, updateMap) where
+module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
 
 import qualified Data.Map as M
 
@@ -64,3 +64,14 @@ updateMap
 updateMap k def f m = let
   x = M.findWithDefault def k m
   in M.insert k (f x) m
+
+-- | Selects a section of a list
+slice
+  :: Int
+  -- ^ The index to start at
+  -> Int
+  -- ^ The number of elements to take
+  -> [a]
+  -- ^ The list to take a subset of
+  -> [a]
+slice offset len = take len . drop offset

test/ActionsSpec.hs

@@ -19,6 +19,8 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
+{-# LANGUAGE LambdaCase #-}
+
 module ActionsSpec (spec) where
 
 import Control.Monad (replicateM)
@@ -26,7 +28,16 @@ import qualified Data.Map as M
 import Data.Maybe (fromJust)
 import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import System.Random (randomRIO)
-import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe)
+import Test.Hspec
+  ( Spec
+  , context
+  , describe
+  , it
+  , runIO
+  , shouldBe
+  , shouldNotBe
+  , shouldSatisfy
+  )
 
 import Mtlstats.Actions
 import Mtlstats.Types
@@ -49,6 +60,9 @@ spec = describe "Mtlstats.Actions" $ do
   awardAssistSpec
   resetGoalDataSpec
   assignPMinsSpec
+  backHomeSpec
+  scrollUpSpec
+  scrollDownSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -640,3 +654,49 @@ makeNum = randomRIO (1, 10)
 
 makeName :: IO String
 makeName = replicateM 10 $ randomRIO ('A', 'Z')
+
+backHomeSpec :: Spec
+backHomeSpec = describe "backHome" $ do
+  let
+    input = newProgState
+      & progMode.gameStateL .~ newGameState
+      & inputBuffer         .~ "foo"
+      & scrollOffset        .~ 123
+    result = backHome input
+
+  it "should set the program mode back to MainMenu" $
+    result^.progMode `shouldSatisfy` \case
+      MainMenu -> True
+      _        -> False
+
+  it "should clear the input buffer" $
+    result^.inputBuffer `shouldBe` ""
+
+  it "should reset the scroll offset" $
+    result^.scrollOffset `shouldBe` 0
+
+scrollUpSpec :: Spec
+scrollUpSpec = describe "scrollUp" $ do
+
+  context "scrolled down" $
+    it "should decrease the scroll offset by one" $ let
+      ps  = newProgState & scrollOffset .~ 10
+      ps' = scrollUp ps
+      in ps'^.scrollOffset `shouldBe` 9
+
+  context "at top" $
+    it "should keep the scroll offset at zero" $ let
+      ps = scrollUp newProgState
+      in ps^.scrollOffset `shouldBe` 0
+
+  context "above top" $
+    it "should return the scroll offset to zero" $ let
+      ps  = newProgState & scrollOffset .~ (-10)
+      ps' = scrollUp ps
+      in ps'^.scrollOffset `shouldBe` 0
+
+scrollDownSpec = describe "scrollDown" $
+  it "should increase the scroll offset" $ let
+    ps  = newProgState & scrollOffset .~ 10
+    ps' = scrollDown ps
+    in ps'^.scrollOffset `shouldBe` 11

test/ReportSpec.hs

@@ -28,8 +28,9 @@ import Mtlstats.Report
 import Mtlstats.Types
 
 spec :: Spec
-spec = describe "Mtlstats.Report"
+spec = describe "Mtlstats.Report" $ do
   gameDateSpec
+  playerNameColWidthSpec
 
 gameDateSpec :: Spec
 gameDateSpec = describe "gameDate" $ do
@@ -45,3 +46,20 @@ gameDateSpec = describe "gameDate" $ do
   context "invalid date" $
     it "should return an empty string" $
       gameDate newGameState `shouldBe` ""
+
+playerNameColWidthSpec :: Spec
+playerNameColWidthSpec = describe "playerNameColWidth" $ do
+  let
+    short1 = newPlayer 1 "short" "foo"
+    short2 = newPlayer 2 "shorty" "bar"
+    long   = newPlayer 3 "123456789012345" "baz"
+
+  mapM_
+    (\(label, players, expected) -> context label $
+      it ("should be " ++ show expected) $
+        playerNameColWidth players `shouldBe` expected)
+    --  label,         players,          expected
+    [ ( "empty list",  [],               10       )
+    , ( "short names", [short1, short2], 10       )
+    , ( "long name",   [short1, long],   16       )
+    ]

test/TypesSpec.hs

@@ -58,6 +58,7 @@ spec = describe "Mtlstats.Types" $ do
   playerSearchExactSpec
   modifyPlayerSpec
   playerSummarySpec
+  playerIsActiveSpec
   psPointsSpec
   addPlayerStatsSpec
   Menu.spec
@@ -567,6 +568,26 @@ playerSummarySpec = describe "playerSummary" $
   it "should be \"Joe (2) center\"" $
     playerSummary joe `shouldBe` "Joe (2) center"
 
+playerIsActiveSpec :: Spec
+playerIsActiveSpec = describe "playerIsActive" $ do
+  let
+    pState = newPlayerStats
+      & psGoals   .~ 10
+      & psAssists .~ 11
+      & psPMin    .~ 12
+    player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
+
+  mapM_
+    (\(label, player', expected) -> context label $
+      it ("should be " ++ show expected) $
+        playerIsActive player' `shouldBe` expected)
+    --  label,                player,                       expected
+    [ ( "not active",         player,                       False    )
+    , ( "has goal",           player & pYtd.psGoals   .~ 1, True     )
+    , ( "has assist",         player & pYtd.psAssists .~ 1, True     )
+    , ( "has penalty minute", player & pYtd.psPMin    .~ 1, True     )
+    ]
+
 psPointsSpec :: Spec
 psPointsSpec = describe "psPoints" $ mapM_
   (\(goals, assists, points) -> let

test/UtilSpec.hs

@@ -31,6 +31,7 @@ spec = describe "Mtlstats.Util" $ do
   nthSpec
   modifyNthSpec
   updateMapSpec
+  sliceSpec
 
 nthSpec :: Spec
 nthSpec = describe "nth" $ mapM_
@@ -75,3 +76,19 @@ updateMapSpec = describe "updateMap" $ do
     expected = M.fromList [(1, 2), (3, 5), (10, 11)]
     in it "should create a new value and update the default" $
       updateMap 10 10 succ input `shouldBe` expected
+
+sliceSpec :: Spec
+sliceSpec = describe "slice" $ do
+  let list = [2, 4, 6, 8]
+
+  context "sublist" $
+    it "should return the sublist" $
+      slice 1 2 list `shouldBe` [4, 6]
+
+  context "too large" $
+    it "should return as much of the list as possible" $
+      slice 1 100 list `shouldBe` [4, 6, 8]
+
+  context "negative offset" $
+    it "should return the correct number of elements from the beginning" $
+      slice (-10) 2 list `shouldBe` [2, 4]