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 Data.Function (on)
import Data.List (groupBy, sortBy)
import Brick.Keybindings.KeyConfig
newtype KeyDispatcher k m = KeyDispatcher (M.Map Binding (KeyHandler k m))
data Handler m =
Handler { forall (m :: * -> *). Handler m -> Text
handlerDescription :: T.Text
, forall (m :: * -> *). Handler m -> m ()
handlerAction :: m ()
}
data KeyHandler k m =
KeyHandler { forall k (m :: * -> *). KeyHandler k m -> KeyEventHandler k m
khHandler :: KeyEventHandler k m
, forall k (m :: * -> *). KeyHandler k m -> Binding
khBinding :: Binding
}
lookupVtyEvent :: Vty.Key -> [Vty.Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
lookupVtyEvent :: forall k (m :: * -> *).
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 :: forall (m :: * -> *) k.
Monad m =>
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe (KeyHandler k m)
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
keyDispatcher :: (Ord k)
=> KeyConfig k
-> [KeyEventHandler k m]
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
keyDispatcher :: forall k (m :: * -> *).
Ord k =>
KeyConfig k
-> [KeyEventHandler k m]
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
keyDispatcher KeyConfig k
conf [KeyEventHandler k m]
ks =
let pairs :: [(Binding, KeyHandler k m)]
pairs = [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
groups :: [[(Binding, KeyHandler k m)]]
groups = ((Binding, KeyHandler k m) -> (Binding, KeyHandler k m) -> Bool)
-> [(Binding, KeyHandler k m)] -> [[(Binding, KeyHandler k m)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Binding -> Binding -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Binding -> Binding -> Bool)
-> ((Binding, KeyHandler k m) -> Binding)
-> (Binding, KeyHandler k m)
-> (Binding, KeyHandler k m)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Binding, KeyHandler k m) -> Binding
forall a b. (a, b) -> a
fst) ([(Binding, KeyHandler k m)] -> [[(Binding, KeyHandler k m)]])
-> [(Binding, KeyHandler k m)] -> [[(Binding, KeyHandler k m)]]
forall a b. (a -> b) -> a -> b
$ ((Binding, KeyHandler k m)
-> (Binding, KeyHandler k m) -> Ordering)
-> [(Binding, KeyHandler k m)] -> [(Binding, KeyHandler k m)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Binding -> Binding -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Binding -> Binding -> Ordering)
-> ((Binding, KeyHandler k m) -> Binding)
-> (Binding, KeyHandler k m)
-> (Binding, KeyHandler k m)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Binding, KeyHandler k m) -> Binding
forall a b. (a, b) -> a
fst) [(Binding, KeyHandler k m)]
pairs
badGroups :: [[(Binding, KeyHandler k m)]]
badGroups = ([(Binding, KeyHandler k m)] -> Bool)
-> [[(Binding, KeyHandler k m)]] -> [[(Binding, KeyHandler k m)]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool)
-> ([(Binding, KeyHandler k m)] -> Int)
-> [(Binding, KeyHandler k m)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Binding, KeyHandler k m)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[(Binding, KeyHandler k m)]]
groups
combine :: [(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])
combine :: forall k (m :: * -> *).
[(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])
combine [(Binding, KeyHandler k m)]
as =
let b :: Binding
b = (Binding, KeyHandler k m) -> Binding
forall a b. (a, b) -> a
fst ((Binding, KeyHandler k m) -> Binding)
-> (Binding, KeyHandler k m) -> Binding
forall a b. (a -> b) -> a -> b
$ [(Binding, KeyHandler k m)] -> (Binding, KeyHandler k m)
forall a. HasCallStack => [a] -> a
head [(Binding, KeyHandler k m)]
as
in (Binding
b, (Binding, KeyHandler k m) -> KeyHandler k m
forall a b. (a, b) -> b
snd ((Binding, KeyHandler k m) -> KeyHandler k m)
-> [(Binding, KeyHandler k m)] -> [KeyHandler k m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Binding, KeyHandler k m)]
as)
in if [[(Binding, KeyHandler k m)]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(Binding, KeyHandler k m)]]
badGroups
then KeyDispatcher k m
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
forall a b. b -> Either a b
Right (KeyDispatcher k m
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m))
-> KeyDispatcher k m
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
forall a b. (a -> b) -> a -> b
$ 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)]
pairs
else [(Binding, [KeyHandler k m])]
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
forall a b. a -> Either a b
Left ([(Binding, [KeyHandler k m])]
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m))
-> [(Binding, [KeyHandler k m])]
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
forall a b. (a -> b) -> a -> b
$ [(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])
forall k (m :: * -> *).
[(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])
combine ([(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m]))
-> [[(Binding, KeyHandler k m)]] -> [(Binding, [KeyHandler k m])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(Binding, KeyHandler k m)]]
badGroups
keyDispatcherToList :: KeyDispatcher k m
-> [(Binding, KeyHandler k m)]
keyDispatcherToList :: forall k (m :: * -> *).
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 :: forall k (m :: * -> *).
Ord k =>
[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 = (KeyEventHandler k m -> [KeyHandler k m])
-> [KeyEventHandler k m] -> [KeyHandler k m]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (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]
ks
keyHandlersFromConfig :: (Ord k)
=> KeyConfig k
-> KeyEventHandler k m
-> [KeyHandler k m]
keyHandlersFromConfig :: forall k (m :: * -> *).
Ord k =>
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 { 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 :: forall (m :: * -> *). Text -> m () -> Handler m
mkHandler Text
msg m ()
action =
Handler { handlerDescription :: Text
handlerDescription = Text
msg
, handlerAction :: m ()
handlerAction = m ()
action
}
onEvent :: k
-> T.Text
-> m ()
-> KeyEventHandler k m
onEvent :: forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent k
ev Text
msg m ()
action =
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 :: forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey a
b Text
msg m ()
action =
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
$cshowsPrec :: forall k. Show k => Int -> EventTrigger k -> ShowS
showsPrec :: Int -> EventTrigger k -> ShowS
$cshow :: forall k. Show k => EventTrigger k -> String
show :: EventTrigger k -> String
$cshowList :: forall k. Show k => [EventTrigger k] -> ShowS
showList :: [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
$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
/= :: 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
$ccompare :: forall k. Ord k => EventTrigger k -> EventTrigger k -> Ordering
compare :: EventTrigger k -> EventTrigger k -> Ordering
$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
>= :: EventTrigger k -> EventTrigger k -> Bool
$cmax :: forall k.
Ord k =>
EventTrigger k -> EventTrigger k -> EventTrigger k
max :: EventTrigger k -> EventTrigger k -> EventTrigger k
$cmin :: forall k.
Ord k =>
EventTrigger k -> EventTrigger k -> EventTrigger k
min :: EventTrigger k -> EventTrigger k -> EventTrigger k
Ord)
data KeyEventHandler k m =
KeyEventHandler { forall k (m :: * -> *). KeyEventHandler k m -> Handler m
kehHandler :: Handler m
, forall k (m :: * -> *). KeyEventHandler k m -> EventTrigger k
kehEventTrigger :: EventTrigger k
}