mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-11-26 09:06:56 +03:00
KeyHandlerMap -> KeyDispatcher
This commit is contained in:
parent
2d5f1c4daa
commit
8249d1ea77
@ -91,7 +91,7 @@ library
|
|||||||
Brick.Keybindings
|
Brick.Keybindings
|
||||||
Brick.Keybindings.KeyConfig
|
Brick.Keybindings.KeyConfig
|
||||||
Brick.Keybindings.KeyEvents
|
Brick.Keybindings.KeyEvents
|
||||||
Brick.Keybindings.KeyHandlerMap
|
Brick.Keybindings.KeyDispatcher
|
||||||
Brick.Keybindings.Parse
|
Brick.Keybindings.Parse
|
||||||
Brick.Keybindings.Pretty
|
Brick.Keybindings.Pretty
|
||||||
Brick.Focus
|
Brick.Focus
|
||||||
|
@ -1,12 +1,12 @@
|
|||||||
module Brick.Keybindings
|
module Brick.Keybindings
|
||||||
( module Brick.Keybindings.KeyEvents
|
( module Brick.Keybindings.KeyEvents
|
||||||
, module Brick.Keybindings.KeyConfig
|
, module Brick.Keybindings.KeyConfig
|
||||||
, module Brick.Keybindings.KeyHandlerMap
|
, module Brick.Keybindings.KeyDispatcher
|
||||||
, module Brick.Keybindings.Pretty
|
, module Brick.Keybindings.Pretty
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Brick.Keybindings.KeyEvents
|
import Brick.Keybindings.KeyEvents
|
||||||
import Brick.Keybindings.KeyConfig
|
import Brick.Keybindings.KeyConfig
|
||||||
import Brick.Keybindings.KeyHandlerMap
|
import Brick.Keybindings.KeyDispatcher
|
||||||
import Brick.Keybindings.Pretty
|
import Brick.Keybindings.Pretty
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
module Brick.Keybindings.KeyHandlerMap
|
module Brick.Keybindings.KeyDispatcher
|
||||||
( KeyHandlerMap
|
( KeyDispatcher
|
||||||
, mkKeybindings
|
, mkKeybindings
|
||||||
, handleKeyboardEvent
|
, handleKeyboardEvent
|
||||||
|
|
||||||
@ -14,7 +14,7 @@ module Brick.Keybindings.KeyHandlerMap
|
|||||||
, onKey
|
, onKey
|
||||||
|
|
||||||
-- * Misc
|
-- * Misc
|
||||||
, keyHandlerMapToList
|
, keyDispatcherToList
|
||||||
, lookupVtyEvent
|
, lookupVtyEvent
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
@ -27,7 +27,7 @@ import Brick.Keybindings.KeyConfig
|
|||||||
|
|
||||||
-- | A set of handlers for specific keys whose handlers run in the monad
|
-- | A set of handlers for specific keys whose handlers run in the monad
|
||||||
-- @m@.
|
-- @m@.
|
||||||
newtype KeyHandlerMap e m = KeyHandlerMap (M.Map Binding (KeyHandler e m))
|
newtype KeyDispatcher e m = KeyDispatcher (M.Map Binding (KeyHandler e m))
|
||||||
|
|
||||||
-- | An 'Handler' represents a handler implementation to be invoked in
|
-- | An 'Handler' represents a handler implementation to be invoked in
|
||||||
-- response to some event that runs in the monad @m@.
|
-- response to some event that runs in the monad @m@.
|
||||||
@ -64,61 +64,60 @@ data KeyHandler e m =
|
|||||||
--
|
--
|
||||||
-- This works by looking up an event handler whose binding is the key
|
-- This works by looking up an event handler whose binding is the key
|
||||||
-- specified in the 'Vty.Event' based on the 'KeyConfig' that was used
|
-- specified in the 'Vty.Event' based on the 'KeyConfig' that was used
|
||||||
-- to build the 'KeyHandlerMap'.
|
-- to build the 'KeyDispatcher'.
|
||||||
--
|
--
|
||||||
-- Ordinarily you will not need to use this function; use
|
-- Ordinarily you will not need to use this function; use
|
||||||
-- 'handleKeyboardEvent' instead. This is provided for more direct
|
-- 'handleKeyboardEvent' instead. This is provided for more direct
|
||||||
-- access to the 'KeyHandlerMap' internals.
|
-- access to the 'KeyDispatcher' internals.
|
||||||
lookupVtyEvent :: Vty.Event -> KeyHandlerMap e m -> Maybe (KeyHandler e m)
|
lookupVtyEvent :: Vty.Event -> KeyDispatcher e m -> Maybe (KeyHandler e m)
|
||||||
lookupVtyEvent (Vty.EvKey k mods) (KeyHandlerMap m) = M.lookup (Binding k mods) m
|
lookupVtyEvent (Vty.EvKey k mods) (KeyDispatcher m) = M.lookup (Binding k mods) m
|
||||||
lookupVtyEvent _ _ = Nothing
|
lookupVtyEvent _ _ = Nothing
|
||||||
|
|
||||||
-- | Handle a keyboard event by looking it up in the 'KeyHandlerMap'
|
-- | Handle a keyboard event by looking it up in the 'KeyDispatcher'
|
||||||
-- and invoking the matching binding's handler if one is found. Return
|
-- 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
|
-- @True@ if the a matching handler was found and run; return @False@ if
|
||||||
-- no matching binding was found.
|
-- no matching binding was found.
|
||||||
handleKeyboardEvent :: (Monad m)
|
handleKeyboardEvent :: (Monad m)
|
||||||
=> KeyHandlerMap e m
|
=> KeyDispatcher e m
|
||||||
-- ^ The handler map to query for a handler for this
|
-- ^ The dispatcher to use for this event.
|
||||||
-- event.
|
|
||||||
-> Vty.Event
|
-> Vty.Event
|
||||||
-- ^ The event to handle.
|
-- ^ The event to handle.
|
||||||
-> m Bool
|
-> m Bool
|
||||||
handleKeyboardEvent handlerMap e = do
|
handleKeyboardEvent d e = do
|
||||||
case lookupVtyEvent e handlerMap of
|
case lookupVtyEvent e d of
|
||||||
Just kh -> (handlerAction $ kehHandler $ khHandler kh) >> return True
|
Just kh -> (handlerAction $ kehHandler $ khHandler kh) >> return True
|
||||||
Nothing -> return False
|
Nothing -> return False
|
||||||
|
|
||||||
-- | Build a 'KeyHandlerMap'.
|
-- | Build a 'KeyDispatcher'.
|
||||||
--
|
--
|
||||||
-- This works by taking a list of abstract 'KeyEventHandler's and
|
-- This works by taking a list of abstract 'KeyEventHandler's and
|
||||||
-- building a 'KeyHandlerMap' of event handlers based on specific Vty
|
-- building a 'KeyDispatcher' of event handlers based on specific Vty
|
||||||
-- keys using the provided 'KeyConfig' to map between abstract key
|
-- keys using the provided 'KeyConfig' to map between abstract key
|
||||||
-- events of type @e@ and Vty keys. Event handlers triggered by an event
|
-- events of type @e@ and Vty keys. Event handlers triggered by an event
|
||||||
-- @e@ are set up to be triggered by either the customized bindings for
|
-- @e@ are set up to be triggered by either the customized bindings for
|
||||||
-- @e@ in the 'KeyConfig', no bindings at all if the 'KeyConfig' has
|
-- @e@ in the 'KeyConfig', no bindings at all if the 'KeyConfig' has
|
||||||
-- marked @e@ as 'Unbound', or the default bindings for @e@ otherwise.
|
-- marked @e@ as 'Unbound', or the default bindings for @e@ otherwise.
|
||||||
--
|
--
|
||||||
-- Once you have a 'KeyHandlerMap', you can dispatch an input key
|
-- Once you have a 'KeyDispatcher', you can dispatch an input key
|
||||||
-- event to it and invoke the corresponding handler (if any) with
|
-- event to it and invoke the corresponding handler (if any) with
|
||||||
-- 'handleKeyboardEvent'.
|
-- 'handleKeyboardEvent'.
|
||||||
mkKeybindings :: (Ord e)
|
mkKeybindings :: (Ord e)
|
||||||
=> [KeyEventHandler e m]
|
=> [KeyEventHandler e m]
|
||||||
-> KeyConfig e
|
-> KeyConfig e
|
||||||
-> KeyHandlerMap e m
|
-> KeyDispatcher e m
|
||||||
mkKeybindings ks conf = KeyHandlerMap $ M.fromList $ buildKeyHandlerMapPairs ks conf
|
mkKeybindings ks conf = KeyDispatcher $ M.fromList $ buildKeyDispatcherPairs ks conf
|
||||||
|
|
||||||
-- | Convert a key handler map to a list of pairs of bindings and their
|
-- | Convert a key dispatcher to a list of pairs of bindings and their
|
||||||
-- handlers.
|
-- handlers.
|
||||||
keyHandlerMapToList :: KeyHandlerMap e m
|
keyDispatcherToList :: KeyDispatcher e m
|
||||||
-> [(Binding, KeyHandler e m)]
|
-> [(Binding, KeyHandler e m)]
|
||||||
keyHandlerMapToList (KeyHandlerMap m) = M.toList m
|
keyDispatcherToList (KeyDispatcher m) = M.toList m
|
||||||
|
|
||||||
buildKeyHandlerMapPairs :: (Ord e)
|
buildKeyDispatcherPairs :: (Ord e)
|
||||||
=> [KeyEventHandler e m]
|
=> [KeyEventHandler e m]
|
||||||
-> KeyConfig e
|
-> KeyConfig e
|
||||||
-> [(Binding, KeyHandler e m)]
|
-> [(Binding, KeyHandler e m)]
|
||||||
buildKeyHandlerMapPairs ks conf = pairs
|
buildKeyDispatcherPairs ks conf = pairs
|
||||||
where
|
where
|
||||||
pairs = mkPair <$> handlers
|
pairs = mkPair <$> handlers
|
||||||
mkPair h = (khBinding h, h)
|
mkPair h = (khBinding h, h)
|
@ -22,7 +22,7 @@ import qualified Graphics.Vty as Vty
|
|||||||
|
|
||||||
import Brick.Keybindings.KeyEvents
|
import Brick.Keybindings.KeyEvents
|
||||||
import Brick.Keybindings.KeyConfig
|
import Brick.Keybindings.KeyConfig
|
||||||
import Brick.Keybindings.KeyHandlerMap
|
import Brick.Keybindings.KeyDispatcher
|
||||||
|
|
||||||
data TextHunk = Verbatim T.Text
|
data TextHunk = Verbatim T.Text
|
||||||
| Comment T.Text
|
| Comment T.Text
|
||||||
|
Loading…
Reference in New Issue
Block a user