enter months by number

ChangeLog.md

@@ -1,5 +1,8 @@
 # Changelog for mtlstats
 
+## current
+- enter months by number
+
 ## 0.15.2
 - allow ties
 

src/Mtlstats/Control/NewGame.hs

@@ -62,7 +62,7 @@ gameYearC :: Controller
 gameYearC = promptControllerWith header gameYearPrompt
 
 gameMonthC :: Controller
-gameMonthC = menuControllerWith header gameMonthMenu
+gameMonthC = promptControllerWith monthHeader gameMonthPrompt
 
 gameDayC :: Controller
 gameDayC = promptControllerWith header gameDayPrompt
@@ -226,6 +226,31 @@ header :: ProgState -> C.Update ()
 header s = C.drawString $
   "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
 
+monthHeader :: ProgState -> C.Update ()
+monthHeader s = do
+  (_, cols) <- C.windowSize
+  header s
+
+  let
+    table = labelTable $ zip (map show ([1..] :: [Int]))
+      [ "JANUARY"
+      , "FEBRUARY"
+      , "MARCH"
+      , "APRIL"
+      , "MAY"
+      , "JUNE"
+      , "JULY"
+      , "AUGUST"
+      , "SEPTEMBER"
+      , "OCTOBER"
+      , "NOVEMBER"
+      , "DECEMBER"
+      ]
+
+  C.drawString $ unlines $
+    map (centre $ fromIntegral $ pred cols) $
+      ["MONTH:", ""] ++ table ++ [""]
+
 gameGoal :: ProgState -> (Int, Int)
 gameGoal s =
   ( s^.database.dbGames

src/Mtlstats/Format.hs

@@ -129,9 +129,14 @@ month _  = ""
 labelTable :: [(String, String)] -> [String]
 labelTable xs = let
   labelWidth = maximum $ map (length . fst) xs
+  valWidth   = maximum $ map (length . snd) xs
+
   in map
-    (\(label, val) -> right labelWidth label ++ ": " ++ val)
+    ( \(label, val)
-    xs
+      -> right labelWidth label
+      ++ ": "
+      ++ left valWidth val
+    ) xs
 
 -- | Creates a variable column table of numbers with two axes
 numTable

src/Mtlstats/Menu.hs

@@ -29,7 +29,6 @@ module Mtlstats.Menu (
   -- * Menus
   mainMenu,
   newSeasonMenu,
-  gameMonthMenu,
   gameTypeMenu,
   gameGoalieMenu,
   editMenu
@@ -130,26 +129,6 @@ newSeasonMenu = Menu "SEASON TYPE" ()
     . startNewGame
   ]
 
--- | Requests the month in which the game took place
-gameMonthMenu :: Menu ()
-gameMonthMenu = Menu "MONTH:" () $ map
-  (\(ch, name, val) ->
-    MenuItem ch name $
-    modify $ progMode.gameStateL.gameMonth ?~ val)
-  [ ( 'A', "JANUARY",   1  )
-  , ( 'B', "FEBRUARY",  2  )
-  , ( 'C', "MARCH",     3  )
-  , ( 'D', "APRIL",     4  )
-  , ( 'E', "MAY",       5  )
-  , ( 'F', "JUNE",      6  )
-  , ( 'G', "JULY",      7  )
-  , ( 'H', "AUGUST",    8  )
-  , ( 'I', "SEPTEMBER", 9  )
-  , ( 'J', "OCTOBER",   10 )
-  , ( 'K', "NOVEMBER",  11 )
-  , ( 'L', "DECEMBER",  12 )
-  ]
-
 -- | The game type menu (home/away)
 gameTypeMenu :: Menu ()
 gameTypeMenu = Menu "GAME TYPE:" ()

src/Mtlstats/Prompt.hs

@@ -31,6 +31,7 @@ module Mtlstats.Prompt (
   ucStrPrompt,
   namePrompt,
   numPrompt,
+  numPromptRange,
   numPromptWithFallback,
   dbNamePrompt,
   selectPrompt,
@@ -154,6 +155,20 @@ numPrompt
   -> Prompt
 numPrompt pStr = numPromptWithFallback pStr $ return ()
 
+-- | Builds a numberic prompt with a range
+numPromptRange
+  :: Int
+  -- ^ The minimum value
+  -> Int
+  -- ^ The maximum value
+  -> String
+  -- ^ The prompt string
+  -> (Int -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+numPromptRange nMin nMax pStr callback = numPrompt pStr $ \n ->
+  when (n >= nMin && n <= nMax) $ callback n
+
 -- | Builds a numeric prompt with a fallback action
 numPromptWithFallback
   :: String

src/Mtlstats/Prompt/NewGame.hs

@@ -23,6 +23,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Prompt.NewGame
   ( gameYearPrompt
+  , gameMonthPrompt
   , gameDayPrompt
   , otherTeamPrompt
   , homeScorePrompt
@@ -48,6 +49,11 @@ gameYearPrompt :: Prompt
 gameYearPrompt = numPrompt "Game year: " $
   modify . (progMode.gameStateL.gameYear ?~)
 
+-- | Prompts for the game month
+gameMonthPrompt :: Prompt
+gameMonthPrompt = numPromptRange 1 12 "Game month: " $
+  modify . (progMode.gameStateL.gameMonth ?~)
+
 -- | Prompts for the day of the month the game took place
 gameDayPrompt :: Prompt
 gameDayPrompt = numPrompt "Day of month: " $

test/FormatSpec.hs

@@ -141,9 +141,9 @@ labelTableSpec = describe "labelTable" $
       ]
 
     expected =
-      [ "   foo: bar"
+      [ "   foo: bar "
       , "   baz: quux"
-      , "longer: x"
+      , "longer: x   "
       ]
 
     in labelTable input `shouldBe` expected

test/Helpers/GoalieSpec.hs

@@ -54,7 +54,7 @@ goalieDetailsSpec = describe "goalieDetails" $ let
       .  ( gsTies         .~ 15 )
 
   expected = unlines
-    [ "Number: 1"
+    [ "Number: 1   "
     , "  Name: Joe*"
     , ""
     , "              YTD Lifetime"

test/Helpers/PlayerSpec.hs

@@ -50,8 +50,8 @@ playerDetailsSpec = describe "playerDetails" $
         }
 
     expected = unlines
-      [ "  Number: 1"
+      [ "  Number: 1     "
-      , "    Name: Joe*"
+      , "    Name: Joe*  "
       , "Position: centre"
       , ""
       , "             YTD Lifetime"