-- | 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'.
module Brick.Keybindings.KeyConfig
  ( KeyConfig
  , newKeyConfig
  , BindingState(..)

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

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

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

-- | 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
(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)

-- | Construct a 'Binding'. Modifier order is ignored.
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
            }

-- | 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
(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)

-- | 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 { KeyConfig k -> Map k BindingState
keyConfigBindingMap :: M.Map k BindingState
              -- ^ The map of custom bindings for events with custom
              -- bindings.
              , KeyConfig k -> KeyEvents k
keyConfigEvents :: KeyEvents k
              -- ^ The base mapping of events and their names that is
              -- used in this configuration.
              , 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
[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)

-- | 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.
             -> 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
              }

-- | 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 :: 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

-- | A convenience function to return the first result of
-- 'allDefaultBindings', if any.
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

-- | 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 :: 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)

-- | A convenience function to return the first result of
-- 'allActiveBindings', if any.
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

-- | 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 :: 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

-- | 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 :: 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) }

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

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

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

-- | Function key binding.
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