-- | This module provides 'KeyConfig' and associated functions. A
-- 'KeyConfig' is the basis for the custom keybinding system in this
-- library.
--
-- To get started, see 'newKeyConfig'. Once a 'KeyConfig' has been
-- constructed, see 'Brick.Keybindings.KeyHandlerMap.keyDispatcher'.
--
-- Since a key configuration can have keys bound to multiple events, it
-- is the application author's responsibility to check for collisions
-- since the nature of the collisions will depend on how the application
-- is implemented. To check for collisions, use the result of
-- 'keyEventMappings'.
module Brick.Keybindings.KeyConfig
  ( KeyConfig
  , newKeyConfig
  , BindingState(..)

  -- * Specifying bindings
  , Binding(..)
  , ToBinding(..)
  , binding
  , fn
  , meta
  , ctrl
  , shift

  -- * Querying KeyConfigs
  , firstDefaultBinding
  , firstActiveBinding
  , allDefaultBindings
  , allActiveBindings
  , keyEventMappings

  -- * Misc
  , 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

-- | A key binding.
--
-- The easiest way to express 'Binding's is to use the helper functions
-- in this module that work with instances of 'ToBinding', e.g.
--
-- @
-- let ctrlB = 'ctrl' \'b\'
--     shiftX = 'shift' \'x\'
--     ctrlMetaK = 'ctrl' $ 'meta' \'k\'
--     -- Or with Vty keys directly:
--     ctrlDown = 'ctrl' 'Graphics.Vty.Input.KDown'
-- @
data Binding =
    Binding { Binding -> Key
kbKey :: Vty.Key
            -- ^ The key itself.
            , Binding -> Set Modifier
kbMods :: S.Set Vty.Modifier
            -- ^ The set of modifiers.
            } deriving (Binding -> Binding -> Bool
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
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
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
Ord)

-- | Construct a 'Binding'. Modifier order is ignored.
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 = forall a. Ord a => [a] -> Set a
S.fromList [Modifier]
mods
            }

-- | An explicit configuration of key bindings for a key event.
data BindingState =
    BindingList [Binding]
    -- ^ Bind the event to the specified list of bindings.
    | Unbound
    -- ^ Disable all bindings for the event, including default bindings.
    deriving (Int -> BindingState -> ShowS
[BindingState] -> ShowS
BindingState -> String
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
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
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
Ord)

-- | A configuration of custom key bindings. A 'KeyConfig'
-- stores everything needed to resolve a key event into one or
-- more key bindings. Make a 'KeyConfig' with 'newKeyConfig',
-- then use it to dispatch to 'KeyEventHandler's with
-- 'Brick.Keybindings.KeyHandlerMap.keyDispatcher'.
--
-- Make a new 'KeyConfig' with 'newKeyConfig'.
--
-- A 'KeyConfig' stores:
--
-- * A collection of named key events, mapping the event type @k@ to
--   'Text' labels.
-- * For each event @k@, optionally store a list of default key bindings
--   for that event.
-- * An optional customized binding list for each event, setting the
--   event to either 'Unbound' or providing explicit overridden bindings
--   with 'BindingList'.
data KeyConfig k =
    KeyConfig { forall k. KeyConfig k -> [(k, BindingState)]
keyConfigCustomBindings :: [(k, BindingState)]
              -- ^ The list of custom binding states for events with
              -- custom bindings. We use a list to ensure that we
              -- preserve key bindings for keys that are mapped to more
              -- than one event. This may be valid or invalid depending
              -- on the events in question; whether those bindings
              -- constitute a collision is up to the application
              -- developer to check.
              , forall k. KeyConfig k -> KeyEvents k
keyConfigEvents :: KeyEvents k
              -- ^ The base mapping of events and their names that is
              -- used in this configuration.
              , forall k. KeyConfig k -> Map k [Binding]
keyConfigDefaultBindings :: M.Map k [Binding]
              -- ^ A mapping of events and their default key bindings,
              -- if any.
              }
              deriving (Int -> KeyConfig k -> ShowS
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
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)

-- | Build a 'KeyConfig' with the specified 'KeyEvents' event-to-name
-- mapping, list of default bindings by event, and list of custom
-- bindings by event.
newKeyConfig :: (Ord k)
             => KeyEvents k
             -- ^ The base mapping of key events and names to use.
             -> [(k, [Binding])]
             -- ^ Default bindings by key event, such as from a
             -- configuration file or embedded code. Optional on a
             -- per-event basis.
             -> [(k, BindingState)]
             -- ^ Custom bindings by key event, such as from a
             -- configuration file. Explicitly setting an event to
             -- 'Unbound' here has the effect of disabling its default
             -- bindings. Optional on a per-event basis. Note that this
             -- function does not check for collisions since it is up to
             -- the application to determine whether a key bound to more
             -- than one event constitutes a collision!
             -> 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 = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, [Binding])]
defaults
              }

-- | Return a list of mappings including each key bound to any event
-- combined with the list of events to which it is bound. This is useful
-- for identifying problematic key binding collisions. Since key binding
-- collisions cannot be determined in general, we leave it up to the
-- application author to determine which key-to-event bindings are
-- problematic.
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 = forall k a. Map k a -> [(k, a)]
M.toList Map Binding (Set k)
resultMap
    where
        -- Get all default bindings
        defaultBindings :: [(k, [Binding])]
defaultBindings = forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall k. KeyConfig k -> Map k [Binding]
keyConfigDefaultBindings KeyConfig k
kc
        -- Get all explicitly unbound events
        explicitlyUnboundEvents :: [k]
explicitlyUnboundEvents = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== BindingState
Unbound) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall k. KeyConfig k -> [(k, BindingState)]
keyConfigCustomBindings KeyConfig k
kc
        -- Remove explicitly unbound events from the default set of
        -- bindings
        defaultBindingsWithoutUnbound :: [(k, [Binding])]
defaultBindingsWithoutUnbound = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [k]
explicitlyUnboundEvents) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(k, [Binding])]
defaultBindings
        -- Now get customized binding lists
        customizedKeybindingLists :: [(k, [Binding])]
customizedKeybindingLists = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (forall k. KeyConfig k -> [(k, BindingState)]
keyConfigCustomBindings KeyConfig k
kc) forall a b. (a -> b) -> a -> b
$ \(k
k, BindingState
bState) -> do
            case BindingState
bState of
                BindingState
Unbound -> forall a. Maybe a
Nothing
                BindingList [Binding]
bs -> forall a. a -> Maybe a
Just (k
k, [Binding]
bs)
        -- Now build a map from binding to event list
        allPairs :: [(k, [Binding])]
allPairs = [(k, [Binding])]
defaultBindingsWithoutUnbound 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) =
            forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Ord a => Set a -> Set a -> Set a
S.union Map k (Set a)
m forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k
b, forall a. a -> Set a
S.singleton a
ev) | k
b <- [k]
bs]
        resultMap :: Map Binding (Set k)
resultMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {k} {a}.
(Ord k, Ord a) =>
Map k (Set a) -> (a, [k]) -> Map k (Set a)
addBindings forall a. Monoid a => a
mempty [(k, [Binding])]
allPairs

-- | Look up the binding state for the specified event. This returns
-- 'Nothing' when the event has no explicitly configured custom
-- 'BindingState'.
lookupKeyConfigBindings :: (Ord k) => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings :: forall k. Ord k => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig k
kc k
e = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup k
e forall a b. (a -> b) -> a -> b
$ forall k. KeyConfig k -> [(k, BindingState)]
keyConfigCustomBindings KeyConfig k
kc

-- | A convenience function to return the first result of
-- 'allDefaultBindings', if any.
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 <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
ev (forall k. KeyConfig k -> Map k [Binding]
keyConfigDefaultBindings KeyConfig k
kc)
    case [Binding]
bs of
        (Binding
b:[Binding]
_) -> forall a. a -> Maybe a
Just Binding
b
        [Binding]
_ -> forall a. Maybe a
Nothing

-- | Returns the list of default bindings for the specified event,
-- irrespective of whether the event has been explicitly configured with
-- other bindings or set to 'Unbound'.
allDefaultBindings :: (Ord k) => KeyConfig k -> k -> [Binding]
allDefaultBindings :: forall k. Ord k => KeyConfig k -> k -> [Binding]
allDefaultBindings KeyConfig k
kc k
ev =
    forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
ev (forall k. KeyConfig k -> Map k [Binding]
keyConfigDefaultBindings KeyConfig k
kc)

-- | A convenience function to return the first result of
-- 'allActiveBindings', if any.
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 = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall k. (Show k, Ord k) => KeyConfig k -> k -> [Binding]
allActiveBindings KeyConfig k
kc k
ev

-- | Return all active key bindings for the specified event. This
-- returns customized bindings if any have been set in the 'KeyConfig',
-- no bindings if the event has been explicitly set to 'Unbound', or the
-- default bindings if the event is absent from the customized bindings.
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 = forall a. Eq a => [a] -> [a]
nub [Binding]
foundBindings
    where
        defaultBindings :: [Binding]
defaultBindings = forall k. Ord k => KeyConfig k -> k -> [Binding]
allDefaultBindings KeyConfig k
kc k
ev
        foundBindings :: [Binding]
foundBindings = case 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

-- | The class of types that can form the basis of 'Binding's.
--
-- This is provided to make it easy to write and modify bindings in less
-- verbose ways.
class ToBinding a where
    -- | Binding constructor.
    bind :: a -> Binding

instance ToBinding Vty.Key where
    bind :: Key -> Binding
bind Key
k = Binding { kbMods :: Set Modifier
kbMods = forall a. Monoid a => a
mempty, kbKey :: Key
kbKey = Key
k }

instance ToBinding Char where
    bind :: Char -> Binding
bind = forall a. ToBinding a => a -> Binding
bind forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Key
Vty.KChar

instance ToBinding Binding where
    bind :: Binding -> Binding
bind = 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 = forall a. ToBinding a => a -> Binding
bind a
val
    in Binding
b { kbMods :: Set Modifier
kbMods = forall a. Ord a => a -> Set a -> Set a
S.insert Modifier
m (Binding -> Set Modifier
kbMods Binding
b) }

-- | Add Meta to a binding.
meta :: (ToBinding a) => a -> Binding
meta :: forall a. ToBinding a => a -> Binding
meta = forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
Vty.MMeta

-- | Add Ctrl to a binding.
ctrl :: (ToBinding a) => a -> Binding
ctrl :: forall a. ToBinding a => a -> Binding
ctrl = forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
Vty.MCtrl

-- | Add Shift to a binding.
shift :: (ToBinding a) => a -> Binding
shift :: forall a. ToBinding a => a -> Binding
shift = forall a. ToBinding a => Modifier -> a -> Binding
addModifier Modifier
Vty.MShift

-- | Function key binding.
fn :: Int -> Binding
fn :: Int -> Binding
fn = forall a. ToBinding a => a -> Binding
bind forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Key
Vty.KFun