Keybindings: normalize parsed and constructed key bindings with modifiers to lowercase

This change fixes a bug where it was possible to parse and construct key
bindings for capitalized characters with modifiers, thus leading to
unusable bindings in terminal applications. This is because a binding
like

   Ctrl-X

can never be generated by a terminal because it always arrives as

   Ctrl-x

Prior to this patch, if a user wrote "Ctrl-X" in a keybinding
configuration file or used the library API to construct such a binding,
it would be accepted but would lead to a binding that was never usable
at runtime for the reason explained above.

This patch updates the library API to always normalize constructed and
parsed key bindings to lowercase when modifiers are present.

brick.cabal

@@ -77,6 +77,7 @@ library
     Brick.Keybindings.KeyConfig
     Brick.Keybindings.KeyEvents
     Brick.Keybindings.KeyDispatcher
+    Brick.Keybindings.Normalize
     Brick.Keybindings.Parse
     Brick.Keybindings.Pretty
     Brick.Focus

src/Brick/Keybindings/KeyConfig.hs

@@ -47,6 +47,7 @@ import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
 import qualified Graphics.Vty as Vty
 
 import Brick.Keybindings.KeyEvents
+import Brick.Keybindings.Normalize
 
 -- | A key binding.
 --
@@ -67,10 +68,12 @@ data Binding =
             -- ^ The set of modifiers.
             } deriving (Eq, Show, Ord)
 
--- | Construct a 'Binding'. Modifier order is ignored.
+-- | Construct a 'Binding'. Modifier order is ignored. If modifiers
+-- are given and the binding is for a character key, it is forced to
+-- lowercase.
 binding :: Vty.Key -> [Vty.Modifier] -> Binding
 binding k mods =
-    Binding { kbKey = k
+    Binding { kbKey = normalizeKey mods k
             , kbMods = S.fromList mods
             }
 
@@ -230,17 +233,23 @@ instance ToBinding Binding where
 addModifier :: (ToBinding a) => Vty.Modifier -> a -> Binding
 addModifier m val =
     let b = bind val
-    in b { kbMods = S.insert m (kbMods b) }
+        newMods = S.insert m $ kbMods b
+    in b { kbMods = newMods
+         , kbKey = normalizeKey (S.toList newMods) $ kbKey b
+         }
 
--- | Add Meta to a binding.
+-- | Add Meta to a binding. If the binding is for a character key, force
+-- it to lowercase.
 meta :: (ToBinding a) => a -> Binding
 meta = addModifier Vty.MMeta
 
--- | Add Ctrl to a binding.
+-- | Add Ctrl to a binding. If the binding is for a character key, force
+-- it to lowercase.
 ctrl :: (ToBinding a) => a -> Binding
 ctrl = addModifier Vty.MCtrl
 
--- | Add Shift to a binding.
+-- | Add Shift to a binding. If the binding is for a character key, force
+-- it to lowercase.
 shift :: (ToBinding a) => a -> Binding
 shift = addModifier Vty.MShift
 

src/Brick/Keybindings/Normalize.hs

@@ -0,0 +1,14 @@
+module Brick.Keybindings.Normalize
+  ( normalizeKey
+  )
+where
+
+import Data.Char (toLower)
+import qualified Graphics.Vty as Vty
+
+-- | A keybinding involving modifiers should have its key character
+-- normalized to lowercase since it's impossible to get uppercase keys
+-- from the terminal when modifiers are present.
+normalizeKey :: [Vty.Modifier] -> Vty.Key -> Vty.Key
+normalizeKey (_:_) (Vty.KChar c) = Vty.KChar $ toLower c
+normalizeKey _ k = k

src/Brick/Keybindings/Parse.hs

@@ -5,6 +5,7 @@
 module Brick.Keybindings.Parse
   ( parseBinding
   , parseBindingList
+  , normalizeKey
 
   , keybindingsFromIni
   , keybindingsFromFile
@@ -14,7 +15,6 @@ where
 
 import Control.Monad (forM)
 import Data.Maybe (catMaybes)
-import qualified Data.Set as S
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import qualified Graphics.Vty as Vty
@@ -23,6 +23,7 @@ import qualified Data.Ini.Config as Ini
 
 import Brick.Keybindings.KeyEvents
 import Brick.Keybindings.KeyConfig
+import Brick.Keybindings.Normalize
 
 -- | Parse a key binding list into a 'BindingState'.
 --
@@ -83,7 +84,7 @@ parseBinding :: T.Text -> Either String Binding
 parseBinding s = go (T.splitOn "-" $ T.toLower s) []
   where go [k] mods = do
           k' <- pKey k
-          return Binding { kbMods = S.fromList mods, kbKey = k' }
+          return $ binding k' mods
         go (k:ks) mods = do
           m <- case k of
             "s"       -> return Vty.MShift