From 6929129e9c856121bad66b08c6f8a8d71a06e1bf Mon Sep 17 00:00:00 2001
From: Jonathan Daugherty <cygnus@foobox.com>
Date: Tue, 2 Jul 2024 18:08:41 -0700
Subject: [PATCH] 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                        |  1 +
 src/Brick/Keybindings/KeyConfig.hs | 21 +++++++++++++++------
 src/Brick/Keybindings/Normalize.hs | 14 ++++++++++++++
 src/Brick/Keybindings/Parse.hs     |  5 +++--
 4 files changed, 33 insertions(+), 8 deletions(-)
 create mode 100644 src/Brick/Keybindings/Normalize.hs

diff --git a/brick.cabal b/brick.cabal
index 176fc95..01ebe8f 100644
--- a/brick.cabal
+++ b/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
diff --git a/src/Brick/Keybindings/KeyConfig.hs b/src/Brick/Keybindings/KeyConfig.hs
index c0daba4..35966b1 100644
--- a/src/Brick/Keybindings/KeyConfig.hs
+++ b/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
 
diff --git a/src/Brick/Keybindings/Normalize.hs b/src/Brick/Keybindings/Normalize.hs
new file mode 100644
index 0000000..6711a64
--- /dev/null
+++ b/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
diff --git a/src/Brick/Keybindings/Parse.hs b/src/Brick/Keybindings/Parse.hs
index ac2370e..b3e8908 100644
--- a/src/Brick/Keybindings/Parse.hs
+++ b/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