From db8bbd978612a6a0886fe98b66f413737744a4bf Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 11 Oct 2019 22:24:27 -0400 Subject: [PATCH 1/9] added scrollOffset field to ProgState --- src/Mtlstats/Types.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 31ddf14..a310c51 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -42,6 +42,7 @@ module Mtlstats.Types ( database, progMode, inputBuffer, + scrollOffset, -- ** ProgMode Lenses gameStateL, createPlayerStateL, @@ -172,12 +173,14 @@ type Action a = StateT ProgState C.Curses a -- | Represents the program state data ProgState = ProgState - { _database :: Database + { _database :: Database -- ^ The data to be saved - , _progMode :: ProgMode + , _progMode :: ProgMode -- ^ The program's mode - , _inputBuffer :: String + , _inputBuffer :: String -- ^ Buffer for user input + , _scrollOffset :: Int + -- ^ The scrolling offset for the display } -- | The program mode @@ -507,9 +510,10 @@ createPlayerStateL = lens -- | Constructor for a 'ProgState' newProgState :: ProgState newProgState = ProgState - { _database = newDatabase - , _progMode = MainMenu - , _inputBuffer = "" + { _database = newDatabase + , _progMode = MainMenu + , _inputBuffer = "" + , _scrollOffset = 0 } -- | Constructor for a 'GameState' From a91ed5afb3abe1f3a7745feb401ffa30f9fd44d6 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 11 Oct 2019 23:13:00 -0400 Subject: [PATCH 2/9] enable scrolling of report --- src/Mtlstats/Actions.hs | 8 ++++++++ src/Mtlstats/Control.hs | 22 +++++++++++++--------- src/Mtlstats/Report.hs | 12 ++++++------ src/Mtlstats/Util.hs | 13 ++++++++++++- test/ActionsSpec.hs | 34 +++++++++++++++++++++++++++++++++- test/UtilSpec.hs | 17 +++++++++++++++++ 6 files changed, 89 insertions(+), 17 deletions(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 48ea77f..45109b0 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -37,6 +37,7 @@ module Mtlstats.Actions , awardAssist , resetGoalData , assignPMins + , backHome ) where import Control.Monad.Trans.State (modify) @@ -229,3 +230,10 @@ 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) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 66445db..2b40913 100644 --- a/src/Mtlstats/Control.hs +++ b/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 $ scrollOffset %~ pred + C.EventSpecialKey C.KeyDownArrow -> modify $ scrollOffset %~ succ + C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0 + C.EventSpecialKey _ -> modify backHome + C.EventCharacter _ -> modify backHome + _ -> return () return True } diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index 17db30a..ba52a21 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -36,14 +36,14 @@ report -- ^ The number of columns for the report -> ProgState -- ^ The program state - -> String + -> [String] report width s = standingsReport width s - ++ "\n" + ++ [""] ++ gameStatsReport 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,8 +88,8 @@ standingsReport width s = unlines $ fromMaybe [] $ do ++ showStats tStats ] -gameStatsReport :: Int -> ProgState -> String -gameStatsReport width s = unlines $ fromMaybe [] $ do +gameStatsReport :: Int -> ProgState -> [String] +gameStatsReport width s = fromMaybe [] $ do pStats <- mapM (\(pid, stats) -> do p <- nth pid $ s^.database.dbPlayers diff --git a/src/Mtlstats/Util.hs b/src/Mtlstats/Util.hs index 0100fc3..a094984 100644 --- a/src/Mtlstats/Util.hs +++ b/src/Mtlstats/Util.hs @@ -19,7 +19,7 @@ along with this program. If not, see . -} -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 diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index a0afc71..5e4f747 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -19,6 +19,8 @@ along with this program. If not, see . -} +{-# 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,7 @@ spec = describe "Mtlstats.Actions" $ do awardAssistSpec resetGoalDataSpec assignPMinsSpec + backHomeSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -640,3 +652,23 @@ 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 diff --git a/test/UtilSpec.hs b/test/UtilSpec.hs index 6a60641..b372b77 100644 --- a/test/UtilSpec.hs +++ b/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] From 363d0cb2d322da0a944d3e4d14e50237f2ce62c4 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Tue, 15 Oct 2019 00:16:44 -0400 Subject: [PATCH 3/9] don't scroll past top of page --- src/Mtlstats/Actions.hs | 10 ++++++++++ src/Mtlstats/Control.hs | 4 ++-- test/ActionsSpec.hs | 28 ++++++++++++++++++++++++++++ 3 files changed, 40 insertions(+), 2 deletions(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 45109b0..7a9b686 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -38,6 +38,8 @@ module Mtlstats.Actions , resetGoalData , assignPMins , backHome + , scrollUp + , scrollDown ) where import Control.Monad.Trans.State (modify) @@ -237,3 +239,11 @@ 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 diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 2b40913..f8dd896 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -278,8 +278,8 @@ reportC = Controller return C.CursorInvisible , handleController = \e -> do case e of - C.EventSpecialKey C.KeyUpArrow -> modify $ scrollOffset %~ pred - C.EventSpecialKey C.KeyDownArrow -> modify $ scrollOffset %~ succ + 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 diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 5e4f747..b45da09 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -61,6 +61,8 @@ spec = describe "Mtlstats.Actions" $ do resetGoalDataSpec assignPMinsSpec backHomeSpec + scrollUpSpec + scrollDownSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -672,3 +674,29 @@ backHomeSpec = describe "backHome" $ do 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 From d3389308000c7f3a1096255f41569b0113def89b Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Tue, 15 Oct 2019 00:51:42 -0400 Subject: [PATCH 4/9] implemented playerIsActive --- src/Mtlstats/Types.hs | 11 +++++++++++ test/TypesSpec.hs | 21 +++++++++++++++++++++ 2 files changed, 32 insertions(+) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index a310c51..7d13fc5 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -133,6 +133,7 @@ module Mtlstats.Types ( playerSearchExact, modifyPlayer, playerSummary, + playerIsActive, -- ** PlayerStats Helpers psPoints, addPlayerStats @@ -736,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 diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index c9f7257..b8bd0bb 100644 --- a/test/TypesSpec.hs +++ b/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 From 277ba9a9dd9444c180c96a7dc0f45704790c084a Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Tue, 15 Oct 2019 01:03:32 -0400 Subject: [PATCH 5/9] implemented playerNameColWidth --- src/Mtlstats/Report.hs | 7 ++++++- test/ReportSpec.hs | 20 +++++++++++++++++++- 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index ba52a21..4b7788b 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -19,7 +19,7 @@ along with this program. If not, see . -} -module Mtlstats.Report (report, gameDate) where +module Mtlstats.Report (report, gameDate, playerNameColWidth) where import qualified Data.Map as M import Data.Maybe (fromMaybe) @@ -141,6 +141,11 @@ gameDate gs = fromMaybe "" $ do day <- padNum 2 <$> gs^.gameDay Just $ month ++ " " ++ day ++ " " ++ year +playerNameColWidth :: [Player] -> Int +playerNameColWidth = foldr + (\player current -> max current $ length $ player^.pName) + 10 + showStats :: GameStats -> String showStats gs = right 2 (show $ gmsGames gs) diff --git a/test/ReportSpec.hs b/test/ReportSpec.hs index dafe415..a42d993 100644 --- a/test/ReportSpec.hs +++ b/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], 15 ) + ] From bfe568492dfd995c5e572605f80722b821f5ef5c Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 16 Oct 2019 02:14:13 -0400 Subject: [PATCH 6/9] implemented playerReport a private function in the Mtlstats.Report module --- src/Mtlstats/Report.hs | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index 4b7788b..70683e8 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -89,19 +89,26 @@ standingsReport width s = fromMaybe [] $ do ] gameStatsReport :: Int -> ProgState -> [String] -gameStatsReport width s = fromMaybe [] $ do - pStats <- mapM +gameStatsReport width s = maybe [] (playerReport width "GAME") $ + 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" + +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 +126,12 @@ gameStatsReport width s = 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,13 +141,6 @@ gameStatsReport width s = 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 $ length $ player^.pName) From 32f61ccc89e0606f52ffc25128cc50c2cb51d829 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 16 Oct 2019 02:23:25 -0400 Subject: [PATCH 7/9] implemented year-to-date report --- src/Mtlstats/Report.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index 70683e8..17a5b8a 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -41,6 +41,8 @@ report width s = standingsReport width s ++ [""] ++ gameStatsReport width s + ++ [""] + ++ yearToDateStatsReport width s standingsReport :: Int -> ProgState -> [String] standingsReport width s = fromMaybe [] $ do @@ -96,6 +98,11 @@ gameStatsReport width s = maybe [] (playerReport width "GAME") $ Just (p, stats)) (M.toList $ s^.progMode.gameStateL.gamePlayerStats) +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 From 19e0242135515085243a3b4cb2325c0d91e36136 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 16 Oct 2019 02:26:42 -0400 Subject: [PATCH 8/9] fixed name column spacing --- src/Mtlstats/Report.hs | 2 +- test/ReportSpec.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index 17a5b8a..aec4cb9 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -150,7 +150,7 @@ playerReport width label ps = let playerNameColWidth :: [Player] -> Int playerNameColWidth = foldr - (\player current -> max current $ length $ player^.pName) + (\player current -> max current $ succ $ length $ player^.pName) 10 showStats :: GameStats -> String diff --git a/test/ReportSpec.hs b/test/ReportSpec.hs index a42d993..e3b0bab 100644 --- a/test/ReportSpec.hs +++ b/test/ReportSpec.hs @@ -61,5 +61,5 @@ playerNameColWidthSpec = describe "playerNameColWidth" $ do -- label, players, expected [ ( "empty list", [], 10 ) , ( "short names", [short1, short2], 10 ) - , ( "long name", [short1, long], 15 ) + , ( "long name", [short1, long], 16 ) ] From cfe2969106aa844c1abf263aae5c05e4a288896d Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 16 Oct 2019 02:32:57 -0400 Subject: [PATCH 9/9] generate empty game stats report on failure --- src/Mtlstats/Report.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index aec4cb9..00976c2 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -91,8 +91,8 @@ standingsReport width s = fromMaybe [] $ do ] gameStatsReport :: Int -> ProgState -> [String] -gameStatsReport width s = maybe [] (playerReport width "GAME") $ - mapM +gameStatsReport width s = playerReport width "GAME" $ + fromMaybe [] $ mapM (\(pid, stats) -> do p <- nth pid $ s^.database.dbPlayers Just (p, stats))