module Brick.Keybindings.KeyConfig
( KeyConfig
, newKeyConfig
, BindingState(..)
, Binding(..)
, ToBinding(..)
, binding
, fn
, meta
, ctrl
, shift
, firstDefaultBinding
, firstActiveBinding
, allDefaultBindings
, allActiveBindings
, keyEventMappings
, keyConfigEvents
, lookupKeyConfigBindings
)
where
import Data.List (nub)
import qualified Data.Map.Strict as M
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import qualified Data.Set as S
import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
import qualified Graphics.Vty as Vty
import Brick.Keybindings.KeyEvents
data Binding =
Binding { Binding -> Key
kbKey :: Vty.Key
, Binding -> Set Modifier
kbMods :: S.Set Vty.Modifier
} deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
/= :: 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
$cshowsPrec :: Int -> Binding -> ShowS
showsPrec :: Int -> Binding -> ShowS
$cshow :: Binding -> String
show :: Binding -> String
$cshowList :: [Binding] -> ShowS
showList :: [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
$ccompare :: Binding -> Binding -> Ordering
compare :: Binding -> Binding -> Ordering
$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
>= :: Binding -> Binding -> Bool
$cmax :: Binding -> Binding -> Binding
max :: Binding -> Binding -> Binding
$cmin :: Binding -> Binding -> Binding
min :: Binding -> Binding -> Binding
Ord)
binding :: Vty.Key -> [Vty.Modifier] -> Binding
binding :: Key -> [Modifier] -> Binding
binding Key
k [Modifier]
mods =
Binding { kbKey :: Key
kbKey = Key
k
, kbMods :: Set Modifier
kbMods = [Modifier] -> Set Modifier
forall a. Ord a => [a] -> Set a
S.fromList [Modifier]
mods
}
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
$cshowsPrec :: Int -> BindingState -> ShowS
showsPrec :: Int -> BindingState -> ShowS
$cshow :: BindingState -> String
show :: BindingState -> String
$cshowList :: [BindingState] -> ShowS
showList :: [BindingState] -> ShowS
Show, BindingState -> BindingState -> Bool
(BindingState -> BindingState -> Bool)
-> (BindingState -> BindingState -> Bool) -> Eq BindingState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BindingState -> BindingState -> Bool
== :: BindingState -> BindingState -> Bool
$c/= :: BindingState -> BindingState -> Bool
/= :: 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
$ccompare :: BindingState -> BindingState -> Ordering
compare :: BindingState -> BindingState -> Ordering
$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
>= :: BindingState -> BindingState -> Bool
$cmax :: BindingState -> BindingState -> BindingState
max :: BindingState -> BindingState -> BindingState
$cmin :: BindingState -> BindingState -> BindingState
min :: BindingState -> BindingState -> BindingState
Ord)
data KeyConfig k =
KeyConfig { forall k. KeyConfig k -> [(k, BindingState)]
keyConfigCustomBindings :: [(k, BindingState)]
, forall k. KeyConfig k -> KeyEvents k
keyConfigEvents :: KeyEvents k
, forall k. KeyConfig k -> Map k [Binding]
keyConfigDefaultBindings :: M.Map k [Binding]
}
deriving (Int -> KeyConfig k -> ShowS
[KeyConfig k] -> ShowS
KeyConfig k -> String
(Int -> KeyConfig k -> ShowS)
-> (KeyConfig k -> String)
-> ([KeyConfig k] -> ShowS)
-> Show (KeyConfig k)
forall k. Show k => Int -> KeyConfig k -> ShowS
forall k. Show k => [KeyConfig k] -> ShowS
forall k. Show k => KeyConfig k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> KeyConfig k -> ShowS
showsPrec :: Int -> KeyConfig k -> ShowS
$cshow :: forall k. Show k => KeyConfig k -> String
show :: KeyConfig k -> String
$cshowList :: forall k. Show k => [KeyConfig k] -> ShowS
showList :: [KeyConfig k] -> ShowS
Show, KeyConfig k -> KeyConfig k -> Bool
(KeyConfig k -> KeyConfig k -> Bool)
-> (KeyConfig k -> KeyConfig k -> Bool) -> Eq (KeyConfig k)
forall k. Eq k => KeyConfig k -> KeyConfig k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall k. Eq k => KeyConfig k -> KeyConfig k -> Bool
== :: KeyConfig k -> KeyConfig k -> Bool
$c/= :: forall k. Eq k => KeyConfig k -> KeyConfig k -> Bool
/= :: KeyConfig k -> KeyConfig k -> Bool
Eq)
newKeyConfig :: (Ord k)
=> KeyEvents k
-> [(k, [Binding])]
-> [(k, BindingState)]
-> KeyConfig k
newKeyConfig :: forall k.
Ord k =>
KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents k
evs [(k, [Binding])]
defaults [(k, BindingState)]
bindings =
KeyConfig { keyConfigCustomBindings :: [(k, BindingState)]
keyConfigCustomBindings = [(k, BindingState)]
bindings
, keyConfigEvents :: KeyEvents k
keyConfigEvents = KeyEvents k
evs
, keyConfigDefaultBindings :: Map k [Binding]
keyConfigDefaultBindings = [(k, [Binding])] -> Map k [Binding]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, [Binding])]
defaults
}
keyEventMappings :: (Ord k, Eq k) => KeyConfig k -> [(Binding, S.Set k)]
keyEventMappings :: forall k. (Ord k, Eq k) => KeyConfig k -> [(Binding, Set k)]
keyEventMappings KeyConfig k
kc = Map Binding (Set k) -> [(Binding, Set k)]
forall k a. Map k a -> [(k, a)]
M.toList Map Binding (Set k)
resultMap
where
defaultBindings :: [(k, [Binding])]
defaultBindings = Map k [Binding] -> [(k, [Binding])]
forall k a. Map k a -> [(k, a)]
M.toList (Map k [Binding] -> [(k, [Binding])])
-> Map k [Binding] -> [(k, [Binding])]
forall a b. (a -> b) -> a -> b
$ KeyConfig k -> Map k [Binding]
forall k. KeyConfig k -> Map k [Binding]
keyConfigDefaultBindings KeyConfig k
kc
explicitlyUnboundEvents :: [k]
explicitlyUnboundEvents = ((k, BindingState) -> k) -> [(k, BindingState)] -> [k]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, BindingState) -> k
forall a b. (a, b) -> a
fst ([(k, BindingState)] -> [k]) -> [(k, BindingState)] -> [k]
forall a b. (a -> b) -> a -> b
$ ((k, BindingState) -> Bool)
-> [(k, BindingState)] -> [(k, BindingState)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((BindingState -> BindingState -> Bool
forall a. Eq a => a -> a -> Bool
== BindingState
Unbound) (BindingState -> Bool)
-> ((k, BindingState) -> BindingState) -> (k, BindingState) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, BindingState) -> BindingState
forall a b. (a, b) -> b
snd) ([(k, BindingState)] -> [(k, BindingState)])
-> [(k, BindingState)] -> [(k, BindingState)]
forall a b. (a -> b) -> a -> b
$ KeyConfig k -> [(k, BindingState)]
forall k. KeyConfig k -> [(k, BindingState)]
keyConfigCustomBindings KeyConfig k
kc
defaultBindingsWithoutUnbound :: [(k, [Binding])]
defaultBindingsWithoutUnbound = ((k, [Binding]) -> Bool) -> [(k, [Binding])] -> [(k, [Binding])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((k -> [k] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [k]
explicitlyUnboundEvents) (k -> Bool) -> ((k, [Binding]) -> k) -> (k, [Binding]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, [Binding]) -> k
forall a b. (a, b) -> a
fst) [(k, [Binding])]
defaultBindings
customizedKeybindingLists :: [(k, [Binding])]
customizedKeybindingLists = [Maybe (k, [Binding])] -> [(k, [Binding])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (k, [Binding])] -> [(k, [Binding])])
-> [Maybe (k, [Binding])] -> [(k, [Binding])]
forall a b. (a -> b) -> a -> b
$ ((((k, BindingState) -> Maybe (k, [Binding]))
-> [(k, BindingState)] -> [Maybe (k, [Binding])])
-> [(k, BindingState)]
-> ((k, BindingState) -> Maybe (k, [Binding]))
-> [Maybe (k, [Binding])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((k, BindingState) -> Maybe (k, [Binding]))
-> [(k, BindingState)] -> [Maybe (k, [Binding])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (KeyConfig k -> [(k, BindingState)]
forall k. KeyConfig k -> [(k, BindingState)]
keyConfigCustomBindings KeyConfig k
kc) (((k, BindingState) -> Maybe (k, [Binding]))
-> [Maybe (k, [Binding])])
-> ((k, BindingState) -> Maybe (k, [Binding]))
-> [Maybe (k, [Binding])]
forall a b. (a -> b) -> a -> b
$ \(k
k, BindingState
bState) -> do
case BindingState
bState of
BindingState
Unbound -> Maybe (k, [Binding])
forall a. Maybe a
Nothing
BindingList [Binding]
bs -> (k, [Binding]) -> Maybe (k, [Binding])
forall a. a -> Maybe a
Just (k
k, [Binding]
bs)
allPairs :: [(k, [Binding])]
allPairs = [(k, [Binding])]
defaultBindingsWithoutUnbound [(k, [Binding])] -> [(k, [Binding])] -> [(k, [Binding])]
forall a. Semigroup a => a -> a -> a
<>
[(k, [Binding])]
customizedKeybindingLists
addBindings :: Map k (Set a) -> (a, [k]) -> Map k (Set a)
addBindings Map k (Set a)
m (a
ev, [k]
bs) =
(Set a -> Set a -> Set a)
-> Map k (Set a) -> Map k (Set a) -> Map k (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Map k (Set a)
m (Map k (Set a) -> Map k (Set a)) -> Map k (Set a) -> Map k (Set a)
forall a b. (a -> b) -> a -> b
$ [(k, Set a)] -> Map k (Set a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k
b, a -> Set a
forall a. a -> Set a
S.singleton a
ev) | k
b <- [k]
bs]
resultMap :: Map Binding (Set k)
resultMap = (Map Binding (Set k) -> (k, [Binding]) -> Map Binding (Set k))
-> Map Binding (Set k) -> [(k, [Binding])] -> Map Binding (Set k)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Binding (Set k) -> (k, [Binding]) -> Map Binding (Set k)
forall {k} {a}.
(Ord k, Ord a) =>
Map k (Set a) -> (a, [k]) -> Map k (Set a)
addBindings Map Binding (Set k)
forall a. Monoid a => a
mempty [(k, [Binding])]
allPairs
lookupKeyConfigBindings :: (Ord k) => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings :: forall k. Ord k => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig k
kc k
e = k -> [(k, BindingState)] -> Maybe BindingState
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup k
e ([(k, BindingState)] -> Maybe BindingState)
-> [(k, BindingState)] -> Maybe BindingState
forall a b. (a -> b) -> a -> b
$ KeyConfig k -> [(k, BindingState)]
forall k. KeyConfig k -> [(k, BindingState)]
keyConfigCustomBindings KeyConfig k
kc
firstDefaultBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstDefaultBinding :: forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstDefaultBinding KeyConfig k
kc k
ev = do
[Binding]
bs <- k -> Map k [Binding] -> Maybe [Binding]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
ev (KeyConfig k -> Map k [Binding]
forall k. KeyConfig k -> Map k [Binding]
keyConfigDefaultBindings KeyConfig k
kc)
case [Binding]
bs of
(Binding
b:[Binding]
_) -> Binding -> Maybe Binding
forall a. a -> Maybe a
Just Binding
b
[Binding]
_ -> Maybe Binding
forall a. Maybe a
Nothing
allDefaultBindings :: (Ord k) => KeyConfig k -> k -> [Binding]
allDefaultBindings :: forall k. Ord k => KeyConfig k -> k -> [Binding]
allDefaultBindings KeyConfig k
kc k
ev =
[Binding] -> Maybe [Binding] -> [Binding]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Binding] -> [Binding]) -> Maybe [Binding] -> [Binding]
forall a b. (a -> b) -> a -> b
$ k -> Map k [Binding] -> Maybe [Binding]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
ev (KeyConfig k -> Map k [Binding]
forall k. KeyConfig k -> Map k [Binding]
keyConfigDefaultBindings KeyConfig k
kc)
firstActiveBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding :: forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig k
kc k
ev = [Binding] -> Maybe Binding
forall a. [a] -> Maybe a
listToMaybe ([Binding] -> Maybe Binding) -> [Binding] -> Maybe Binding
forall a b. (a -> b) -> a -> b
$ KeyConfig k -> k -> [Binding]
forall k. (Show k, Ord k) => KeyConfig k -> k -> [Binding]
allActiveBindings KeyConfig k
kc k
ev
allActiveBindings :: (Show k, Ord k) => KeyConfig k -> k -> [Binding]
allActiveBindings :: forall k. (Show k, Ord k) => KeyConfig k -> k -> [Binding]
allActiveBindings KeyConfig k
kc k
ev = [Binding] -> [Binding]
forall a. Eq a => [a] -> [a]
nub [Binding]
foundBindings
where
defaultBindings :: [Binding]
defaultBindings = KeyConfig k -> k -> [Binding]
forall k. Ord k => KeyConfig k -> k -> [Binding]
allDefaultBindings KeyConfig k
kc k
ev
foundBindings :: [Binding]
foundBindings = case KeyConfig k -> k -> Maybe BindingState
forall k. Ord k => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig k
kc k
ev of
Just (BindingList [Binding]
bs) -> [Binding]
bs
Just BindingState
Unbound -> []
Maybe BindingState
Nothing -> [Binding]
defaultBindings
class ToBinding a where
bind :: a -> Binding
instance ToBinding Vty.Key where
bind :: Key -> Binding
bind Key
k = Binding { kbMods :: Set Modifier
kbMods = Set Modifier
forall a. Monoid a => a
mempty, kbKey :: Key
kbKey = Key
k }
instance ToBinding Char where
bind :: Char -> Binding
bind = Key -> Binding
forall a. ToBinding a => a -> Binding
bind (Key -> Binding) -> (Char -> Key) -> Char -> Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Key
Vty.KChar
instance ToBinding Binding where
bind :: Binding -> Binding
bind = Binding -> Binding
forall a. a -> a
id
addModifier :: (ToBinding a) => Vty.Modifier -> a -> Binding
addModifier :: forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
m a
val =
let b :: Binding
b = a -> Binding
forall a. ToBinding a => a -> Binding
bind a
val
in Binding
b { kbMods = S.insert m (kbMods b) }
meta :: (ToBinding a) => a -> Binding
meta :: forall a. ToBinding a => a -> Binding
meta = Modifier -> a -> Binding
forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
Vty.MMeta
ctrl :: (ToBinding a) => a -> Binding
ctrl :: forall a. ToBinding a => a -> Binding
ctrl = Modifier -> a -> Binding
forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
Vty.MCtrl
shift :: (ToBinding a) => a -> Binding
shift :: forall a. ToBinding a => a -> Binding
shift = Modifier -> a -> Binding
forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
Vty.MShift
fn :: Int -> Binding
fn :: Int -> Binding
fn = Key -> Binding
forall a. ToBinding a => a -> Binding
bind (Key -> Binding) -> (Int -> Key) -> Int -> Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Key
Vty.KFun