Merge pull request #26 from mtlstats/ytd-stats

year-to-date statistics
This commit is contained in:
Jonathan Lamothe 2019-10-16 02:37:50 -04:00 committed by GitHub
commit 569f009dcd
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
9 changed files with 217 additions and 41 deletions

View File

@ -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

View File

@ -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
}

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 )
]

View File

@ -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

View File

@ -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]