module Matterhorn.Types.KeyEvents
(
KeyEvent(..)
, KeyConfig
, Binding(..)
, BindingState(..)
, allEvents
, parseBinding
, parseBindingList
, ppBinding
, nonCharKeys
, eventToBinding
, keyEventFromName
, keyEventName
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
data KeyEvent
= VtyRefreshEvent
| ShowHelpEvent
| EnterSelectModeEvent
| ReplyRecentEvent
| ToggleMessagePreviewEvent
| InvokeEditorEvent
| EnterFastSelectModeEvent
| QuitEvent
| NextChannelEvent
| PrevChannelEvent
| NextChannelEventAlternate
| PrevChannelEventAlternate
| NextUnreadChannelEvent
| NextUnreadUserOrChannelEvent
| LastChannelEvent
| EnterOpenURLModeEvent
| ClearUnreadEvent
| ToggleMultiLineEvent
| EnterFlaggedPostsEvent
| ToggleChannelListVisibleEvent
| ToggleExpandedChannelTopicsEvent
| ShowAttachmentListEvent
| ChangeMessageEditorFocus
| EditorKillToBolEvent
| EditorKillToEolEvent
| EditorBolEvent
| EditorEolEvent
| EditorTransposeCharsEvent
| EditorDeleteCharacter
| EditorPrevCharEvent
| EditorNextCharEvent
| EditorPrevWordEvent
| EditorNextWordEvent
| EditorDeleteNextWordEvent
| EditorDeletePrevWordEvent
| EditorHomeEvent
| EditorEndEvent
| EditorYankEvent
| CycleChannelListSorting
| SelectNextTabEvent
| SelectPreviousTabEvent
| SaveAttachmentEvent
| CancelEvent
| LoadMoreEvent
| OpenMessageURLEvent
| ScrollUpEvent
| ScrollDownEvent
| ScrollLeftEvent
| ScrollRightEvent
| PageUpEvent
| PageDownEvent
|
| PageLeftEvent
| ScrollTopEvent
| ScrollBottomEvent
| SelectOldestMessageEvent
| ChannelListScrollUpEvent
| ChannelListScrollDownEvent
| SelectUpEvent
| SelectDownEvent
| SearchSelectUpEvent
| SearchSelectDownEvent
| ActivateListItemEvent
| ViewMessageEvent
| FillGapEvent
| CopyPostLinkEvent
| FlagMessageEvent
| OpenThreadEvent
| PinMessageEvent
| YankMessageEvent
| YankWholeMessageEvent
| DeleteMessageEvent
| EditMessageEvent
| ReplyMessageEvent
| ReactToMessageEvent
| AttachmentListAddEvent
| AttachmentListDeleteEvent
| AttachmentOpenEvent
| FileBrowserBeginSearchEvent
| FileBrowserSelectEnterEvent
| FileBrowserSelectCurrentEvent
| FileBrowserListPageUpEvent
| FileBrowserListPageDownEvent
| FileBrowserListHalfPageUpEvent
| FileBrowserListHalfPageDownEvent
| FileBrowserListTopEvent
| FileBrowserListBottomEvent
| FileBrowserListNextEvent
| FileBrowserListPrevEvent
| FormSubmitEvent
| NextTeamEvent
| PrevTeamEvent
| MoveCurrentTeamLeftEvent
| MoveCurrentTeamRightEvent
deriving (KeyEvent -> KeyEvent -> Bool
(KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool) -> Eq KeyEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyEvent -> KeyEvent -> Bool
$c/= :: KeyEvent -> KeyEvent -> Bool
== :: KeyEvent -> KeyEvent -> Bool
$c== :: KeyEvent -> KeyEvent -> Bool
Eq, Int -> KeyEvent -> ShowS
[KeyEvent] -> ShowS
KeyEvent -> String
(Int -> KeyEvent -> ShowS)
-> (KeyEvent -> String) -> ([KeyEvent] -> ShowS) -> Show KeyEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyEvent] -> ShowS
$cshowList :: [KeyEvent] -> ShowS
show :: KeyEvent -> String
$cshow :: KeyEvent -> String
showsPrec :: Int -> KeyEvent -> ShowS
$cshowsPrec :: Int -> KeyEvent -> ShowS
Show, Eq KeyEvent
Eq KeyEvent
-> (KeyEvent -> KeyEvent -> Ordering)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> KeyEvent)
-> (KeyEvent -> KeyEvent -> KeyEvent)
-> Ord KeyEvent
KeyEvent -> KeyEvent -> Bool
KeyEvent -> KeyEvent -> Ordering
KeyEvent -> KeyEvent -> KeyEvent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyEvent -> KeyEvent -> KeyEvent
$cmin :: KeyEvent -> KeyEvent -> KeyEvent
max :: KeyEvent -> KeyEvent -> KeyEvent
$cmax :: KeyEvent -> KeyEvent -> KeyEvent
>= :: KeyEvent -> KeyEvent -> Bool
$c>= :: KeyEvent -> KeyEvent -> Bool
> :: KeyEvent -> KeyEvent -> Bool
$c> :: KeyEvent -> KeyEvent -> Bool
<= :: KeyEvent -> KeyEvent -> Bool
$c<= :: KeyEvent -> KeyEvent -> Bool
< :: KeyEvent -> KeyEvent -> Bool
$c< :: KeyEvent -> KeyEvent -> Bool
compare :: KeyEvent -> KeyEvent -> Ordering
$ccompare :: KeyEvent -> KeyEvent -> Ordering
$cp1Ord :: Eq KeyEvent
Ord, Int -> KeyEvent
KeyEvent -> Int
KeyEvent -> [KeyEvent]
KeyEvent -> KeyEvent
KeyEvent -> KeyEvent -> [KeyEvent]
KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
(KeyEvent -> KeyEvent)
-> (KeyEvent -> KeyEvent)
-> (Int -> KeyEvent)
-> (KeyEvent -> Int)
-> (KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent])
-> Enum KeyEvent
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
$cenumFromThenTo :: KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
enumFromTo :: KeyEvent -> KeyEvent -> [KeyEvent]
$cenumFromTo :: KeyEvent -> KeyEvent -> [KeyEvent]
enumFromThen :: KeyEvent -> KeyEvent -> [KeyEvent]
$cenumFromThen :: KeyEvent -> KeyEvent -> [KeyEvent]
enumFrom :: KeyEvent -> [KeyEvent]
$cenumFrom :: KeyEvent -> [KeyEvent]
fromEnum :: KeyEvent -> Int
$cfromEnum :: KeyEvent -> Int
toEnum :: Int -> KeyEvent
$ctoEnum :: Int -> KeyEvent
pred :: KeyEvent -> KeyEvent
$cpred :: KeyEvent -> KeyEvent
succ :: KeyEvent -> KeyEvent
$csucc :: KeyEvent -> KeyEvent
Enum)
allEvents :: [KeyEvent]
allEvents :: [KeyEvent]
allEvents =
[ KeyEvent
QuitEvent
, KeyEvent
VtyRefreshEvent
, KeyEvent
ClearUnreadEvent
, KeyEvent
ToggleMessagePreviewEvent
, KeyEvent
InvokeEditorEvent
, KeyEvent
ToggleMultiLineEvent
, KeyEvent
CancelEvent
, KeyEvent
ReplyRecentEvent
, KeyEvent
SelectNextTabEvent
, KeyEvent
SelectPreviousTabEvent
, KeyEvent
SaveAttachmentEvent
, KeyEvent
EnterFastSelectModeEvent
, KeyEvent
NextChannelEvent
, KeyEvent
PrevChannelEvent
, KeyEvent
NextChannelEventAlternate
, KeyEvent
PrevChannelEventAlternate
, KeyEvent
NextUnreadChannelEvent
, KeyEvent
NextUnreadUserOrChannelEvent
, KeyEvent
LastChannelEvent
, KeyEvent
ShowAttachmentListEvent
, KeyEvent
ChangeMessageEditorFocus
, KeyEvent
EditorKillToBolEvent
, KeyEvent
EditorKillToEolEvent
, KeyEvent
EditorBolEvent
, KeyEvent
EditorEolEvent
, KeyEvent
EditorTransposeCharsEvent
, KeyEvent
EditorDeleteCharacter
, KeyEvent
EditorPrevCharEvent
, KeyEvent
EditorNextCharEvent
, KeyEvent
EditorPrevWordEvent
, KeyEvent
EditorNextWordEvent
, KeyEvent
EditorDeleteNextWordEvent
, KeyEvent
EditorDeletePrevWordEvent
, KeyEvent
EditorHomeEvent
, KeyEvent
EditorEndEvent
, KeyEvent
EditorYankEvent
, KeyEvent
CycleChannelListSorting
, KeyEvent
EnterFlaggedPostsEvent
, KeyEvent
ToggleChannelListVisibleEvent
, KeyEvent
ToggleExpandedChannelTopicsEvent
, KeyEvent
ShowHelpEvent
, KeyEvent
EnterSelectModeEvent
, KeyEvent
EnterOpenURLModeEvent
, KeyEvent
LoadMoreEvent
, KeyEvent
OpenMessageURLEvent
, KeyEvent
ScrollUpEvent
, KeyEvent
ScrollDownEvent
, KeyEvent
ScrollLeftEvent
, KeyEvent
ScrollRightEvent
, KeyEvent
ChannelListScrollUpEvent
, KeyEvent
ChannelListScrollDownEvent
, KeyEvent
PageUpEvent
, KeyEvent
PageDownEvent
, KeyEvent
PageLeftEvent
, KeyEvent
PageRightEvent
, KeyEvent
ScrollTopEvent
, KeyEvent
ScrollBottomEvent
, KeyEvent
SelectOldestMessageEvent
, KeyEvent
SelectUpEvent
, KeyEvent
SelectDownEvent
, KeyEvent
ActivateListItemEvent
, KeyEvent
SearchSelectUpEvent
, KeyEvent
SearchSelectDownEvent
, KeyEvent
NextTeamEvent
, KeyEvent
PrevTeamEvent
, KeyEvent
MoveCurrentTeamLeftEvent
, KeyEvent
MoveCurrentTeamRightEvent
, KeyEvent
OpenThreadEvent
, KeyEvent
FlagMessageEvent
, KeyEvent
PinMessageEvent
, KeyEvent
ViewMessageEvent
, KeyEvent
FillGapEvent
, KeyEvent
CopyPostLinkEvent
, KeyEvent
YankMessageEvent
, KeyEvent
YankWholeMessageEvent
, KeyEvent
DeleteMessageEvent
, KeyEvent
EditMessageEvent
, KeyEvent
ReplyMessageEvent
, KeyEvent
ReactToMessageEvent
, KeyEvent
AttachmentListAddEvent
, KeyEvent
AttachmentListDeleteEvent
, KeyEvent
AttachmentOpenEvent
, KeyEvent
FileBrowserBeginSearchEvent
, KeyEvent
FileBrowserSelectEnterEvent
, KeyEvent
FileBrowserSelectCurrentEvent
, KeyEvent
FileBrowserListPageUpEvent
, KeyEvent
FileBrowserListPageDownEvent
, KeyEvent
FileBrowserListHalfPageUpEvent
, KeyEvent
FileBrowserListHalfPageDownEvent
, KeyEvent
FileBrowserListTopEvent
, KeyEvent
FileBrowserListBottomEvent
, KeyEvent
FileBrowserListNextEvent
, KeyEvent
FileBrowserListPrevEvent
, KeyEvent
FormSubmitEvent
]
eventToBinding :: Vty.Event -> Binding
eventToBinding :: Event -> Binding
eventToBinding (Vty.EvKey Key
k [Modifier]
mods) = [Modifier] -> Key -> Binding
Binding [Modifier]
mods Key
k
eventToBinding Event
k = String -> Binding
forall a. HasCallStack => String -> a
error (String -> Binding) -> String -> Binding
forall a b. (a -> b) -> a -> b
$ String
"BUG: invalid keybinding " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Event -> String
forall a. Show a => a -> String
show Event
k
data Binding = Binding
{ Binding -> [Modifier]
kbMods :: [Vty.Modifier]
, Binding -> Key
kbKey :: Vty.Key
} deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c== :: Binding -> Binding -> Bool
Eq, Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binding] -> ShowS
$cshowList :: [Binding] -> ShowS
show :: Binding -> String
$cshow :: Binding -> String
showsPrec :: Int -> Binding -> ShowS
$cshowsPrec :: Int -> Binding -> ShowS
Show, Eq Binding
Eq Binding
-> (Binding -> Binding -> Ordering)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Binding)
-> (Binding -> Binding -> Binding)
-> Ord Binding
Binding -> Binding -> Bool
Binding -> Binding -> Ordering
Binding -> Binding -> Binding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Binding -> Binding -> Binding
$cmin :: Binding -> Binding -> Binding
max :: Binding -> Binding -> Binding
$cmax :: Binding -> Binding -> Binding
>= :: Binding -> Binding -> Bool
$c>= :: Binding -> Binding -> Bool
> :: Binding -> Binding -> Bool
$c> :: Binding -> Binding -> Bool
<= :: Binding -> Binding -> Bool
$c<= :: Binding -> Binding -> Bool
< :: Binding -> Binding -> Bool
$c< :: Binding -> Binding -> Bool
compare :: Binding -> Binding -> Ordering
$ccompare :: Binding -> Binding -> Ordering
$cp1Ord :: Eq Binding
Ord)
data BindingState =
BindingList [Binding]
| Unbound
deriving (Int -> BindingState -> ShowS
[BindingState] -> ShowS
BindingState -> String
(Int -> BindingState -> ShowS)
-> (BindingState -> String)
-> ([BindingState] -> ShowS)
-> Show BindingState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindingState] -> ShowS
$cshowList :: [BindingState] -> ShowS
show :: BindingState -> String
$cshow :: BindingState -> String
showsPrec :: Int -> BindingState -> ShowS
$cshowsPrec :: Int -> BindingState -> ShowS
Show, BindingState -> BindingState -> Bool
(BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool) -> Eq BindingState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingState -> BindingState -> Bool
$c/= :: BindingState -> BindingState -> Bool
== :: BindingState -> BindingState -> Bool
$c== :: BindingState -> BindingState -> Bool
Eq, Eq BindingState
Eq BindingState
-> (BindingState -> BindingState -> Ordering)
-> (BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> BindingState)
-> (BindingState -> BindingState -> BindingState)
-> Ord BindingState
BindingState -> BindingState -> Bool
BindingState -> BindingState -> Ordering
BindingState -> BindingState -> BindingState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BindingState -> BindingState -> BindingState
$cmin :: BindingState -> BindingState -> BindingState
max :: BindingState -> BindingState -> BindingState
$cmax :: BindingState -> BindingState -> BindingState
>= :: BindingState -> BindingState -> Bool
$c>= :: BindingState -> BindingState -> Bool
> :: BindingState -> BindingState -> Bool
$c> :: BindingState -> BindingState -> Bool
<= :: BindingState -> BindingState -> Bool
$c<= :: BindingState -> BindingState -> Bool
< :: BindingState -> BindingState -> Bool
$c< :: BindingState -> BindingState -> Bool
compare :: BindingState -> BindingState -> Ordering
$ccompare :: BindingState -> BindingState -> Ordering
$cp1Ord :: Eq BindingState
Ord)
type KeyConfig = M.Map KeyEvent BindingState
parseBinding :: Text -> Either String Binding
parseBinding :: Text -> Either String Binding
parseBinding Text
kb = [Text] -> [Modifier] -> Either String Binding
go (Text -> Text -> [Text]
T.splitOn Text
"-" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
kb) []
where go :: [Text] -> [Modifier] -> Either String Binding
go [Text
k] [Modifier]
mods = do
Key
key <- Text -> Either String Key
pKey Text
k
Binding -> Either String Binding
forall (m :: * -> *) a. Monad m => a -> m a
return Binding :: [Modifier] -> Key -> Binding
Binding { kbMods :: [Modifier]
kbMods = [Modifier]
mods, kbKey :: Key
kbKey = Key
key }
go (Text
k:[Text]
ks) [Modifier]
mods = do
Modifier
m <- case Text
k of
Text
"s" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MShift
Text
"shift" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MShift
Text
"m" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MMeta
Text
"meta" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MMeta
Text
"a" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MAlt
Text
"alt" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MAlt
Text
"c" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
Text
"ctrl" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
Text
"control" -> Modifier -> Either String Modifier
forall (m :: * -> *) a. Monad m => a -> m a
return Modifier
Vty.MCtrl
Text
_ -> String -> Either String Modifier
forall a b. a -> Either a b
Left (String
"Unknown modifier prefix: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k)
[Text] -> [Modifier] -> Either String Binding
go [Text]
ks (Modifier
mModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
mods)
go [] [Modifier]
_ = String -> Either String Binding
forall a b. a -> Either a b
Left String
"Empty keybinding not allowed"
pKey :: Text -> Either String Key
pKey Text
"esc" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEsc
pKey Text
"backspace" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBS
pKey Text
"enter" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEnter
pKey Text
"left" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KLeft
pKey Text
"right" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KRight
pKey Text
"up" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUp
pKey Text
"down" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDown
pKey Text
"upleft" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUpLeft
pKey Text
"upright" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KUpRight
pKey Text
"downleft" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDownLeft
pKey Text
"downright" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDownRight
pKey Text
"center" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KCenter
pKey Text
"backtab" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBackTab
pKey Text
"printscreen" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPrtScr
pKey Text
"pause" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPause
pKey Text
"insert" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KIns
pKey Text
"home" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KHome
pKey Text
"pgup" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPageUp
pKey Text
"del" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KDel
pKey Text
"end" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KEnd
pKey Text
"pgdown" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KPageDown
pKey Text
"begin" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KBegin
pKey Text
"menu" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
Vty.KMenu
pKey Text
"space" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
' ')
pKey Text
"tab" = Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
'\t')
pKey Text
t
| Just (Char
c, Text
"") <- Text -> Maybe (Char, Text)
T.uncons Text
t =
Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Key
Vty.KChar Char
c)
| Just Text
n <- Text -> Text -> Maybe Text
T.stripPrefix Text
"f" Text
t =
case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
n) of
Maybe Int
Nothing -> String -> Either String Key
forall a b. a -> Either a b
Left (String
"Unknown keybinding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)
Just Int
i -> Key -> Either String Key
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Key
Vty.KFun Int
i)
| Bool
otherwise = String -> Either String Key
forall a b. a -> Either a b
Left (String
"Unknown keybinding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)
ppBinding :: Binding -> Text
ppBinding :: Binding -> Text
ppBinding (Binding [Modifier]
mods Key
k) =
Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Modifier -> Text
ppMod (Modifier -> Text) -> [Modifier] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Modifier]
mods) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Key -> Text
ppKey Key
k]
ppKey :: Vty.Key -> Text
ppKey :: Key -> Text
ppKey (Vty.KChar Char
c) = Char -> Text
ppChar Char
c
ppKey (Vty.KFun Int
n) = Text
"F" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n)
ppKey Key
Vty.KBackTab = Text
"BackTab"
ppKey Key
Vty.KEsc = Text
"Esc"
ppKey Key
Vty.KBS = Text
"Backspace"
ppKey Key
Vty.KEnter = Text
"Enter"
ppKey Key
Vty.KUp = Text
"Up"
ppKey Key
Vty.KDown = Text
"Down"
ppKey Key
Vty.KLeft = Text
"Left"
ppKey Key
Vty.KRight = Text
"Right"
ppKey Key
Vty.KHome = Text
"Home"
ppKey Key
Vty.KEnd = Text
"End"
ppKey Key
Vty.KPageUp = Text
"PgUp"
ppKey Key
Vty.KPageDown = Text
"PgDown"
ppKey Key
Vty.KDel = Text
"Del"
ppKey Key
Vty.KUpLeft = Text
"UpLeft"
ppKey Key
Vty.KUpRight = Text
"UpRight"
ppKey Key
Vty.KDownLeft = Text
"DownLeft"
ppKey Key
Vty.KDownRight = Text
"DownRight"
ppKey Key
Vty.KCenter = Text
"Center"
ppKey Key
Vty.KPrtScr = Text
"PrintScreen"
ppKey Key
Vty.KPause = Text
"Pause"
ppKey Key
Vty.KIns = Text
"Insert"
ppKey Key
Vty.KBegin = Text
"Begin"
ppKey Key
Vty.KMenu = Text
"Menu"
nonCharKeys :: [Text]
nonCharKeys :: [Text]
nonCharKeys = (Key -> Text) -> [Key] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Key -> Text
ppKey
[ Key
Vty.KBackTab, Key
Vty.KEsc, Key
Vty.KBS, Key
Vty.KEnter, Key
Vty.KUp, Key
Vty.KDown
, Key
Vty.KLeft, Key
Vty.KRight, Key
Vty.KHome, Key
Vty.KEnd, Key
Vty.KPageDown
, Key
Vty.KPageUp, Key
Vty.KDel, Key
Vty.KUpLeft, Key
Vty.KUpRight, Key
Vty.KDownLeft
, Key
Vty.KDownRight, Key
Vty.KCenter, Key
Vty.KPrtScr, Key
Vty.KPause, Key
Vty.KIns
, Key
Vty.KBegin, Key
Vty.KMenu
]
ppChar :: Char -> Text
ppChar :: Char -> Text
ppChar Char
'\t' = Text
"Tab"
ppChar Char
' ' = Text
"Space"
ppChar Char
c = Char -> Text
T.singleton Char
c
ppMod :: Vty.Modifier -> Text
ppMod :: Modifier -> Text
ppMod Modifier
Vty.MMeta = Text
"M"
ppMod Modifier
Vty.MAlt = Text
"A"
ppMod Modifier
Vty.MCtrl = Text
"C"
ppMod Modifier
Vty.MShift = Text
"S"
parseBindingList :: Text -> Either String BindingState
parseBindingList :: Text -> Either String BindingState
parseBindingList Text
t =
if Text -> Text
T.toLower Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"unbound"
then BindingState -> Either String BindingState
forall (m :: * -> *) a. Monad m => a -> m a
return BindingState
Unbound
else [Binding] -> BindingState
BindingList ([Binding] -> BindingState)
-> Either String [Binding] -> Either String BindingState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Either String Binding)
-> [Text] -> Either String [Binding]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Either String Binding
parseBinding (Text -> Either String Binding)
-> (Text -> Text) -> Text -> Either String Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) (Text -> Text -> [Text]
T.splitOn Text
"," Text
t)
keyEventFromName :: Text -> Either String KeyEvent
keyEventFromName :: Text -> Either String KeyEvent
keyEventFromName Text
t =
let mapping :: Map Text KeyEvent
mapping = [(Text, KeyEvent)] -> Map Text KeyEvent
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (KeyEvent -> Text
keyEventName KeyEvent
e, KeyEvent
e) | KeyEvent
e <- [KeyEvent]
allEvents ]
in case Text -> Map Text KeyEvent -> Maybe KeyEvent
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
t Map Text KeyEvent
mapping of
Just KeyEvent
e -> KeyEvent -> Either String KeyEvent
forall (m :: * -> *) a. Monad m => a -> m a
return KeyEvent
e
Maybe KeyEvent
Nothing -> String -> Either String KeyEvent
forall a b. a -> Either a b
Left (String
"Unknown event: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t)
keyEventName :: KeyEvent -> Text
keyEventName :: KeyEvent -> Text
keyEventName KeyEvent
ev = case KeyEvent
ev of
KeyEvent
QuitEvent -> Text
"quit"
KeyEvent
VtyRefreshEvent -> Text
"vty-refresh"
KeyEvent
ClearUnreadEvent -> Text
"clear-unread"
KeyEvent
CancelEvent -> Text
"cancel"
KeyEvent
ToggleMessagePreviewEvent -> Text
"toggle-message-preview"
KeyEvent
InvokeEditorEvent -> Text
"invoke-editor"
KeyEvent
ToggleMultiLineEvent -> Text
"toggle-multiline"
KeyEvent
ReplyRecentEvent -> Text
"reply-recent"
KeyEvent
EnterFastSelectModeEvent -> Text
"enter-fast-select"
KeyEvent
NextChannelEvent -> Text
"focus-next-channel"
KeyEvent
PrevChannelEvent -> Text
"focus-prev-channel"
KeyEvent
NextChannelEventAlternate -> Text
"focus-next-channel-alternate"
KeyEvent
PrevChannelEventAlternate -> Text
"focus-prev-channel-alternate"
KeyEvent
NextUnreadChannelEvent -> Text
"focus-next-unread"
KeyEvent
NextUnreadUserOrChannelEvent -> Text
"focus-next-unread-user-or-channel"
KeyEvent
LastChannelEvent -> Text
"focus-last-channel"
KeyEvent
SelectNextTabEvent -> Text
"select-next-tab"
KeyEvent
SelectPreviousTabEvent -> Text
"select-previous-tab"
KeyEvent
SaveAttachmentEvent -> Text
"save-attachment"
KeyEvent
ShowAttachmentListEvent -> Text
"show-attachment-list"
KeyEvent
ChangeMessageEditorFocus -> Text
"change-message-editor-focus"
KeyEvent
EditorKillToBolEvent -> Text
"editor-kill-to-beginning-of-line"
KeyEvent
EditorKillToEolEvent -> Text
"editor-kill-to-end-of-line"
KeyEvent
EditorBolEvent -> Text
"editor-beginning-of-line"
KeyEvent
EditorEolEvent -> Text
"editor-end-of-line"
KeyEvent
EditorTransposeCharsEvent -> Text
"editor-transpose-chars"
KeyEvent
EditorDeleteCharacter -> Text
"editor-delete-char"
KeyEvent
EditorPrevCharEvent -> Text
"editor-prev-char"
KeyEvent
EditorNextCharEvent -> Text
"editor-next-char"
KeyEvent
EditorPrevWordEvent -> Text
"editor-prev-word"
KeyEvent
EditorNextWordEvent -> Text
"editor-next-word"
KeyEvent
EditorDeleteNextWordEvent -> Text
"editor-delete-next-word"
KeyEvent
EditorDeletePrevWordEvent -> Text
"editor-delete-prev-word"
KeyEvent
EditorHomeEvent -> Text
"editor-home"
KeyEvent
EditorEndEvent -> Text
"editor-end"
KeyEvent
EditorYankEvent -> Text
"editor-yank"
KeyEvent
CycleChannelListSorting -> Text
"cycle-channel-list-sorting"
KeyEvent
NextTeamEvent -> Text
"next-team"
KeyEvent
PrevTeamEvent -> Text
"prev-team"
KeyEvent
MoveCurrentTeamLeftEvent -> Text
"move-current-team-left"
KeyEvent
MoveCurrentTeamRightEvent -> Text
"move-current-team-right"
KeyEvent
EnterFlaggedPostsEvent -> Text
"show-flagged-posts"
KeyEvent
ToggleChannelListVisibleEvent -> Text
"toggle-channel-list-visibility"
KeyEvent
ToggleExpandedChannelTopicsEvent -> Text
"toggle-expanded-channel-topics"
KeyEvent
ShowHelpEvent -> Text
"show-help"
KeyEvent
EnterSelectModeEvent -> Text
"select-mode"
KeyEvent
EnterOpenURLModeEvent -> Text
"enter-url-open"
KeyEvent
LoadMoreEvent -> Text
"load-more"
KeyEvent
OpenMessageURLEvent -> Text
"open-message-url"
KeyEvent
ScrollUpEvent -> Text
"scroll-up"
KeyEvent
ScrollDownEvent -> Text
"scroll-down"
KeyEvent
ScrollLeftEvent -> Text
"scroll-left"
KeyEvent
ScrollRightEvent -> Text
"scroll-right"
KeyEvent
ChannelListScrollUpEvent -> Text
"channel-list-scroll-up"
KeyEvent
ChannelListScrollDownEvent -> Text
"channel-list-scroll-down"
KeyEvent
PageUpEvent -> Text
"page-up"
KeyEvent
PageDownEvent -> Text
"page-down"
KeyEvent
PageLeftEvent -> Text
"page-left"
KeyEvent
PageRightEvent -> Text
"page-right"
KeyEvent
ScrollTopEvent -> Text
"scroll-top"
KeyEvent
ScrollBottomEvent -> Text
"scroll-bottom"
KeyEvent
SelectOldestMessageEvent -> Text
"select-oldest-message"
KeyEvent
SelectUpEvent -> Text
"select-up"
KeyEvent
SelectDownEvent -> Text
"select-down"
KeyEvent
SearchSelectUpEvent -> Text
"search-select-up"
KeyEvent
SearchSelectDownEvent -> Text
"search-select-down"
KeyEvent
ActivateListItemEvent -> Text
"activate-list-item"
KeyEvent
OpenThreadEvent -> Text
"open-thread"
KeyEvent
FlagMessageEvent -> Text
"flag-message"
KeyEvent
PinMessageEvent -> Text
"pin-message"
KeyEvent
ViewMessageEvent -> Text
"view-message"
KeyEvent
FillGapEvent -> Text
"fetch-for-gap"
KeyEvent
CopyPostLinkEvent -> Text
"copy-post-link"
KeyEvent
YankMessageEvent -> Text
"yank-message"
KeyEvent
YankWholeMessageEvent -> Text
"yank-whole-message"
KeyEvent
DeleteMessageEvent -> Text
"delete-message"
KeyEvent
EditMessageEvent -> Text
"edit-message"
KeyEvent
ReplyMessageEvent -> Text
"reply-message"
KeyEvent
ReactToMessageEvent -> Text
"react-to-message"
KeyEvent
AttachmentListAddEvent -> Text
"add-to-attachment-list"
KeyEvent
AttachmentListDeleteEvent -> Text
"delete-from-attachment-list"
KeyEvent
AttachmentOpenEvent -> Text
"open-attachment"
KeyEvent
FileBrowserBeginSearchEvent -> Text
"filebrowser-begin-search"
KeyEvent
FileBrowserSelectEnterEvent -> Text
"filebrowser-select-file-or-enter-directory"
KeyEvent
FileBrowserSelectCurrentEvent -> Text
"filebrowser-select-current"
KeyEvent
FileBrowserListPageUpEvent -> Text
"filebrowser-list-page-up"
KeyEvent
FileBrowserListPageDownEvent -> Text
"filebrowser-list-page-down"
KeyEvent
FileBrowserListHalfPageUpEvent -> Text
"filebrowser-list-half-page-up"
KeyEvent
FileBrowserListHalfPageDownEvent -> Text
"filebrowser-list-half-page-down"
KeyEvent
FileBrowserListTopEvent -> Text
"filebrowser-list-top"
KeyEvent
FileBrowserListBottomEvent -> Text
"filebrowser-list-bottom"
KeyEvent
FileBrowserListNextEvent -> Text
"filebrowser-list-next"
KeyEvent
FileBrowserListPrevEvent -> Text
"filebrowser-list-previous"
KeyEvent
FormSubmitEvent -> Text
"submit-form"