allow lower case

- allow strPrompt to accept lower case letters
- implemented ucStrPrompt which forces characters to upper case

src/Mtlstats/Prompt.hs

@@ -28,6 +28,7 @@ module Mtlstats.Prompt (
   promptControllerWith,
   promptController,
   strPrompt,
+  ucStrPrompt,
   numPrompt,
   selectPrompt,
   -- * Individual prompts
@@ -46,7 +47,7 @@ import Control.Monad.Extra (whenJust)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (isDigit, toUpper)
 import Data.Foldable (forM_)
-import Lens.Micro ((^.), (&), (.~), (?~))
+import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import Lens.Micro.Extras (view)
 import Text.Read (readMaybe)
 import qualified UI.NCurses as C
@@ -68,10 +69,8 @@ promptHandler p (C.EventCharacter '\n') = do
   val <- gets $ view inputBuffer
   modify $ inputBuffer .~ ""
   promptAction p val
-promptHandler p (C.EventCharacter c) = let
+promptHandler p (C.EventCharacter c) =
-  c' = toUpper c
+  modify $ inputBuffer %~ promptProcessChar p c
-  in when (promptCharCheck p c') $
-   modify $ addChar c'
 promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
   modify removeChar
 promptHandler p (C.EventSpecialKey k) =
@@ -111,12 +110,22 @@ strPrompt
   -- ^ The callback function for the result
   -> Prompt
 strPrompt pStr act = Prompt
-  { promptDrawer     = drawSimplePrompt pStr
+  { promptDrawer      = drawSimplePrompt pStr
-  , promptCharCheck  = const True
+  , promptProcessChar = \ch -> (++ [ch])
-  , promptAction     = act
+  , promptAction      = act
-  , promptSpecialKey = const $ return ()
+  , promptSpecialKey  = const $ return ()
   }
 
+-- | Creates an upper case string prompt
+ucStrPrompt
+  :: String
+  -- ^ The prompt string
+  -> (String -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+ucStrPrompt pStr act = (ucStrPrompt pStr act)
+  { promptProcessChar = \ch -> (++ [toUpper ch]) }
+
 -- | Builds a numeric prompt
 numPrompt
   :: String
@@ -125,10 +134,12 @@ numPrompt
   -- ^ The callback function for the result
   -> Prompt
 numPrompt pStr act = Prompt
-  { promptDrawer     = drawSimplePrompt pStr
+  { promptDrawer      = drawSimplePrompt pStr
-  , promptCharCheck  = isDigit
+  , promptProcessChar = \ch str -> if isDigit ch
-  , promptAction     = \inStr -> forM_ (readMaybe inStr) act
+    then str ++ [ch]
-  , promptSpecialKey = const $ return ()
+    else str
+  , promptAction      = \inStr -> forM_ (readMaybe inStr) act
+  , promptSpecialKey  = const $ return ()
   }
 
 -- | Builds a selection prompt
@@ -146,7 +157,7 @@ selectPrompt params = Prompt
         in "F" ++ show n ++ ") " ++ desc)
       results
     C.moveCursor row col
-  , promptCharCheck = const True
+  , promptProcessChar = \ch -> (++[ch])
   , promptAction = \sStr -> if null sStr
     then spCallback params Nothing
     else do

src/Mtlstats/Types.hs

@@ -599,13 +599,13 @@ instance ToJSON GameStats where
 
 -- | Defines a user prompt
 data Prompt = Prompt
-  { promptDrawer     :: ProgState -> C.Update ()
+  { promptDrawer      :: ProgState -> C.Update ()
   -- ^ Draws the prompt to the screen
-  , promptCharCheck  :: Char -> Bool
+  , promptProcessChar :: Char -> String -> String
-  -- ^ Determines whether or not the character is valid
+  -- ^ Modifies the string based on the character entered
-  , promptAction     :: String -> Action ()
+  , promptAction      :: String -> Action ()
   -- ^ Action to perform when the value is entered
-  , promptSpecialKey :: C.Key -> Action ()
+  , promptSpecialKey  :: C.Key -> Action ()
   -- ^ Action to perform when a special key is pressed
   }