module Brick.Keybindings.KeyDispatcher
(
KeyDispatcher
, keyDispatcher
, handleKey
, onEvent
, onKey
, Handler(..)
, KeyHandler(..)
, KeyEventHandler(..)
, EventTrigger(..)
, keyDispatcherToList
, lookupVtyEvent
)
where
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import Brick.Keybindings.KeyConfig
newtype KeyDispatcher k m = KeyDispatcher (M.Map Binding (KeyHandler k m))
data Handler m =
Handler { Handler m -> Text
handlerDescription :: T.Text
, Handler m -> m ()
handlerAction :: m ()
}
data KeyHandler k m =
KeyHandler { KeyHandler k m -> KeyEventHandler k m
khHandler :: KeyEventHandler k m
, KeyHandler k m -> Binding
khBinding :: Binding
}
lookupVtyEvent :: Vty.Key -> [Vty.Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
lookupVtyEvent :: Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
lookupVtyEvent Key
k [Modifier]
mods (KeyDispatcher Map Binding (KeyHandler k m)
m) = Binding -> Map Binding (KeyHandler k m) -> Maybe (KeyHandler k m)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Key -> Set Modifier -> Binding
Binding Key
k (Set Modifier -> Binding) -> Set Modifier -> Binding
forall a b. (a -> b) -> a -> b
$ [Modifier] -> Set Modifier
forall a. Ord a => [a] -> Set a
S.fromList [Modifier]
mods) Map Binding (KeyHandler k m)
m
handleKey :: (Monad m)
=> KeyDispatcher k m
-> Vty.Key
-> [Vty.Modifier]
-> m Bool
handleKey :: KeyDispatcher k m -> Key -> [Modifier] -> m Bool
handleKey KeyDispatcher k m
d Key
k [Modifier]
mods = do
case Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
forall k (m :: * -> *).
Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
lookupVtyEvent Key
k [Modifier]
mods KeyDispatcher k m
d of
Just KeyHandler k m
kh -> (Handler m -> m ()
forall (m :: * -> *). Handler m -> m ()
handlerAction (Handler m -> m ()) -> Handler m -> m ()
forall a b. (a -> b) -> a -> b
$ KeyEventHandler k m -> Handler m
forall k (m :: * -> *). KeyEventHandler k m -> Handler m
kehHandler (KeyEventHandler k m -> Handler m)
-> KeyEventHandler k m -> Handler m
forall a b. (a -> b) -> a -> b
$ KeyHandler k m -> KeyEventHandler k m
forall k (m :: * -> *). KeyHandler k m -> KeyEventHandler k m
khHandler KeyHandler k m
kh) m () -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe (KeyHandler k m)
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
keyDispatcher :: (Ord k)
=> KeyConfig k
-> [KeyEventHandler k m]
-> KeyDispatcher k m
keyDispatcher :: KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
keyDispatcher KeyConfig k
conf [KeyEventHandler k m]
ks = Map Binding (KeyHandler k m) -> KeyDispatcher k m
forall k (m :: * -> *).
Map Binding (KeyHandler k m) -> KeyDispatcher k m
KeyDispatcher (Map Binding (KeyHandler k m) -> KeyDispatcher k m)
-> Map Binding (KeyHandler k m) -> KeyDispatcher k m
forall a b. (a -> b) -> a -> b
$ [(Binding, KeyHandler k m)] -> Map Binding (KeyHandler k m)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Binding, KeyHandler k m)] -> Map Binding (KeyHandler k m))
-> [(Binding, KeyHandler k m)] -> Map Binding (KeyHandler k m)
forall a b. (a -> b) -> a -> b
$ [KeyEventHandler k m] -> KeyConfig k -> [(Binding, KeyHandler k m)]
forall k (m :: * -> *).
Ord k =>
[KeyEventHandler k m] -> KeyConfig k -> [(Binding, KeyHandler k m)]
buildKeyDispatcherPairs [KeyEventHandler k m]
ks KeyConfig k
conf
keyDispatcherToList :: KeyDispatcher k m
-> [(Binding, KeyHandler k m)]
keyDispatcherToList :: KeyDispatcher k m -> [(Binding, KeyHandler k m)]
keyDispatcherToList (KeyDispatcher Map Binding (KeyHandler k m)
m) = Map Binding (KeyHandler k m) -> [(Binding, KeyHandler k m)]
forall k a. Map k a -> [(k, a)]
M.toList Map Binding (KeyHandler k m)
m
buildKeyDispatcherPairs :: (Ord k)
=> [KeyEventHandler k m]
-> KeyConfig k
-> [(Binding, KeyHandler k m)]
buildKeyDispatcherPairs :: [KeyEventHandler k m] -> KeyConfig k -> [(Binding, KeyHandler k m)]
buildKeyDispatcherPairs [KeyEventHandler k m]
ks KeyConfig k
conf = [(Binding, KeyHandler k m)]
pairs
where
pairs :: [(Binding, KeyHandler k m)]
pairs = KeyHandler k m -> (Binding, KeyHandler k m)
forall k (m :: * -> *). KeyHandler k m -> (Binding, KeyHandler k m)
mkPair (KeyHandler k m -> (Binding, KeyHandler k m))
-> [KeyHandler k m] -> [(Binding, KeyHandler k m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyHandler k m]
handlers
mkPair :: KeyHandler k m -> (Binding, KeyHandler k m)
mkPair KeyHandler k m
h = (KeyHandler k m -> Binding
forall k (m :: * -> *). KeyHandler k m -> Binding
khBinding KeyHandler k m
h, KeyHandler k m
h)
handlers :: [KeyHandler k m]
handlers = [[KeyHandler k m]] -> [KeyHandler k m]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KeyHandler k m]] -> [KeyHandler k m])
-> [[KeyHandler k m]] -> [KeyHandler k m]
forall a b. (a -> b) -> a -> b
$ KeyConfig k -> KeyEventHandler k m -> [KeyHandler k m]
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> KeyEventHandler k m -> [KeyHandler k m]
keyHandlersFromConfig KeyConfig k
conf (KeyEventHandler k m -> [KeyHandler k m])
-> [KeyEventHandler k m] -> [[KeyHandler k m]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyEventHandler k m]
ks
keyHandlersFromConfig :: (Ord k)
=> KeyConfig k
-> KeyEventHandler k m
-> [KeyHandler k m]
keyHandlersFromConfig :: KeyConfig k -> KeyEventHandler k m -> [KeyHandler k m]
keyHandlersFromConfig KeyConfig k
kc KeyEventHandler k m
eh =
let allBindingsFor :: k -> [Binding]
allBindingsFor k
ev | Just (BindingList [Binding]
ks) <- KeyConfig k -> k -> Maybe BindingState
forall k. Ord k => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig k
kc k
ev = [Binding]
ks
| Just BindingState
Unbound <- KeyConfig k -> k -> Maybe BindingState
forall k. Ord k => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig k
kc k
ev = []
| Bool
otherwise = KeyConfig k -> k -> [Binding]
forall k. Ord k => KeyConfig k -> k -> [Binding]
allDefaultBindings KeyConfig k
kc k
ev
bindings :: [Binding]
bindings = case KeyEventHandler k m -> EventTrigger k
forall k (m :: * -> *). KeyEventHandler k m -> EventTrigger k
kehEventTrigger KeyEventHandler k m
eh of
ByKey Binding
b -> [Binding
b]
ByEvent k
ev -> k -> [Binding]
allBindingsFor k
ev
in [ KeyHandler :: forall k (m :: * -> *).
KeyEventHandler k m -> Binding -> KeyHandler k m
KeyHandler { khHandler :: KeyEventHandler k m
khHandler = KeyEventHandler k m
eh, khBinding :: Binding
khBinding = Binding
b } | Binding
b <- [Binding]
bindings ]
mkHandler :: T.Text -> m () -> Handler m
mkHandler :: Text -> m () -> Handler m
mkHandler Text
msg m ()
action =
Handler :: forall (m :: * -> *). Text -> m () -> Handler m
Handler { handlerDescription :: Text
handlerDescription = Text
msg
, handlerAction :: m ()
handlerAction = m ()
action
}
onEvent :: k
-> T.Text
-> m ()
-> KeyEventHandler k m
onEvent :: k -> Text -> m () -> KeyEventHandler k m
onEvent k
ev Text
msg m ()
action =
KeyEventHandler :: forall k (m :: * -> *).
Handler m -> EventTrigger k -> KeyEventHandler k m
KeyEventHandler { kehHandler :: Handler m
kehHandler = Text -> m () -> Handler m
forall (m :: * -> *). Text -> m () -> Handler m
mkHandler Text
msg m ()
action
, kehEventTrigger :: EventTrigger k
kehEventTrigger = k -> EventTrigger k
forall k. k -> EventTrigger k
ByEvent k
ev
}
onKey :: (ToBinding a)
=> a
-> T.Text
-> m ()
-> KeyEventHandler k m
onKey :: a -> Text -> m () -> KeyEventHandler k m
onKey a
b Text
msg m ()
action =
KeyEventHandler :: forall k (m :: * -> *).
Handler m -> EventTrigger k -> KeyEventHandler k m
KeyEventHandler { kehHandler :: Handler m
kehHandler = Text -> m () -> Handler m
forall (m :: * -> *). Text -> m () -> Handler m
mkHandler Text
msg m ()
action
, kehEventTrigger :: EventTrigger k
kehEventTrigger = Binding -> EventTrigger k
forall k. Binding -> EventTrigger k
ByKey (Binding -> EventTrigger k) -> Binding -> EventTrigger k
forall a b. (a -> b) -> a -> b
$ a -> Binding
forall a. ToBinding a => a -> Binding
bind a
b
}
data EventTrigger k =
ByKey Binding
| ByEvent k
deriving (Int -> EventTrigger k -> ShowS
[EventTrigger k] -> ShowS
EventTrigger k -> String
(Int -> EventTrigger k -> ShowS)
-> (EventTrigger k -> String)
-> ([EventTrigger k] -> ShowS)
-> Show (EventTrigger k)
forall k. Show k => Int -> EventTrigger k -> ShowS
forall k. Show k => [EventTrigger k] -> ShowS
forall k. Show k => EventTrigger k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventTrigger k] -> ShowS
$cshowList :: forall k. Show k => [EventTrigger k] -> ShowS
show :: EventTrigger k -> String
$cshow :: forall k. Show k => EventTrigger k -> String
showsPrec :: Int -> EventTrigger k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> EventTrigger k -> ShowS
Show, EventTrigger k -> EventTrigger k -> Bool
(EventTrigger k -> EventTrigger k -> Bool)
-> (EventTrigger k -> EventTrigger k -> Bool)
-> Eq (EventTrigger k)
forall k. Eq k => EventTrigger k -> EventTrigger k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventTrigger k -> EventTrigger k -> Bool
$c/= :: forall k. Eq k => EventTrigger k -> EventTrigger k -> Bool
== :: EventTrigger k -> EventTrigger k -> Bool
$c== :: forall k. Eq k => EventTrigger k -> EventTrigger k -> Bool
Eq, Eq (EventTrigger k)
Eq (EventTrigger k)
-> (EventTrigger k -> EventTrigger k -> Ordering)
-> (EventTrigger k -> EventTrigger k -> Bool)
-> (EventTrigger k -> EventTrigger k -> Bool)
-> (EventTrigger k -> EventTrigger k -> Bool)
-> (EventTrigger k -> EventTrigger k -> Bool)
-> (EventTrigger k -> EventTrigger k -> EventTrigger k)
-> (EventTrigger k -> EventTrigger k -> EventTrigger k)
-> Ord (EventTrigger k)
EventTrigger k -> EventTrigger k -> Bool
EventTrigger k -> EventTrigger k -> Ordering
EventTrigger k -> EventTrigger k -> EventTrigger k
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
forall k. Ord k => Eq (EventTrigger k)
forall k. Ord k => EventTrigger k -> EventTrigger k -> Bool
forall k. Ord k => EventTrigger k -> EventTrigger k -> Ordering
forall k.
Ord k =>
EventTrigger k -> EventTrigger k -> EventTrigger k
min :: EventTrigger k -> EventTrigger k -> EventTrigger k
$cmin :: forall k.
Ord k =>
EventTrigger k -> EventTrigger k -> EventTrigger k
max :: EventTrigger k -> EventTrigger k -> EventTrigger k
$cmax :: forall k.
Ord k =>
EventTrigger k -> EventTrigger k -> EventTrigger k
>= :: EventTrigger k -> EventTrigger k -> Bool
$c>= :: forall k. Ord k => EventTrigger k -> EventTrigger k -> Bool
> :: EventTrigger k -> EventTrigger k -> Bool
$c> :: forall k. Ord k => EventTrigger k -> EventTrigger k -> Bool
<= :: EventTrigger k -> EventTrigger k -> Bool
$c<= :: forall k. Ord k => EventTrigger k -> EventTrigger k -> Bool
< :: EventTrigger k -> EventTrigger k -> Bool
$c< :: forall k. Ord k => EventTrigger k -> EventTrigger k -> Bool
compare :: EventTrigger k -> EventTrigger k -> Ordering
$ccompare :: forall k. Ord k => EventTrigger k -> EventTrigger k -> Ordering
$cp1Ord :: forall k. Ord k => Eq (EventTrigger k)
Ord)
data KeyEventHandler k m =
KeyEventHandler { KeyEventHandler k m -> Handler m
kehHandler :: Handler m
, KeyEventHandler k m -> EventTrigger k
kehEventTrigger :: EventTrigger k
}