diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,26 @@ Brick changelog --------------- +1.1 +--- + +API changes: +* `keyDispatcher` now returns `Either` to fail with collision + information if collisions are detected due to overloaded keybindings. + This fixes a critical problem in `KeyDispatcher` where it would + previously silently ignore all but one handler for a specified key + if the key configuration resulted in the same key being mapped to + multiple handlers (either by event or by statically specified key). +* Added `Brick.Keybindings.KeyConfig.keyEventMappings` to allow + applications to check for colliding bindings at the key configuration + level. + +Other changes: +* The User Guide got a new subsection on keybinding collisions. +* `programs/CustomKeybindingDemo.hs` got additional code to demonstrate + how to check for and deal with keybinding collisions. +* `FileBrowser` got a `Named` instance. + 1.0 --- @@ -80,6 +100,8 @@ * `Brick.Widgets.List` got `listSelectedElementL`, a traversal for accessing the currently selected element of a list. (Thanks Fraser Tweedale) +* The `MonadFail` derived instance for `EventM` was removed for GHC >= + 8.8. 0.73 ---- diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 1.0 +version: 1.1 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You @@ -155,6 +155,7 @@ brick, text, vty, + containers, microlens, microlens-mtl, microlens-th diff --git a/docs/guide.rst b/docs/guide.rst --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1687,6 +1687,87 @@ | | | handler is run. | +---------------------+------------------------+-------------------------+ +Keybinding Collisions +--------------------- + +An important issue to consider in using the custom keybinding API is +that it is possible for the user to map the same key to more than one +event. We refer to this situation as a *keybinding collision*. Whether +the collision represents a problem depends on how the events in question +are going to be handled by the application. This section provides an +example scenario and describes a way to deal with this situation. + +Suppose an application has two key events: + +.. code:: haskell + + data KeyEvent = QuitEvent + | CloseWindowEvent + + allKeyEvents :: KeyEvents KeyEvent + allKeyEvents = + K.keyEvents [ ("quit", QuitEvent) + , ("close-window", CloseWindowEvent) + ] + + defaultBindings :: [(KeyEvent, [Binding])] + defaultBindings = + [ (QuitEvent, [ctrl 'q']) + , (CloseWindowEvent, [bind KEsc]) + ] + +Suppose also that the application using the above key events has a +feature that opens a window, and that ``CloseWindowEvent`` is used to +close the window, while ``QuitEvent`` is used to quit the application. + +A user might then provide a custom INI file to rebind keys as follows:: + + [keybindings] + quit = Esc + close-window = Esc + +While this is a valid configuration for the user to provide, it would +result in a keybinding collision for ``Esc`` since it is now bound +to two events. Whether that's a problem depends entirely on how +``QuitEvent`` and ``CloseWindowEvent`` are handled: + +* If the application handles both events in the same event handler, + the ``KeyDispatcher`` for those events would fail to construct since + ``Esc`` maps to more than one event. Building a ``KeyDispatcher`` + from a ``KeyConfig`` with such a collision would fail and return + information about the collisions. +* If the application handles the two events in different dispatchers + then the collision has no effect and is not a problem since different + ``KeyDispatcher`` values would be constructed to handle the events + separately. This could happen, for instance, if the application only + ever handled ``CloseWindowEvent`` when the window in question was + open and only handled ``QuitEvent`` when the window had been closed. + This kind of "modal" approach to handling events means that we only + consider a key to have a collision if it is bound to two or more + events that are handled in the same event handler. + +There's also another situation that would be problematic, which is when +an abstract event like ``QuitEvent`` has a key mapping that +collides with a key handler that is bound to a specific key using +``Brick.Keybindings.KeyDispatcher.onKey`` rather than an event: + +.. code:: haskell + + K.onKey (K.bind '\t') "Increment the counter by 10" $ + counter %= (+ 10) + +If ``onKey`` is used, the handler it creates is only triggered by the +specified key (``Tab`` in the example above). But the handler may be +included alongside handlers in the same dispatcher that are *also* +triggered by ``Tab``, so if those event handlers were provided together +when creating a ``KeyDispatcher`` then it would fail to construct due to +the collision. + +Brick provides ``Brick.Keybindings.KeyConfig.keyEventMappings`` to help +finding collisions at the key configuration level. Finding out about +collisions at the dispatcher level is possible by handling the failure +case when calling ``Brick.Keybindings.KeyDispatcher.keyDispatcher``. + Joining Borders =============== diff --git a/programs/CustomKeybindingDemo.hs b/programs/CustomKeybindingDemo.hs --- a/programs/CustomKeybindingDemo.hs +++ b/programs/CustomKeybindingDemo.hs @@ -6,7 +6,9 @@ import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl ((<~), (.=), (%=), use) -import Control.Monad (void) +import Control.Monad (void, forM_, when) +import qualified Data.Set as S +import Data.Maybe (fromJust) import qualified Data.Text as Text import qualified Data.Text.IO as Text #if !(MIN_VERSION_base(4,11,0)) @@ -60,6 +62,8 @@ , _customBindingsPath :: Maybe FilePath -- ^ Set if the application found custom keybindings in the -- specified file. + , _dispatcher :: K.KeyDispatcher KeyEvent (T.EventM () St) + -- ^ The key dispatcher we'll use to dispatch input events. } makeLenses ''St @@ -90,8 +94,7 @@ -- Dispatch the key to the event handler to which the key is mapped, -- if any. Also record in lastKeyHandled whether the dispatcher -- found a matching handler. - kc <- use keyConfig - let d = K.keyDispatcher kc handlers + d <- use dispatcher lastKey .= Just (k, mods) lastKeyHandled <~ K.handleKey d k mods appEvent _ = @@ -187,11 +190,52 @@ -- the custom bindings we loaded from the INI file, if any. let kc = K.newKeyConfig allKeyEvents defaultBindings customBindings + -- Before starting the application, check on whether any events have + -- colliding bindings. Exit if so. + -- + -- Note that in a Real Application, we would more than likely + -- want to check for collisions among specific sets of + -- events. For example, if 'Esc' was bound to both 'quit' and + -- 'close-dialog-box', we might not care about such a collision + -- if the application only ever handled the 'close-dialog-box' + -- event in a separate mode and only ever handled 'quit' at the + -- top-level of the event handler. But if we had two events such as + -- 'dialog-box-okay' and 'dialog-box-cancel' that were intended to + -- be handled in the same mode, we might want to check that those + -- two events did not have the same binding. + forM_ (K.keyEventMappings kc) $ \(b, evs) -> do + when (S.size evs > 1) $ do + Text.putStrLn $ "Error: key '" <> K.ppBinding b <> "' is bound to multiple events:" + forM_ evs $ \e -> + Text.putStrLn $ " " <> Text.pack (show e) <> " (" <> fromJust (K.keyEventName allKeyEvents e) <> ")" + exitFailure + + -- Now build a key dispatcher for our event handlers. If this fails + -- due to key collision detection, we'll print out info about the + -- collisions. + d <- case K.keyDispatcher kc handlers of + Right d -> return d + Left collisions -> do + putStrLn "Error: some key events have the same keys bound to them." + + forM_ collisions $ \(b, hs) -> do + Text.putStrLn $ "Handlers with the '" <> K.ppBinding b <> "' binding:" + forM_ hs $ \h -> do + let trigger = case K.kehEventTrigger $ K.khHandler h of + K.ByKey k -> "triggered by the key '" <> K.ppBinding k <> "'" + K.ByEvent e -> "triggered by the event '" <> fromJust (K.keyEventName allKeyEvents e) <> "'" + desc = K.handlerDescription $ K.kehHandler $ K.khHandler h + + Text.putStrLn $ " " <> desc <> " (" <> trigger <> ")" + + exitFailure + void $ M.defaultMain app $ St { _keyConfig = kc , _lastKey = Nothing , _lastKeyHandled = False , _counter = 0 , _customBindingsPath = customFile + , _dispatcher = d } -- Now demonstrate how the library's generated key binding help text diff --git a/src/Brick/Keybindings/KeyConfig.hs b/src/Brick/Keybindings/KeyConfig.hs --- a/src/Brick/Keybindings/KeyConfig.hs +++ b/src/Brick/Keybindings/KeyConfig.hs @@ -4,6 +4,12 @@ -- -- 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 @@ -23,6 +29,7 @@ , firstActiveBinding , allDefaultBindings , allActiveBindings + , keyEventMappings -- * Misc , keyConfigEvents @@ -32,8 +39,11 @@ 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) +import Data.Maybe (fromMaybe, listToMaybe, catMaybes) import qualified Graphics.Vty as Vty import Brick.Keybindings.KeyEvents @@ -90,9 +100,14 @@ -- event to either 'Unbound' or providing explicit overridden bindings -- with 'BindingList'. data KeyConfig k = - KeyConfig { keyConfigBindingMap :: M.Map k BindingState - -- ^ The map of custom bindings for events with custom - -- bindings. + KeyConfig { 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. , keyConfigEvents :: KeyEvents k -- ^ The base mapping of events and their names that is -- used in this configuration. @@ -116,19 +131,50 @@ -- ^ 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. + -- 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 evs defaults bindings = - KeyConfig { keyConfigBindingMap = M.fromList bindings + KeyConfig { keyConfigCustomBindings = bindings , keyConfigEvents = evs , keyConfigDefaultBindings = M.fromList 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 kc = M.toList resultMap + where + -- Get all default bindings + defaultBindings = M.toList $ keyConfigDefaultBindings kc + -- Get all explicitly unbound events + explicitlyUnboundEvents = fmap fst $ filter ((== Unbound) . snd) $ keyConfigCustomBindings kc + -- Remove explicitly unbound events from the default set of + -- bindings + defaultBindingsWithoutUnbound = filter ((`notElem` explicitlyUnboundEvents) . fst) defaultBindings + -- Now get customized binding lists + customizedKeybindingLists = catMaybes $ (flip fmap) (keyConfigCustomBindings kc) $ \(k, bState) -> do + case bState of + Unbound -> Nothing + BindingList bs -> Just (k, bs) + -- Now build a map from binding to event list + allPairs = defaultBindingsWithoutUnbound <> + customizedKeybindingLists + addBindings m (ev, bs) = + M.unionWith S.union m $ M.fromList [(b, S.singleton ev) | b <- bs] + resultMap = foldl addBindings mempty 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 kc e = M.lookup e $ keyConfigBindingMap kc +lookupKeyConfigBindings kc e = lookup e $ keyConfigCustomBindings kc -- | A convenience function to return the first result of -- 'allDefaultBindings', if any. diff --git a/src/Brick/Keybindings/KeyDispatcher.hs b/src/Brick/Keybindings/KeyDispatcher.hs --- a/src/Brick/Keybindings/KeyDispatcher.hs +++ b/src/Brick/Keybindings/KeyDispatcher.hs @@ -15,14 +15,17 @@ -- 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'. +-- 'KeyDispatcher' with 'keyDispatcher', dealing with collisions if +-- they arise. -- * As user input events arrive, dispatch them to the appropriate --- handler using 'handleKey'. +-- handler in the dispatcher using 'handleKey'. module Brick.Keybindings.KeyDispatcher ( -- * Key dispatching KeyDispatcher @@ -49,14 +52,16 @@ 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 set of handlers for specific keys whose handlers run in the monad --- @m@. +-- | 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)) --- | An 'Handler' represents a handler implementation to be invoked in +-- | 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. @@ -71,8 +76,8 @@ -- | 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. +-- 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 { khHandler :: KeyEventHandler k m -- ^ The handler to invoke. Note that this maintains @@ -119,7 +124,13 @@ Nothing -> return False -- | Build a 'KeyDispatcher' to dispatch keys to handle events of type --- @k@ using actions in a Monad @m@. +-- @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 @@ -134,8 +145,18 @@ keyDispatcher :: (Ord k) => KeyConfig k -> [KeyEventHandler k m] - -> KeyDispatcher k m -keyDispatcher conf ks = KeyDispatcher $ M.fromList $ buildKeyDispatcherPairs ks conf + -> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m) +keyDispatcher conf ks = + let pairs = buildKeyDispatcherPairs ks conf + groups = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) pairs + badGroups = filter ((> 1) . length) groups + combine :: [(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m]) + combine as = + let b = fst $ head as + in (b, snd <$> as) + in if null badGroups + then Right $ KeyDispatcher $ M.fromList pairs + else Left $ combine <$> badGroups -- | Convert a key dispatcher to a list of pairs of bindings and their -- handlers. diff --git a/src/Brick/Main.hs b/src/Brick/Main.hs --- a/src/Brick/Main.hs +++ b/src/Brick/Main.hs @@ -110,11 +110,8 @@ -- application state is what you probably want to use to decide -- which one wins. , appHandleEvent :: BrickEvent n e -> EventM n s () - -- ^ This function takes the current application state and an - -- event and returns an action to be taken and a corresponding - -- transformed application state. Possible options are - -- 'continue', 'continueWithoutRedraw', 'suspendAndResume', and - -- 'halt'. + -- ^ This function handles an event and updates the current + -- application state. , appStartEvent :: EventM n s () -- ^ This function gets called once just prior to the first -- drawing of your application. Here is where you can make @@ -588,10 +585,11 @@ -- state without redrawing the screen. This is faster than 'continue' -- because it skips the redraw, but the drawback is that you need to -- be really sure that you don't want a screen redraw. If your state --- changed in a way that needs to be reflected on the screen, use --- 'continue'. This function is for cases where you know that you did --- something that won't have an impact on the screen state and you want --- to save on redraw cost. +-- changed in a way that needs to be reflected on the screen, just don't +-- call this; 'EventM' blocks default to triggering redraws when they +-- finish executing. This function is for cases where you know that you +-- did something that won't have an impact on the screen state and you +-- want to save on redraw cost. continueWithoutRedraw :: EventM n s () continueWithoutRedraw = EventM $ lift $ lift $ modify $ \es -> es { nextAction = ContinueWithoutRedraw } diff --git a/src/Brick/Widgets/FileBrowser.hs b/src/Brick/Widgets/FileBrowser.hs --- a/src/Brick/Widgets/FileBrowser.hs +++ b/src/Brick/Widgets/FileBrowser.hs @@ -3,6 +3,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} -- | This module provides a file browser widget that allows users to -- navigate directory trees, search for files and directories, and -- select entries of interest. For a complete working demonstration of @@ -198,6 +200,9 @@ -- Note that this is a record field so it can be used to -- change the selection function. } + +instance Named (FileBrowser n) n where + getName = getName . fileBrowserEntries -- | File status information. data FileStatus =