module Brick.Keybindings.KeyConfig
( KeyConfig
, newKeyConfig
, BindingState(..)
, Binding(..)
, ToBinding(..)
, binding
, fn
, meta
, ctrl
, shift
, firstDefaultBinding
, firstActiveBinding
, allDefaultBindings
, allActiveBindings
, keyConfigEvents
, lookupKeyConfigBindings
)
where
import Data.List (nub)
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Maybe (fromMaybe, listToMaybe)
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
/= :: 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)
binding :: Vty.Key -> [Vty.Modifier] -> Binding
binding :: Key -> [Modifier] -> Binding
binding Key
k [Modifier]
mods =
Binding :: Key -> Set Modifier -> Binding
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
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)
data KeyConfig k =
KeyConfig { KeyConfig k -> Map k BindingState
keyConfigBindingMap :: M.Map k BindingState
, KeyConfig k -> KeyEvents k
keyConfigEvents :: KeyEvents 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
showList :: [KeyConfig k] -> ShowS
$cshowList :: forall k. Show k => [KeyConfig k] -> ShowS
show :: KeyConfig k -> String
$cshow :: forall k. Show k => KeyConfig k -> String
showsPrec :: Int -> KeyConfig k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> 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
/= :: KeyConfig k -> KeyConfig k -> Bool
$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
Eq)
newKeyConfig :: (Ord k)
=> KeyEvents k
-> [(k, [Binding])]
-> [(k, BindingState)]
-> KeyConfig k
newKeyConfig :: KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents k
evs [(k, [Binding])]
defaults [(k, BindingState)]
bindings =
KeyConfig :: forall k.
Map k BindingState -> KeyEvents k -> Map k [Binding] -> KeyConfig k
KeyConfig { keyConfigBindingMap :: Map k BindingState
keyConfigBindingMap = [(k, BindingState)] -> Map k BindingState
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(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
}
lookupKeyConfigBindings :: (Ord k) => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings :: KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig k
kc k
e = k -> Map k BindingState -> Maybe BindingState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
e (Map k BindingState -> Maybe BindingState)
-> Map k BindingState -> Maybe BindingState
forall a b. (a -> b) -> a -> b
$ KeyConfig k -> Map k BindingState
forall k. KeyConfig k -> Map k BindingState
keyConfigBindingMap KeyConfig k
kc
firstDefaultBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstDefaultBinding :: 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 :: 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 :: 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 :: 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 :: Key -> Set Modifier -> Binding
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 :: 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 :: Set Modifier
kbMods = Modifier -> Set Modifier -> Set Modifier
forall a. Ord a => a -> Set a -> Set a
S.insert Modifier
m (Binding -> Set Modifier
kbMods Binding
b) }
meta :: (ToBinding a) => a -> Binding
meta :: a -> Binding
meta = Modifier -> a -> Binding
forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
Vty.MMeta
ctrl :: (ToBinding a) => a -> Binding
ctrl :: a -> Binding
ctrl = Modifier -> a -> Binding
forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
Vty.MCtrl
shift :: (ToBinding a) => a -> Binding
shift :: 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