enable scrolling of report

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)

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
   }
 

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

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

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]