module Matterhorn.Events.Keybindings
( defaultBindings
, lookupKeybinding
, getFirstDefaultBinding
, mkKb
, staticKb
, mkKeybindings
, handleKeyboardEvent
, EventHandler(..)
, KeyHandler(..)
, KeyEventHandler(..)
, KeyEventTrigger(..)
, KeyHandlerMap(..)
, KeyEvent (..)
, KeyConfig
, allEvents
, parseBinding
, keyEventName
, keyEventFromName
, ensureKeybindingConsistency
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import qualified Graphics.Vty as Vty
import Matterhorn.Types
import Matterhorn.Types.KeyEvents
data EventHandler =
EH { EventHandler -> Text
ehDescription :: Text
, EventHandler -> MH ()
ehAction :: MH ()
}
data KeyEventTrigger =
Static Vty.Event
| ByEvent KeyEvent
deriving (Int -> KeyEventTrigger -> ShowS
[KeyEventTrigger] -> ShowS
KeyEventTrigger -> String
(Int -> KeyEventTrigger -> ShowS)
-> (KeyEventTrigger -> String)
-> ([KeyEventTrigger] -> ShowS)
-> Show KeyEventTrigger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyEventTrigger] -> ShowS
$cshowList :: [KeyEventTrigger] -> ShowS
show :: KeyEventTrigger -> String
$cshow :: KeyEventTrigger -> String
showsPrec :: Int -> KeyEventTrigger -> ShowS
$cshowsPrec :: Int -> KeyEventTrigger -> ShowS
Show, KeyEventTrigger -> KeyEventTrigger -> Bool
(KeyEventTrigger -> KeyEventTrigger -> Bool)
-> (KeyEventTrigger -> KeyEventTrigger -> Bool)
-> Eq KeyEventTrigger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyEventTrigger -> KeyEventTrigger -> Bool
$c/= :: KeyEventTrigger -> KeyEventTrigger -> Bool
== :: KeyEventTrigger -> KeyEventTrigger -> Bool
$c== :: KeyEventTrigger -> KeyEventTrigger -> Bool
Eq, Eq KeyEventTrigger
Eq KeyEventTrigger
-> (KeyEventTrigger -> KeyEventTrigger -> Ordering)
-> (KeyEventTrigger -> KeyEventTrigger -> Bool)
-> (KeyEventTrigger -> KeyEventTrigger -> Bool)
-> (KeyEventTrigger -> KeyEventTrigger -> Bool)
-> (KeyEventTrigger -> KeyEventTrigger -> Bool)
-> (KeyEventTrigger -> KeyEventTrigger -> KeyEventTrigger)
-> (KeyEventTrigger -> KeyEventTrigger -> KeyEventTrigger)
-> Ord KeyEventTrigger
KeyEventTrigger -> KeyEventTrigger -> Bool
KeyEventTrigger -> KeyEventTrigger -> Ordering
KeyEventTrigger -> KeyEventTrigger -> KeyEventTrigger
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 :: KeyEventTrigger -> KeyEventTrigger -> KeyEventTrigger
$cmin :: KeyEventTrigger -> KeyEventTrigger -> KeyEventTrigger
max :: KeyEventTrigger -> KeyEventTrigger -> KeyEventTrigger
$cmax :: KeyEventTrigger -> KeyEventTrigger -> KeyEventTrigger
>= :: KeyEventTrigger -> KeyEventTrigger -> Bool
$c>= :: KeyEventTrigger -> KeyEventTrigger -> Bool
> :: KeyEventTrigger -> KeyEventTrigger -> Bool
$c> :: KeyEventTrigger -> KeyEventTrigger -> Bool
<= :: KeyEventTrigger -> KeyEventTrigger -> Bool
$c<= :: KeyEventTrigger -> KeyEventTrigger -> Bool
< :: KeyEventTrigger -> KeyEventTrigger -> Bool
$c< :: KeyEventTrigger -> KeyEventTrigger -> Bool
compare :: KeyEventTrigger -> KeyEventTrigger -> Ordering
$ccompare :: KeyEventTrigger -> KeyEventTrigger -> Ordering
$cp1Ord :: Eq KeyEventTrigger
Ord)
data KeyEventHandler =
KEH { KeyEventHandler -> EventHandler
kehHandler :: EventHandler
, KeyEventHandler -> KeyEventTrigger
kehEventTrigger :: KeyEventTrigger
}
data KeyHandler =
KH { KeyHandler -> KeyEventHandler
khHandler :: KeyEventHandler
, KeyHandler -> Event
khKey :: Vty.Event
}
newtype KeyHandlerMap = KeyHandlerMap (M.Map Vty.Event KeyHandler)
lookupKeybinding :: Vty.Event -> KeyHandlerMap -> Maybe KeyHandler
lookupKeybinding :: Event -> KeyHandlerMap -> Maybe KeyHandler
lookupKeybinding Event
e (KeyHandlerMap Map Event KeyHandler
m) = Event -> Map Event KeyHandler -> Maybe KeyHandler
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Event
e Map Event KeyHandler
m
handleKeyboardEvent :: (KeyConfig -> KeyHandlerMap)
-> (Vty.Event -> MH ())
-> Vty.Event
-> MH Bool
handleKeyboardEvent :: (KeyConfig -> KeyHandlerMap)
-> (Event -> MH ()) -> Event -> MH Bool
handleKeyboardEvent KeyConfig -> KeyHandlerMap
mkKeyMap Event -> MH ()
fallthrough Event
e = do
Config
conf <- Getting Config ChatState Config -> MH Config
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration)
let keyMap :: KeyHandlerMap
keyMap = KeyConfig -> KeyHandlerMap
mkKeyMap (Config -> KeyConfig
configUserKeys Config
conf)
case Event -> KeyHandlerMap -> Maybe KeyHandler
lookupKeybinding Event
e KeyHandlerMap
keyMap of
Just KeyHandler
kh -> (EventHandler -> MH ()
ehAction (EventHandler -> MH ()) -> EventHandler -> MH ()
forall a b. (a -> b) -> a -> b
$ KeyEventHandler -> EventHandler
kehHandler (KeyEventHandler -> EventHandler)
-> KeyEventHandler -> EventHandler
forall a b. (a -> b) -> a -> b
$ KeyHandler -> KeyEventHandler
khHandler KeyHandler
kh) MH () -> MH Bool -> MH Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe KeyHandler
Nothing -> Event -> MH ()
fallthrough Event
e MH () -> MH Bool -> MH Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
mkHandler :: Text -> MH () -> EventHandler
mkHandler :: Text -> MH () -> EventHandler
mkHandler Text
msg MH ()
action =
EH :: Text -> MH () -> EventHandler
EH { ehDescription :: Text
ehDescription = Text
msg
, ehAction :: MH ()
ehAction = MH ()
action
}
mkKb :: KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb :: KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ev Text
msg MH ()
action =
KEH :: EventHandler -> KeyEventTrigger -> KeyEventHandler
KEH { kehHandler :: EventHandler
kehHandler = Text -> MH () -> EventHandler
mkHandler Text
msg MH ()
action
, kehEventTrigger :: KeyEventTrigger
kehEventTrigger = KeyEvent -> KeyEventTrigger
ByEvent KeyEvent
ev
}
keyHandlerFromConfig :: KeyConfig -> KeyEventHandler -> [KeyHandler]
keyHandlerFromConfig :: KeyConfig -> KeyEventHandler -> [KeyHandler]
keyHandlerFromConfig KeyConfig
conf KeyEventHandler
eh =
case KeyEventHandler -> KeyEventTrigger
kehEventTrigger KeyEventHandler
eh of
Static Event
key ->
[ KeyEventHandler -> Event -> KeyHandler
KH KeyEventHandler
eh Event
key ]
ByEvent KeyEvent
ev ->
[ KeyEventHandler -> Event -> KeyHandler
KH KeyEventHandler
eh (Binding -> Event
bindingToEvent Binding
b) | Binding
b <- [Binding]
allBindings ]
where allBindings :: [Binding]
allBindings | Just (BindingList [Binding]
ks) <- KeyEvent -> KeyConfig -> Maybe BindingState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeyEvent
ev KeyConfig
conf = [Binding]
ks
| Just BindingState
Unbound <- KeyEvent -> KeyConfig -> Maybe BindingState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeyEvent
ev KeyConfig
conf = []
| Bool
otherwise = KeyEvent -> [Binding]
defaultBindings KeyEvent
ev
staticKb :: Text -> Vty.Event -> MH () -> KeyEventHandler
staticKb :: Text -> Event -> MH () -> KeyEventHandler
staticKb Text
msg Event
event MH ()
action =
KEH :: EventHandler -> KeyEventTrigger -> KeyEventHandler
KEH { kehHandler :: EventHandler
kehHandler = Text -> MH () -> EventHandler
mkHandler Text
msg MH ()
action
, kehEventTrigger :: KeyEventTrigger
kehEventTrigger = Event -> KeyEventTrigger
Static Event
event
}
mkKeybindings :: [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings :: [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings [KeyEventHandler]
ks KeyConfig
conf = Map Event KeyHandler -> KeyHandlerMap
KeyHandlerMap (Map Event KeyHandler -> KeyHandlerMap)
-> Map Event KeyHandler -> KeyHandlerMap
forall a b. (a -> b) -> a -> b
$ [(Event, KeyHandler)] -> Map Event KeyHandler
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Event, KeyHandler)]
pairs
where
pairs :: [(Event, KeyHandler)]
pairs = KeyHandler -> (Event, KeyHandler)
mkPair (KeyHandler -> (Event, KeyHandler))
-> [KeyHandler] -> [(Event, KeyHandler)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyHandler]
handlers
mkPair :: KeyHandler -> (Event, KeyHandler)
mkPair KeyHandler
h = (KeyHandler -> Event
khKey KeyHandler
h, KeyHandler
h)
handlers :: [KeyHandler]
handlers = [[KeyHandler]] -> [KeyHandler]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KeyHandler]] -> [KeyHandler]) -> [[KeyHandler]] -> [KeyHandler]
forall a b. (a -> b) -> a -> b
$ KeyConfig -> KeyEventHandler -> [KeyHandler]
keyHandlerFromConfig KeyConfig
conf (KeyEventHandler -> [KeyHandler])
-> [KeyEventHandler] -> [[KeyHandler]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyEventHandler]
ks
bindingToEvent :: Binding -> Vty.Event
bindingToEvent :: Binding -> Event
bindingToEvent Binding
binding =
Key -> [Modifier] -> Event
Vty.EvKey (Binding -> Key
kbKey Binding
binding) (Binding -> [Modifier]
kbMods Binding
binding)
getFirstDefaultBinding :: KeyEvent -> Binding
getFirstDefaultBinding :: KeyEvent -> Binding
getFirstDefaultBinding KeyEvent
ev =
case KeyEvent -> [Binding]
defaultBindings KeyEvent
ev of
[] -> String -> Binding
forall a. HasCallStack => String -> a
error (String -> Binding) -> String -> Binding
forall a b. (a -> b) -> a -> b
$ String
"BUG: event " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KeyEvent -> String
forall a. Show a => a -> String
show KeyEvent
ev String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" has no default bindings!"
(Binding
b:[Binding]
_) -> Binding
b
defaultBindings :: KeyEvent -> [Binding]
defaultBindings :: KeyEvent -> [Binding]
defaultBindings KeyEvent
ev =
let meta :: Binding -> Binding
meta Binding
binding = Binding
binding { kbMods :: [Modifier]
kbMods = Modifier
Vty.MMeta Modifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
: Binding -> [Modifier]
kbMods Binding
binding }
ctrl :: Binding -> Binding
ctrl Binding
binding = Binding
binding { kbMods :: [Modifier]
kbMods = Modifier
Vty.MCtrl Modifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
: Binding -> [Modifier]
kbMods Binding
binding }
shift :: Binding -> Binding
shift Binding
binding = Binding
binding { kbMods :: [Modifier]
kbMods = Modifier
Vty.MShift Modifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
: Binding -> [Modifier]
kbMods Binding
binding }
kb :: Key -> Binding
kb Key
k = Binding :: [Modifier] -> Key -> Binding
Binding { kbMods :: [Modifier]
kbMods = [], kbKey :: Key
kbKey = Key
k }
key :: Char -> Binding
key Char
c = Binding :: [Modifier] -> Key -> Binding
Binding { kbMods :: [Modifier]
kbMods = [], kbKey :: Key
kbKey = Char -> Key
Vty.KChar Char
c }
fn :: Int -> Binding
fn Int
n = Binding :: [Modifier] -> Key -> Binding
Binding { kbMods :: [Modifier]
kbMods = [], kbKey :: Key
kbKey = Int -> Key
Vty.KFun Int
n }
in case KeyEvent
ev of
KeyEvent
VtyRefreshEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'l') ]
KeyEvent
ShowHelpEvent -> [ Int -> Binding
fn Int
1 ]
KeyEvent
EnterSelectModeEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
's') ]
KeyEvent
ReplyRecentEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'r') ]
KeyEvent
ToggleMessagePreviewEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'p') ]
KeyEvent
InvokeEditorEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'k') ]
KeyEvent
EnterFastSelectModeEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'g') ]
KeyEvent
QuitEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'q') ]
KeyEvent
NextChannelEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'n') ]
KeyEvent
PrevChannelEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'p') ]
KeyEvent
NextChannelEventAlternate -> [ Key -> Binding
kb Key
Vty.KDown ]
KeyEvent
PrevChannelEventAlternate -> [ Key -> Binding
kb Key
Vty.KUp ]
KeyEvent
NextUnreadChannelEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'a') ]
KeyEvent
ShowAttachmentListEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'x') ]
KeyEvent
NextUnreadUserOrChannelEvent -> [ ]
KeyEvent
LastChannelEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
's') ]
KeyEvent
EnterOpenURLModeEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'o') ]
KeyEvent
ClearUnreadEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'l') ]
KeyEvent
ToggleMultiLineEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'e') ]
KeyEvent
EnterFlaggedPostsEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'8') ]
KeyEvent
ToggleChannelListVisibleEvent -> [ Int -> Binding
fn Int
2 ]
KeyEvent
ToggleExpandedChannelTopicsEvent -> [ Int -> Binding
fn Int
3 ]
KeyEvent
SelectNextTabEvent -> [ Char -> Binding
key Char
'\t' ]
KeyEvent
SelectPreviousTabEvent -> [ Key -> Binding
kb Key
Vty.KBackTab ]
KeyEvent
SaveAttachmentEvent -> [ Char -> Binding
key Char
's' ]
KeyEvent
LoadMoreEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'b') ]
KeyEvent
ScrollUpEvent -> [ Key -> Binding
kb Key
Vty.KUp ]
KeyEvent
ScrollDownEvent -> [ Key -> Binding
kb Key
Vty.KDown ]
KeyEvent
ScrollLeftEvent -> [ Key -> Binding
kb Key
Vty.KLeft ]
KeyEvent
ScrollRightEvent -> [ Key -> Binding
kb Key
Vty.KRight ]
KeyEvent
PageUpEvent -> [ Key -> Binding
kb Key
Vty.KPageUp ]
KeyEvent
PageDownEvent -> [ Key -> Binding
kb Key
Vty.KPageDown ]
KeyEvent
PageLeftEvent -> [ Binding -> Binding
shift (Key -> Binding
kb Key
Vty.KLeft) ]
KeyEvent
PageRightEvent -> [ Binding -> Binding
shift (Key -> Binding
kb Key
Vty.KRight) ]
KeyEvent
ScrollTopEvent -> [ Key -> Binding
kb Key
Vty.KHome ]
KeyEvent
ScrollBottomEvent -> [ Key -> Binding
kb Key
Vty.KEnd ]
KeyEvent
SelectOldestMessageEvent -> [ Binding -> Binding
shift (Key -> Binding
kb Key
Vty.KHome) ]
KeyEvent
SelectUpEvent -> [ Char -> Binding
key Char
'k', Key -> Binding
kb Key
Vty.KUp ]
KeyEvent
SelectDownEvent -> [ Char -> Binding
key Char
'j', Key -> Binding
kb Key
Vty.KDown ]
KeyEvent
ActivateListItemEvent -> [ Key -> Binding
kb Key
Vty.KEnter ]
KeyEvent
SearchSelectUpEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'p'), Key -> Binding
kb Key
Vty.KUp ]
KeyEvent
SearchSelectDownEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'n'), Key -> Binding
kb Key
Vty.KDown ]
KeyEvent
ViewMessageEvent -> [ Char -> Binding
key Char
'v' ]
KeyEvent
FillGapEvent -> [ Key -> Binding
kb Key
Vty.KEnter ]
KeyEvent
FlagMessageEvent -> [ Char -> Binding
key Char
'f' ]
KeyEvent
PinMessageEvent -> [ Char -> Binding
key Char
'p' ]
KeyEvent
YankMessageEvent -> [ Char -> Binding
key Char
'y' ]
KeyEvent
YankWholeMessageEvent -> [ Char -> Binding
key Char
'Y' ]
KeyEvent
DeleteMessageEvent -> [ Char -> Binding
key Char
'd' ]
KeyEvent
EditMessageEvent -> [ Char -> Binding
key Char
'e' ]
KeyEvent
ReplyMessageEvent -> [ Char -> Binding
key Char
'r' ]
KeyEvent
ReactToMessageEvent -> [ Char -> Binding
key Char
'a' ]
KeyEvent
OpenMessageURLEvent -> [ Char -> Binding
key Char
'o' ]
KeyEvent
AttachmentListAddEvent -> [ Char -> Binding
key Char
'a' ]
KeyEvent
AttachmentListDeleteEvent -> [ Char -> Binding
key Char
'd' ]
KeyEvent
AttachmentOpenEvent -> [ Char -> Binding
key Char
'o' ]
KeyEvent
CancelEvent -> [ Key -> Binding
kb Key
Vty.KEsc, Binding -> Binding
ctrl (Char -> Binding
key Char
'c') ]
KeyEvent
EditorBolEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'a') ]
KeyEvent
EditorEolEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'e') ]
KeyEvent
EditorTransposeCharsEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
't') ]
KeyEvent
EditorDeleteCharacter -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'd') ]
KeyEvent
EditorKillToBolEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'u') ]
KeyEvent
EditorKillToEolEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'k') ]
KeyEvent
EditorPrevCharEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'b') ]
KeyEvent
EditorNextCharEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'f') ]
KeyEvent
EditorPrevWordEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'b') ]
KeyEvent
EditorNextWordEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'f') ]
KeyEvent
EditorDeleteNextWordEvent -> [ Binding -> Binding
meta (Char -> Binding
key Char
'd') ]
KeyEvent
EditorDeletePrevWordEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'w'), Binding -> Binding
meta (Key -> Binding
kb Key
Vty.KBS) ]
KeyEvent
EditorHomeEvent -> [ Key -> Binding
kb Key
Vty.KHome ]
KeyEvent
EditorEndEvent -> [ Key -> Binding
kb Key
Vty.KEnd ]
KeyEvent
EditorYankEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'y') ]
KeyEvent
FileBrowserBeginSearchEvent -> [ Char -> Binding
key Char
'/' ]
KeyEvent
FileBrowserSelectEnterEvent -> [ Key -> Binding
kb Key
Vty.KEnter ]
KeyEvent
FileBrowserSelectCurrentEvent -> [ Key -> Binding
kb (Char -> Key
Vty.KChar Char
' ') ]
KeyEvent
FileBrowserListPageUpEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'b'), Key -> Binding
kb Key
Vty.KPageUp ]
KeyEvent
FileBrowserListPageDownEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'f'), Key -> Binding
kb Key
Vty.KPageDown ]
KeyEvent
FileBrowserListHalfPageUpEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'u') ]
KeyEvent
FileBrowserListHalfPageDownEvent -> [ Binding -> Binding
ctrl (Char -> Binding
key Char
'd') ]
KeyEvent
FileBrowserListTopEvent -> [ Char -> Binding
key Char
'g', Key -> Binding
kb Key
Vty.KHome ]
KeyEvent
FileBrowserListBottomEvent -> [ Char -> Binding
key Char
'G', Key -> Binding
kb Key
Vty.KEnd ]
KeyEvent
FileBrowserListNextEvent -> [ Char -> Binding
key Char
'j', Binding -> Binding
ctrl (Char -> Binding
key Char
'n'), Key -> Binding
kb Key
Vty.KDown ]
KeyEvent
FileBrowserListPrevEvent -> [ Char -> Binding
key Char
'k', Binding -> Binding
ctrl (Char -> Binding
key Char
'p'), Key -> Binding
kb Key
Vty.KUp ]
KeyEvent
FormSubmitEvent -> [ Key -> Binding
kb Key
Vty.KEnter ]
KeyEvent
NextTeamEvent -> [ Binding -> Binding
ctrl (Key -> Binding
kb Key
Vty.KRight) ]
KeyEvent
PrevTeamEvent -> [ Binding -> Binding
ctrl (Key -> Binding
kb Key
Vty.KLeft) ]
KeyEvent
MoveCurrentTeamLeftEvent -> [ ]
KeyEvent
MoveCurrentTeamRightEvent -> [ ]
ensureKeybindingConsistency :: KeyConfig -> [(String, KeyConfig -> KeyHandlerMap)] -> Either String ()
ensureKeybindingConsistency :: KeyConfig
-> [(String, KeyConfig -> KeyHandlerMap)] -> Either String ()
ensureKeybindingConsistency KeyConfig
kc [(String, KeyConfig -> KeyHandlerMap)]
modeMaps = ([(Binding, (Bool, KeyEvent))] -> Either String ())
-> [[(Binding, (Bool, KeyEvent))]] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [(Binding, (Bool, KeyEvent))] -> Either String ()
checkGroup [[(Binding, (Bool, KeyEvent))]]
allBindings
where
allBindings :: [[(Binding, (Bool, KeyEvent))]]
allBindings = ((Binding, (Bool, KeyEvent)) -> Binding)
-> [(Binding, (Bool, KeyEvent))] -> [[(Binding, (Bool, KeyEvent))]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith (Binding, (Bool, KeyEvent)) -> Binding
forall a b. (a, b) -> a
fst ([(Binding, (Bool, KeyEvent))] -> [[(Binding, (Bool, KeyEvent))]])
-> [(Binding, (Bool, KeyEvent))] -> [[(Binding, (Bool, KeyEvent))]]
forall a b. (a -> b) -> a -> b
$ [[(Binding, (Bool, KeyEvent))]] -> [(Binding, (Bool, KeyEvent))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ case KeyEvent -> KeyConfig -> Maybe BindingState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeyEvent
ev KeyConfig
kc of
Maybe BindingState
Nothing -> [Binding] -> [(Bool, KeyEvent)] -> [(Binding, (Bool, KeyEvent))]
forall a b. [a] -> [b] -> [(a, b)]
zip (KeyEvent -> [Binding]
defaultBindings KeyEvent
ev) ((Bool, KeyEvent) -> [(Bool, KeyEvent)]
forall a. a -> [a]
repeat (Bool
False, KeyEvent
ev))
Just (BindingList [Binding]
bs) -> [Binding] -> [(Bool, KeyEvent)] -> [(Binding, (Bool, KeyEvent))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Binding]
bs ((Bool, KeyEvent) -> [(Bool, KeyEvent)]
forall a. a -> [a]
repeat (Bool
True, KeyEvent
ev))
Just BindingState
Unbound -> []
| KeyEvent
ev <- [KeyEvent]
allEvents
]
checkGroup :: [(Binding, (Bool, KeyEvent))] -> Either String ()
checkGroup :: [(Binding, (Bool, KeyEvent))] -> Either String ()
checkGroup [] = String -> Either String ()
forall a. HasCallStack => String -> a
error String
"[ensureKeybindingConsistency: unreachable]"
checkGroup evs :: [(Binding, (Bool, KeyEvent))]
evs@((Binding
b, (Bool, KeyEvent)
_):[(Binding, (Bool, KeyEvent))]
_) = do
let modesFor :: M.Map String [(Bool, KeyEvent)]
modesFor :: Map String [(Bool, KeyEvent)]
modesFor = ([(Bool, KeyEvent)] -> [(Bool, KeyEvent)] -> [(Bool, KeyEvent)])
-> [Map String [(Bool, KeyEvent)]] -> Map String [(Bool, KeyEvent)]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [(Bool, KeyEvent)] -> [(Bool, KeyEvent)] -> [(Bool, KeyEvent)]
forall a. [a] -> [a] -> [a]
(++)
[ [(String, [(Bool, KeyEvent)])] -> Map String [(Bool, KeyEvent)]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (String
m, [(Bool
i, KeyEvent
ev)]) | String
m <- KeyEvent -> [String]
modeMap KeyEvent
ev ]
| (Binding
_, (Bool
i, KeyEvent
ev)) <- [(Binding, (Bool, KeyEvent))]
evs
]
[(String, [(Bool, KeyEvent)])]
-> ((String, [(Bool, KeyEvent)]) -> Either String ())
-> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map String [(Bool, KeyEvent)] -> [(String, [(Bool, KeyEvent)])]
forall k a. Map k a -> [(k, a)]
M.assocs Map String [(Bool, KeyEvent)]
modesFor) (((String, [(Bool, KeyEvent)]) -> Either String ())
-> Either String ())
-> ((String, [(Bool, KeyEvent)]) -> Either String ())
-> Either String ()
forall a b. (a -> b) -> a -> b
$ \ (String
_, [(Bool, KeyEvent)]
vs) ->
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Bool, KeyEvent)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, KeyEvent)]
vs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
String
"Multiple overlapping events bound to `" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
Text -> String
T.unpack (Binding -> Text
ppBinding Binding
b) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
String
"`:\n" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ String
" - `"
, Text -> String
T.unpack (KeyEvent -> Text
keyEventName KeyEvent
ev)
, String
"` "
, if Bool
isFromUser
then String
"(via user override)"
else String
"(matterhorn default)"
, String
"\n"
]
| (Bool
isFromUser, KeyEvent
ev) <- [(Bool, KeyEvent)]
vs
]
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
"main" String -> Map String [(Bool, KeyEvent)] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map String [(Bool, KeyEvent)]
modesFor Bool -> Bool -> Bool
&& Binding -> Bool
isBareBinding Binding
b) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ do
String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
"The keybinding `"
, Text -> String
T.unpack (Binding -> Text
ppBinding Binding
b)
, String
"` is bound to the "
, case ((Binding, (Bool, KeyEvent)) -> String)
-> [(Binding, (Bool, KeyEvent))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (KeyEvent -> String
ppEvent (KeyEvent -> String)
-> ((Binding, (Bool, KeyEvent)) -> KeyEvent)
-> (Binding, (Bool, KeyEvent))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, KeyEvent) -> KeyEvent
forall a b. (a, b) -> b
snd ((Bool, KeyEvent) -> KeyEvent)
-> ((Binding, (Bool, KeyEvent)) -> (Bool, KeyEvent))
-> (Binding, (Bool, KeyEvent))
-> KeyEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binding, (Bool, KeyEvent)) -> (Bool, KeyEvent)
forall a b. (a, b) -> b
snd) [(Binding, (Bool, KeyEvent))]
evs of
[] -> ShowS
forall a. HasCallStack => String -> a
error String
"unreachable"
[String
e] -> String
"event " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
[String]
es -> String
"events " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" and " [String]
es
, String
"\n"
, String
"This is probably not what you want, as it will interfere "
, String
"with the ability to write messages!\n"
]
ppEvent :: KeyEvent -> String
ppEvent KeyEvent
ev = String
"`" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (KeyEvent -> Text
keyEventName KeyEvent
ev) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"`"
isBareBinding :: Binding -> Bool
isBareBinding (Binding [] (Vty.KChar {})) = Bool
True
isBareBinding Binding
_ = Bool
False
modeMap :: KeyEvent -> [String]
modeMap :: KeyEvent -> [String]
modeMap KeyEvent
ev =
let matches :: KeyHandler -> Bool
matches KeyHandler
kh = KeyEvent -> KeyEventTrigger
ByEvent KeyEvent
ev KeyEventTrigger -> KeyEventTrigger -> Bool
forall a. Eq a => a -> a -> Bool
== (KeyEventHandler -> KeyEventTrigger
kehEventTrigger (KeyEventHandler -> KeyEventTrigger)
-> KeyEventHandler -> KeyEventTrigger
forall a b. (a -> b) -> a -> b
$ KeyHandler -> KeyEventHandler
khHandler KeyHandler
kh)
in [ String
mode
| (String
mode, KeyConfig -> KeyHandlerMap
mkBindings) <- [(String, KeyConfig -> KeyHandlerMap)]
modeMaps
, let KeyHandlerMap Map Event KeyHandler
m = KeyConfig -> KeyHandlerMap
mkBindings KeyConfig
kc
in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map Event KeyHandler -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map Event KeyHandler -> Bool) -> Map Event KeyHandler -> Bool
forall a b. (a -> b) -> a -> b
$ (KeyHandler -> Bool)
-> Map Event KeyHandler -> Map Event KeyHandler
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter KeyHandler -> Bool
matches Map Event KeyHandler
m
]