diff --git a/ChangeLog.md b/ChangeLog.md index 7cd7aa9..defc24d 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,7 @@ ## current - Bugfix: Display lifetime stats ib report, not YTD +- Force expected capitalization on player/goalie names ## 0.8.0 - Bugfix: removed quotation marks from goalie names in report diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 4ac5316..667d185 100644 --- a/src/Mtlstats/Prompt.hs +++ b/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) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index c0162e6..04f612b 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -622,6 +622,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 () diff --git a/src/Mtlstats/Util.hs b/src/Mtlstats/Util.hs index a094984..78bef2d 100644 --- a/src/Mtlstats/Util.hs +++ b/src/Mtlstats/Util.hs @@ -19,8 +19,15 @@ along with this program. If not, see . -} -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 diff --git a/test/UtilSpec.hs b/test/UtilSpec.hs index 87eb482..77e3718 100644 --- a/test/UtilSpec.hs +++ b/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" ) + ]