brick-2.4: src/Brick/Keybindings/Parse.hs
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
-- | This module provides key binding string parsing functions for use
-- in e.g. reading key bindings from configuration files.
module Brick.Keybindings.Parse
( parseBinding
, parseBindingList
, normalizeKey
, keybindingsFromIni
, keybindingsFromFile
, keybindingIniParser
)
where
import Control.Monad (forM)
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Graphics.Vty as Vty
import Text.Read (readMaybe)
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'.
--
-- A key binding list either the string @"unbound"@ or is a
-- comma-separated list of 'Binding's parsed with 'parseBinding'.
parseBindingList :: T.Text -> Either String BindingState
parseBindingList t =
if T.toLower t == "unbound"
then return Unbound
else BindingList <$> mapM (parseBinding . T.strip) (T.splitOn "," $ T.strip t)
-- | Parse a key binding string. Key binding strings specify zero or
-- more modifier keys and a base key, separated by hyphens.
--
-- @
-- (modifier "-")* key
-- @
--
-- e.g. @c-down@, @backspace@, @ctrl-shift-f1@.
--
-- where each @modifier@ is parsed case-insensitively as follows:
--
-- * @"s", "shift"@: 'Vty.MShift'
-- * @"m", "meta"@: 'Vty.MMeta'
-- * @"a", "alt"@: 'Vty.MAlt'
-- * @"c", "ctrl", "control"@: 'Vty.MCtrl'
--
-- and @key@ is parsed case-insensitively as follows:
--
-- * "f1", "f2", ...: 'Vty.KFun'
-- * "esc": 'Vty.KEsc'
-- * "backspace": 'Vty.KBS'
-- * "enter": 'Vty.KEnter'
-- * "left": 'Vty.KLeft'
-- * "right": 'Vty.KRight'
-- * "up": 'Vty.KUp'
-- * "down": 'Vty.KDown'
-- * "upleft": 'Vty.KUpLeft'
-- * "upright": 'Vty.KUpRight'
-- * "downleft": 'Vty.KDownLeft'
-- * "downright": 'Vty.KDownRight'
-- * "center": 'Vty.KCenter'
-- * "backtab": 'Vty.KBackTab'
-- * "printscreen": 'Vty.KPrtScr'
-- * "pause": 'Vty.KPause'
-- * "insert": 'Vty.KIns'
-- * "home": 'Vty.KHome'
-- * "pgup": 'Vty.KPageUp'
-- * "del": 'Vty.KDel'
-- * "end": 'Vty.KEnd'
-- * "pgdown": 'Vty.KPageDown'
-- * "begin": 'Vty.KBegin'
-- * "menu": 'Vty.KMenu'
-- * "space": @' '@
-- * "tab": @'\\t'@
-- * Otherwise, 'Vty.KChar'
parseBinding :: T.Text -> Either String Binding
parseBinding s = go (T.splitOn "-" $ T.toLower s) []
where go [k] mods = do
k' <- pKey k
return $ binding k' mods
go (k:ks) mods = do
m <- case k of
"s" -> return Vty.MShift
"shift" -> return Vty.MShift
"m" -> return Vty.MMeta
"meta" -> return Vty.MMeta
"a" -> return Vty.MAlt
"alt" -> return Vty.MAlt
"c" -> return Vty.MCtrl
"ctrl" -> return Vty.MCtrl
"control" -> return Vty.MCtrl
_ -> Left ("Unknown modifier prefix: " ++ show k)
go ks (m:mods)
go [] _ = Left "Empty keybinding not allowed"
pKey "esc" = return Vty.KEsc
pKey "backspace" = return Vty.KBS
pKey "enter" = return Vty.KEnter
pKey "left" = return Vty.KLeft
pKey "right" = return Vty.KRight
pKey "up" = return Vty.KUp
pKey "down" = return Vty.KDown
pKey "upleft" = return Vty.KUpLeft
pKey "upright" = return Vty.KUpRight
pKey "downleft" = return Vty.KDownLeft
pKey "downright" = return Vty.KDownRight
pKey "center" = return Vty.KCenter
pKey "backtab" = return Vty.KBackTab
pKey "printscreen" = return Vty.KPrtScr
pKey "pause" = return Vty.KPause
pKey "insert" = return Vty.KIns
pKey "home" = return Vty.KHome
pKey "pgup" = return Vty.KPageUp
pKey "del" = return Vty.KDel
pKey "end" = return Vty.KEnd
pKey "pgdown" = return Vty.KPageDown
pKey "begin" = return Vty.KBegin
pKey "menu" = return Vty.KMenu
pKey "space" = return (Vty.KChar ' ')
pKey "tab" = return (Vty.KChar '\t')
pKey t
| T.length t == 1 =
return (Vty.KChar $ T.last s)
| Just n <- T.stripPrefix "f" t =
case readMaybe (T.unpack n) of
Nothing -> Left ("Unknown keybinding: " ++ show t)
Just i -> return (Vty.KFun i)
| otherwise = Left ("Unknown keybinding: " ++ show t)
-- | Parse custom key bindings from the specified INI file using the
-- provided event name mapping.
--
-- Each line in the specified section can take the form
--
-- > <event-name> = <"unbound"|[binding,...]>
--
-- where the event name must be a valid event name in the specified
-- 'KeyEvents' and each binding is valid as parsed by 'parseBinding'.
--
-- Returns @Nothing@ if the named section was not found; otherwise
-- returns a (possibly empty) list of binding states for each event in
-- @evs@.
keybindingsFromIni :: KeyEvents k
-- ^ The key event name mapping to use to parse the
-- configuration data.
-> T.Text
-- ^ The name of the INI configuration section to
-- read.
-> T.Text
-- ^ The text of the INI document to read.
-> Either String (Maybe [(k, BindingState)])
keybindingsFromIni evs section doc =
Ini.parseIniFile doc (keybindingIniParser evs section)
-- | Parse custom key bindings from the specified INI file path. This
-- does not catch or convert any exceptions resulting from I/O errors.
-- See 'keybindingsFromIni' for details.
keybindingsFromFile :: KeyEvents k
-- ^ The key event name mapping to use to parse the
-- configuration data.
-> T.Text
-- ^ The name of the INI configuration section to
-- read.
-> FilePath
-- ^ The path to the INI file to read.
-> IO (Either String (Maybe [(k, BindingState)]))
keybindingsFromFile evs section path =
keybindingsFromIni evs section <$> T.readFile path
-- | The low-level INI parser for custom key bindings used by this
-- module, exported for applications that use the @config-ini@ package.
keybindingIniParser :: KeyEvents k -> T.Text -> Ini.IniParser (Maybe [(k, BindingState)])
keybindingIniParser evs section =
Ini.sectionMb section $ do
fmap catMaybes $ forM (keyEventsList evs) $ \(name, e) -> do
fmap (e,) <$> Ini.fieldMbOf name parseBindingList