version 0.9.0

implement edit menu

ChangeLog.md

@@ -1,5 +1,12 @@
 # Changelog for mtlstats
 
+## 0.9.0
+- Bugfix: Display lifetime stats in report, not YTD
+- Force expected capitalization on player/goalie names
+- Don't show lifetime totals in report
+- Sort players in YTD and lifetime reports by points
+- Moved player/goalie creation/editing to edit submenu
+
 ## 0.8.0
 - Bugfix: removed quotation marks from goalie names in report
 - Allow lower case player names

package.yaml

@@ -1,5 +1,5 @@
 name:                mtlstats
-version:             0.8.0
+version:             0.9.0
 github:              "mtlstats/mtlstats"
 license:             GPL-3
 author:              "Jonathan Lamothe"

src/Mtlstats/Actions.hs

@@ -30,6 +30,7 @@ module Mtlstats.Actions
   , removeChar
   , createPlayer
   , createGoalie
+  , edit
   , editPlayer
   , editGoalie
   , addPlayer
@@ -82,7 +83,7 @@ removeChar = inputBuffer %~ \case
 -- | Starts player creation mode
 createPlayer :: ProgState -> ProgState
 createPlayer = let
-  callback = modify $ progMode .~ MainMenu
+  callback = modify edit
   cps = newCreatePlayerState
     & cpsSuccessCallback .~ callback
     & cpsFailureCallback .~ callback
@@ -91,12 +92,16 @@ createPlayer = let
 -- | Starts goalie creation mode
 createGoalie :: ProgState -> ProgState
 createGoalie = let
-  callback = modify $ progMode .~ MainMenu
+  callback = modify edit
   cgs = newCreateGoalieState
     & cgsSuccessCallback .~ callback
     & cgsFailureCallback .~ callback
   in progMode .~ CreateGoalie cgs
 
+-- | Launches the edit menu
+edit :: ProgState -> ProgState
+edit = progMode .~ EditMenu
+
 -- | Starts the player editing process
 editPlayer :: ProgState -> ProgState
 editPlayer = progMode .~ EditPlayer newEditPlayerState

src/Mtlstats/Control.hs

@@ -41,9 +41,10 @@ import Mtlstats.Types
 -- run
 dispatch :: ProgState -> Controller
 dispatch s = case s^.progMode of
-  MainMenu  -> mainMenuC
+  MainMenu   -> mainMenuC
-  NewSeason -> newSeasonC
+  NewSeason  -> newSeasonC
   NewGame gs -> newGameC gs
+  EditMenu   -> editMenuC
   CreatePlayer cps
     | null $ cps^.cpsNumber   -> getPlayerNumC
     | null $ cps^.cpsName     -> getPlayerNameC
@@ -70,6 +71,9 @@ newSeasonC = Controller
     return True
   }
 
+editMenuC :: Controller
+editMenuC = menuController editMenu
+
 getPlayerNumC :: Controller
 getPlayerNumC = Controller
   { drawController   = drawPrompt playerNumPrompt

src/Mtlstats/Format.hs

@@ -26,6 +26,7 @@ module Mtlstats.Format
   , left
   , right
   , centre
+  , padRight
   , overlay
   , month
   , labelTable
@@ -87,6 +88,16 @@ centre n str = let
   pad  = replicate pLen ' '
   in take n $ pad ++ str ++ repeat ' '
 
+-- | Pads text on the right with spaces to fit a minimum width
+padRight
+  :: Int
+  -- ^ The width to pad to
+  -> String
+  -- ^ The text to pad
+  -> String
+padRight width str =
+  overlay str $ replicate width ' '
+
 -- | Overlays one string on top of another
 overlay
   :: String

src/Mtlstats/Menu.hs

@@ -31,7 +31,8 @@ module Mtlstats.Menu (
   newSeasonMenu,
   gameMonthMenu,
   gameTypeMenu,
-  gameGoalieMenu
+  gameGoalieMenu,
+  editMenu
 ) where
 
 import Control.Monad.IO.Class (liftIO)
@@ -113,14 +114,8 @@ mainMenu = Menu "*** MAIN MENU ***" True
     modify startNewSeason >> return True
   , MenuItem '2' "New Game" $
     modify startNewGame >> return True
-  , MenuItem '3' "Create Player" $
+  , MenuItem '3' "Edit" $
-    modify createPlayer >> return True
+    modify edit >> return True
-  , MenuItem '4' "Create Goalie" $
-    modify createGoalie >> return True
-  , MenuItem '5' "Edit Player" $
-    modify editPlayer >> return True
-  , MenuItem '6' "Edit Goalie" $
-    modify editGoalie >> return True
   , MenuItem 'X' "Exit" $ do
     db <- gets $ view database
     liftIO $ do
@@ -186,3 +181,18 @@ gameGoalieMenu s = let
     (\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
       modify $ GI.setGameGoalie gid) $
     zip ['1'..] goalies
+
+-- | The edit menu
+editMenu :: Menu ()
+editMenu = Menu "*** EDIT ***" ()
+  [ MenuItem '1' "Create Player" $
+    modify createPlayer
+  , MenuItem '2' "Create Goalie" $
+    modify createGoalie
+  , MenuItem '3' "Edit Player" $
+    modify editPlayer
+  , MenuItem '4' "Edit Goalie" $
+    modify editGoalie
+  , MenuItem 'R' "Return to Main Menu" $
+    modify backHome
+  ]

src/Mtlstats/Menu/EditGoalie.hs

@@ -26,25 +26,25 @@ module Mtlstats.Menu.EditGoalie
   ) where
 
 import Control.Monad.Trans.State (modify)
-import Data.Maybe (maybe)
 import Lens.Micro ((.~))
 
+import Mtlstats.Actions
 import Mtlstats.Types
 import Mtlstats.Types.Menu
 
 -- | The 'Goalie' edit menu
 editGoalieMenu :: Menu ()
 editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
-  (\(key, label, val) -> MenuItem key label $ modify $ maybe
+  (\(ch, label, mode) -> MenuItem ch label $
-    (progMode .~ MainMenu)
+    modify $ case mode of
-    (progMode.editGoalieStateL.egsMode .~)
+      Nothing -> edit
-    val)
+      Just m  -> progMode.editGoalieStateL.egsMode .~ m)
   --  key, label,                 value
   [ ( '1', "Edit number",         Just EGNumber   )
   , ( '2', "Edit name",           Just EGName     )
   , ( '3', "Edit YTD stats",      Just EGYtd      )
   , ( '4', "Edit Lifetime stats", Just EGLifetime )
-  , ( 'R', "Return to Main Menu", Nothing         )
+  , ( 'R', "Return to Edit Menu", Nothing         )
   ]
 
 -- | The 'Goalie' YTD edit menu

src/Mtlstats/Menu/EditPlayer.hs

@@ -28,22 +28,24 @@ module Mtlstats.Menu.EditPlayer
 import Control.Monad.Trans.State (modify)
 import Lens.Micro ((.~))
 
+import Mtlstats.Actions
 import Mtlstats.Types
 import Mtlstats.Types.Menu
 
 -- | The 'Player' edit menu
 editPlayerMenu :: Menu ()
 editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
-  (\(ch, label, mode) -> MenuItem ch label $ case mode of
+  (\(ch, label, mode) -> MenuItem ch label $
-    Nothing -> modify $ progMode .~ MainMenu
+    modify $ case mode of
-    Just m  -> modify $ progMode.editPlayerStateL.epsMode .~ m)
+      Nothing -> edit
+      Just m  -> progMode.editPlayerStateL.epsMode .~ m)
   --  key, label,                 value
   [ ( '1', "Edit number",         Just EPNumber   )
   , ( '2', "Edit name",           Just EPName     )
   , ( '3', "Edit position",       Just EPPosition )
   , ( '4', "Edit YTD stats",      Just EPYtd      )
   , ( '5', "Edit lifetime stats", Just EPLifetime )
-  , ( 'R', "Finished editing",    Nothing         )
+  , ( 'R', "Return to Edit Menu", Nothing         )
   ]
 
 -- | The 'Player' YTD stats edit menu

src/Mtlstats/Prompt.hs

@@ -29,6 +29,7 @@ module Mtlstats.Prompt (
   promptController,
   strPrompt,
   ucStrPrompt,
+  namePrompt,
   numPrompt,
   selectPrompt,
   -- * Individual prompts
@@ -126,6 +127,17 @@ ucStrPrompt
 ucStrPrompt pStr act = (strPrompt pStr act)
   { promptProcessChar = \ch -> (++ [toUpper ch]) }
 
+-- | Creates a prompt which forces capitalization of input to
+-- accomodate a player or goalie name
+namePrompt
+  :: String
+  -- ^ The prompt string
+  -> (String -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+namePrompt pStr act = (strPrompt pStr act)
+  { promptProcessChar = capitalizeName }
+
 -- | Builds a numeric prompt
 numPrompt
   :: String
@@ -157,7 +169,7 @@ selectPrompt params = Prompt
         in "F" ++ show n ++ ") " ++ desc)
       results
     C.moveCursor row col
-  , promptProcessChar = \ch -> (++[ch])
+  , promptProcessChar = spProcessChar params
   , promptAction = \sStr -> if null sStr
     then spCallback params Nothing
     else do
@@ -186,7 +198,7 @@ playerNumPrompt = numPrompt "Player number: " $
 
 -- | Prompts for a new player's name
 playerNamePrompt :: Prompt
-playerNamePrompt = strPrompt "Player name: " $
+playerNamePrompt = namePrompt "Player name: " $
   modify . (progMode.createPlayerStateL.cpsName .~)
 
 -- | Prompts for a new player's position
@@ -201,7 +213,7 @@ goalieNumPrompt = numPrompt "Goalie number: " $
 
 -- | Prompts for the goalie's name
 goalieNamePrompt :: Prompt
-goalieNamePrompt = strPrompt "Goalie name: " $
+goalieNamePrompt = namePrompt "Goalie name: " $
   modify . (progMode.createGoalieStateL.cgsName .~)
 
 -- | Selects a player (creating one if necessary)
@@ -218,6 +230,7 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
   , spSearch       = \sStr db -> playerSearch sStr (db^.dbPlayers)
   , spSearchExact  = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
   , spElemDesc     = playerSummary
+  , spProcessChar  = capitalizeName
   , spCallback     = callback
   , spNotFound     = \sStr -> do
     mode <- gets (^.progMode)
@@ -246,6 +259,7 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
   , spSearch       = \sStr db -> goalieSearch sStr (db^.dbGoalies)
   , spSearchExact  = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
   , spElemDesc     = goalieSummary
+  , spProcessChar  = capitalizeName
   , spCallback     = callback
   , spNotFound     = \sStr -> do
     mode <- gets (^.progMode)

src/Mtlstats/Report.hs

@@ -21,8 +21,10 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Report (report, gameDate) where
 
+import Data.List (sortOn)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Ord (Down (Down))
 import Lens.Micro ((^.))
 
 import Mtlstats.Config
@@ -127,7 +129,7 @@ gameStatsReport width s = let
 
   criteria (_, ps) = psPoints ps > 0
 
-  in filteredPlayerReport width "GAME" criteria playerStats
+  in filteredPlayerReport width "GAME" criteria True playerStats
   ++ [""]
   ++ gameGoalieReport width goalieStats
 
@@ -135,7 +137,8 @@ yearToDateStatsReport :: Int -> ProgState -> [String]
 yearToDateStatsReport width s = let
   db = s^.database
 
-  playerStats = map (\p -> (p, p^.pYtd))
+  playerStats = sortOn (Down . psPoints . snd)
+    $ map (\p -> (p, p^.pYtd))
     $ filter playerIsActive
     $ db^.dbPlayers
 
@@ -143,23 +146,24 @@ yearToDateStatsReport width s = let
     $ filter goalieIsActive
     $ db^.dbGoalies
 
-  in playerReport width "YEAR TO DATE" playerStats
+  in playerReport width "YEAR TO DATE" True playerStats
   ++ [""]
-  ++ goalieReport width goalieStats
+  ++ goalieReport width True goalieStats
 
 lifetimeStatsReport :: Int -> ProgState -> [String]
 lifetimeStatsReport width s = let
   db = s^.database
 
-  playerStats = map (\p -> (p, p^.pYtd))
+  playerStats = sortOn (Down . psPoints . snd)
+    $ map (\p -> (p, p^.pLifetime))
     $ db^.dbPlayers
 
-  goalieStats = map (\g -> (g, g^.gYtd))
+  goalieStats = map (\g -> (g, g^.gLifetime))
     $ db^.dbGoalies
 
-  in playerReport width "LIFETIME" playerStats
+  in playerReport width "LIFETIME" False playerStats
   ++ [""]
-  ++ goalieReport width goalieStats
+  ++ goalieReport width False goalieStats
 
 gameDate :: GameState -> String
 gameDate gs = fromMaybe "" $ do
@@ -168,17 +172,23 @@ gameDate gs = fromMaybe "" $ do
   d <- padNum 2 <$> gs^.gameDay
   Just $ m ++ " " ++ d ++ " " ++ y
 
-playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
+playerReport
-playerReport width label ps =
+  :: Int
-  filteredPlayerReport width label (const True) ps
+  -> String
+  -> Bool
+  -> [(Player, PlayerStats)]
+  -> [String]
+playerReport width label =
+  filteredPlayerReport width label (const True)
 
 filteredPlayerReport
   :: Int
   -> String
   -> ((Player, PlayerStats) -> Bool)
+  -> Bool
   -> [(Player, PlayerStats)]
   -> [String]
-filteredPlayerReport width label criteria ps = let
+filteredPlayerReport width label criteria showTotals ps = let
   tStats = foldl addPlayerStats newPlayerStats $ map snd ps
   fps    = filter criteria ps
 
@@ -217,23 +227,35 @@ filteredPlayerReport width label criteria ps = let
     , CellText ""
     ] ++ statsCells tStats
 
-  table = overlayLast (label ++ " TOTALS")
+  olayText = if showTotals
+    then label ++ " TOTALS"
+    else ""
+
+  table = overlayLast olayText
     $ map (centre width)
     $ complexTable ([right, left] ++ repeat right)
-    $ tHeader : body ++ [separator, totals]
+    $ tHeader : body ++ if showTotals
+      then [separator, totals]
+      else []
 
   in rHeader ++ table
 
-goalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
+goalieReport
-goalieReport width goalieData = let
+  :: Int
-  olayText = "GOALTENDING TOTALS"
+  -> Bool
+  -> [(Goalie, GoalieStats)]
+  -> [String]
+goalieReport width showTotals goalieData = let
+  olayText = if showTotals
+    then "GOALTENDING TOTALS"
+    else ""
 
   tData = foldl addGoalieStats newGoalieStats
     $ map snd goalieData
 
   header =
     [ CellText "NO."
-    , CellText $ left (length olayText) "GOALTENDER"
+    , CellText $ padRight (length olayText) "GOALTENDER"
     , CellText "GP"
     , CellText " MIN"
     , CellText "  GA"
@@ -265,7 +287,9 @@ goalieReport width goalieData = let
   in map (centre width)
     $ overlayLast olayText
     $ complexTable ([right, left] ++ repeat right)
-    $ header : body ++ [separator, summary]
+    $ header : body ++ if showTotals
+      then [separator, summary]
+      else []
 
 gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
 gameGoalieReport width goalieData = let

src/Mtlstats/Types.hs

@@ -230,6 +230,7 @@ data ProgMode
   = MainMenu
   | NewSeason
   | NewGame GameState
+  | EditMenu
   | CreatePlayer CreatePlayerState
   | CreateGoalie CreateGoalieState
   | EditPlayer EditPlayerState
@@ -239,6 +240,7 @@ instance Show ProgMode where
   show MainMenu         = "MainMenu"
   show NewSeason        = "NewSeason"
   show (NewGame _)      = "NewGame"
+  show EditMenu         = "EditMenu"
   show (CreatePlayer _) = "CreatePlayer"
   show (CreateGoalie _) = "CreateGoalie"
   show (EditPlayer _)   = "EditPlayer"
@@ -622,6 +624,8 @@ data SelectParams a = SelectParams
   -- ^ Search function looking for an exact match
   , spElemDesc     :: a -> String
   -- ^ Provides a string description of an element
+  , spProcessChar  :: Char -> String -> String
+  -- ^ Processes a character entered by the user
   , spCallback     :: Maybe Int -> Action ()
   -- ^ The function when the selection is made
   , spNotFound     :: String -> Action ()

src/Mtlstats/Util.hs

@@ -19,8 +19,15 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
+module Mtlstats.Util
+  ( nth
+  , modifyNth
+  , updateMap
+  , slice
+  , capitalizeName
+  ) where
 
+import Data.Char (isSpace, toUpper)
 import qualified Data.Map as M
 
 -- | Attempt to select the element from a list at a given index
@@ -75,3 +82,25 @@ slice
   -- ^ The list to take a subset of
   -> [a]
 slice offset len = take len . drop offset
+
+-- | Name capitalization function for a player
+capitalizeName
+  :: Char
+  -- ^ The character being input
+  -> String
+  -- ^ The current string
+  -> String
+  -- ^ The resulting string
+capitalizeName ch str = str ++ [ch']
+  where
+    ch' = if lockFlag str
+      then toUpper ch
+      else ch
+    lockFlag "" = True
+    lockFlag (c:cs)
+      | c == ','  = lockFlag' cs
+      | otherwise = lockFlag cs
+    lockFlag' "" = True
+    lockFlag' (c:cs)
+      | isSpace c = lockFlag' cs
+      | otherwise = False

test/ActionsSpec.hs

@@ -52,6 +52,7 @@ spec = describe "Mtlstats.Actions" $ do
   removeCharSpec
   createPlayerSpec
   createGoalieSpec
+  editSpec
   editPlayerSpec
   editGoalieSpec
   addPlayerSpec
@@ -198,6 +199,12 @@ createGoalieSpec = describe "createGoalie" $
     s = createGoalie newProgState
     in show (s^.progMode) `shouldBe` "CreateGoalie"
 
+editSpec :: Spec
+editSpec = describe "edit" $
+  it "should change the mode to EditMenu" $ let
+    ps = edit newProgState
+    in show (ps^.progMode) `shouldBe` "EditMenu"
+
 editPlayerSpec :: Spec
 editPlayerSpec = describe "editPlayer" $
   it "should change the mode appropriately" $ let

test/FormatSpec.hs

@@ -33,6 +33,7 @@ spec = describe "Mtlstats.Format" $ do
   leftSpec
   rightSpec
   centreSpec
+  padRightSpec
   overlaySpec
   monthSpec
   labelTableSpec
@@ -98,6 +99,16 @@ centreSpec = describe "centre" $ do
     it "should truncate the text" $
       centre 2 "foo" `shouldBe` "fo"
 
+padRightSpec :: Spec
+padRightSpec = describe "padRight" $ mapM_
+  (\(label, width, str, expected) -> context label $
+    it ("should be " ++ show expected) $
+      padRight width str `shouldBe` expected)
+  --  label,          width, input string, expected
+  [ ( "text shorter", 5,     "foo",        "foo  "  )
+  , ( "text longer",  3,     "foobar",     "foobar" )
+  ]
+
 overlaySpec :: Spec
 overlaySpec = describe "overlay" $ do
 

test/UtilSpec.hs

@@ -32,6 +32,7 @@ spec = describe "Mtlstats.Util" $ do
   modifyNthSpec
   updateMapSpec
   sliceSpec
+  capitalizeNameSpec
 
 nthSpec :: Spec
 nthSpec = describe "nth" $ mapM_
@@ -93,3 +94,23 @@ sliceSpec = describe "slice" $ do
   context "negative offset" $
     it "should return the correct number of elements from the beginning" $
       slice (-10) 2 list `shouldBe` [2, 4]
+
+capitalizeNameSpec :: Spec
+capitalizeNameSpec = describe "capitalizeName" $ mapM_
+  (\(label, ch, str, expected) -> context label $
+    it ("should be " ++ expected) $
+      capitalizeName ch str `shouldBe` expected)
+  --  label,                        character, string,   expected
+  [ ( "initial lower",              'a',       "",       "A"       )
+  , ( "initial upper",              'A',       "",       "A"       )
+  , ( "initial non-alpha",          '0',       "",       "0"       )
+  , ( "pre-comma lower",            'a',       "A",      "AA"      )
+  , ( "pre-comma upper",            'A',       "A",      "AA"      )
+  , ( "pre-comma non-alpha",        '0',       "A",      "A0"      )
+  , ( "post-comma first lower",     'a',       "FOO, ",  "FOO, A"  )
+  , ( "post-comma first upper",     'A',       "FOO, ",  "FOO, A"  )
+  , ( "post-comma first non-alpha", '0',       "FOO, ",  "FOO, 0"  )
+  , ( "unrestricted upper",         'A',       "FOO, A", "FOO, AA" )
+  , ( "unrestricted lower",         'a',       "FOO, A", "FOO, Aa" )
+  , ( "unrestricted non-alpha",     '0',       "FOO, A", "FOO, A0" )
+  ]