-- | 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'.
-- * Optionally check for configuration-wide keybinding collisions with
--   'Brick.Keybindings.KeyConfig.keyEventMappings'.
-- * 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', dealing with collisions if
--   they arise.
-- * As user input events arrive, dispatch them to the appropriate
--   handler in the dispatcher 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 Data.Function (on)
import Data.List (groupBy, sortBy)

import Brick.Keybindings.KeyConfig

-- | A dispatcher keys that map to abstract events @k@ and whose
-- handlers run in the monad @m@.
newtype KeyDispatcher k m = KeyDispatcher (M.Map Binding (KeyHandler k m))

-- | A '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 { forall (m :: * -> *). Handler m -> Text
handlerDescription :: T.Text
            -- ^ The description of this handler's behavior.
            , forall (m :: * -> *). 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 manually.
-- The internals are exposed to make inspection easy.
data KeyHandler k m =
    KeyHandler { forall k (m :: * -> *). 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.
               , forall k (m :: * -> *). 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 :: forall k (m :: * -> *).
Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
lookupVtyEvent Key
k [Modifier]
mods (KeyDispatcher Map Binding (KeyHandler k m)
m) = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Key -> Set Modifier -> Binding
Binding Key
k forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
handleKey KeyDispatcher k m
d Key
k [Modifier]
mods = do
    case 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 -> (forall (m :: * -> *). Handler m -> m ()
handlerAction forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *). KeyEventHandler k m -> Handler m
kehHandler forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *). KeyHandler k m -> KeyEventHandler k m
khHandler KeyHandler k m
kh) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Maybe (KeyHandler k m)
Nothing -> 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@. If any collisions are detected,
-- this fails with 'Left' and returns the list of colliding event
-- handlers for each overloaded binding. (Each returned 'KeyHandler'
-- contains the original 'KeyEventHandler' that was used to build it so
-- those can be inspected to understand which handlers are mapped to the
-- same key, either via an abstract key event using 'onEvent' or via a
-- statically configured key using 'onKey'.)
--
-- 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]
              -> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
keyDispatcher :: forall k (m :: * -> *).
Ord k =>
KeyConfig k
-> [KeyEventHandler k m]
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
keyDispatcher KeyConfig k
conf [KeyEventHandler k m]
ks =
    let pairs :: [(Binding, KeyHandler k m)]
pairs = forall k (m :: * -> *).
Ord k =>
[KeyEventHandler k m] -> KeyConfig k -> [(Binding, KeyHandler k m)]
buildKeyDispatcherPairs [KeyEventHandler k m]
ks KeyConfig k
conf
        groups :: [[(Binding, KeyHandler k m)]]
groups = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) [(Binding, KeyHandler k m)]
pairs
        badGroups :: [[(Binding, KeyHandler k m)]]
badGroups = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[(Binding, KeyHandler k m)]]
groups
        combine :: [(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])
        combine :: forall k (m :: * -> *).
[(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])
combine [(Binding, KeyHandler k m)]
as =
            let b :: Binding
b = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Binding, KeyHandler k m)]
as
            in (Binding
b, forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Binding, KeyHandler k m)]
as)
    in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(Binding, KeyHandler k m)]]
badGroups
       then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *).
Map Binding (KeyHandler k m) -> KeyDispatcher k m
KeyDispatcher forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Binding, KeyHandler k m)]
pairs
       else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *).
[(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])
combine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(Binding, KeyHandler k m)]]
badGroups

-- | Convert a key dispatcher to a list of pairs of bindings and their
-- handlers.
keyDispatcherToList :: KeyDispatcher k m
                    -> [(Binding, KeyHandler k m)]
keyDispatcherToList :: forall k (m :: * -> *).
KeyDispatcher k m -> [(Binding, KeyHandler k m)]
keyDispatcherToList (KeyDispatcher Map Binding (KeyHandler k m)
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 :: forall k (m :: * -> *).
Ord k =>
[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 = forall {k} {m :: * -> *}.
KeyHandler k m -> (Binding, KeyHandler k m)
mkPair 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 = (forall k (m :: * -> *). KeyHandler k m -> Binding
khBinding KeyHandler k m
h, KeyHandler k m
h)
        handlers :: [KeyHandler k m]
handlers = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall k (m :: * -> *).
Ord k =>
KeyConfig k -> KeyEventHandler k m -> [KeyHandler k m]
keyHandlersFromConfig KeyConfig k
conf) [KeyEventHandler k m]
ks

keyHandlersFromConfig :: (Ord k)
                      => KeyConfig k
                      -> KeyEventHandler k m
                      -> [KeyHandler k m]
keyHandlersFromConfig :: forall k (m :: * -> *).
Ord k =>
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) <- forall k. Ord k => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig k
kc k
ev = [Binding]
ks
                          | Just BindingState
Unbound <- forall k. Ord k => KeyConfig k -> k -> Maybe BindingState
lookupKeyConfigBindings KeyConfig k
kc k
ev = []
                          | Bool
otherwise = forall k. Ord k => KeyConfig k -> k -> [Binding]
allDefaultBindings KeyConfig k
kc k
ev
        bindings :: [Binding]
bindings = case 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 { 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 :: forall (m :: * -> *). Text -> m () -> Handler m
mkHandler Text
msg m ()
action =
    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 :: forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent k
ev Text
msg m ()
action =
    KeyEventHandler { kehHandler :: Handler m
kehHandler = forall (m :: * -> *). Text -> m () -> Handler m
mkHandler Text
msg m ()
action
                    , kehEventTrigger :: EventTrigger k
kehEventTrigger = 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 :: forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey a
b Text
msg m ()
action =
    KeyEventHandler { kehHandler :: Handler m
kehHandler = forall (m :: * -> *). Text -> m () -> Handler m
mkHandler Text
msg m ()
action
                    , kehEventTrigger :: EventTrigger k
kehEventTrigger = forall k. Binding -> EventTrigger k
ByKey forall a b. (a -> b) -> a -> b
$ 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
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
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, EventTrigger k -> EventTrigger k -> Bool
EventTrigger k -> EventTrigger k -> Ordering
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
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 { forall k (m :: * -> *). KeyEventHandler k m -> Handler m
kehHandler :: Handler m
                    -- ^ The handler to invoke.
                    , forall k (m :: * -> *). KeyEventHandler k m -> EventTrigger k
kehEventTrigger :: EventTrigger k
                    -- ^ The trigger for the handler.
                    }