Parse: move pretty-printing functions to Pretty

This commit is contained in:
Jonathan Daugherty 2022-07-10 09:50:02 -07:00
parent 04676115e6
commit 52a370fad8
2 changed files with 54 additions and 53 deletions

View File

@ -2,10 +2,6 @@
module Brick.Keybindings.Parse
( parseBinding
, parseBindingList
, ppBinding
, ppMaybeBinding
, ppKey
, ppModifier
)
where
@ -73,51 +69,3 @@ parseBinding s = go (T.splitOn "-" $ T.toLower s) []
Nothing -> Left ("Unknown keybinding: " ++ show t)
Just i -> return (Vty.KFun i)
| otherwise = Left ("Unknown keybinding: " ++ show t)
ppBinding :: Binding -> T.Text
ppBinding (Binding k mods) =
T.intercalate "-" $ (ppModifier <$> mods) <> [ppKey k]
ppMaybeBinding :: Maybe Binding -> T.Text
ppMaybeBinding Nothing =
"(no binding)"
ppMaybeBinding (Just b) =
ppBinding b
ppKey :: Vty.Key -> T.Text
ppKey (Vty.KChar c) = ppChar c
ppKey (Vty.KFun n) = "F" <> (T.pack $ show n)
ppKey Vty.KBackTab = "BackTab"
ppKey Vty.KEsc = "Esc"
ppKey Vty.KBS = "Backspace"
ppKey Vty.KEnter = "Enter"
ppKey Vty.KUp = "Up"
ppKey Vty.KDown = "Down"
ppKey Vty.KLeft = "Left"
ppKey Vty.KRight = "Right"
ppKey Vty.KHome = "Home"
ppKey Vty.KEnd = "End"
ppKey Vty.KPageUp = "PgUp"
ppKey Vty.KPageDown = "PgDown"
ppKey Vty.KDel = "Del"
ppKey Vty.KUpLeft = "UpLeft"
ppKey Vty.KUpRight = "UpRight"
ppKey Vty.KDownLeft = "DownLeft"
ppKey Vty.KDownRight = "DownRight"
ppKey Vty.KCenter = "Center"
ppKey Vty.KPrtScr = "PrintScreen"
ppKey Vty.KPause = "Pause"
ppKey Vty.KIns = "Insert"
ppKey Vty.KBegin = "Begin"
ppKey Vty.KMenu = "Menu"
ppChar :: Char -> T.Text
ppChar '\t' = "Tab"
ppChar ' ' = "Space"
ppChar c = T.singleton c
ppModifier :: Vty.Modifier -> T.Text
ppModifier Vty.MMeta = "M"
ppModifier Vty.MAlt = "A"
ppModifier Vty.MCtrl = "C"
ppModifier Vty.MShift = "S"

View File

@ -3,6 +3,11 @@ module Brick.Keybindings.Pretty
( keybindingTextTable
, keybindingMarkdownTable
, keybindingHelpWidget
, ppBinding
, ppMaybeBinding
, ppKey
, ppModifier
)
where
@ -10,8 +15,8 @@ import Brick
import Data.Maybe (fromJust)
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import Brick.Keybindings.Parse
import Brick.Keybindings.KeyEvents
import Brick.Keybindings.KeyConfig
import Brick.Keybindings.KeyHandlerMap
@ -119,3 +124,51 @@ keybindEventHelpWidget (evName, desc, evs) =
vBox [ txtWrap ("; " <> desc)
, label <+> txt (" = " <> evText)
]
ppBinding :: Binding -> T.Text
ppBinding (Binding k mods) =
T.intercalate "-" $ (ppModifier <$> mods) <> [ppKey k]
ppMaybeBinding :: Maybe Binding -> T.Text
ppMaybeBinding Nothing =
"(no binding)"
ppMaybeBinding (Just b) =
ppBinding b
ppKey :: Vty.Key -> T.Text
ppKey (Vty.KChar c) = ppChar c
ppKey (Vty.KFun n) = "F" <> (T.pack $ show n)
ppKey Vty.KBackTab = "BackTab"
ppKey Vty.KEsc = "Esc"
ppKey Vty.KBS = "Backspace"
ppKey Vty.KEnter = "Enter"
ppKey Vty.KUp = "Up"
ppKey Vty.KDown = "Down"
ppKey Vty.KLeft = "Left"
ppKey Vty.KRight = "Right"
ppKey Vty.KHome = "Home"
ppKey Vty.KEnd = "End"
ppKey Vty.KPageUp = "PgUp"
ppKey Vty.KPageDown = "PgDown"
ppKey Vty.KDel = "Del"
ppKey Vty.KUpLeft = "UpLeft"
ppKey Vty.KUpRight = "UpRight"
ppKey Vty.KDownLeft = "DownLeft"
ppKey Vty.KDownRight = "DownRight"
ppKey Vty.KCenter = "Center"
ppKey Vty.KPrtScr = "PrintScreen"
ppKey Vty.KPause = "Pause"
ppKey Vty.KIns = "Insert"
ppKey Vty.KBegin = "Begin"
ppKey Vty.KMenu = "Menu"
ppChar :: Char -> T.Text
ppChar '\t' = "Tab"
ppChar ' ' = "Space"
ppChar c = T.singleton c
ppModifier :: Vty.Modifier -> T.Text
ppModifier Vty.MMeta = "M"
ppModifier Vty.MAlt = "A"
ppModifier Vty.MCtrl = "C"
ppModifier Vty.MShift = "S"