From 996bad94f1f6dff607523f95f80c828793ddd163 Mon Sep 17 00:00:00 2001
From: Jonathan Lamothe <jlamothe1980@gmail.com>
Date: Sat, 14 Dec 2019 01:09:40 -0500
Subject: [PATCH] force capitalization of player/goalie names in player
 selection

---
 src/Mtlstats/Prompt.hs |  4 +++-
 src/Mtlstats/Types.hs  |  2 ++
 src/Mtlstats/Util.hs   | 31 ++++++++++++++++++++++++++++++-
 test/UtilSpec.hs       | 21 +++++++++++++++++++++
 4 files changed, 56 insertions(+), 2 deletions(-)

diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs
index 4ac5316..3b4ac6f 100644
--- a/src/Mtlstats/Prompt.hs
+++ b/src/Mtlstats/Prompt.hs
@@ -157,7 +157,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
@@ -218,6 +218,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 +247,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 <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
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" )
+  ]