-- | This is the entry point into the keybinding infrastructure in
-- this library. Note that usage of this API is not required to create
-- working Brick applications; this API is provided for applications
-- that need to support custom keybindings that are less tightly coupled
-- to application behavior.
--
-- The workflow for this API is as follows:
--
-- * Create a data type @k@ with a constructor for each abstract
--   application event that you want to trigger with an input key.
-- * To each event @k@, assign a unique user-readable name (such as a
--   name you could imagine using in a configuration file to refer to
--   the event) and a list of default key bindings.
-- * Use the resulting data to create a 'KeyConfig' with 'newKeyConfig'.
--   If desired, provide custom keybindings to 'newKeyConfig' from
--   within the program or load them from an INI file with routines like
--   'Brick.Keybindings.Parse.keybindingsFromFile'.
-- * Implement application event handlers that will be run in response
--   to either specific hard-coded keys or events @k@, both in some
--   monad @m@ of your choosing, using constructors 'onKey' and
--   'onEvent'.
-- * Use the created 'KeyConfig' and handlers to create a
--   'KeyDispatcher' with 'keyDispatcher'.
-- * As user input events arrive, dispatch them to the appropriate
--   handler using 'handleKey'.
module Brick.Keybindings.KeyDispatcher
  ( -- * Key dispatching
    KeyDispatcher
  , keyDispatcher
  , handleKey

  -- * Building handlers
  , onEvent
  , onKey

  -- * Handlers and triggers
  , Handler(..)
  , KeyHandler(..)
  , KeyEventHandler(..)
  , EventTrigger(..)

  -- * Misc
  , 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 Brick.Keybindings.KeyConfig

-- | A set of handlers for specific keys whose handlers run in the monad
-- @m@.
newtype KeyDispatcher k m = KeyDispatcher (M.Map Binding (KeyHandler k m))

-- | An 'Handler' represents a handler implementation to be invoked in
-- response to some event that runs in the monad @m@.
--
-- In general, you should never need to make one of these manually.
-- Instead, use 'onEvent' and 'onKey'. This type's internals are exposed
-- for easy inspection, not construction.
data Handler m =
    Handler { Handler m -> Text
handlerDescription :: T.Text
            -- ^ The description of this handler's behavior.
            , Handler m -> m ()
handlerAction :: m ()
            -- ^ The action to take when this handler is invoked.
            }

-- | A handler for a specific key.
--
-- In general, you should never need to create one of these. The
-- internals are exposed to make inspection easy.
data KeyHandler k m =
    KeyHandler { KeyHandler k m -> KeyEventHandler k m
khHandler :: KeyEventHandler k m
               -- ^ The handler to invoke. Note that this maintains
               -- the original abstract key event handler; this allows
               -- us to obtain the original 'EventTrigger' for the
               -- 'KeyEventHandler' upon which this 'KeyHandler'
               -- is built. This can be important for keybinding
               -- consistency checks or collision checks as well as help
               -- text generation.
               , KeyHandler k m -> Binding
khBinding :: Binding
               -- ^ The specific key binding that should trigger this
               -- handler.
               }

-- | Find the key handler that matches a Vty key event, if any. Modifier
-- order is unimportant since the lookup for a matching binding ignores
-- modifier order.
--
-- This works by looking up an event handler whose binding is the
-- specified key and modifiers based on the 'KeyConfig' that was used to
-- build the 'KeyDispatcher'.
--
-- Ordinarily you will not need to use this function; use 'handleKey'
-- instead. This is provided for more direct access to the
-- 'KeyDispatcher' internals.
lookupVtyEvent :: Vty.Key -> [Vty.Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
lookupVtyEvent :: 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

-- | Handle a keyboard event by looking it up in the 'KeyDispatcher'
-- and invoking the matching binding's handler if one is found. Return
-- @True@ if the a matching handler was found and run; return @False@ if
-- no matching binding was found.
handleKey :: (Monad m)
          => KeyDispatcher k m
          -- ^ The dispatcher to use.
          -> Vty.Key
          -- ^ The key to handle.
          -> [Vty.Modifier]
          -- ^ The modifiers for the key, if any.
          -> m Bool
handleKey :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Maybe (KeyHandler k m)
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Build a 'KeyDispatcher' to dispatch keys to handle events of type
-- @k@ using actions in a Monad @m@.
--
-- This works by taking a list of abstract 'KeyEventHandler's and
-- building a 'KeyDispatcher' of event handlers based on specific Vty
-- keys using the provided 'KeyConfig' to map between abstract key
-- events of type @k@ and Vty keys. Event handlers triggered by an event
-- @k@ are set up to be triggered by either the customized bindings for
-- @k@ in the 'KeyConfig', no bindings at all if the 'KeyConfig' has
-- marked @k@ as 'Unbound', or the default bindings for @k@ otherwise.
--
-- Once you have a 'KeyDispatcher', you can dispatch an input key event
-- to it and invoke the corresponding handler (if any) with 'handleKey'.
keyDispatcher :: (Ord k)
              => KeyConfig k
              -> [KeyEventHandler k m]
              -> KeyDispatcher k m
keyDispatcher :: KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
keyDispatcher KeyConfig k
conf [KeyEventHandler k m]
ks = 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)] -> Map Binding (KeyHandler k m))
-> [(Binding, KeyHandler k m)] -> Map Binding (KeyHandler k m)
forall a b. (a -> b) -> a -> b
$ [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

-- | Convert a key dispatcher to a list of pairs of bindings and their
-- handlers.
keyDispatcherToList :: KeyDispatcher k m
                    -> [(Binding, KeyHandler k m)]
keyDispatcherToList :: 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 :: [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 = [[KeyHandler k m]] -> [KeyHandler k m]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KeyHandler k m]] -> [KeyHandler k m])
-> [[KeyHandler k m]] -> [KeyHandler k m]
forall a b. (a -> b) -> a -> b
$ 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 -> [KeyHandler k m])
-> [KeyEventHandler k m] -> [[KeyHandler k m]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyEventHandler k m]
ks

keyHandlersFromConfig :: (Ord k)
                      => KeyConfig k
                      -> KeyEventHandler k m
                      -> [KeyHandler k m]
keyHandlersFromConfig :: 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 :: forall k (m :: * -> *).
KeyEventHandler k m -> Binding -> KeyHandler k m
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 :: Text -> m () -> Handler m
mkHandler Text
msg m ()
action =
    Handler :: forall (m :: * -> *). Text -> m () -> Handler m
Handler { handlerDescription :: Text
handlerDescription = Text
msg
            , handlerAction :: m ()
handlerAction = m ()
action
            }

-- | Specify a handler for the specified key event.
onEvent :: k
        -- ^ The key event whose bindings should trigger this handler.
        -> T.Text
        -- ^ The description of the handler.
        -> m ()
        -- ^ The handler to invoke.
        -> KeyEventHandler k m
onEvent :: k -> Text -> m () -> KeyEventHandler k m
onEvent k
ev Text
msg m ()
action =
    KeyEventHandler :: forall k (m :: * -> *).
Handler m -> EventTrigger k -> KeyEventHandler k m
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
                    }

-- | Specify a handler for the specified key.
onKey :: (ToBinding a)
      => a
      -- ^ The binding that should trigger this handler.
      -> T.Text
      -- ^ The description of the handler.
      -> m ()
      -- ^ The handler to invoke.
      -> KeyEventHandler k m
onKey :: a -> Text -> m () -> KeyEventHandler k m
onKey a
b Text
msg m ()
action =
    KeyEventHandler :: forall k (m :: * -> *).
Handler m -> EventTrigger k -> KeyEventHandler k m
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
                    }

-- | A trigger for an event handler.
data EventTrigger k =
    ByKey Binding
    -- ^ The key event is always triggered by a specific key.
    | ByEvent k
    -- ^ The trigger is an abstract key event.
    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
showList :: [EventTrigger k] -> ShowS
$cshowList :: forall k. Show k => [EventTrigger k] -> ShowS
show :: EventTrigger k -> String
$cshow :: forall k. Show k => EventTrigger k -> String
showsPrec :: Int -> EventTrigger k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> 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
/= :: EventTrigger k -> EventTrigger k -> Bool
$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
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
min :: EventTrigger k -> EventTrigger k -> EventTrigger k
$cmin :: forall k.
Ord k =>
EventTrigger k -> EventTrigger k -> EventTrigger k
max :: EventTrigger k -> EventTrigger k -> EventTrigger k
$cmax :: forall k.
Ord k =>
EventTrigger k -> EventTrigger k -> EventTrigger k
>= :: 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
$c< :: forall k. Ord k => EventTrigger k -> EventTrigger k -> Bool
compare :: EventTrigger k -> EventTrigger k -> Ordering
$ccompare :: forall k. Ord k => EventTrigger k -> EventTrigger k -> Ordering
$cp1Ord :: forall k. Ord k => Eq (EventTrigger k)
Ord)

-- | A handler for an abstract key event.
--
-- In general, you should never need to create these manually. Instead,
-- use 'onEvent' and 'onKey'. The internals of this type are exposed to
-- allow inspection of handler data for e.g. custom help generation.
data KeyEventHandler k m =
    KeyEventHandler { KeyEventHandler k m -> Handler m
kehHandler :: Handler m
                    -- ^ The handler to invoke.
                    , KeyEventHandler k m -> EventTrigger k
kehEventTrigger :: EventTrigger k
                    -- ^ The trigger for the handler.
                    }