brick 0.73 → 1.0

raw patch · 49 files changed

+2664/−1680 lines, 49 filesdep +bimapdep +mtldep −transformersdep ~basedep ~microlensdep ~vtynew-component:exe:brick-custom-keybinding-demoPVP ok

version bump matches the API change (PVP)

Dependencies added: bimap, mtl

Dependencies removed: transformers

Dependency ranges changed: base, microlens, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +79/−0
• README.md +0/−1
• brick.cabal +57/−13
• docs/guide.rst +349/−220
• docs/samtay-tutorial.md +0/−546
• programs/AttrDemo.hs +15/−14
• programs/BorderDemo.hs +1/−1
• programs/CacheDemo.hs +12/−10
• programs/CroppingDemo.hs +2/−2
• programs/CustomEventDemo.hs +11/−11
• programs/CustomKeybindingDemo.hs +209/−0
• programs/DialogDemo.hs +7/−7
• programs/EditDemo.hs +15/−13
• programs/FileBrowserDemo.hs +17/−13
• programs/FormDemo.hs +9/−7
• programs/LayerDemo.hs +24/−23
• programs/ListDemo.hs +19/−16
• programs/ListViDemo.hs +19/−16
• programs/MouseDemo.hs +32/−31
• programs/PaddingDemo.hs +2/−2
• programs/ProgressBarDemo.hs +18/−13
• programs/SuspendAndResumeDemo.hs +9/−10
• programs/TailDemo.hs +35/−30
• programs/ThemeDemo.hs +10/−11
• programs/ViewportScrollDemo.hs +12/−12
• programs/ViewportScrollbarsDemo.hs +20/−14
• programs/VisibilityDemo.hs +15/−15
• programs/custom_keys.ini +4/−0
• src/Brick/AttrMap.hs +3/−10
• src/Brick/Forms.hs +85/−77
• src/Brick/Keybindings.hs +20/−0
• src/Brick/Keybindings/KeyConfig.hs +203/−0
• src/Brick/Keybindings/KeyDispatcher.hs +220/−0
• src/Brick/Keybindings/KeyEvents.hs +52/−0
• src/Brick/Keybindings/Parse.hs +181/−0
• src/Brick/Keybindings/Pretty.hs +249/−0
• src/Brick/Main.hs +144/−102
• src/Brick/Types.hs +51/−43
• src/Brick/Types/EventM.hs +45/−0
• src/Brick/Types/Internal.hs +39/−29
• src/Brick/Widgets/Border.hs +1/−1
• src/Brick/Widgets/Core.hs +20/−14
• src/Brick/Widgets/Dialog.hs +6/−6
• src/Brick/Widgets/Edit.hs +8/−7
• src/Brick/Widgets/FileBrowser.hs +100/−103
• src/Brick/Widgets/Internal.hs +2/−3
• src/Brick/Widgets/List.hs +69/−47
• src/Brick/Widgets/ProgressBar.hs +2/−2
• tests/List.hs +162/−185

@@ -2,6 +2,85 @@ Brick changelog --------------- +1.0+---++Version 1.0 of `brick` comes with some improvements that will require+you to update your programs. This section details the list of API+changes in 1.0 that are likely to introduce breakage and how to deal+with each one. You can also consult the demonstration+programs to see orking examples of the new API. For those+interested in a bit of discussion on the changes, see [this+ticket](https://github.com/jtdaugherty/brick/issues/379).++* The event-handling monad `EventM` was improved and changed in some+  substantial ways, all aimed at making `EventM` code cleaner, more+  composable, and more amenable to lens updates to the application+  state.+  * The type has changed from `EventM n a` to `EventM n s a` and is now+    an `mtl`-compatible state monad over `s`. Some consequences and+    related changes are:+    * Event handlers no longer take and return an explicit state value;+      an event handler that formerly had the type `handler :: s ->+      BrickEvent n e -> EventM n (Next s)` now has type `handler ::+      BrickEvent n e -> EventM n s ()`. This also affected all of+      Brick's built-in event handler functions for `List`, `Editor`,+      etc.+    * The `appHandleEvent` and `appStartEvent` fields of `App` changed+      types to reflect the new structure of `EventM`. `appStartEvent`+      will just be `return ()` rather than `return` for most+      applications.+    * `EventM` can be used with the `MonadState` API from `mtl` as well+      as with the very nice lens combinators in `microlens-mtl`.+    * The `Next` type was removed.+    * State-specific event handlers like `handleListEvent` and+      `handleEditorEvent` are now statically typed to be scoped to+      just the states they manage, so `zoom` from `microlens-mtl` must+      be used to invoke them. `Brick.Types` re-exports `zoom` for+      convenience. `handleEventLensed` was removed from the API in lieu+      of the new `zoom` behavior. Code that previously handled events+      with `handleEventLensed s someLens someHandler e` is now just+      written `zoom someLens $ someHandler e`.+    * If an `EventM` block needs to operate on some state `s` that is+      not accessible via a lens into the application state, the `EventM`+      block can be set up with `Brick.Types.nestEventM`.+  * Since `Next` was removed, control flow is now as follows:+    * Without any explicit specification, an `EventM` block always+      continues execution of the `brick` event loop when it finishes.+      `continue` was removed from the API. What was previously `continue+      $ s & someLens .~ value` will become `someLens .= value`.+    * `halt` is still used to indicate that the event loop should halt+      after the calling handler is finished, but `halt` no longer takes+      an explicit state value argument.+    * `suspendAndResume` is now immediate; previously,+      `suspendAndResume` indicated that the specified action should run+      once the event handler finished. Now, the event handler is paused+      while the specified action is run. This allows `EventM` code to+      continue to run after `suspendAndResume` is called and before+      control is returned to `brick`.+  * Brick now depends on `mtl` rather than `transformers`.+* The `IsString` instance for `AttrName` was removed.+  * This change is motivated by the API wart that resulted from the+    overloading of both `<>` and string literals (via+    `OverloadedStrings`) that resulted in code such as `someAttrName+    = "blah" <> "things"`. While that worked to create an `AttrName`+    with two segments, it was far too easy to read as two strings+    concatenated. The overloading hid what is really going on with the+    segments of the attribute name. The way to write the above example+    after this change is `someAttrName = attrName "blah" <> attrName+    "things"`.++Other changes in this release:++* Brick now provides an optional API for user-defined keybindings+  for applications! See the User Guide section "Customizable+  Keybindings", the Haddock for `Brick.Keybindings.KeyDispatcher`,+  and the new demo program `programs/CustomKeybindingDemo.hs` to get+  started.+* `Brick.Widgets.List` got `listSelectedElementL`, a traversal for+  accessing the currently selected element of a list. (Thanks Fraser+  Tweedale)+ 0.73 ---- 

@@ -119,7 +119,6 @@ Documentation for `brick` comes in a variety of forms:  * [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-* [Samuel Tay's brick tutorial](https://github.com/jtdaugherty/brick/blob/master/docs/samtay-tutorial.md) * Haddock (all modules) * [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs) ([Screenshots](https://github.com/jtdaugherty/brick/blob/master/docs/programs-screenshots.md)) * [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md)

@@ -1,5 +1,5 @@ name:                brick-version:             0.73+version:             1.0 synopsis:            A declarative terminal user interface library description:   Write terminal user interfaces (TUIs) painlessly with 'brick'! You@@ -42,9 +42,9 @@  extra-doc-files:     README.md,                      docs/guide.rst,-                     docs/samtay-tutorial.md,                      docs/snake-demo.gif,                      CHANGELOG.md,+                     programs/custom_keys.ini,                      docs/programs-screenshots.md,                      docs/programs-screenshots/brick-attr-demo.png,                      docs/programs-screenshots/brick-border-demo.png,@@ -88,6 +88,12 @@     Brick.AttrMap     Brick.BChan     Brick.BorderMap+    Brick.Keybindings+    Brick.Keybindings.KeyConfig+    Brick.Keybindings.KeyEvents+    Brick.Keybindings.KeyDispatcher+    Brick.Keybindings.Parse+    Brick.Keybindings.Pretty     Brick.Focus     Brick.Forms     Brick.Main@@ -108,12 +114,13 @@   other-modules:     Brick.Types.Common     Brick.Types.TH+    Brick.Types.EventM     Brick.Types.Internal     Brick.Widgets.Internal    build-depends:       base >= 4.9.0.0 && < 4.17.0.0,                        vty >= 5.36,-                       transformers,+                       bimap >= 0.5 && < 0.6,                        data-clist >= 0.1,                        directory >= 1.2.5.0,                        dlist,@@ -123,6 +130,7 @@                        microlens >= 0.3.0.0,                        microlens-th,                        microlens-mtl,+                       mtl,                        config-ini,                        vector,                        contravariant,@@ -135,6 +143,22 @@                        bytestring,                        word-wrap >= 0.2 +executable brick-custom-keybinding-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             CustomKeybindingDemo.hs+  build-depends:       base,+                       brick,+                       text,+                       vty,+                       microlens,+                       microlens-mtl,+                       microlens-th+ executable brick-table-demo   if !flag(demos)     Buildable: False@@ -160,7 +184,9 @@                        brick,                        text,                        vty,-                       random+                       random,+                       microlens-th,+                       microlens-mtl  executable brick-readme-demo   if !flag(demos)@@ -185,7 +211,8 @@   build-depends:       base,                        vty,                        brick,-                       text+                       text,+                       mtl  executable brick-form-demo   if !flag(demos)@@ -228,7 +255,8 @@                        vty,                        text,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       mtl  executable brick-visibility-demo   if !flag(demos)@@ -242,7 +270,8 @@                        vty,                        text,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl  executable brick-viewport-scrollbars-demo   if !flag(demos)@@ -256,7 +285,9 @@                        brick,                        vty,                        text,-                       microlens+                       microlens,+                       microlens-mtl,+                       microlens-th  executable brick-viewport-scroll-demo   if !flag(demos)@@ -298,7 +329,9 @@                        text,                        microlens >= 0.3.0.0,                        microlens-th,-                       text-zipper+                       microlens-mtl,+                       text-zipper,+                       mtl  executable brick-layer-demo   if !flag(demos)@@ -312,7 +345,8 @@                        vty,                        text,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl  executable brick-suspend-resume-demo   if !flag(demos)@@ -365,6 +399,7 @@                        brick,                        vty,                        text,+                       mtl,                        microlens  executable brick-attr-demo@@ -392,6 +427,8 @@                        vty,                        text,                        microlens >= 0.3.0.0,+                       microlens-mtl,+                       mtl,                        vector  executable brick-list-vi-demo@@ -406,6 +443,8 @@                        vty,                        text,                        microlens >= 0.3.0.0,+                       microlens-mtl,+                       mtl,                        vector  executable brick-custom-event-demo@@ -420,7 +459,8 @@                        vty,                        text,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl  executable brick-fill-demo   if !flag(demos)@@ -460,8 +500,10 @@                        vty,                        text,                        vector,+                       mtl,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl  executable brick-border-demo   if !flag(demos)@@ -503,7 +545,9 @@                        brick,                        vty,                        text,-                       microlens+                       microlens,+                       microlens-mtl,+                       microlens-th  test-suite brick-tests   type:                exitcode-stdio-1.0

@@ -68,16 +68,17 @@ documentation and as you explore the library source and write your own programs. -- Use of `microlens`_ packages: ``brick`` uses ``microlens`` family of-  packages internally and also exposes lenses for many types in the+- Use of `microlens`_ packages: ``brick`` uses the ``microlens`` family+  of packages internally and also exposes lenses for many types in the   library. However, if you prefer not to use the lens interface in your   program, all lens interfaces have non-lens equivalents exported by   the same module. In general, the "``L``" suffix on something tells   you it is a lens; the name without the "``L``" suffix is the non-lens-  version. You can get by without using ``brick``'s lens interface but-  your life will probably be much more pleasant once your application-  state becomes sufficiently complex if you use lenses to modify it (see-  `appHandleEvent: Handling Events`_).+  version. You can get by without using ``brick``'s lens interface+  but your life will probably be much more pleasant if you use lenses+  to modify your application state once it state becomes sufficiently+  complex (see `appHandleEvent: Handling Events`_ and `Event Handlers+  for Component State`_). - Attribute names: some modules export attribute names (see `How   Attributes Work`_) associated with user interface elements. These tend   to end in an "``Attr``" suffix (e.g. ``borderAttr``). In addition,@@ -96,8 +97,8 @@ Brick applications must be compiled with the threaded RTS using the GHC ``-threaded`` option. -The App Type-============+The ``App`` Type+================  To use the library we must provide it with a value of type ``Brick.Main.App``. This type is a record type whose fields perform@@ -108,8 +109,8 @@    data App s e n =        App { appDraw         :: s -> [Widget n]            , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)-           , appHandleEvent  :: s -> BrickEvent n e -> EventM n (Next s)-           , appStartEvent   :: s -> EventM n s+           , appHandleEvent  :: BrickEvent n e -> EventM n s ()+           , appStartEvent   :: EventM n s ()            , appAttrMap      :: s -> AttrMap            } @@ -150,16 +151,16 @@     main :: IO ()    main = do-     let app = App { ... }-         initialState = ...-     finalState <- defaultMain app initialState-     -- Use finalState and exit+       let app = App { ... }+           initialState = ...+       finalState <- defaultMain app initialState+       -- Use finalState and exit  The ``customMain`` function is for more advanced uses; for details see `Using Your Own Event Type`_. -appDraw: Drawing an Interface------------------------------+``appDraw``: Drawing an Interface+---------------------------------  The value of ``appDraw`` is a function that turns the current application state into a list of *layers* of type ``Widget``, listed@@ -201,116 +202,162 @@ ``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets`` namespace provides specific kinds of functionality. -appHandleEvent: Handling Events--------------------------------+``appHandleEvent``: Handling Events+-----------------------------------  The value of ``appHandleEvent`` is a function that decides how to modify the application state as a result of an event:  .. code:: haskell -   appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)+   appHandleEvent :: BrickEvent n e -> EventM n s () -The first parameter of type ``s`` is your application's state at the-time the event arrives. ``appHandleEvent`` is responsible for deciding-how to change the state based on the event and then return it.+``appHandleEvent`` is responsible for deciding how to change the state+based on the event. The single parameter to the event handler is the+event to be handled. Its type variables ``n`` and ``e`` correspond+to the *resource name type* and *event type* of your application,+respectively, and must match the corresponding types in ``App`` and+``EventM``. -The second parameter of type ``BrickEvent n e`` is the event itself.-The type variables ``n`` and ``e`` correspond to the *resource name-type* and *event type* of your application, respectively, and must match-the corresponding types in ``App`` and ``EventM``.+The ``EventM`` monad is parameterized on the *resource name type*+``n`` and your application's state type ``s``. The ``EventM`` monad+is a state monad over ``s``, so one way to access and modify your+application's state in an event handler is to use the ``MonadState``+type class and associated operations from the ``mtl`` package. The+recommended approach, however, is to use the lens operations from the+``microlens-mtl`` package with lenses to perform concise state updates.+We'll cover this topic in more detail in `Event Handlers for Component+State`_. -The return value type ``Next s`` value describes what should happen-after the event handler is finished. We have four choices:+Once the event handler has performed any relevant state updates, it can+also indicate what should happen once the event handler has finished+executing. By default, after an event handler has completed, Brick will+redraw the screen with the application state (by calling ``appDraw``)+and wait for the next input event. However, there are two other options: -* ``Brick.Main.continue s``: continue executing the event loop with the-  specified application state ``s`` as the next value. Commonly this is-  where you'd modify the state based on the event and return it.-* ``Brick.Main.continueWithoutRedraw s``: continue executing the event-  loop with the specified application state ``s`` as the next value, but-  unlike ``continue``, do not redraw the screen using the new state.-  This is a faster version of ``continue`` since it doesn't redraw the-  screen; it just leaves up the previous screen contents. This function-  is only useful when you know that your state change won't cause-  anything on the screen to change. When in doubt, use ``continue``.-* ``Brick.Main.halt s``: halt the event loop and return the final-  application state value ``s``. This state value is returned to the-  caller of ``defaultMain`` or ``customMain`` where it can be used prior-  to finally exiting ``main``.-* ``Brick.Main.suspendAndResume act``: suspend the ``brick`` event loop-  and execute the specified ``IO`` action ``act``. The action ``act``-  must be of type ``IO s``, so when it executes it must return the next-  application state. When ``suspendAndResume`` is used, the ``brick``-  event loop is shut down and the terminal state is restored to its-  state when the ``brick`` event loop began execution. When it finishes-  executing, the event loop will be resumed using the returned state-  value. This is useful for situations where your program needs to-  suspend your interface and execute some other program that needs to-  gain control of the terminal (such as an external editor).+* ``Brick.Main.halt``: halt the event loop. The application state as it+  exists after the event handler completes is returned to the caller+  of ``defaultMain`` or ``customMain``.+* ``Brick.Main.continueWithoutRedraw``: continue executing the event+  loop, but do not redraw the screen using the new state before waiting+  for another input event. This is faster than the default continue+  behavior since it doesn't redraw the screen; it just leaves up the+  previous screen contents. This function is only useful when you know+  that your event handler's state change(s) won't cause anything on+  the screen to change. Use this only when you are certain that no+  redraw of the screen is needed *and* when you are trying to address a+  performance problem. (See also `The Rendering Cache`_ for details on+  how to detail with rendering performance issues.) -The ``EventM`` monad is the event-handling monad. This monad is a-transformer around ``IO`` so you are free to do I/O in this monad by-using ``liftIO``. Beyond I/O, this monad is used to make scrolling-requests to the renderer (see `Viewports`_) and obtain named extents-(see `Extents`_). Keep in mind that time spent blocking in your event-handler is time during which your UI is unresponsive, so consider this-when deciding whether to have background threads do work instead of-inlining the work in the event handler.+The ``EventM`` monad is a transformer around ``IO`` so I/O is possible+in this monad by using ``liftIO``. Keep in mind, however, that event+handlers should execute as quickly as possible to avoid introducing+screen redraw latency. Consider using background threads to work+asynchronously when it would otherwise cause redraw latency. -Widget Event Handlers-*********************+Beyond I/O, ``EventM`` is used to make scrolling requests to the+renderer (see `Viewports`_), obtain named extents (see `Extents`_), and+other duties. -Event handlers are responsible for transforming the application state.-While you can use ordinary methods to do this such as pattern matching-and pure function calls, some widget state types such as the ones-provided by the ``Brick.Widgets.List`` and ``Brick.Widgets.Edit``-modules provide their own widget-specific event-handling functions.-For example, ``Brick.Widgets.Edit`` provides ``handleEditorEvent`` and-``Brick.Widgets.List`` provides ``handleListEvent``.+Event Handlers for Component State+********************************** -Since these event handlers run in ``EventM``, they have access to-rendering viewport states via ``Brick.Main.lookupViewport`` and the-``IO`` monad via ``liftIO``.+The top-level ``appHandleEvent`` handler is responsible for managing+the application state, but it also needs to be able to update the state+associated with UI components such as those that come with Brick. -To use these handlers in your program, invoke them on the relevant piece-of state in your application state. In the following example we use an-``Edit`` state from ``Brick.Widgets.Edit``:+For example, consider an application that uses Brick's built-in text+editor from ``Brick.Widgets.Edit``. The built-in editor is similar to+the main application in that it has three important elements: -.. code:: haskell+* The editor state of type ``Editor t n``: this stores the editor's+  contents, cursor position, etc.+* The editor's drawing function, ``renderEditor``: this is responsible+  for drawing the editor in the UI.+* The editor's event handler, ``handleEditorEvent``: this is responsible+  for updating the editor's contents and cursor position in response to+  key events. -   data Name = Edit1-   type MyState = Editor String Name+To use the built-in editor, the application must: -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = continue =<< handleEditorEvent e s+* Embed an ``Editor t n`` somewhere in the application state ``s``,+* Render the editor's state at the appropriate place in ``appDraw`` with+  ``renderEditor``, and+* Dispatch events to the editor in the ``appHandleEvent`` with+  ``handleEditorEvent``. -This pattern works well enough when your application state has an-event handler as shown in the ``Edit`` example above, but it can-become unpleasant if the value on which you want to invoke a handler-is embedded deeply within your application state. If you have chosen-to generate lenses for your application state fields, you can use the-convenience function ``handleEventLensed`` by specifying your state, a-lens, and the event:+An example application state using an editor might look like this:  .. code:: haskell -   data Name = Edit1-   data MyState = MyState { _theEdit :: Editor String Name-                          }+   data MyState = MyState { _editor :: Editor Text n }    makeLenses ''MyState -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = continue =<< handleEventLensed s theEdit handleEditorEvent e+This declares the ``MyState`` type with an ``Editor`` contained within+it and uses Template Haskell to generate a lens, ``editor``, to allow us+to easily update the editor state in our event handler. -You might consider that preferable to the desugared version:+To dispatch events to the ``editor`` we'd start by writing the+application event handler:  .. code:: haskell -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = do-     newVal <- handleEditorEvent e (s^.theEdit)-     continue $ s & theEdit .~ newVal+   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       ... +But there's a problem: ``handleEditorEvent``'s type indicates that it+can only run over a state of type ``Editor t n``, but our handler runs+on ``MyState``. Specifically, ``handleEditorEvent`` has this type:++.. code:: haskell++   handleEditorEvent :: BrickEvent n e -> EventM n (Editor t n) ()++This means that to use ``handleEditorEvent``, it must be composed+into the application's event handler, but since the state types ``s``+and ``Editor t n`` do not match, we need a way to compose these event+handlers. There are two ways to do this:++* Use ``Lens.Micro.Mtl.zoom`` from the ``microlens-mtl`` package+  (re-exported by ``Brick.Types`` for convenience). This function is+  required when you want to change the state type to a field embedded in+  your application state using a lens. For example:++.. code:: haskell++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       zoom editor $ handleEditorEvent e++* Use ``Brick.Types.nestEventM``: this function lets you provide a state+  value and run ``EventM`` using that state. The following+  ``nestEventM`` example is equivalent to the ``zoom`` example above:++.. code:: haskell++   import Lens.Micro (_1)+   import Lens.Micro.Mtl (use, (.=))++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       editorState <- use editor+       (newEditorState, ()) <- nestEventM editorState $ do+           handleEditorEvent e+       editor .= newEditorState++The ``zoom`` function, together with lenses for your application state's+fields, is by far the best way to manage your state in ``EventM``. As+you can see from the examples above, the ``zoom`` approach avoids a lot+of boilerplate. The ``nestEventM`` approach is provided in cases where+the state that you need to mutate is not easily accessed by ``zoom``.++Finally, if you prefer to avoid the use of lenses, you can always use+the ``MonadState`` API to get, put, and modify your state. Keep in+mind that the ``MonadState`` approach will still require the use of+``nestEventM`` when events scoped to widget states such as ``Editor``+need to be handled.+ Using Your Own Event Type ************************* @@ -339,8 +386,8 @@  .. code:: haskell -   myEvent :: s -> BrickEvent n CounterEvent -> EventM n (Next s)-   myEvent s (AppEvent (Counter i)) = ...+   myEvent :: BrickEvent n CounterEvent -> EventM n s ()+   myEvent (AppEvent (Counter i)) = ...  The next step is to actually *generate* our custom events and inject them into the ``brick`` event stream so they make it to the@@ -391,8 +438,8 @@ your event handler when choosing the channel capacity and design event producers so that they can block if the channel is full. -appStartEvent: Starting up---------------------------+``appStartEvent``: Starting up+------------------------------  When an application starts, it may be desirable to perform some of the duties typically only possible when an event has arrived, such as@@ -403,16 +450,17 @@  .. code:: haskell -   appStartEvent :: s -> EventM n s+   appStartEvent :: EventM n s () -This function takes the initial application state and returns it in-``EventM``, possibly changing it and possibly making viewport requests.-This function is invoked once and only once, at application startup.-For more details, see `Viewports`_. You will probably just want to use-``return`` as the implementation of this function for most applications.+This function is a handler action to run on the initial application+state. This function is invoked once and only once, at application+startup. This might be a place to make initial viewport scroll requests+or make changes to the Vty environment. You will probably just want+to use ``return ()`` as the implementation of this function for most+applications. -appChooseCursor: Placing the Cursor------------------------------------+``appChooseCursor``: Placing the Cursor+---------------------------------------  The rendering process for a ``Widget`` may return information about where that widget would like to place the cursor. For example, a text@@ -469,9 +517,10 @@  .. code:: haskell -   myApp = App { ...-               , appChooseCursor = \_ -> showCursorNamed CustomName-               }+   myApp =+       App { ...+           , appChooseCursor = \_ -> showCursorNamed CustomName+           }  See the next section for more information on using names. @@ -522,9 +571,8 @@  .. code:: haskell -   do-     let vp = viewportScroll Viewport1-     vScrollBy vp 1+   let vp = viewportScroll Viewport1+   vScrollBy vp 1  The solution is to ensure that for a given resource type (in this case viewport), a unique name is assigned in each use.@@ -537,8 +585,8 @@    ui = (viewport Viewport1 Vertical $ str "Foo") <+>         (viewport Viewport2 Vertical $ str "Bar") <+> -appAttrMap: Managing Attributes--------------------------------+``appAttrMap``: Managing Attributes+-----------------------------------  In ``brick`` we use an *attribute map* to assign attributes to elements of the interface. Rather than specifying specific attributes when@@ -918,16 +966,20 @@ If the theme is further customized at runtime, any changes can be saved with ``Brick.Themes.saveCustomizations``. -Wide Character Support and the TextWidth class-==============================================+Wide Character Support and the ``TextWidth`` class+================================================== -Brick supports rendering wide characters in all widgets, and the brick-editor supports entering and editing wide characters. Wide characters-are those such as many Asian characters and emoji that need more than-a single terminal column to be displayed. Brick relies on Vty's use of-the `utf8proc`_ library to determine the column width of each character-rendered.+Brick attempts to support rendering wide characters in all widgets,+and the brick editor supports entering and editing wide characters.+Wide characters are those such as many Asian characters and emoji+that need more than a single terminal column to be displayed. +Unfortunatley, there is not a fully correct solution to determining+the character width that the user's terminal will use for a given+character. The current recommendation is to avoid use of wide characters+due to these issues. If you still must use them, you can read `vty`_'s+documentation for options that will affect character width calculations.+ As a result of supporting wide characters, it is important to know that computing the length of a string to determine its screen width will *only* work for single-column characters. So, for example, if you want@@ -937,26 +989,28 @@     let width = Data.Text.length t -because if the string contains any wide characters, their widths-will not be counted properly. In order to get this right, use the-``TextWidth`` type class to compute the width:+If the string contains any wide characters, their widths will not be+counted properly. In order to get this right, use the ``TextWidth`` type+class to compute the width:  .. code:: haskell     let width = Brick.Widgets.Core.textWidth t -The ``TextWidth`` type class uses Vty's character width routine (and-thus ``utf8proc``) to compute the correct width. If you need to compute-the width of a single character, use ``Graphics.Text.wcwidth``.+The ``TextWidth`` type class uses Vty's character width routine to+compute the width by looking up the string's characdters in a Unicode+width table. If you need to compute the width of a single character, use+``Graphics.Text.wcwidth``.  Extents ======= -When an application needs to know where a particular widget was drawn by-the renderer, the application can request that the renderer record the-*extent* of the widget--its upper-left corner and size--and provide it-in an event handler. In the following example, the application needs to-know where the bordered box containing "Foo" is rendered:+When an application needs to know where a particular widget was drawn+by the renderer, the application can request that the renderer record+the *extent* of the widget--its upper-left corner and size--and provide+access to it in an event handler. Extents are represented using Brick's+``Brick.Types.Extent`` type. In the following example, the application+needs to know where the bordered box containing "Foo" is rendered:  .. code:: haskell @@ -975,15 +1029,14 @@         reportExtent FooBox $         border $ str "Foo" -Now, whenever the ``ui`` is rendered, the location and size of the-bordered box containing "Foo" will be recorded. We can then look it up-in event handlers in ``EventM``:+Now, whenever the ``ui`` is rendered, the extent of the bordered box+containing "Foo" will be recorded. We can then look it up in event+handlers in ``EventM``:  .. code:: haskell -   do-     mExtent <- Brick.Main.lookupExtent FooBox-     case mExtent of+   mExtent <- Brick.Main.lookupExtent FooBox+   case mExtent of        Nothing -> ...        Just (Extent _ upperLeft (width, height)) -> ... @@ -1008,10 +1061,10 @@    import qualified Graphics.Vty as V     do-     vty <- Brick.Main.getVtyHandle-     let output = V.outputIface vty-     when (V.supportsMode output V.BracketedPaste) $-         liftIO $ V.setMode output V.BracketedPaste True+       vty <- Brick.Main.getVtyHandle+       let output = V.outputIface vty+       when (V.supportsMode output V.BracketedPaste) $+           liftIO $ V.setMode output V.BracketedPaste True  Once enabled, paste mode will generate Vty ``EvPaste`` events. These events will give you the entire pasted content as a ``ByteString`` which@@ -1029,10 +1082,10 @@ .. code:: haskell     do-     vty <- Brick.Main.getVtyHandle-     let output = outputIface vty-     when (supportsMode output Mouse) $-       liftIO $ setMode output Mouse True+       vty <- Brick.Main.getVtyHandle+       let output = outputIface vty+       when (supportsMode output Mouse) $+           liftIO $ setMode output Mouse True  Bear in mind that some terminals do not support mouse interaction, so use Vty's ``getModeStatus`` to find out whether your terminal will@@ -1053,7 +1106,7 @@  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row button mods) = ...+   handleEvent (VtyEvent (EvMouseDown col row button mods) = ...  Brick Mouse Events ------------------@@ -1063,27 +1116,60 @@ language. The disadvantage to the low-level interface described above is that you still need to determine *what* was clicked, i.e., the part of the interface that was under the mouse cursor. There are two ways to do-this with ``brick``: with *extent checking* and *click reporting*.+this with ``brick``: with *click reporting* and *extent checking*. +Click reporting+***************++The *click reporting* approach is the most high-level approach offered+by ``brick`` and the one that we recommend you use. In this approach,+we use ``Brick.Widgets.Core.clickable`` when drawing the interface to+request that a given widget generate ``MouseDown`` and ``MouseUp``+events when it is clicked.++.. code:: haskell++   data Name = MyButton++   ui :: Widget Name+   ui = center $+        clickable MyButton $+        border $+        str "Click me"++   handleEvent (MouseDown MyButton button modifiers coords) = ...+   handleEvent (MouseUp MyButton button coords) = ...++This approach enables event handlers to use pattern matching to check+for mouse clicks on specific regions; this uses `Extent checking`_+under the hood but makes it possible to denote which widgets are+clickable in the interface description. The event's click coordinates+are local to the widget being clicked. In the above example, a click+on the upper-left corner of the border would result in coordinates of+``(0,0)``.+ Extent checking ***************  The *extent checking* approach entails requesting extents (see `Extents`_) for parts of your interface, then checking the Vty mouse-click event's coordinates against one or more extents.+click event's coordinates against one or more extents. This approach+is slightly lower-level than the direct mouse click reporting approach+above but is provided in case you need more control over how mouse+clicks are dealt with.  The most direct way to do this is to check a specific extent:  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do-     mExtent <- lookupExtent SomeExtent-     case mExtent of-       Nothing -> continue s-       Just e -> do-         if Brick.Main.clickedExtent (col, row) e-           then ...-           else ...+   handleEvent (VtyEvent (EvMouseDown col row _ _)) = do+       mExtent <- lookupExtent SomeExtent+       case mExtent of+           Nothing -> return ()+           Just e -> do+               if Brick.Main.clickedExtent (col, row) e+                   then ...+                   else ...  This approach works well enough if you know which extent you're interested in checking, but what if there are many extents and you@@ -1092,10 +1178,10 @@  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do-     extents <- Brick.Main.findClickedExtents (col, row)-     -- Then check to see if a specific extent is in the list, or just-     -- take the first one in the list.+   handleEvent (VtyEvent (EvMouseDown col row _ _)) = do+       extents <- Brick.Main.findClickedExtents (col, row)+       -- Then check to see if a specific extent is in the list, or just+       -- take the first one in the list.  This approach finds all clicked extents and returns them in a list with the following properties:@@ -1109,35 +1195,6 @@ As a result, the extents are ordered in a natural way, starting with the most specific extents and proceeding to the most general. -Click reporting-***************--The *click reporting* approach is the most high-level approach-offered by ``brick``. When rendering the interface we use-``Brick.Widgets.Core.clickable`` to request that a given widget generate-``MouseDown`` and ``MouseUp`` events when it is clicked.--.. code:: haskell--   data Name = MyButton--   ui :: Widget Name-   ui = center $-        clickable MyButton $-        border $-        str "Click me"--   handleEvent s (MouseDown MyButton button modifiers coords) = ...-   handleEvent s (MouseUp MyButton button coords) = ...--This approach enables event handlers to use pattern matching to check-for mouse clicks on specific regions; this uses extent reporting-under the hood but makes it possible to denote which widgets are-clickable in the interface description. The event's click coordinates-are local to the widget being clicked. In the above example, a click-on the upper-left corner of the border would result in coordinates of-``(0,0)``.- Viewports ========= @@ -1210,14 +1267,14 @@  .. code:: haskell -   hScrollPage        :: Direction -> EventM n ()-   hScrollBy          :: Int       -> EventM n ()-   hScrollToBeginning ::              EventM n ()-   hScrollToEnd       ::              EventM n ()-   vScrollPage        :: Direction -> EventM n ()-   vScrollBy          :: Int       -> EventM n ()-   vScrollToBeginning ::              EventM n ()-   vScrollToEnd       ::              EventM n ()+   hScrollPage        :: Direction -> EventM n s ()+   hScrollBy          :: Int       -> EventM n s ()+   hScrollToBeginning ::              EventM n s ()+   hScrollToEnd       ::              EventM n s ()+   vScrollPage        :: Direction -> EventM n s ()+   vScrollBy          :: Int       -> EventM n s ()+   vScrollToBeginning ::              EventM n s ()+   vScrollToEnd       ::              EventM n s ()  In each case the scrolling function scrolls the viewport by the specified amount in the specified direction; functions prefixed with@@ -1233,11 +1290,10 @@  .. code:: haskell -   myHandler :: s -> e -> EventM n (Next s)-   myHandler s e = do+   myHandler :: e -> EventM n s ()+   myHandler e = do        let vp = viewportScroll Viewport1        hScrollBy vp 1-       continue s  Scrolling Viewports With Visibility Requests --------------------------------------------@@ -1469,7 +1525,7 @@ .. code:: haskell      (str "Name: " <+>) @@=-      editTextField name NameField (Just 1)+        editTextField name NameField (Just 1)  Now when we invoke ``renderForm`` on a form using the above example, we'll see a ``"Name:"`` label to the left of the editor field for@@ -1504,14 +1560,14 @@ Handling Form Events -------------------- -Handling form events is easy: we just call-``Brick.Forms.handleFormEvent`` with the ``BrickEvent`` and the-``Form``. This automatically dispatches input events to the-currently-focused input field, and it also manages focus changes with-``Tab`` and ``Shift-Tab`` keybindings. (For details on all of its-behaviors, see the Haddock documentation for ``handleFormEvent``.) It's-still up to the application to decide when events should go to the form-in the first place.+Handling form events is easy: we just use ``zoom`` to call+``Brick.Forms.handleFormEvent`` with the ``BrickEvent`` and a lens+to access the ``Form`` in the application state. This automatically+dispatches input events to the currently-focused input field, and it+also manages focus changes with ``Tab`` and ``Shift-Tab`` keybindings.+(For details on all of its behaviors, see the Haddock documentation for+``handleFormEvent``.) It's still up to the application to decide when+events should go to the form in the first place.  Since the form field handlers take ``BrickEvent`` values, that means that custom fields could even handle application-specific events (of the@@ -1557,6 +1613,80 @@ the ``FormFieldState`` and ``FormField`` data types along with the implementations of the built-in form field types. +Customizable Keybindings+========================++Brick applications typically start out by explicitly checking incoming+events for specific keys in ``appHandleEvent``. While this works well+enough, it results in *tight coupling* between the input key events and+the event handlers that get run. As applications evolve, it becomes+important to decouple the input key events and their handlers to allow+the input keys to be customized by the user. That's where Brick's+customizable keybindings API comes in.++The customizable keybindings API provides:++* ``Brick.Keybindings.Parse``: parsing and loading user-provided+  keybinding configuration files,+* ``Brick.Keybindings.Pretty``: pretty-printing keybindings and+  generating keybinding help text in ``Widget``, plain text, and+  Markdown formats so you can provide help to users both within the+  program and outside of it,+* ``Brick.Keybindings.KeyEvents``: specifying the application's abstract+  key events and their configuration names,+* ``Brick.Keybindings.KeyConfig``: bundling default and customized+  keybindings for each abstract event into a structure for use by the+  dispatcher, and+* ``Brick.Keybindings.KeyDispatcher``: specifying handlers and+  dispatching incoming key events to them.++This section of the User Guide describes the API at a high level,+but Brick also provides a complete working example of the custom+keybinding API in ``programs/CustomKeybindingDemo.hs`` and+provides detailed documentation on how to use the API, including a+step-by-step process for using it, in the module documentation for+``Brick.Keybindings.KeyDispatcher``.++The following table compares Brick application design decisions and+runtime behaviors in a typical application compared to one that uses the+customizable keybindings API:+++---------------------+------------------------+-------------------------++| **Approach**        | **Before runtime**     | **At runtime**          |++---------------------+------------------------+-------------------------++| Typical application | The application author | #. An input event       |+| (no custom          | decides which keys will|    arrives when the user|+| keybindings)        | trigger application    |    presses a key.       |+|                     | behaviors. The event   | #. The event handler    |+|                     | handler is written to  |    pattern-mathces on   |+|                     | pattern-match on       |    the input event to   |+|                     | specific keys.         |    check for a match and|+|                     |                        |    then runs the        |+|                     |                        |    corresponding        |+|                     |                        |    handler.             |++---------------------+------------------------+-------------------------++| Application with    | The application author | #. A Vty input event    |+| custom keybindings  | specifies the possible |    arrives when the user|+| API integrated      | *abstract events* that |    presses a key.       |+|                     | correspond to the      | #. The input event is   |+|                     | application's          |    provided to          |+|                     | behaviors. The events  |    ``appHandleEvent``.  |+|                     | are given default      | #. ``appHandleEvent``   |+|                     | keybindings. The       |    passes the event on  |+|                     | application provides   |    to a                 |+|                     | event handlers for the |    ``KeyDispatcher``.   |+|                     | abstract events, not   | #. The key dispatcher   |+|                     | specific keys. If      |    checks to see whether|+|                     | desired, the           |    the input key event  |+|                     | application can load   |    maps to an abstract  |+|                     | user-defined custom    |    event.               |+|                     | keybindings from an INI| #. If the dispatcher    |+|                     | file at startup to     |    finds a match, the   |+|                     | override the           |    corresponding        |+|                     | application's defaults.|    abstract event's key |+|                     |                        |    handler is run.      |++---------------------+------------------------+-------------------------++ Joining Borders =============== @@ -1778,12 +1908,12 @@  .. code:: haskell -   handleEvent s ... = do-     -- Invalidate just a single cache entry:-     Brick.Main.invalidateCacheEntry ExpensiveThing+   handleEvent ... = do+       -- Invalidate just a single cache entry:+       Brick.Main.invalidateCacheEntry ExpensiveThing -     -- Invalidate the entire cache (useful on a resize):-     Brick.Main.invalidateCache+       -- Invalidate the entire cache (useful on a resize):+       Brick.Main.invalidateCache  Implementing Custom Widgets ===========================@@ -1924,4 +2054,3 @@ .. _Hackage: http://hackage.haskell.org/ .. _microlens: http://hackage.haskell.org/package/microlens .. _bracketed paste mode: https://cirw.in/blog/bracketed-paste-.. _utf8proc: http://julialang.org/utf8proc/

@@ -1,546 +0,0 @@--# Brick Tutorial by Samuel Tay--This tutorial was written by Samuel Tay, Copyright 2017-(https://github.com/samtay, https://samtay.github.io/). It is provided-as part of the brick distribution with permission.--## Introduction--I'm going to give a short introduction to-[brick](https://hackage.haskell.org/package/brick), a Haskell library-for building terminal user interfaces. So far I've used `brick` to-implement [Conway's Game of Life](https://github.com/samtay/conway) and-a [Tetris clone](https://github.com/samtay/tetris). I'll explain the-basics, walk through an example [snake](https://github.com/samtay/snake)-application, and then explain some more complicated scenarios.--The first thing I'll say is that this package has some of the most-impressive documentation and resources, which makes it easy to figure-out pretty much anything you need to do. I'll try to make this useful,-but I imagine if you're reading this then it is mostly being used as a-reference in addition to the existing resources:--1. [Demo programs](https://github.com/jtdaugherty/brick/tree/master/programs)-(clone down to explore the code and run them locally)-2. [User guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-3. [Haddock docs](https://hackage.haskell.org/package/brick)-4. [Google group](https://groups.google.com/forum/#!forum/brick-users)--### The basic idea--`brick` is very declarative. Once your base application logic is in-place, the interface is generally built by two functions: drawing and-handling events. The drawing function--```haskell-appDraw :: s -> [Widget n]-```--takes your app state `s` and produces the visuals `[Widget n]`. The-handler--```haskell-appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)-```--takes your app state, an event (e.g. user presses the `'m'` key), and-produces the resulting app state. *That's pretty much it.*--## `snake`--We're going to build the [classic-snake](https://en.wikipedia.org/wiki/Snake_(video_game)) game that you-might recall from arcades or the first cell phones. The full source code-is [here](https://github.com/samtay/snake). This is the end product:--![](snake-demo.gif)--### Structure of the app--The library makes it easy to separate the concerns of your application-and the interface; I like to have a module with all of the core business-logic that exports the core state of the app and functions for modifying-it, and then have an interface module that just handles the setup,-drawing, and handling events. So let's just use the `simple` stack-template and add two modules--```-├── LICENSE-├── README.md-├── Setup.hs-├── snake.cabal-├── src-│   ├── Main.hs-│   ├── Snake.hs-│   └── UI.hs-└── stack.yaml-```--and our dependencies to `test.cabal`--```yaml-executable snake-  hs-source-dirs:      src-  main-is:             Main.hs-  ghc-options:         -threaded-  exposed-modules:     Snake-                     , UI-  default-language:    Haskell2010-  build-depends:       base >= 4.7 && < 5-                     , brick-                     , containers-                     , linear-                     , microlens-                     , microlens-th-                     , random-```--### `Snake`--Since this tutorial is about `brick`, I'll elide most of the-implementation details of the actual game, but here are some of the key-types and scaffolding:--```haskell-{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}-module Snake where--import Control.Applicative ((<|>))-import Control.Monad (guard)-import Data.Maybe (fromMaybe)--import Data.Sequence (Seq, ViewL(..), ViewR(..), (<|))-import qualified Data.Sequence as S-import Lens.Micro.TH (makeLenses)-import Lens.Micro ((&), (.~), (%~), (^.))-import Linear.V2 (V2(..), _x, _y)-import System.Random (Random(..), newStdGen)---- Types--data Game = Game-  { _snake  :: Snake        -- ^ snake as a sequence of points in R2-  , _dir    :: Direction    -- ^ direction-  , _food   :: Coord        -- ^ location of the food-  , _foods  :: Stream Coord -- ^ infinite list of random food locations-  , _dead   :: Bool         -- ^ game over flag-  , _paused :: Bool         -- ^ paused flag-  , _score  :: Int          -- ^ score-  , _frozen :: Bool         -- ^ freeze to disallow duplicate turns-  } deriving (Show)--type Coord = V2 Int-type Snake = Seq Coord--data Stream a = a :| Stream a-  deriving (Show)--data Direction-  = North-  | South-  | East-  | West-  deriving (Eq, Show)-```--All of this is pretty self-explanatory, with the possible exception-of lenses if you haven't seen them. At first glance they may seem-complicated (and the underlying theory arguably is), but using them as-getters and setters is very straightforward. So, if you are following-along because you are writing a terminal app like this, I'd recommend-using them, but they are not required to use `brick`.--Here are the core functions for playing the game:--```haskell--- | Step forward in time-step :: Game -> Game-step g = fromMaybe g $ do-  guard (not $ g ^. paused || g ^. dead)-  let g' = g & frozen .~ False-  return . fromMaybe (move g') $ die g' <|> eatFood g'---- | Possibly die if next head position is disallowed-die :: Game -> Maybe Game---- | Possibly eat food if next head position is food-eatFood :: Game -> Maybe Game---- | Move snake along in a marquee fashion-move :: Game -> Game---- | Turn game direction (only turns orthogonally)------ Implicitly unpauses yet freezes game-turn :: Direction -> Game -> Game---- | Initialize a paused game with random food location-initGame :: IO Game-```--### `UI`--To start, we need to determine what our `App s e n` type parameters are.-This will completely describe the interface application and be passed-to one of the library's `main` style functions for execution. Note that-`s` is the app state, `e` is an event type, and `n` is a resource name.-The `e` is abstracted so that we can provide custom events. The `n`-is usually a custom sum type called `Name` which allows us to *name*-particular viewports. This is important so that we can keep track of-where the user currently has *focus*, such as typing in one of two-textboxes; however, for this simple snake game we don't need to worry-about that.--In simpler cases, the state `s` can directly coincide with a core-datatype such as our `Snake.Game`. In many cases however, it will be-necessary to wrap the core state within the ui state `s` to keep track-of things that are interface specific (more on this later).--Let's write out our app definition and leave some undefined functions:--```haskell-{-# LANGUAGE OverloadedStrings #-}-module UI where--import Control.Monad (forever, void)-import Control.Monad.IO.Class (liftIO)-import Control.Concurrent (threadDelay, forkIO)-import Data.Maybe (fromMaybe)--import Snake--import Brick-  ( App(..), AttrMap, BrickEvent(..), EventM, Next, Widget-  , customMain, neverShowCursor-  , continue, halt-  , hLimit, vLimit, vBox, hBox-  , padRight, padLeft, padTop, padAll, Padding(..)-  , withBorderStyle-  , str-  , attrMap, withAttr, emptyWidget, AttrName, on, fg-  , (<+>)-  )-import Brick.BChan (newBChan, writeBChan)-import qualified Brick.Widgets.Border as B-import qualified Brick.Widgets.Border.Style as BS-import qualified Brick.Widgets.Center as C-import qualified Graphics.Vty as V-import Data.Sequence (Seq)-import qualified Data.Sequence as S-import Linear.V2 (V2(..))-import Lens.Micro ((^.))---- Types---- | Ticks mark passing of time------ This is our custom event that will be constantly fed into the app.-data Tick = Tick---- | Named resources------ Not currently used, but will be easier to refactor--- if we call this "Name" now.-type Name = ()--data Cell = Snake | Food | Empty---- App definition--app :: App Game Tick Name-app = App { appDraw = drawUI-          , appChooseCursor = neverShowCursor-          , appHandleEvent = handleEvent-          , appStartEvent = return-          , appAttrMap = const theMap-          }--main :: IO ()-main = undefined---- Handling events--handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent = undefined---- Drawing--drawUI :: Game -> [Widget Name]-drawUI = undefined--theMap :: AttrMap-theMap = undefined-```--#### Custom Events--So far I've only used `brick` to make games which need to be redrawn-as time passes, with or without user input. This requires using-`Brick.customMain` with that `Tick` event type, and opening a forked-process to `forever` feed that event type into the channel. Since this-is a common scenario, there is a `Brick.BChan` module that makes this-pretty quick:--```haskell-main :: IO ()-main = do-  chan <- newBChan 10-  forkIO $ forever $ do-    writeBChan chan Tick-    threadDelay 100000 -- decides how fast your game moves-  g <- initGame-  let buildVty = V.mkVty V.defaultConfig-  initialVty <- buildVty-  void $ customMain initialVty buildVty (Just chan) app g-```--We do need to import `Vty.Graphics` since `customMain` allows us-to specify a custom `IO Vty.Graphics.Vty` handle, but we're only-customizing the existence of the event channel `BChan Tick`. The app-is now bootstrapped, and all we need to do is implement `handleEvent`,-`drawUI`, and `theMap` (handles styling).--#### Handling events--Handling events is largely straightforward, and can be very clean when-your underlying application logic is taken care of in a core module. All-we do is essentially map events to the proper state modifiers.--```haskell-handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent g (AppEvent Tick)                       = continue $ step g-handleEvent g (VtyEvent (V.EvKey V.KUp []))         = continue $ turn North g-handleEvent g (VtyEvent (V.EvKey V.KDown []))       = continue $ turn South g-handleEvent g (VtyEvent (V.EvKey V.KRight []))      = continue $ turn East g-handleEvent g (VtyEvent (V.EvKey V.KLeft []))       = continue $ turn West g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'k') [])) = continue $ turn North g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'j') [])) = continue $ turn South g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'l') [])) = continue $ turn East g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'h') [])) = continue $ turn West g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'r') [])) = liftIO (initGame) >>= continue-handleEvent g (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt g-handleEvent g (VtyEvent (V.EvKey V.KEsc []))        = halt g-handleEvent g _                                     = continue g-```--It's probably obvious, but `continue` will continue execution with-the supplied state value, which is then drawn. We can also `halt` to-stop execution, which will essentially finish the evaluation of our-`customMain` and result in `IO Game`, where the resulting game is the-last value that we supplied to `halt`.--#### Drawing--Drawing is fairly simple as well but can require a good amount of code-to position things how you want them. I like to break up the visual-space into regions with drawing functions for each one.--```haskell-drawUI :: Game -> [Widget Name]-drawUI g =-  [ C.center $ padRight (Pad 2) (drawStats g) <+> drawGrid g ]--drawStats :: Game -> Widget Name-drawStats = undefined--drawGrid :: Game -> Widget Name-drawGrid = undefined-```--This will center the overall interface (`C.center`), put the stats and-grid widgets horizontally side by side (`<+>`), and separate them by a-2-character width (`padRight (Pad 2)`).--Let's move forward with the stats column:--```haskell-drawStats :: Game -> Widget Name-drawStats g = hLimit 11-  $ vBox [ drawScore (g ^. score)-         , padTop (Pad 2) $ drawGameOver (g ^. dead)-         ]--drawScore :: Int -> Widget Name-drawScore n = withBorderStyle BS.unicodeBold-  $ B.borderWithLabel (str "Score")-  $ C.hCenter-  $ padAll 1-  $ str $ show n--drawGameOver :: Bool -> Widget Name-drawGameOver dead =-  if dead-     then withAttr gameOverAttr $ C.hCenter $ str "GAME OVER"-     else emptyWidget--gameOverAttr :: AttrName-gameOverAttr = "gameOver"-```--I'm throwing in that `hLimit 11` to prevent the widget greediness caused-by the outer `C.center`. I'm also using `vBox` to show some other-options of aligning widgets; `vBox` and `hBox` align a list of widgets-vertically and horizontally, respectfully. They can be thought of as-folds over the binary `<=>` and `<+>` operations.--The score is straightforward, but it is the first border in-this tutorial. Borders are well documented in the [border-demo](https://github.com/jtdaugherty/brick/blob/master/programs/BorderDemo.hs)-and the Haddocks for that matter.--We also only show the "game over" widget if the game is actually over.-In that case, we are rendering the string widget with the `gameOverAttr`-attribute name. Attribute names are basically type safe *names* that-we can assign to widgets to apply predetermined styles, similar to-assigning a class name to a div in HTML and defining the CSS styles for-that class elsewhere.--Attribute names implement `IsString`, so they are easy to construct with-the `OverloadedStrings` pragma.--Now for the main event:--```haskell-drawGrid :: Game -> Widget Name-drawGrid g = withBorderStyle BS.unicodeBold-  $ B.borderWithLabel (str "Snake")-  $ vBox rows-  where-    rows         = [hBox $ cellsInRow r | r <- [height-1,height-2..0]]-    cellsInRow y = [drawCoord (V2 x y) | x <- [0..width-1]]-    drawCoord    = drawCell . cellAt-    cellAt c-      | c `elem` g ^. snake = Snake-      | c == g ^. food      = Food-      | otherwise           = Empty--drawCell :: Cell -> Widget Name-drawCell Snake = withAttr snakeAttr cw-drawCell Food  = withAttr foodAttr cw-drawCell Empty = withAttr emptyAttr cw--cw :: Widget Name-cw = str "  "--snakeAttr, foodAttr, emptyAttr :: AttrName-snakeAttr = "snakeAttr"-foodAttr = "foodAttr"-emptyAttr = "emptyAttr"--```--There's actually nothing new here! We've already covered all the-`brick` functions necessary to draw the grid. My approach to grids is-to render a square cell widget `cw` with different colors depending-on the cell state. The easiest way to draw a colored square is to-stick two characters side by side. If we assign an attribute with a-matching foreground and background, then it doesn't matter what the two-characters are (provided that they aren't some crazy Unicode characters-that might render to an unexpected size). However, if we want empty-cells to render with the same color as the user's default background-color, then spaces are a good choice.--Finally, we'll define the attribute map:--```haskell-theMap :: AttrMap-theMap = attrMap V.defAttr-  [ (snakeAttr, V.blue `on` V.blue)-  , (foodAttr, V.red `on` V.red)-  , (gameOverAttr, fg V.red `V.withStyle` V.bold)-  ]-```--Again, styles aren't terribly complicated, but it-will be one area where you might have to look in the-[vty](http://hackage.haskell.org/package/vty) package (specifically-[Graphics.Vty.Attributes](http://hackage.haskell.org/package/vty-5.15.1/docs/Graphics-Vty-Attributes.html)) to find what you need.--Another thing to mention is that the attributes form a hierarchy and-can be combined in a parent-child relationship via `mappend`. I haven't-actually used this feature, but it does sound quite handy. For a more-detailed discussion see the-[Brick.AttrMap](https://hackage.haskell.org/package/brick-0.18/docs/Brick-AttrMap.html) haddocks.--## Variable speed--One difficult problem I encountered was implementing a variable speed in-the GoL. I could have just used the same approach above with the minimum-thread delay (corresponding to the maximum speed) and counted `Tick`-events, only issuing an actual `step` in the game when the modular count-of `Tick`s reached an amount corresponding to the current game speed,-but that's kind of an ugly approach.--Instead, I reached out to the author and he advised me to use a `TVar`-within the app state.  I had never used `TVar`, but it's pretty easy!--```haskell-main :: IO ()-main = do-  chan <- newBChan 10-  tv   <- atomically $ newTVar (spToInt initialSpeed)-  forkIO $ forever $ do-    writeBChan chan Tick-    int <- atomically $ readTVar tv-    threadDelay int-  let buildVty = V.mkVty V.defaultConfig-  initialVty <- buildVty-  customMain initialVty buildVty (Just chan) app (initialGame tv)-    >>= printResult-```--The `tv <- atomically $ newTVar (value :: a)` creates a new mutable-reference to a value of type `a`, i.e. `TVar a`, and returns it in `IO`.-In this case `value` is an `Int` which represents the delay between game-steps. Then in the forked process, we read the delay from the `TVar`-reference and use that to space out the calls to `writeBChan chan Tick`.--I store that same `tv :: TVar Int` in the brick app state, so that the-user can change the speed:--```haskell-handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent g (VtyEvent (V.EvKey V.KRight [V.MCtrl])) = handleSpeed g (+)-handleEvent g (VtyEvent (V.EvKey V.KLeft [V.MCtrl]))  = handleSpeed g (-)--handleSpeed :: Game -> (Float -> Float -> Float) -> EventM n (Next Game)-handleSpeed g (+/-) = do-  let newSp = validS $ (g ^. speed) +/- speedInc-  liftIO $ atomically $ writeTVar (g ^. interval) (spToInt newSp)-  continue $ g & speed .~ newSp---- where---- | Speed increments = 0.01 gives 100 discrete speed settings-speedInc :: Float-speedInc = 0.01---- | Game state-data Game = Game-  { _board    :: Board -- ^ Board state-  , _time     :: Int   -- ^ Time elapsed-  , _paused   :: Bool  -- ^ Playing vs. paused-  , _speed    :: Float -- ^ Speed in [0..1]-  , _interval :: TVar Int -- ^ Interval kept in TVar-  , _focus    :: F.FocusRing Name -- ^ Keeps track of grid focus-  , _selected :: Cell -- ^ Keeps track of cell focus-  }-```--## Conclusion--`brick` let's you build TUIs very quickly. I was able to write `snake`-along with this tutorial within a few hours. More complicated interfaces-can be tougher, but if you can successfully separate the interface and-core functionality, you'll have an easier time tacking on the frontend.--Lastly, let me remind you to look in the-[demo programs](https://github.com/jtdaugherty/brick/tree/master/programs)-to figure stuff out, as *many* scenarios are covered throughout them.--## Links-* [brick](https://hackage.haskell.org/package/brick)-* [snake](https://github.com/samtay/snake)-* [tetris](https://github.com/samtay/tetris)-* [conway](https://github.com/samtay/conway)

@@ -23,28 +23,28 @@   , modifyDefAttr   ) import Brick.Util (on, fg)-import Brick.AttrMap (attrMap, AttrMap)+import Brick.AttrMap (attrMap, AttrMap, attrName)  ui :: Widget n ui =     vBox [ str "This text uses the global default attribute."-         , withAttr "foundFull" $+         , withAttr (attrName "foundFull") $            str "Specifying an attribute name means we look it up in the attribute tree."-         , (withAttr "foundFgOnly" $+         , (withAttr (attrName "foundFgOnly") $            str ("When we find a value, we merge it with its parent in the attribute")            <=> str "name tree all the way to the root (the global default).")-         , withAttr "missing" $+         , withAttr (attrName "missing") $            str "A missing attribute name just resumes the search at its parent."-         , withAttr ("general" <> "specific") $+         , withAttr (attrName "general" <> attrName "specific") $            str "In this way we build complete attribute values by using an inheritance scheme."-         , withAttr "foundFull" $+         , withAttr (attrName "foundFull") $            str "You can override everything ..."-         , withAttr "foundFgOnly" $+         , withAttr (attrName "foundFgOnly") $            str "... or only what you want to change and inherit the rest."          , str "Attribute names are assembled with the Monoid append operation to indicate"          , str "hierarchy levels, e.g. \"window\" <> \"title\"."          , str " "-         , withAttr "linked" $+         , withAttr (attrName "linked") $            str "This text is hyperlinked in terminals that support hyperlinking."          , str " "          , hyperlink "http://www.google.com/" $@@ -59,18 +59,19 @@  theMap :: AttrMap theMap = attrMap globalDefault-    [ ("foundFull",               white `on` green)-    , ("foundFgOnly",             fg red)-    , ("general",                 yellow `on` black)-    , ("general" <> "specific",   fg cyan)-    , ("linked",                  fg yellow `withURL` "http://www.google.com/")+    [ (attrName "foundFull",               white `on` green)+    , (attrName "foundFgOnly",             fg red)+    , (attrName "general",                 yellow `on` black)+    , (attrName "general" <> attrName "specific",+                                           fg cyan)+    , (attrName "linked",                  fg yellow `withURL` "http://www.google.com/")     ]  app :: App () e () app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const theMap         , appChooseCursor = neverShowCursor         }

@@ -68,7 +68,7 @@     txt $ "  " <> styleName <> " style  "  titleAttr :: A.AttrName-titleAttr = "title"+titleAttr = A.attrName "title"  borderMappings :: [(A.AttrName, V.Attr)] borderMappings =

@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Monad (void)+import Control.Monad.State (modify) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif@@ -16,7 +16,8 @@   , BrickEvent(..)   ) import Brick.Widgets.Core-  ( vBox+  ( Padding(..)+  , vBox   , padTopBottom   , withDefAttr   , cached@@ -29,6 +30,7 @@   ) import Brick.AttrMap   ( AttrName+  , attrName   , attrMap   ) @@ -50,26 +52,26 @@              , padTopBottom 1 $                cached ExpensiveWidget $                withDefAttr emphAttr $ str $ "This widget is cached (state = " <> show i <> ")"-             , padBottom (T.Pad 1) $+             , padBottom (Pad 1) $                withDefAttr emphAttr $ str $ "This widget is not cached (state = " <> show i <> ")"              , hCenter $ str "Press 'i' to invalidate the cache,"              , str "'+' to change the state value, and"              , str "'Esc' to quit."              ] -appEvent :: Int -> BrickEvent Name e -> T.EventM Name (T.Next Int)-appEvent i (VtyEvent (V.EvKey (V.KChar '+') [])) = M.continue $ i + 1-appEvent i (VtyEvent (V.EvKey (V.KChar 'i') [])) = M.invalidateCacheEntry ExpensiveWidget >> M.continue i-appEvent i (VtyEvent (V.EvKey V.KEsc [])) = M.halt i-appEvent i _ = M.continue i+appEvent :: BrickEvent Name e -> T.EventM Name Int ()+appEvent (VtyEvent (V.EvKey (V.KChar '+') [])) = modify (+ 1)+appEvent (VtyEvent (V.EvKey (V.KChar 'i') [])) = M.invalidateCacheEntry ExpensiveWidget+appEvent (VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return ()  emphAttr :: AttrName-emphAttr = "emphasis"+emphAttr = attrName "emphasis"  app :: M.App Int e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const $ attrMap V.defAttr [(emphAttr, V.white `on` V.blue)]           , M.appChooseCursor = M.neverShowCursor

@@ -4,7 +4,6 @@ import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain) import Brick.Types   ( Widget-  , Padding(..)   ) import Brick.Widgets.Core   ( vBox@@ -20,6 +19,7 @@   , cropRightTo   , cropTopTo   , cropBottomTo+  , Padding(..)   ) import Brick.Widgets.Border (border) import Brick.AttrMap (attrMap)@@ -52,7 +52,7 @@ app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         , appChooseCursor = neverShowCursor         }

@@ -3,8 +3,9 @@ {-# LANGUAGE CPP #-} module Main where -import Lens.Micro ((^.), (&), (.~), (%~))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void, forever) import Control.Concurrent (threadDelay, forkIO) #if !(MIN_VERSION_base(4,11,0))@@ -17,7 +18,6 @@   ( App(..)   , showFirstCursor   , customMain-  , continue   , halt   ) import Brick.AttrMap@@ -25,7 +25,6 @@   ) import Brick.Types   ( Widget-  , Next   , EventM   , BrickEvent(..)   )@@ -50,14 +49,15 @@             <=>             (str $ "Counter value is: " <> (show $ st^.stCounter)) -appEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St)-appEvent st e =+appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e =     case e of-        VtyEvent (V.EvKey V.KEsc []) -> halt st-        VtyEvent _ -> continue $ st & stLastBrickEvent .~ (Just e)-        AppEvent Counter -> continue $ st & stCounter %~ (+1)-                                          & stLastBrickEvent .~ (Just e)-        _ -> continue st+        VtyEvent (V.EvKey V.KEsc []) -> halt+        VtyEvent _ -> stLastBrickEvent .= (Just e)+        AppEvent Counter -> do+            stCounter %= (+1)+            stLastBrickEvent .= (Just e)+        _ -> return ()  initialState :: St initialState =@@ -70,7 +70,7 @@     App { appDraw = drawUI         , appChooseCursor = showFirstCursor         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         } 

@@ -0,0 +1,209 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl ((<~), (.=), (%=), use)+import Control.Monad (void)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Graphics.Vty as V+import System.Environment (getArgs)+import System.Exit (exitFailure)++import qualified Brick.Types as T+import Brick.Types (Widget)+import qualified Brick.Keybindings as K+import Brick.AttrMap+import Brick.Util (fg)+import qualified Brick.Main as M+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C+import Brick.Widgets.Core++-- | The abstract key events for the application.+data KeyEvent = QuitEvent+              | IncrementEvent+              | DecrementEvent+              deriving (Ord, Eq, Show)++-- | The mapping of key events to their configuration field names.+allKeyEvents :: K.KeyEvents KeyEvent+allKeyEvents =+    K.keyEvents [ ("quit",      QuitEvent)+                , ("increment", IncrementEvent)+                , ("decrement", DecrementEvent)+                ]++-- | Default key bindings for each abstract key event.+defaultBindings :: [(KeyEvent, [K.Binding])]+defaultBindings =+    [ (QuitEvent,      [K.ctrl 'q', K.bind V.KEsc])+    , (IncrementEvent, [K.bind '+'])+    , (DecrementEvent, [K.bind '-'])+    ]++data St =+    St { _keyConfig :: K.KeyConfig KeyEvent+       -- ^ The key config to use.+       , _lastKey :: Maybe (V.Key, [V.Modifier])+       -- ^ The last key that was pressed.+       , _lastKeyHandled :: Bool+       -- ^ Whether the last key was handled by a handler.+       , _counter :: Int+       -- ^ The counter value to manipulate in the handlers.+       , _customBindingsPath :: Maybe FilePath+       -- ^ Set if the application found custom keybindings in the+       -- specified file.+       }++makeLenses ''St++-- | Key event handlers for our application.+handlers :: [K.KeyEventHandler KeyEvent (T.EventM () St)]+handlers =+    -- The first three handlers are triggered by keys mapped to abstract+    -- events, thus decoupling the configured key bindings from these+    -- handlers.+    [ K.onEvent QuitEvent "Quit the program"+          M.halt+    , K.onEvent IncrementEvent "Increment the counter" $+          counter %= succ+    , K.onEvent DecrementEvent "Decrement the counter" $+          counter %= subtract 1++    -- These handlers are always triggered by specific keys and thus+    -- cannot be rebound.+    , K.onKey (K.bind '\t') "Increment the counter by 10" $+          counter %= (+ 10)+    , K.onKey (K.bind V.KBackTab) "Decrement the counter by 10" $+          counter %= subtract 10+    ]++appEvent :: T.BrickEvent () e -> T.EventM () St ()+appEvent (T.VtyEvent (V.EvKey k mods)) = do+    -- 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+    lastKey .= Just (k, mods)+    lastKeyHandled <~ K.handleKey d k mods+appEvent _ =+    return ()++drawUi :: St -> [Widget ()]+drawUi st = [body]+    where+        binding = uncurry K.binding <$> st^.lastKey++        -- Generate key binding help using the library so we can embed+        -- it in the UI.+        keybindingHelp = B.borderWithLabel (txt "Active Keybindings") $+                         K.keybindingHelpWidget (st^.keyConfig) handlers++        lastKeyDisplay = withDefAttr lastKeyAttr $+                         txt $ maybe "(none)" K.ppBinding binding++        -- Show the status of the last pressed key, whether we handled+        -- it, and other bits of the application state.+        status = B.borderWithLabel (txt "Status") $+                 hLimit 40 $+                 padRight Max $+                 vBox [ txt   "Last key:         " <+> lastKeyDisplay+                      , str $ "Last key handled: " <> show (st^.lastKeyHandled)+                      , str $ "Counter:          " <> show (st^.counter)+                      ]++        -- Show info about whether the application is currently using+        -- custom bindings loaded from an INI file.+        customBindingInfo =+            B.borderWithLabel (txt "Custom Bindings") $+            case st^.customBindingsPath of+                Nothing ->+                    hLimit 40 $+                    txtWrap $ "No custom bindings loaded. Create an INI file with a " <>+                              (Text.pack $ show sectionName) <>+                              " section or use 'programs/custom_keys.ini'. " <>+                              "Pass its path to this program on the command line."+                Just f -> str "Loaded custom bindings from:" <=> str (show f)++        body = C.center $+               (padRight (Pad 2) $ status <=> customBindingInfo) <+>+               keybindingHelp++lastKeyAttr :: AttrName+lastKeyAttr = attrName "lastKey"++app :: M.App St e ()+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = return ()+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const $ attrMap V.defAttr [ (K.eventNameAttr, fg V.magenta)+                                                     , (K.eventDescriptionAttr, fg V.cyan)+                                                     , (K.keybindingAttr, fg V.yellow)+                                                     , (lastKeyAttr, fg V.white `V.withStyle` V.bold)+                                                     ]+          , M.appChooseCursor = M.showFirstCursor+          }++sectionName :: Text.Text+sectionName = "keybindings"++main :: IO ()+main = do+    args <- getArgs++    -- If the command line specified the path to an INI file with custom+    -- bindings, attempt to load it.+    (customBindings, customFile) <- case args of+        [iniFilePath] -> do+            result <- K.keybindingsFromFile allKeyEvents sectionName iniFilePath+            case result of+                -- A section was found and had zero more bindings.+                Right (Just bindings) ->+                    return (bindings, Just iniFilePath)++                -- No section was found at all.+                Right Nothing -> do+                    putStrLn $ "Error: found no section " <> show sectionName <> " in " <> show iniFilePath+                    exitFailure++                -- There was some problem parsing the file as an INI+                -- file.+                Left e -> do+                    putStrLn $ "Error reading keybindings file " <> show iniFilePath <> ": " <> e+                    exitFailure++        _ -> return ([], Nothing)++    -- Create a key config that includes the default bindings as well as+    -- the custom bindings we loaded from the INI file, if any.+    let kc = K.newKeyConfig allKeyEvents defaultBindings customBindings++    void $ M.defaultMain app $ St { _keyConfig = kc+                                  , _lastKey = Nothing+                                  , _lastKeyHandled = False+                                  , _counter = 0+                                  , _customBindingsPath = customFile+                                  }++    -- Now demonstrate how the library's generated key binding help text+    -- looks in plain text and Markdown formats. These can be used to+    -- generate documentation for users. Note that the output generated+    -- here takes the active bindings into account! If you don't want+    -- that, use handlers that were built from a KeyConfig that didn't+    -- have any custom bindings applied.+    let sections = [("Main", handlers)]++    putStrLn "Generated plain text help:"+    Text.putStrLn $ K.keybindingTextTable kc sections++    putStrLn "Generated Markdown help:"+    Text.putStrLn $ K.keybindingMarkdownTable kc sections

@@ -30,13 +30,13 @@     where         ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." -appEvent :: D.Dialog Choice -> BrickEvent () e -> T.EventM () (T.Next (D.Dialog Choice))-appEvent d (VtyEvent ev) =+appEvent :: BrickEvent () e -> T.EventM () (D.Dialog Choice) ()+appEvent (VtyEvent ev) =     case ev of-        V.EvKey V.KEsc [] -> M.halt d-        V.EvKey V.KEnter [] -> M.halt d-        _ -> M.continue =<< D.handleDialogEvent ev d-appEvent d _ = M.continue d+        V.EvKey V.KEsc [] -> M.halt+        V.EvKey V.KEnter [] -> M.halt+        _ -> D.handleDialogEvent ev+appEvent _ = return ()  initialState :: D.Dialog Choice initialState = D.dialog (Just "Title") (Just (0, choices)) 50@@ -58,7 +58,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           } 

@@ -5,6 +5,7 @@  import Lens.Micro import Lens.Micro.TH+import Lens.Micro.Mtl import qualified Graphics.Vty as V  import qualified Brick.Main as M@@ -47,18 +48,19 @@             str " " <=>             str "Press Tab to switch between editors, Esc to quit." -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) =-    M.halt st-appEvent st (T.VtyEvent (V.EvKey (V.KChar '\t') [])) =-    M.continue $ st & focusRing %~ F.focusNext-appEvent st (T.VtyEvent (V.EvKey V.KBackTab [])) =-    M.continue $ st & focusRing %~ F.focusPrev-appEvent st ev =-    M.continue =<< case F.focusGetCurrent (st^.focusRing) of-      Just Edit1 -> T.handleEventLensed st edit1 E.handleEditorEvent ev-      Just Edit2 -> T.handleEventLensed st edit2 E.handleEditorEvent ev-      Nothing -> return st+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    M.halt+appEvent (T.VtyEvent (V.EvKey (V.KChar '\t') [])) =+    focusRing %= F.focusNext+appEvent (T.VtyEvent (V.EvKey V.KBackTab [])) =+    focusRing %= F.focusPrev+appEvent ev = do+    r <- use focusRing+    case F.focusGetCurrent r of+      Just Edit1 -> zoom edit1 $ E.handleEditorEvent ev+      Just Edit2 -> zoom edit2 $ E.handleEditorEvent ev+      Nothing -> return ()  initialState :: St initialState =@@ -80,7 +82,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = appCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           } 

@@ -8,10 +8,11 @@ #endif import qualified Graphics.Vty as V +import Control.Monad.State (get) import qualified Data.Text as Text import qualified Brick.Main as M import qualified Brick.Widgets.List as L-import Brick.AttrMap (AttrName)+import Brick.AttrMap (AttrName, attrName) import Brick.Types   ( Widget   , BrickEvent(..)@@ -27,6 +28,7 @@   ( vBox, (<=>), padTop   , hLimit, vLimit, txt   , withDefAttr, emptyWidget+  , Padding(..)   ) import qualified Brick.Widgets.FileBrowser as FB import qualified Brick.AttrMap as A@@ -44,7 +46,7 @@              hLimit 50 $              borderWithLabel (txt "Choose a file") $              FB.renderFileBrowser True b-        help = padTop (T.Pad 1) $+        help = padTop (Pad 1) $                vBox [ case FB.fileBrowserException b of                           Nothing -> emptyWidget                           Just e -> hCenter $ withDefAttr errorAttr $@@ -55,25 +57,27 @@                     , hCenter $ txt "Esc: quit"                     ] -appEvent :: FB.FileBrowser Name -> BrickEvent Name e -> T.EventM Name (T.Next (FB.FileBrowser Name))-appEvent b (VtyEvent ev) =+appEvent :: BrickEvent Name e -> T.EventM Name (FB.FileBrowser Name) ()+appEvent (VtyEvent ev) = do+    b <- get     case ev of         V.EvKey V.KEsc [] | not (FB.fileBrowserIsSearching b) ->-            M.halt b+            M.halt         _ -> do-            b' <- FB.handleFileBrowserEvent ev b+            FB.handleFileBrowserEvent ev             -- If the browser has a selected file after handling the             -- event (because the user pressed Enter), shut down.             case ev of-                V.EvKey V.KEnter [] ->+                V.EvKey V.KEnter [] -> do+                    b' <- get                     case FB.fileBrowserSelection b' of-                        [] -> M.continue b'-                        _ -> M.halt b'-                _ -> M.continue b'-appEvent b _ = M.continue b+                        [] -> return ()+                        _ -> M.halt+                _ -> return ()+appEvent _ = return ()  errorAttr :: AttrName-errorAttr = "error"+errorAttr = attrName "error"  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -95,7 +99,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           } 

@@ -112,22 +112,24 @@ app :: App (Form UserInfo e Name) e Name app =     App { appDraw = draw-        , appHandleEvent = \s ev ->+        , appHandleEvent = \ev -> do+            f <- gets formFocus             case ev of-                VtyEvent (V.EvResize {})     -> continue s-                VtyEvent (V.EvKey V.KEsc [])   -> halt s+                VtyEvent (V.EvResize {}) -> return ()+                VtyEvent (V.EvKey V.KEsc []) -> halt                 -- Enter quits only when we aren't in the multi-line editor.                 VtyEvent (V.EvKey V.KEnter [])-                    | focusGetCurrent (formFocus s) /= Just AddressField -> halt s+                    | focusGetCurrent f /= Just AddressField -> halt                 _ -> do-                    s' <- handleFormEvent ev s+                    handleFormEvent ev                      -- Example of external validation:                     -- Require age field to contain a value that is at least 18.-                    continue $ setFieldValid ((formState s')^.age >= 18) AgeField s'+                    st <- gets formState+                    modify $ setFieldValid (st^.age >= 18) AgeField          , appChooseCursor = focusRingCursor formFocus-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const theMap         } 

@@ -1,13 +1,13 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where  #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif-import Lens.Micro ((^.), (&), (%~))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void) import qualified Graphics.Vty as V @@ -30,6 +30,7 @@ import Brick.AttrMap   ( attrMap   , AttrName+  , attrName   )  data St =@@ -72,35 +73,35 @@     translateBy (st^.bottomLayerLocation) $     B.border $ str "Bottom layer\n(Ctrl-arrow keys move)" -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.VtyEvent (V.EvKey V.KDown []))  =-    M.continue $ st & middleLayerLocation.locationRowL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp []))    =-    M.continue $ st & middleLayerLocation.locationRowL %~ (subtract 1)-appEvent st (T.VtyEvent (V.EvKey V.KRight [])) =-    M.continue $ st & middleLayerLocation.locationColumnL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft []))  =-    M.continue $ st & middleLayerLocation.locationColumnL %~ (subtract 1)+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KDown []))  =+    middleLayerLocation.locationRowL %= (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp []))    =+    middleLayerLocation.locationRowL %= (subtract 1)+appEvent (T.VtyEvent (V.EvKey V.KRight [])) =+    middleLayerLocation.locationColumnL %= (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft []))  =+    middleLayerLocation.locationColumnL %= (subtract 1) -appEvent st (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) =-    M.continue $ st & bottomLayerLocation.locationRowL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) =-    M.continue $ st & bottomLayerLocation.locationRowL %~ (subtract 1)-appEvent st (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) =-    M.continue $ st & bottomLayerLocation.locationColumnL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) =-    M.continue $ st & bottomLayerLocation.locationColumnL %~ (subtract 1)+appEvent (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) =+    bottomLayerLocation.locationRowL %= (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) =+    bottomLayerLocation.locationRowL %= (subtract 1)+appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) =+    bottomLayerLocation.locationColumnL %= (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) =+    bottomLayerLocation.locationColumnL %= (subtract 1) -appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st-appEvent st _ = M.continue st+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return ()  arrowAttr :: AttrName-arrowAttr = "attr"+arrowAttr = attrName "attr"  app :: M.App St e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const $ attrMap V.defAttr [(arrowAttr, fg V.cyan)]           , M.appChooseCursor = M.neverShowCursor

@@ -1,9 +1,10 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where  import Lens.Micro ((^.))+import Lens.Micro.Mtl import Control.Monad (void)+import Control.Monad.State (modify) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif@@ -48,26 +49,28 @@                               , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List () Char -> T.BrickEvent () e -> T.EventM () (T.Next (L.List () Char))-appEvent l (T.VtyEvent e) =+appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent (T.VtyEvent e) =     case e of-        V.EvKey (V.KChar '+') [] ->-            let el = nextElement (L.listElements l)-                pos = Vec.length $ l^.(L.listElementsL)-            in M.continue $ L.listInsert pos el l+        V.EvKey (V.KChar '+') [] -> do+            els <- use L.listElementsL+            let el = nextElement els+                pos = Vec.length els+            modify $ L.listInsert pos el -        V.EvKey (V.KChar '-') [] ->-            case l^.(L.listSelectedL) of-                Nothing -> M.continue l-                Just i -> M.continue $ L.listRemove i l+        V.EvKey (V.KChar '-') [] -> do+            sel <- use L.listSelectedL+            case sel of+                Nothing -> return ()+                Just i -> modify $ L.listRemove i -        V.EvKey V.KEsc [] -> M.halt l+        V.EvKey V.KEsc [] -> M.halt -        ev -> M.continue =<< L.handleListEvent ev l+        ev -> L.handleListEvent ev     where       nextElement :: Vec.Vector Char -> Char       nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])-appEvent l _ = M.continue l+appEvent _ = return ()  listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a =@@ -80,7 +83,7 @@ initialState = L.list () (Vec.fromList ['a','b','c']) 1  customAttr :: A.AttrName-customAttr = L.listSelectedAttr <> "custom"+customAttr = L.listSelectedAttr <> A.attrName "custom"  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -94,7 +97,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           } 

@@ -1,14 +1,15 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where  import Control.Monad (void)+import Control.Monad.State (modify) import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import qualified Graphics.Vty as V import Lens.Micro ((^.))+import Lens.Micro.Mtl  import qualified Brick.AttrMap as A import qualified Brick.Main as M@@ -39,26 +40,28 @@                               , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List () Char -> T.BrickEvent () e -> T.EventM () (T.Next (L.List () Char))-appEvent l (T.VtyEvent e) =+appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent (T.VtyEvent e) =     case e of-        V.EvKey (V.KChar '+') [] ->-            let el = nextElement (L.listElements l)-                pos = Vec.length $ l^.(L.listElementsL)-            in M.continue $ L.listInsert pos el l+        V.EvKey (V.KChar '+') [] -> do+            els <- use L.listElementsL+            let el = nextElement els+                pos = Vec.length els+            modify $ L.listInsert pos el -        V.EvKey (V.KChar '-') [] ->-            case l^.(L.listSelectedL) of-                Nothing -> M.continue l-                Just i  -> M.continue $ L.listRemove i l+        V.EvKey (V.KChar '-') [] -> do+            sel <- use L.listSelectedL+            case sel of+                Nothing -> return ()+                Just i  -> modify $ L.listRemove i -        V.EvKey V.KEsc [] -> M.halt l+        V.EvKey V.KEsc [] -> M.halt -        ev -> M.continue =<< (L.handleListEventVi L.handleListEvent) ev l+        ev -> L.handleListEventVi L.handleListEvent ev     where       nextElement :: Vec.Vector Char -> Char       nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])-appEvent l _ = M.continue l+appEvent _ = return ()  listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a =@@ -71,7 +74,7 @@ initialState = L.list () (Vec.fromList ['a','b','c']) 1  customAttr :: A.AttrName-customAttr = L.listSelectedAttr <> "custom"+customAttr = L.listSelectedAttr <> A.attrName "custom"  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -85,7 +88,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           } 

@@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where -import Lens.Micro ((^.), (&), (.~))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void)+import Control.Monad.Trans (liftIO) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif@@ -43,15 +44,15 @@ buttonLayer :: St -> Widget Name buttonLayer st =     C.vCenterLayer $-      C.hCenterLayer (padBottom (T.Pad 1) $ str "Click a button:") <=>+      C.hCenterLayer (padBottom (Pad 1) $ str "Click a button:") <=>       C.hCenterLayer (hBox $ padLeftRight 1 <$> buttons) <=>       C.hCenterLayer (padTopBottom 1 $ str "Or enter text and then click in this editor:") <=>       C.hCenterLayer (vLimit 3 $ hLimit 50 $ E.renderEditor (str . unlines) True (st^.edit))     where         buttons = mkButton <$> buttonData-        buttonData = [ (Button1, "Button 1", "button1")-                     , (Button2, "Button 2", "button2")-                     , (Button3, "Button 3", "button3")+        buttonData = [ (Button1, "Button 1", attrName "button1")+                     , (Button2, "Button 2", attrName "button2")+                     , (Button3, "Button 3", attrName "button3")                      ]         mkButton (name, label, attr) =             let wasClicked = (fst <$> st^.lastReportedClick) == Just name@@ -80,35 +81,41 @@                 Just (name, T.Location l) ->                     "Mouse down at " <> show name <> " @ " <> show l     T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $-               withDefAttr "info" $+               withDefAttr (attrName "info") $                C.hCenter $ str msg -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st ev@(T.MouseDown n _ _ loc) =-    M.continue =<< T.handleEventLensed (st & lastReportedClick .~ Just (n, loc))-                                       edit-                                       E.handleEditorEvent-                                       ev-appEvent st (T.MouseUp {}) = M.continue $ st & lastReportedClick .~ Nothing-appEvent st (T.VtyEvent (V.EvMouseUp {})) = M.continue $ st & lastReportedClick .~ Nothing-appEvent st (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) = M.vScrollBy (M.viewportScroll Prose) (-1) >> M.continue st-appEvent st (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) = M.vScrollBy (M.viewportScroll Prose) 1 >> M.continue st-appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st-appEvent st ev = M.continue =<< T.handleEventLensed st edit E.handleEditorEvent ev+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent ev@(T.MouseDown n _ _ loc) = do+    lastReportedClick .= Just (n, loc)+    zoom edit $ E.handleEditorEvent ev+appEvent (T.MouseUp {}) =+    lastReportedClick .= Nothing+appEvent (T.VtyEvent (V.EvMouseUp {})) =+    lastReportedClick .= Nothing+appEvent (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) =+    M.vScrollBy (M.viewportScroll Prose) (-1)+appEvent (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) =+    M.vScrollBy (M.viewportScroll Prose) 1+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    M.halt+appEvent ev =+    zoom edit $ E.handleEditorEvent ev  aMap :: AttrMap aMap = attrMap V.defAttr-    [ ("info",      V.white `on` V.magenta)-    , ("button1",   V.white `on` V.cyan)-    , ("button2",   V.white `on` V.green)-    , ("button3",   V.white `on` V.blue)+    [ (attrName "info",      V.white `on` V.magenta)+    , (attrName "button1",   V.white `on` V.cyan)+    , (attrName "button2",   V.white `on` V.green)+    , (attrName "button3",   V.white `on` V.blue)     , (E.editFocusedAttr, V.black `on` V.yellow)     ]  app :: M.App St e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = do+              vty <- M.getVtyHandle+              liftIO $ V.setMode (V.outputIface vty) V.Mouse True           , M.appHandleEvent = appEvent           , M.appAttrMap = const aMap           , M.appChooseCursor = M.showFirstCursor@@ -116,13 +123,7 @@  main :: IO () main = do-    let buildVty = do-          v <- V.mkVty =<< V.standardIOConfig-          V.setMode (V.outputIface v) V.Mouse True-          return v--    initialVty <- buildVty-    void $ M.customMain initialVty buildVty Nothing app $ St [] Nothing+    void $ M.defaultMain app $ St [] Nothing            (unlines [ "Try clicking on various UI elements."                     , "Observe that the click coordinates identify the"                     , "underlying widget coordinates."

@@ -4,7 +4,6 @@ import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain) import Brick.Types   ( Widget-  , Padding(..)   ) import Brick.Widgets.Core   ( vBox@@ -17,6 +16,7 @@   , padBottom   , padTopBottom   , padLeftRight+  , Padding(..)   ) import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Center as C@@ -49,7 +49,7 @@ app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         , appChooseCursor = neverShowCursor         }

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} module Main where  import Control.Monad (void)@@ -7,6 +8,8 @@ import Data.Monoid #endif import qualified Graphics.Vty as V+import Lens.Micro.Mtl+import Lens.Micro.TH  import qualified Brick.AttrMap as A import qualified Brick.Main as M@@ -23,8 +26,10 @@   ) import Brick.Util (fg, bg, on, clamp) -data MyAppState n = MyAppState { x, y, z :: Float }+data MyAppState n = MyAppState { _x, _y, _z :: Float } +makeLenses ''MyAppState+ drawUI :: MyAppState () -> [Widget ()] drawUI p = [ui]     where@@ -33,16 +38,16 @@              (A.mapAttrNames [ (xDoneAttr, P.progressCompleteAttr)                              , (xToDoAttr, P.progressIncompleteAttr)                              ]-             ) $ bar $ x p+             ) $ bar $ _x p       -- or use individual mapAttrName calls       yBar = updateAttrMap              (A.mapAttrName yDoneAttr P.progressCompleteAttr .               A.mapAttrName yToDoAttr P.progressIncompleteAttr) $-             bar $ y p+             bar $ _y p       -- or use overrideAttr calls       zBar = overrideAttr P.progressCompleteAttr zDoneAttr $              overrideAttr P.progressIncompleteAttr zToDoAttr $-             bar $ z p+             bar $ _z p       lbl c = Just $ show $ fromEnum $ c * 100       bar v = P.progressBar (lbl v) v       ui = (str "X: " <+> xBar) <=>@@ -51,16 +56,16 @@            str "" <=>            str "Hit 'x', 'y', or 'z' to advance progress, or 'q' to quit" -appEvent :: MyAppState () -> T.BrickEvent () e -> T.EventM () (T.Next (MyAppState ()))-appEvent p (T.VtyEvent e) =+appEvent :: T.BrickEvent () e -> T.EventM () (MyAppState ()) ()+appEvent (T.VtyEvent e) =     let valid = clamp (0.0 :: Float) 1.0     in case e of-         V.EvKey (V.KChar 'x') [] -> M.continue $ p { x = valid $ x p + 0.05 }-         V.EvKey (V.KChar 'y') [] -> M.continue $ p { y = valid $ y p + 0.03 }-         V.EvKey (V.KChar 'z') [] -> M.continue $ p { z = valid $ z p + 0.02 }-         V.EvKey (V.KChar 'q') [] -> M.halt p-         _ -> M.continue p-appEvent p _ = M.continue p+         V.EvKey (V.KChar 'x') [] -> x %= valid . (+ 0.05)+         V.EvKey (V.KChar 'y') [] -> y %= valid . (+ 0.03)+         V.EvKey (V.KChar 'z') [] -> z %= valid . (+ 0.02)+         V.EvKey (V.KChar 'q') [] -> M.halt+         _ -> return ()+appEvent _ = return ()  initialState :: MyAppState () initialState = MyAppState 0.25 0.18 0.63@@ -96,7 +101,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           } 

@@ -3,7 +3,7 @@ {-# LANGUAGE CPP #-} module Main where -import Lens.Micro ((.~), (^.), (&))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) import Control.Monad (void) #if !(MIN_VERSION_base(4,11,0))@@ -13,7 +13,7 @@  import Brick.Main   ( App(..), neverShowCursor, defaultMain-  , suspendAndResume, halt, continue+  , suspendAndResume, halt   ) import Brick.AttrMap   ( attrMap@@ -21,7 +21,6 @@ import Brick.Types   ( Widget   , EventM-  , Next   , BrickEvent(..)   ) import Brick.Widgets.Core@@ -42,16 +41,16 @@                   , str "(Press Esc to quit or Space to ask for input)"                   ] -appEvent :: St -> BrickEvent () e -> EventM () (Next St)-appEvent st (VtyEvent e) =+appEvent :: BrickEvent () e -> EventM () St ()+appEvent (VtyEvent e) =     case e of-        V.EvKey V.KEsc [] -> halt st+        V.EvKey V.KEsc [] -> halt         V.EvKey (V.KChar ' ') [] -> suspendAndResume $ do             putStrLn "Suspended. Please enter something and press enter to resume:"             s <- getLine-            return $ st & stExternalInput .~ s-        _ -> continue st-appEvent st _ = continue st+            return $ St { _stExternalInput = s }+        _ -> return ()+appEvent _ = return ()  initialState :: St initialState =@@ -63,7 +62,7 @@     App { appDraw = drawUI         , appChooseCursor = neverShowCursor         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         } 

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Main where  #if !(MIN_VERSION_base(4,11,0))@@ -7,6 +8,8 @@ import qualified Data.Text as T import Control.Monad (void) import Control.Concurrent+import Lens.Micro.TH+import Lens.Micro.Mtl import System.Random  import Brick@@ -14,6 +17,14 @@ import Brick.Widgets.Border import qualified Graphics.Vty as V +data AppState =+    AppState { _textAreaHeight :: Int+             , _textAreaWidth :: Int+             , _textAreaContents :: [T.Text]+             }++makeLenses ''AppState+ draw :: AppState -> Widget n draw st =     header st <=> box st@@ -22,18 +33,18 @@ header st =     padBottom (Pad 1) $     hBox [ padRight (Pad 7) $-           (str $ "Max width: " <> show (textAreaWidth st)) <=>+           (str $ "Max width: " <> show (_textAreaWidth st)) <=>            (str "Left(-)/Right(+)")-         , (str $ "Max height: " <> show (textAreaHeight st)) <=>+         , (str $ "Max height: " <> show (_textAreaHeight st)) <=>            (str "Down(-)/Up(+)")          ]  box :: AppState -> Widget n box st =     border $-    hLimit (textAreaWidth st) $-    vLimit (textAreaHeight st) $-    (renderBottomUp (txtWrap <$> textAreaContents st))+    hLimit (_textAreaWidth st) $+    vLimit (_textAreaHeight st) $+    (renderBottomUp (txtWrap <$> _textAreaContents st))  -- | Given a list of widgets, draw them bottom-up in a vertical -- arrangement, i.e., the first widget in this list will appear at the@@ -69,45 +80,39 @@     , "cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."     ] -handleEvent :: AppState -> BrickEvent n CustomEvent -> EventM n (Next AppState)-handleEvent s (AppEvent (NewLine l)) =-    continue $ s { textAreaContents = l : textAreaContents s }-handleEvent s (VtyEvent (V.EvKey V.KUp [])) =-    continue $ s { textAreaHeight = textAreaHeight s + 1 }-handleEvent s (VtyEvent (V.EvKey V.KDown [])) =-    continue $ s { textAreaHeight = max 0 $ textAreaHeight s - 1 }-handleEvent s (VtyEvent (V.EvKey V.KRight [])) =-    continue $ s { textAreaWidth = textAreaWidth s + 1 }-handleEvent s (VtyEvent (V.EvKey V.KLeft [])) =-    continue $ s { textAreaWidth = max 0 $ textAreaWidth s - 1 }-handleEvent s (VtyEvent (V.EvKey V.KEsc [])) =-    halt s-handleEvent s _ =-    continue s+handleEvent :: BrickEvent n CustomEvent -> EventM n AppState ()+handleEvent (AppEvent (NewLine l)) =+    textAreaContents %= (l :)+handleEvent (VtyEvent (V.EvKey V.KUp [])) =+    textAreaHeight %= (+ 1)+handleEvent (VtyEvent (V.EvKey V.KDown [])) =+    textAreaHeight %= max 0 . subtract 1+handleEvent (VtyEvent (V.EvKey V.KRight [])) =+    textAreaWidth %= (+ 1)+handleEvent (VtyEvent (V.EvKey V.KLeft [])) =+    textAreaWidth %= max 0 . subtract 1+handleEvent (VtyEvent (V.EvKey V.KEsc [])) =+    halt+handleEvent _ =+    return ()  data CustomEvent =     NewLine T.Text -data AppState =-    AppState { textAreaHeight :: Int-             , textAreaWidth :: Int-             , textAreaContents :: [T.Text]-             }- app :: App AppState CustomEvent () app =     App { appDraw = (:[]) . draw         , appChooseCursor = neverShowCursor         , appHandleEvent = handleEvent         , appAttrMap = const $ attrMap V.defAttr []-        , appStartEvent = return+        , appStartEvent = return ()         }  initialState :: AppState initialState =-    AppState { textAreaHeight = 20-             , textAreaWidth = 40-             , textAreaContents = []+    AppState { _textAreaHeight = 20+             , _textAreaWidth = 40+             , _textAreaContents = []              }  -- | Run forever, generating new lines of text for the application

@@ -1,7 +1,7 @@-{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Monad (void)+import Control.Monad.State (put) import Graphics.Vty   ( white, blue, green, yellow, black, magenta   , Event(EvKey)@@ -18,7 +18,6 @@   ( Widget   , BrickEvent(VtyEvent)   , EventM-  , Next   ) import Brick.Widgets.Center   ( hCenter@@ -32,7 +31,7 @@   , withDefAttr   ) import Brick.Util (on, fg)-import Brick.AttrMap (AttrName)+import Brick.AttrMap (AttrName, attrName)  ui :: Widget n ui =@@ -44,7 +43,7 @@          ]  keybindingAttr :: AttrName-keybindingAttr = "keybinding"+keybindingAttr = attrName "keybinding"  theme1 :: Theme theme1 =@@ -58,18 +57,18 @@              [ (keybindingAttr, fg yellow)              ] -appEvent :: Int -> BrickEvent () e -> EventM () (Next Int)-appEvent _ (VtyEvent (EvKey (KChar '1') [])) = continue 1-appEvent _ (VtyEvent (EvKey (KChar '2') [])) = continue 2-appEvent s (VtyEvent (EvKey (KChar 'q') [])) = halt s-appEvent s (VtyEvent (EvKey KEsc [])) = halt s-appEvent s _ = continue s+appEvent :: BrickEvent () e -> EventM () Int ()+appEvent (VtyEvent (EvKey (KChar '1') [])) = put 1+appEvent (VtyEvent (EvKey (KChar '2') [])) = put 2+appEvent (VtyEvent (EvKey (KChar 'q') [])) = halt+appEvent (VtyEvent (EvKey KEsc [])) = halt+appEvent _ = return ()  app :: App Int e () app =     App { appDraw = const [ui]         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = \s ->             -- Note that in practice this is not ideal: we don't want             -- to build an attribute from a theme every time this is

@@ -59,22 +59,22 @@ vp3Scroll :: M.ViewportScroll Name vp3Scroll = M.viewportScroll VP3 -appEvent :: () -> T.BrickEvent Name e -> T.EventM Name (T.Next ())-appEvent _ (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = M.vScrollBy vp3Scroll 1 >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = M.vScrollBy vp3Scroll (-1) >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.hScrollBy vp3Scroll 1 >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = M.hScrollBy vp3Scroll (-1) >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KDown []))  = M.vScrollBy vp1Scroll 1 >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KUp []))    = M.vScrollBy vp1Scroll (-1) >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KRight [])) = M.hScrollBy vp2Scroll 1 >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KLeft []))  = M.hScrollBy vp2Scroll (-1) >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt ()-appEvent _ _ = M.continue ()+appEvent :: T.BrickEvent Name e -> T.EventM Name () ()+appEvent (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = M.vScrollBy vp3Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = M.vScrollBy vp3Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.hScrollBy vp3Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = M.hScrollBy vp3Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KDown []))  = M.vScrollBy vp1Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KUp []))    = M.vScrollBy vp1Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KRight [])) = M.hScrollBy vp2Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KLeft []))  = M.hScrollBy vp2Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return ()  app :: M.App () e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const $ attrMap V.defAttr []           , M.appChooseCursor = M.neverShowCursor

@@ -1,7 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Main where +import Lens.Micro.TH+import Lens.Micro.Mtl import Control.Monad (void) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))@@ -26,7 +29,8 @@   , attrMap   ) import Brick.Widgets.Core-  ( hLimit+  ( Padding(..)+  , hLimit   , vLimit   , padRight   , hBox@@ -57,17 +61,19 @@ data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name           deriving (Ord, Show, Eq) -data St = St { lastClickedElement :: Maybe (T.ClickableScrollbarElement, Name) }+data St = St { _lastClickedElement :: Maybe (T.ClickableScrollbarElement, Name) } +makeLenses ''St+ drawUi :: St -> [Widget Name] drawUi st = [ui]     where         ui = C.center $ hLimit 70 $ vLimit 21 $              (vBox [ pair                    , C.hCenter (str "Last clicked scroll bar element:")-                   , str $ show $ lastClickedElement st+                   , str $ show $ _lastClickedElement st                    ])-        pair = hBox [ padRight (T.Pad 5) $+        pair = hBox [ padRight (Pad 5) $                       B.border $                       withClickableHScrollBars SBClick $                       withHScrollBars OnBottom $@@ -92,13 +98,13 @@ vp2Scroll :: M.ViewportScroll Name vp2Scroll = M.viewportScroll VP2 -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.VtyEvent (V.EvKey V.KRight []))  = M.hScrollBy vp1Scroll 1 >> M.continue st-appEvent st (T.VtyEvent (V.EvKey V.KLeft []))   = M.hScrollBy vp1Scroll (-1) >> M.continue st-appEvent st (T.VtyEvent (V.EvKey V.KDown []))   = M.vScrollBy vp2Scroll 1 >> M.continue st-appEvent st (T.VtyEvent (V.EvKey V.KUp []))     = M.vScrollBy vp2Scroll (-1) >> M.continue st-appEvent st (T.VtyEvent (V.EvKey V.KEsc []))    = M.halt st-appEvent st (T.MouseDown (SBClick el n) _ _ _) = do+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KRight []))  = M.hScrollBy vp1Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KLeft []))   = M.hScrollBy vp1Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KDown []))   = M.vScrollBy vp2Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KUp []))     = M.vScrollBy vp2Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KEsc []))    = M.halt+appEvent (T.MouseDown (SBClick el n) _ _ _) = do     case n of         VP1 -> do             let vp = M.viewportScroll VP1@@ -119,8 +125,8 @@         _ ->             return () -    M.continue $ st { lastClickedElement = Just (el, n) }-appEvent st _ = M.continue st+    lastClickedElement .= Just (el, n)+appEvent _ = return ()  theme :: AttrMap theme =@@ -132,7 +138,7 @@ app :: M.App St e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const theme           , M.appChooseCursor = M.neverShowCursor

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} module Main where@@ -6,6 +5,7 @@ import Control.Monad (void) import Lens.Micro import Lens.Micro.TH+import Lens.Micro.Mtl #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif@@ -15,7 +15,7 @@ import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B-import Brick.AttrMap (AttrMap, AttrName, attrMap)+import Brick.AttrMap (AttrMap, AttrName, attrMap, attrName) import Brick.Util (on) import Brick.Types   ( Widget@@ -55,7 +55,7 @@ vp3Size = (25, 25)  selectedAttr :: AttrName-selectedAttr = "selected"+selectedAttr = attrName "selected"  drawUi :: St -> [Widget Name] drawUi st = [ui]@@ -102,17 +102,17 @@ vp3Scroll :: M.ViewportScroll Name vp3Scroll = M.viewportScroll VP3 -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = M.continue $ st & vp3Index._2 %~ max 1 .  subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KDown []))         = M.continue $ st & vp1Index %~ min vp1Size . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp []))           = M.continue $ st & vp1Index %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KRight []))        = M.continue $ st & vp2Index %~ min vp2Size . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft []))         = M.continue $ st & vp2Index %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st-appEvent st _ = M.continue st+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = vp3Index._1 %= min (vp3Size^._1) . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = vp3Index._1 %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = vp3Index._2 %= min (vp3Size^._1) . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = vp3Index._2 %= max 1 .  subtract 1+appEvent (T.VtyEvent (V.EvKey V.KDown []))         = vp1Index %= min vp1Size . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp []))           = vp1Index %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KRight []))        = vp2Index %= min vp2Size . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft []))         = vp2Index %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return ()  theMap :: AttrMap theMap = attrMap V.defAttr@@ -122,7 +122,7 @@ app :: M.App St e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const theMap           , M.appChooseCursor = M.neverShowCursor

@@ -0,0 +1,4 @@+[keybindings]+quit = x+increment = i+decrement = d

@@ -2,9 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} -- | This module provides types and functions for managing an attribute -- map which maps attribute names ('AttrName') to attributes ('Attr').--- This module is designed to be used with the 'OverloadedStrings'--- language extension to permit easy construction of 'AttrName' values--- and you should also use 'mappend' ('<>') to combine names. -- -- Attribute maps work by mapping hierarchical attribute names to -- attributes and inheriting parent names' attributes when child names@@ -52,7 +49,6 @@ import qualified Data.Map as M import Data.Maybe (catMaybes) import Data.List (inits)-import Data.String (IsString(..)) import GHC.Generics (Generic)  import Graphics.Vty (Attr(..), MaybeDefault(..), Style)@@ -65,9 +61,9 @@ -- example: -- -- @--- "window" <> "border"--- "window" <> "title"--- "header" <> "clock" <> "seconds"+-- attrName "window" <> attrName "border"+-- attrName "window" <> attrName "title"+-- attrName "header" <> attrName "clock" <> attrName "seconds" -- @ data AttrName = AttrName [String]               deriving (Show, Read, Eq, Ord, Generic, NFData)@@ -78,9 +74,6 @@ instance Monoid AttrName where     mempty = AttrName []     mappend = (Sem.<>)--instance IsString AttrName where-    fromString = AttrName . (:[])  -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr)

@@ -3,6 +3,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-} -- | Note - this API is designed to support a narrow (but common!) set -- of use cases. If you find that you need more customization than this -- offers, then you will need to consider building your own layout and@@ -103,6 +105,7 @@ import Text.Read (readMaybe)  import Lens.Micro+import Lens.Micro.Mtl  -- | A form field. This represents an interactive input field in the -- form. Its user input is validated and thus converted into a type of@@ -138,10 +141,8 @@               -- ^ A function to render this form field. Parameters are               -- whether the field is currently focused, followed by the               -- field state.-              , formFieldHandleEvent :: BrickEvent n e -> b -> EventM n b-              -- ^ An event handler for this field. This receives the-              -- event and the field state and returns a new field-              -- state.+              , formFieldHandleEvent :: BrickEvent n e -> EventM n b ()+              -- ^ An event handler for this field.               }  -- | A form field state accompanied by the fields that manipulate that@@ -216,6 +217,8 @@          -- ^ Concatenation function for this form's field renderings.          } +suffixLenses ''Form+ -- | Compose a new rendering augmentation function with the one in the -- form field collection. For example, we might put a label on the left -- side of a form field:@@ -328,9 +331,9 @@ checkboxCustomField lb check rb stLens name label initialState =     let initVal = initialState ^. stLens -        handleEvent (MouseDown n _ _ _) s | n == name = return $ not s-        handleEvent (VtyEvent (EvKey (KChar ' ') [])) s = return $ not s-        handleEvent _ s = return s+        handleEvent (MouseDown n _ _ _) | n == name = modify not+        handleEvent (VtyEvent (EvKey (KChar ' ') [])) = modify not+        handleEvent _ = return ()      in FormFieldState { formFieldState = initVal                       , formFields = [ FormField name Just True@@ -385,8 +388,8 @@                                Just e -> listMoveToElement e l                setList s l = s & stLens .~ (snd <$> listSelectedElement l) -        handleEvent (VtyEvent e) s = handleListEvent e s-        handleEvent _ s = return s+        handleEvent (VtyEvent e) = handleListEvent e+        handleEvent _ = return ()      in FormFieldState { formFieldState = initVal                       , formFields = [ FormField name Just True@@ -447,12 +450,12 @@                 [(val, _, _)] -> Just val                 _ -> Nothing -        handleEvent _ (MouseDown n _ _ _) s =+        handleEvent _ (MouseDown n _ _ _) =             case lookupOptionValue n of-                Nothing -> return s-                Just v -> return v-        handleEvent new (VtyEvent (EvKey (KChar ' ') [])) _ = return new-        handleEvent _ _ s = return s+                Nothing -> return ()+                Just v -> put v+        handleEvent new (VtyEvent (EvKey (KChar ' ') [])) = put new+        handleEvent _ _ = return ()          optionFields = mkOptionField <$> options         mkOptionField (val, name, label) =@@ -479,10 +482,11 @@         csr = if foc then putCursor name (Location (1,0)) else id     in clickable name $        addAttr $ csr $-       hBox [ txt $ T.singleton lb-            , txt $ if isSet then T.singleton check else " "-            , txt $ T.singleton rb <> " " <> label-            ]+       txt $ T.concat $+       [ T.singleton lb+       , if isSet then T.singleton check else " "+       , T.singleton rb <> " " <> label+       ]  -- | A form field for using an editor to edit the text representation of -- a value. The other editing fields in this module are special cases of@@ -638,15 +642,15 @@  -- | The namespace for the other form attributes. formAttr :: AttrName-formAttr = "brickForm"+formAttr = attrName "brickForm"  -- | The attribute for form input fields with invalid values. invalidFormInputAttr :: AttrName-invalidFormInputAttr = formAttr <> "invalidInput"+invalidFormInputAttr = formAttr <> attrName "invalidInput"  -- | The attribute for form input fields that have the focus. focusedFormInputAttr :: AttrName-focusedFormInputAttr = formAttr <> "focusedInput"+focusedFormInputAttr = formAttr <> attrName "focusedInput"  -- | Returns whether all form fields in the form currently have valid -- values according to the fields' validation functions. This is useful@@ -729,8 +733,8 @@             in maybeInvalid (renderField foc st) : renderFields fs     in helper $ concatFields $ renderFields fields --- | Dispatch an event to the appropriate form field and return a new--- form. This handles the following events in this order:+-- | Dispatch an event to the currently focused form field. This handles+-- the following events in this order: -- -- * On @Tab@ keypresses, this changes the focus to the next field in --   the form.@@ -755,44 +759,31 @@ -- lens. The external validation flag is ignored during this step to -- ensure that external validators have a chance to get the intermediate -- validated value.-handleFormEvent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n)-handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) f =-    return $ f { formFocus = focusNext $ formFocus f }-handleFormEvent (VtyEvent (EvKey KBackTab [])) f =-    return $ f { formFocus = focusPrev $ formFocus f }-handleFormEvent e@(MouseDown n _ _ _) f =-    handleFormFieldEvent n e $ f { formFocus = focusSetCurrent n (formFocus f) }-handleFormEvent e@(MouseUp n _ _) f =-    handleFormFieldEvent n e $ f { formFocus = focusSetCurrent n (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KUp [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryBefore grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KDown [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryAfter grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KLeft [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryBefore grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KRight [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryAfter grp n) (formFocus f) }-handleFormEvent e f = forwardToCurrent e f+handleFormEvent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()+handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) =+    formFocusL %= focusNext+handleFormEvent (VtyEvent (EvKey KBackTab [])) =+    formFocusL %= focusPrev+handleFormEvent e@(MouseDown n _ _ _) = do+    formFocusL %= focusSetCurrent n+    handleFormFieldEvent e n+handleFormEvent e@(MouseUp n _ _) = do+    formFocusL %= focusSetCurrent n+    handleFormFieldEvent e n+handleFormEvent e@(VtyEvent (EvKey KUp [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryBefore grp n)+handleFormEvent e@(VtyEvent (EvKey KDown [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryAfter grp n)+handleFormEvent e@(VtyEvent (EvKey KLeft [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryBefore grp n)+handleFormEvent e@(VtyEvent (EvKey KRight [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryAfter grp n)+handleFormEvent e =+    forwardToCurrent e  getFocusGrouping :: (Eq n) => Form s e n -> n -> Maybe [n] getFocusGrouping f n = findGroup (formFieldStates f)@@ -816,16 +807,31 @@         i' = if i == 0 then length as - 1 else i - 1     in as !! i' -forwardToCurrent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n)-forwardToCurrent e f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  -> handleFormFieldEvent n e f+withFocusAndGrouping :: (Eq n) => BrickEvent n e -> (n -> [n] -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()+withFocusAndGrouping e act = do+    foc <- gets formFocus+    case focusGetCurrent foc of+        Nothing -> return ()+        Just n -> do+            f <- get+            case getFocusGrouping f n of+                Nothing -> forwardToCurrent e+                Just grp -> act n grp -handleFormFieldEvent :: (Eq n) => n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)-handleFormFieldEvent n ev f = findFieldState [] (formFieldStates f)-    where-        findFieldState _ [] = return f+withFocus :: (n -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()+withFocus act = do+    foc <- gets formFocus+    case focusGetCurrent foc of+        Nothing -> return ()+        Just n -> act n++forwardToCurrent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()+forwardToCurrent =+    withFocus . handleFormFieldEvent++handleFormFieldEvent :: (Eq n) => BrickEvent n e -> n -> EventM n (Form s e n) ()+handleFormFieldEvent ev n = do+    let findFieldState _ [] = return ()         findFieldState prev (e:es) =             case e of                 FormFieldState st stLens upd fields helper concatAll -> do@@ -833,7 +839,7 @@                         findField (field:rest) =                             case field of                                 FormField n' validate _ _ handleFunc | n == n' -> do-                                    nextSt <- handleFunc ev st+                                    (nextSt, ()) <- nestEventM st (handleFunc ev)                                     -- If the new state validates, go ahead and update                                     -- the form state with it.                                     case validate nextSt of@@ -844,10 +850,12 @@                     result <- findField fields                     case result of                         Nothing -> findFieldState (prev <> [e]) es-                        Just (newSt, maybeSt) ->+                        Just (newSt, maybeSt) -> do                             let newFieldState = FormFieldState newSt stLens upd fields helper concatAll-                            in return $ f { formFieldStates = prev <> [newFieldState] <> es-                                          , formState = case maybeSt of-                                              Nothing -> formState f-                                              Just s  -> formState f & stLens .~ s-                                          }+                            formFieldStatesL .= prev <> [newFieldState] <> es+                            case maybeSt of+                              Nothing -> return ()+                              Just s  -> formStateL.stLens .= s++    states <- gets formFieldStates+    findFieldState [] states

@@ -0,0 +1,20 @@+-- | The re-exporting catch-all module for the customizable keybindings+-- API.+--+-- To get started using this API, see the documentation in+-- @KeyDispatcher@ as well as the User Guide section on customizable+-- keybindings.+module Brick.Keybindings+  ( module Brick.Keybindings.KeyEvents+  , module Brick.Keybindings.KeyConfig+  , module Brick.Keybindings.KeyDispatcher+  , module Brick.Keybindings.Pretty+  , module Brick.Keybindings.Parse+  )+where++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.KeyDispatcher+import Brick.Keybindings.Pretty+import Brick.Keybindings.Parse

@@ -0,0 +1,203 @@+-- | 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 { kbKey :: Vty.Key+            -- ^ The key itself.+            , kbMods :: S.Set Vty.Modifier+            -- ^ The set of modifiers.+            } deriving (Eq, Show, Ord)++-- | Construct a 'Binding'. Modifier order is ignored.+binding :: Vty.Key -> [Vty.Modifier] -> Binding+binding k mods =+    Binding { kbKey = k+            , kbMods = S.fromList 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 (Show, Eq, 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 { keyConfigBindingMap :: M.Map k BindingState+              -- ^ The map of custom bindings for events with custom+              -- bindings.+              , keyConfigEvents :: KeyEvents k+              -- ^ The base mapping of events and their names that is+              -- used in this configuration.+              , keyConfigDefaultBindings :: M.Map k [Binding]+              -- ^ A mapping of events and their default key bindings,+              -- if any.+              }+              deriving (Show, 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 evs defaults bindings =+    KeyConfig { keyConfigBindingMap = M.fromList bindings+              , keyConfigEvents = evs+              , keyConfigDefaultBindings = M.fromList 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 kc e = M.lookup e $ keyConfigBindingMap kc++-- | A convenience function to return the first result of+-- 'allDefaultBindings', if any.+firstDefaultBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding+firstDefaultBinding kc ev = do+    bs <- M.lookup ev (keyConfigDefaultBindings kc)+    case bs of+        (b:_) -> Just b+        _ -> 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 kc ev =+    fromMaybe [] $ M.lookup ev (keyConfigDefaultBindings kc)++-- | A convenience function to return the first result of+-- 'allActiveBindings', if any.+firstActiveBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding+firstActiveBinding kc ev = listToMaybe $ allActiveBindings kc 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 kc ev = nub foundBindings+    where+        defaultBindings = allDefaultBindings kc ev+        foundBindings = case lookupKeyConfigBindings kc ev of+            Just (BindingList bs) -> bs+            Just Unbound -> []+            Nothing -> 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 k = Binding { kbMods = mempty, kbKey = k }++instance ToBinding Char where+    bind = bind . Vty.KChar++instance ToBinding Binding where+    bind = id++addModifier :: (ToBinding a) => Vty.Modifier -> a -> Binding+addModifier m val =+    let b = bind val+    in b { kbMods = S.insert m (kbMods b) }++-- | Add Meta to a binding.+meta :: (ToBinding a) => a -> Binding+meta = addModifier Vty.MMeta++-- | Add Ctrl to a binding.+ctrl :: (ToBinding a) => a -> Binding+ctrl = addModifier Vty.MCtrl++-- | Add Shift to a binding.+shift :: (ToBinding a) => a -> Binding+shift = addModifier Vty.MShift++-- | Function key binding.+fn :: Int -> Binding+fn = bind . Vty.KFun

@@ -0,0 +1,220 @@+-- | 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 { handlerDescription :: T.Text+            -- ^ The description of this handler's behavior.+            , 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 { 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.+               , 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 k mods (KeyDispatcher m) = M.lookup (Binding k $ S.fromList mods) 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 d k mods = do+    case lookupVtyEvent k mods d of+        Just kh -> (handlerAction $ kehHandler $ khHandler kh) >> return True+        Nothing -> return 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 conf ks = KeyDispatcher $ M.fromList $ buildKeyDispatcherPairs ks 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 m) = M.toList m++buildKeyDispatcherPairs :: (Ord k)+                        => [KeyEventHandler k m]+                        -> KeyConfig k+                        -> [(Binding, KeyHandler k m)]+buildKeyDispatcherPairs ks conf = pairs+    where+        pairs = mkPair <$> handlers+        mkPair h = (khBinding h, h)+        handlers = concat $ keyHandlersFromConfig conf <$> ks++keyHandlersFromConfig :: (Ord k)+                      => KeyConfig k+                      -> KeyEventHandler k m+                      -> [KeyHandler k m]+keyHandlersFromConfig kc eh =+    let allBindingsFor ev | Just (BindingList ks) <- lookupKeyConfigBindings kc ev = ks+                          | Just Unbound <- lookupKeyConfigBindings kc ev = []+                          | otherwise = allDefaultBindings kc ev+        bindings = case kehEventTrigger eh of+            ByKey b    -> [b]+            ByEvent ev -> allBindingsFor ev+    in [ KeyHandler { khHandler = eh, khBinding = b } | b <- bindings ]++mkHandler :: T.Text -> m () -> Handler m+mkHandler msg action =+    Handler { handlerDescription = msg+            , handlerAction = 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 ev msg action =+    KeyEventHandler { kehHandler = mkHandler msg action+                    , kehEventTrigger = ByEvent 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 b msg action =+    KeyEventHandler { kehHandler = mkHandler msg action+                    , kehEventTrigger = ByKey $ bind 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 (Show, Eq, 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 { kehHandler :: Handler m+                    -- ^ The handler to invoke.+                    , kehEventTrigger :: EventTrigger k+                    -- ^ The trigger for the handler.+                    }

@@ -0,0 +1,52 @@+-- | This module provides 'KeyEvents', a data type for mapping+-- application-defined abstract events to user-facing names (e.g.+-- for use in configuration files and documentation). This data+-- structure gives you a place to define the correspondence between+-- your application's key events and their names. A 'KeyEvents' also+-- effectively tells the key binding system about the collection of+-- possible abstract events that can be handled.+--+-- A 'KeyEvents' is used to construct a+-- 'Brick.Keybindings.KeyConfig.KeyConfig' with+-- 'Brick.Keybindings.KeyConfig.newKeyConfig'.+module Brick.Keybindings.KeyEvents+  ( KeyEvents+  , keyEvents+  , keyEventsList+  , lookupKeyEvent+  , keyEventName+  )+where++import qualified Data.Bimap as B+import qualified Data.Text as T++-- | A bidirectional mapping between events @k@ and their user-readable+-- names.+data KeyEvents k = KeyEvents (B.Bimap T.Text k)+                 deriving (Eq, Show)++-- | Build a new 'KeyEvents' map from the specified list of events and+-- names. Key event names are stored in lowercase.+--+-- Calls 'error' if any events have the same name (ignoring case) or if+-- multiple names map to the same event.+keyEvents :: (Ord k) => [(T.Text, k)] -> KeyEvents k+keyEvents pairs =+    let m = B.fromList [(T.strip $ T.toLower n, e) | (n, e) <- pairs]+    in if B.size m /= length pairs+       then error "keyEvents: input list contains duplicates by name or by event value"+       else KeyEvents $ B.fromList pairs++-- | Convert the 'KeyEvents' to a list.+keyEventsList :: KeyEvents k -> [(T.Text, k)]+keyEventsList (KeyEvents m) = B.toList m++-- | Look up the specified event name to get its abstract event. The+-- lookup ignores leading and trailing whitespace as well as case.+lookupKeyEvent :: (Ord k) => KeyEvents k -> T.Text -> Maybe k+lookupKeyEvent (KeyEvents m) name = B.lookup (T.strip $ T.toLower name) m++-- | Given an abstract event, get its event name.+keyEventName :: (Ord k) => KeyEvents k -> k -> Maybe T.Text+keyEventName (KeyEvents m) e = B.lookupR e m

@@ -0,0 +1,181 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides key binding string parsing functions for use+-- in e.g. reading key bindings from configuration files.+module Brick.Keybindings.Parse+  ( parseBinding+  , parseBindingList++  , keybindingsFromIni+  , keybindingsFromFile+  , keybindingIniParser+  )+where++import Control.Monad (forM)+import Data.Maybe (catMaybes)+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Graphics.Vty as Vty+import Text.Read (readMaybe)+import qualified Data.Ini.Config as Ini++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig++-- | Parse a key binding list into a 'BindingState'.+--+-- A key binding list either the string @"unbound"@ or is a+-- comma-separated list of 'Binding's parsed with 'parseBinding'.+parseBindingList :: T.Text -> Either String BindingState+parseBindingList t =+    if T.toLower t == "unbound"+    then return Unbound+    else BindingList <$> mapM (parseBinding . T.strip) (T.splitOn "," $ T.strip t)++-- | Parse a key binding string. Key binding strings specify zero or+-- more modifier keys and a base key, separated by hyphens.+--+-- @+-- (modifier "-")* key+-- @+--+-- e.g. @c-down@, @backspace@, @ctrl-shift-f1@.+--+-- where each @modifier@ is parsed case-insensitively as follows:+--+-- * @"s", "shift"@: 'Vty.MShift'+-- * @"m", "meta"@: 'Vty.MMeta'+-- * @"a", "alt"@: 'Vty.MAlt'+-- * @"c", "ctrl", "control"@: 'Vty.MCtrl'+--+-- and @key@ is parsed case-insensitively as follows:+--+-- * "f1", "f2", ...: 'Vty.KFun'+-- * "esc": 'Vty.KEsc'+-- * "backspace": 'Vty.KBS'+-- * "enter": 'Vty.KEnter'+-- * "left": 'Vty.KLeft'+-- * "right": 'Vty.KRight'+-- * "up": 'Vty.KUp'+-- * "down": 'Vty.KDown'+-- * "upleft": 'Vty.KUpLeft'+-- * "upright": 'Vty.KUpRight'+-- * "downleft": 'Vty.KDownLeft'+-- * "downright": 'Vty.KDownRight'+-- * "center": 'Vty.KCenter'+-- * "backtab": 'Vty.KBackTab'+-- * "printscreen": 'Vty.KPrtScr'+-- * "pause": 'Vty.KPause'+-- * "insert": 'Vty.KIns'+-- * "home": 'Vty.KHome'+-- * "pgup": 'Vty.KPageUp'+-- * "del": 'Vty.KDel'+-- * "end": 'Vty.KEnd'+-- * "pgdown": 'Vty.KPageDown'+-- * "begin": 'Vty.KBegin'+-- * "menu": 'Vty.KMenu'+-- * "space": @' '@+-- * "tab": @'\\t'@+-- * Otherwise, 'Vty.KChar'+parseBinding :: T.Text -> Either String Binding+parseBinding s = go (T.splitOn "-" $ T.toLower s) []+  where go [k] mods = do+          k' <- pKey k+          return Binding { kbMods = S.fromList mods, kbKey = k' }+        go (k:ks) mods = do+          m <- case k of+            "s"       -> return Vty.MShift+            "shift"   -> return Vty.MShift+            "m"       -> return Vty.MMeta+            "meta"    -> return Vty.MMeta+            "a"       -> return Vty.MAlt+            "alt"     -> return Vty.MAlt+            "c"       -> return Vty.MCtrl+            "ctrl"    -> return Vty.MCtrl+            "control" -> return Vty.MCtrl+            _         -> Left ("Unknown modifier prefix: " ++ show k)+          go ks (m:mods)+        go [] _ = Left "Empty keybinding not allowed"+        pKey "esc"       = return Vty.KEsc+        pKey "backspace" = return Vty.KBS+        pKey "enter"     = return Vty.KEnter+        pKey "left"      = return Vty.KLeft+        pKey "right"     = return Vty.KRight+        pKey "up"        = return Vty.KUp+        pKey "down"      = return Vty.KDown+        pKey "upleft"    = return Vty.KUpLeft+        pKey "upright"   = return Vty.KUpRight+        pKey "downleft"  = return Vty.KDownLeft+        pKey "downright" = return Vty.KDownRight+        pKey "center"    = return Vty.KCenter+        pKey "backtab"   = return Vty.KBackTab+        pKey "printscreen" = return Vty.KPrtScr+        pKey "pause"     = return Vty.KPause+        pKey "insert"    = return Vty.KIns+        pKey "home"      = return Vty.KHome+        pKey "pgup"      = return Vty.KPageUp+        pKey "del"       = return Vty.KDel+        pKey "end"       = return Vty.KEnd+        pKey "pgdown"    = return Vty.KPageDown+        pKey "begin"     = return Vty.KBegin+        pKey "menu"      = return Vty.KMenu+        pKey "space"     = return (Vty.KChar ' ')+        pKey "tab"       = return (Vty.KChar '\t')+        pKey t+          | T.length t == 1 =+              return (Vty.KChar $ T.last s)+          | Just n <- T.stripPrefix "f" t =+              case readMaybe (T.unpack n) of+                  Nothing -> Left ("Unknown keybinding: " ++ show t)+                  Just i -> return (Vty.KFun i)+          | otherwise = Left ("Unknown keybinding: " ++ show t)++-- | Parse custom key bindings from the specified INI file using the+-- provided event name mapping.+--+-- Each line in the specified section can take the form+--+-- > <event-name> = <"unbound"|[binding,...]>+--+-- where the event name must be a valid event name in the specified+-- 'KeyEvents' and each binding is valid as parsed by 'parseBinding'.+--+-- Returns @Nothing@ if the named section was not found; otherwise+-- returns a (possibly empty) list of binding states for each event in+-- @evs@.+keybindingsFromIni :: KeyEvents k+                   -- ^ The key event name mapping to use to parse the+                   -- configuration data.+                   -> T.Text+                   -- ^ The name of the INI configuration section to+                   -- read.+                   -> T.Text+                   -- ^ The text of the INI document to read.+                   -> Either String (Maybe [(k, BindingState)])+keybindingsFromIni evs section doc =+    Ini.parseIniFile doc (keybindingIniParser evs section)++-- | Parse custom key binidngs from the specified INI file path. This+-- does not catch or convert any exceptions resulting from I/O errors.+-- See 'keybindingsFromIni' for details.+keybindingsFromFile :: KeyEvents k+                    -- ^ The key event name mapping to use to parse the+                    -- configuration data.+                    -> T.Text+                    -- ^ The name of the INI configuration section to+                    -- read.+                    -> FilePath+                    -- ^ The path to the INI file to read.+                    -> IO (Either String (Maybe [(k, BindingState)]))+keybindingsFromFile evs section path =+    keybindingsFromIni evs section <$> T.readFile path++-- | The low-level INI parser for custom key bindings used by this+-- module, exported for applications that use the @config-ini@ package.+keybindingIniParser :: KeyEvents k -> T.Text -> Ini.IniParser (Maybe [(k, BindingState)])+keybindingIniParser evs section =+    Ini.sectionMb section $ do+        fmap catMaybes $ forM (keyEventsList evs) $ \(name, e) -> do+            fmap (e,) <$> Ini.fieldMbOf name parseBindingList

@@ -0,0 +1,249 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides functions for pretty-printing key bindings+-- and for generating Markdown, plain text, and Brick displays of event+-- handler key binding configurations.+module Brick.Keybindings.Pretty+  (+  -- * Generating help output+    keybindingTextTable+  , keybindingMarkdownTable+  , keybindingHelpWidget++  -- * Pretty-printing primitives+  , ppBinding+  , ppMaybeBinding+  , ppKey+  , ppModifier++  -- * Attributes for Widget rendering+  , keybindingHelpBaseAttr+  , eventNameAttr+  , eventDescriptionAttr+  , keybindingAttr+  )+where++import Brick+import Data.List (sort, intersperse)+import Data.Maybe (fromJust)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Graphics.Vty as Vty++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.KeyDispatcher++data TextHunk = Verbatim T.Text+              | Comment T.Text++-- | Generate a Markdown document of sections indicating the key binding+-- state for each event handler.+keybindingMarkdownTable :: (Ord k)+                        => KeyConfig k+                        -- ^ The key binding configuration in use.+                        -> [(T.Text, [KeyEventHandler k m])]+                        -- ^ Key event handlers by named section.+                        -> T.Text+keybindingMarkdownTable kc sections = title <> keybindSectionStrings+    where title = "# Keybindings\n"+          keybindSectionStrings = T.concat $ sectionText <$> sections+          sectionText (heading, handlers) =+              mkHeading heading <>+              mkKeybindEventSectionHelp kc keybindEventHelpMarkdown T.unlines handlers+          mkHeading n =+              "\n# " <> n <>+              "\n| Keybinding | Event Name | Description |" <>+              "\n| ---------- | ---------- | ----------- |\n"++-- | Generate a plain text document of sections indicating the key+-- binding state for each event handler.+keybindingTextTable :: (Ord k)+                    => KeyConfig k+                    -- ^ The key binding configuration in use.+                    -> [(T.Text, [KeyEventHandler k m])]+                    -- ^ Key event handlers by named section.+                    -> T.Text+keybindingTextTable kc sections = title <> keybindSectionStrings+    where title = "Keybindings\n===========\n"+          keybindSectionStrings = T.concat $ sectionText <$> sections+          sectionText (heading, handlers) =+              mkHeading heading <>+              mkKeybindEventSectionHelp kc (keybindEventHelpText keybindingWidth eventNameWidth) T.unlines handlers+          keybindingWidth = 15+          eventNameWidth = 30+          mkHeading n =+              "\n" <> n <>+              "\n" <> (T.replicate (T.length n) "=") <>+              "\n"++keybindEventHelpText :: Int -> Int -> (TextHunk, T.Text, [TextHunk]) -> T.Text+keybindEventHelpText width eventNameWidth (evName, desc, evs) =+    let getText (Comment s) = s+        getText (Verbatim s) = s+    in padTo width (T.intercalate ", " $ getText <$> evs) <> " " <>+       padTo eventNameWidth (getText evName) <> " " <>+       desc++padTo :: Int -> T.Text -> T.Text+padTo n s = s <> T.replicate (n - T.length s) " "++mkKeybindEventSectionHelp :: (Ord k)+                          => KeyConfig k+                          -> ((TextHunk, T.Text, [TextHunk]) -> a)+                          -> ([a] -> a)+                          -> [KeyEventHandler k m]+                          -> a+mkKeybindEventSectionHelp kc mkKeybindHelpFunc vertCat kbs =+  vertCat $ mkKeybindHelpFunc <$> (mkKeybindEventHelp kc <$> kbs)++keybindEventHelpMarkdown :: (TextHunk, T.Text, [TextHunk]) -> T.Text+keybindEventHelpMarkdown (evName, desc, evs) =+    let quote s = "`" <> s <> "`"+        format (Comment s) = s+        format (Verbatim s) = quote s+        name = case evName of+            Comment s -> s+            Verbatim s -> quote s+    in "| " <> (T.intercalate ", " $ format <$> evs) <>+       " | " <> name <>+       " | " <> desc <>+       " |"++mkKeybindEventHelp :: (Ord k)+                   => KeyConfig k+                   -> KeyEventHandler k m+                   -> (TextHunk, T.Text, [TextHunk])+mkKeybindEventHelp kc h =+  let trig = kehEventTrigger h+      unbound = [Comment "(unbound)"]+      (label, evText) = case trig of+          ByKey b ->+              (Comment "(non-customizable key)", [Verbatim $ ppBinding b])+          ByEvent ev ->+              let name = fromJust $ keyEventName (keyConfigEvents kc) ev+              in case lookupKeyConfigBindings kc ev of+                  Nothing ->+                      if not (null (allDefaultBindings kc ev))+                      then (Verbatim name, Verbatim <$> ppBinding <$> allDefaultBindings kc ev)+                      else (Verbatim name, unbound)+                  Just Unbound ->+                      (Verbatim name, unbound)+                  Just (BindingList bs) ->+                      let result = if not (null bs)+                                   then Verbatim <$> ppBinding <$> bs+                                   else unbound+                      in (Verbatim name, result)+  in (label, handlerDescription $ kehHandler h, evText)++-- | Build a 'Widget' displaying key binding information for a single+-- related group of event handlers. This is provided for convenience+-- so that basic help text for the application's event handlers can be+-- produced and embedded in the UI.+--+-- The resulting widget lists the key events (and keys) bound to the+-- specified handlers, along with the events' names and the list of+-- available key bindings for each handler.+keybindingHelpWidget :: (Ord k)+                     => KeyConfig k+                     -- ^ The key binding configuration in use.+                     -> [KeyEventHandler k m]+                     -- ^ The list of the event handlers to include in+                     -- the help display.+                     -> Widget n+keybindingHelpWidget kc =+    withDefAttr keybindingHelpBaseAttr .+    mkKeybindEventSectionHelp kc keybindEventHelpWidget (vBox . intersperse (str " "))++keybindEventHelpWidget :: (TextHunk, T.Text, [TextHunk]) -> Widget n+keybindEventHelpWidget (evName, desc, evs) =+    let evText = T.intercalate ", " (getText <$> evs)+        getText (Comment s) = s+        getText (Verbatim s) = s+        label = withDefAttr eventNameAttr $ case evName of+            Comment s -> txt s -- TODO: was "; " <> s+            Verbatim s -> txt s -- TODO: was: emph $ txt s+    in vBox [ withDefAttr eventDescriptionAttr $ txt desc+            , label <+> txt " = " <+> withDefAttr keybindingAttr (txt evText)+            ]++-- | Pretty-print a 'Binding' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppBinding :: Binding -> T.Text+ppBinding (Binding k mods) =+    T.intercalate "-" $ (ppModifier <$> modifierList mods) <> [ppKey k]++modifierList :: S.Set Vty.Modifier -> [Vty.Modifier]+modifierList = sort . S.toList++-- | Pretty-print a 'Binding' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'; if no binding is given,+-- produce a message indicating no binding.+ppMaybeBinding :: Maybe Binding -> T.Text+ppMaybeBinding Nothing =+    "(no binding)"+ppMaybeBinding (Just b) =+    ppBinding b++-- | Pretty-print a 'Vty.Key' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppKey :: Vty.Key -> T.Text+ppKey (Vty.KChar c)   = ppChar c+ppKey (Vty.KFun n)    = "F" <> (T.pack $ show n)+ppKey Vty.KBackTab    = "BackTab"+ppKey Vty.KEsc        = "Esc"+ppKey Vty.KBS         = "Backspace"+ppKey Vty.KEnter      = "Enter"+ppKey Vty.KUp         = "Up"+ppKey Vty.KDown       = "Down"+ppKey Vty.KLeft       = "Left"+ppKey Vty.KRight      = "Right"+ppKey Vty.KHome       = "Home"+ppKey Vty.KEnd        = "End"+ppKey Vty.KPageUp     = "PgUp"+ppKey Vty.KPageDown   = "PgDown"+ppKey Vty.KDel        = "Del"+ppKey Vty.KUpLeft     = "UpLeft"+ppKey Vty.KUpRight    = "UpRight"+ppKey Vty.KDownLeft   = "DownLeft"+ppKey Vty.KDownRight  = "DownRight"+ppKey Vty.KCenter     = "Center"+ppKey Vty.KPrtScr     = "PrintScreen"+ppKey Vty.KPause      = "Pause"+ppKey Vty.KIns        = "Insert"+ppKey Vty.KBegin      = "Begin"+ppKey Vty.KMenu       = "Menu"++-- | Pretty-print a character in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppChar :: Char -> T.Text+ppChar '\t' = "Tab"+ppChar ' '  = "Space"+ppChar c    = T.singleton c++-- | Pretty-print a 'Vty.Modifier' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppModifier :: Vty.Modifier -> T.Text+ppModifier Vty.MMeta  = "M"+ppModifier Vty.MAlt   = "A"+ppModifier Vty.MCtrl  = "C"+ppModifier Vty.MShift = "S"++-- | The base attribute for 'Widget' keybinding help.+keybindingHelpBaseAttr :: AttrName+keybindingHelpBaseAttr = attrName "keybindingHelp"++-- | The attribute for event names in keybinding help 'Widget's.+eventNameAttr :: AttrName+eventNameAttr = keybindingHelpBaseAttr <> attrName "eventName"++-- | The attribute for event descriptions in keybinding help 'Widget's.+eventDescriptionAttr :: AttrName+eventDescriptionAttr = keybindingHelpBaseAttr <> attrName "eventDescription"++-- | The attribute for keybinding lists in keybinding help 'Widget's.+keybindingAttr :: AttrName+keybindingAttr = keybindingHelpBaseAttr <> attrName "keybinding"

@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-} module Brick.Main   ( App(..)   , defaultMain@@ -9,10 +10,10 @@   , simpleApp    -- * Event handler functions-  , continue   , continueWithoutRedraw   , halt   , suspendAndResume+  , suspendAndResume'   , makeVisible   , lookupViewport   , lookupExtent@@ -53,10 +54,8 @@  import qualified Control.Exception as E import Lens.Micro ((^.), (&), (.~), (%~), _1, _2)-import Control.Monad (forever)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State-import Control.Monad.Trans.Reader+import Control.Monad.State.Strict+import Control.Monad.Reader import Control.Concurrent (forkIO, killThread) import qualified Data.Foldable as F import Data.List (find)@@ -81,7 +80,7 @@ import Graphics.Vty.Attributes (defAttr)  import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan)-import Brick.Types (EventM(..))+import Brick.Types.EventM import Brick.Types.Internal import Brick.Widgets.Internal import Brick.AttrMap@@ -110,13 +109,13 @@         -- is that many widgets may request a cursor placement but your         -- application state is what you probably want to use to decide         -- which one wins.-        , appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)+        , 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'.-        , appStartEvent :: s -> EventM n s+        , appStartEvent :: EventM n s ()         -- ^ This function gets called once just prior to the first         -- drawing of your application. Here is where you can make         -- initial scrolling requests, for example.@@ -159,7 +158,7 @@ simpleApp w =     App { appDraw = const [w]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap defAttr []         , appChooseCursor = neverShowCursor         }@@ -169,46 +168,40 @@ -- a halt. This is a convenience function useful as an 'appHandleEvent' -- value for simple applications using the 'Event' type that do not need -- to get more sophisticated user input.-resizeOrQuit :: s -> BrickEvent n e -> EventM n (Next s)-resizeOrQuit s (VtyEvent (EvResize _ _)) = continue s-resizeOrQuit s _ = halt s--data InternalNext n a = InternalSuspendAndResume (RenderState n) (IO a)-                      | InternalHalt a+resizeOrQuit :: BrickEvent n e -> EventM n s ()+resizeOrQuit (VtyEvent (EvResize _ _)) = return ()+resizeOrQuit _ = halt  readBrickEvent :: BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e) readBrickEvent brickChan userChan = either id AppEvent <$> readBChan2 brickChan userChan  runWithVty :: (Ord n)-           => Vty+           => VtyContext            -> BChan (BrickEvent n e)            -> Maybe (BChan e)            -> App s e n            -> RenderState n            -> s-           -> IO (InternalNext n s)-runWithVty vty brickChan mUserChan app initialRS initialSt = do-    pid <- forkIO $ supplyVtyEvents vty brickChan+           -> IO (s, VtyContext)+runWithVty vtyCtx brickChan mUserChan app initialRS initialSt = do     let readEvent = case mUserChan of           Nothing -> readBChan brickChan           Just uc -> readBrickEvent brickChan uc-        runInner rs es draw st = do+        runInner ctx rs es draw st = do           let nextRS = if draw                        then resetRenderState rs                        else rs-          (result, newRS, newExtents) <- runVty vty readEvent app st nextRS es draw+          (nextSt, result, newRS, newExtents, newCtx) <- runVty ctx readEvent app st nextRS es draw           case result of-              SuspendAndResume act -> do-                  killThread pid-                  return $ InternalSuspendAndResume newRS act-              Halt s -> do-                  killThread pid-                  return $ InternalHalt s-              Continue s -> runInner newRS newExtents True s-              ContinueWithoutRedraw s ->-                  runInner newRS newExtents False s-    runInner initialRS mempty True initialSt+              Halt ->+                  return (nextSt, newCtx)+              Continue ->+                  runInner newCtx newRS newExtents True nextSt+              ContinueWithoutRedraw ->+                  runInner newCtx newRS newExtents False nextSt +    runInner vtyCtx initialRS mempty True initialSt+ -- | The custom event loop entry point to use when the simpler ones -- don't permit enough control. Returns the final application state -- after the application halts.@@ -267,22 +260,19 @@                   -- ^ The initial application state.                   -> IO (s, Vty) customMainWithVty initialVty buildVty mUserChan app initialAppState = do-    let run vty rs st brickChan = do-            result <- runWithVty vty brickChan mUserChan app rs st-                `E.catch` (\(e::E.SomeException) -> shutdown vty >> E.throw e)-            case result of-                InternalHalt s -> return (s, vty)-                InternalSuspendAndResume newRS action -> do-                    shutdown vty-                    newAppState <- action-                    newVty <- buildVty-                    run newVty (newRS { renderCache = mempty }) newAppState brickChan+    brickChan <- newBChan 20+    vtyCtx <- newVtyContext buildVty (Just initialVty) (writeBChan brickChan . VtyEvent) -    let emptyES = ES [] mempty mempty+    let emptyES = ES { esScrollRequests = []+                     , cacheInvalidateRequests = mempty+                     , requestedVisibleNames = mempty+                     , nextAction = Continue+                     , vtyContext = vtyCtx+                     }         emptyRS = RS M.empty mempty S.empty mempty mempty mempty mempty-        eventRO = EventRO M.empty initialVty mempty emptyRS+        eventRO = EventRO M.empty mempty emptyRS -    (st, eState) <- runStateT (runReaderT (runEventM (appStartEvent app initialAppState)) eventRO) emptyES+    (((), appState), eState) <- runStateT (runStateT (runReaderT (runEventM (appStartEvent app)) eventRO) initialAppState) emptyES     let initialRS = RS { viewportMap = M.empty                        , rsScrollRequests = esScrollRequests eState                        , observedNames = S.empty@@ -291,27 +281,57 @@                        , requestedVisibleNames_ = requestedVisibleNames eState                        , reportedExtents = mempty                        }-    brickChan <- newBChan 20-    run initialVty initialRS st brickChan -supplyVtyEvents :: Vty -> BChan (BrickEvent n e) -> IO ()-supplyVtyEvents vty chan =-    forever $ do-        e <- nextEvent vty-        writeBChan chan $ VtyEvent e+    (s, ctx) <- runWithVty vtyCtx brickChan mUserChan app initialRS appState+                `E.catch` (\(e::E.SomeException) -> shutdownVtyContext vtyCtx >> E.throw e) +    -- Shut down the context's event thread but do NOT shut down Vty+    -- itself because we want the handle to be live when we return it to+    -- the caller.+    shutdownVtyContextThread ctx+    return (s, vtyContextHandle ctx)++supplyVtyEvents :: Vty -> (Event -> IO ()) -> IO ()+supplyVtyEvents vty putEvent =+    forever $ putEvent =<< nextEvent vty++newVtyContextFrom :: VtyContext -> IO VtyContext+newVtyContextFrom old =+    newVtyContext (vtyContextBuilder old) Nothing (vtyContextPutEvent old)++newVtyContext :: IO Vty -> Maybe Vty -> (Event -> IO ()) -> IO VtyContext+newVtyContext builder handle putEvent = do+    vty <- case handle of+        Just h -> return h+        Nothing -> builder+    tId <- forkIO $ supplyVtyEvents vty putEvent+    return VtyContext { vtyContextHandle = vty+                      , vtyContextBuilder = builder+                      , vtyContextThread = tId+                      , vtyContextPutEvent = putEvent+                      }++shutdownVtyContext :: VtyContext -> IO ()+shutdownVtyContext ctx = do+    shutdown $ vtyContextHandle ctx+    shutdownVtyContextThread ctx++shutdownVtyContextThread :: VtyContext -> IO ()+shutdownVtyContextThread ctx =+    killThread $ vtyContextThread ctx+ runVty :: (Ord n)-       => Vty+       => VtyContext        -> IO (BrickEvent n e)        -> App s e n        -> s        -> RenderState n        -> [Extent n]        -> Bool-       -> IO (Next s, RenderState n, [Extent n])-runVty vty readEvent app appState rs prevExtents draw = do+       -> IO (s, NextAction, RenderState n, [Extent n], VtyContext)+runVty vtyCtx readEvent app appState rs prevExtents draw = do     (firstRS, exts) <- if draw-                       then renderApp vty app appState rs+                       then renderApp vtyCtx app appState rs                        else return (rs, prevExtents)      e <- readEvent@@ -322,7 +342,7 @@         -- want the event handler to have access to accurate viewport         -- information.         VtyEvent (EvResize _ _) -> do-            (rs', exts') <- renderApp vty app appState $ firstRS & observedNamesL .~ S.empty+            (rs', exts') <- renderApp vtyCtx app appState $ firstRS & observedNamesL .~ S.empty             return (e, rs', exts')         VtyEvent (EvMouseDown c r button mods) -> do             let matching = findClickedExtents_ (c, r) exts@@ -374,18 +394,20 @@                 _ -> return (e, firstRS, exts)         _ -> return (e, firstRS, exts) -    let emptyES = ES [] mempty mempty-        eventRO = EventRO (viewportMap nextRS) vty nextExts nextRS+    let emptyES = ES [] mempty mempty Continue vtyCtx+        eventRO = EventRO (viewportMap nextRS) nextExts nextRS -    (next, eState) <- runStateT (runReaderT (runEventM (appHandleEvent app appState e'))-                                eventRO) emptyES-    return ( next+    (((), newAppState), eState) <- runStateT (runStateT (runReaderT (runEventM (appHandleEvent app e'))+                                eventRO) appState) emptyES+    return ( newAppState+           , nextAction eState            , nextRS { rsScrollRequests = esScrollRequests eState                     , renderCache = applyInvalidations (cacheInvalidateRequests eState) $                                     renderCache nextRS                     , requestedVisibleNames_ = requestedVisibleNames eState                     }            , nextExts+           , vtyContext eState            )  applyInvalidations :: (Ord n) => S.Set (CacheInvalidateRequest n) -> M.Map n v -> M.Map n v@@ -410,7 +432,7 @@ -- associated functions without relying on this function. Those -- functions queue up scrolling requests that can be made in advance of -- the next rendering to affect the viewport.-lookupViewport :: (Ord n) => n -> EventM n (Maybe Viewport)+lookupViewport :: (Ord n) => n -> EventM n s (Maybe Viewport) lookupViewport n = EventM $ asks (M.lookup n . eventViewportMap)  -- | Did the specified mouse coordinates (column, row) intersect the@@ -422,7 +444,7 @@  -- | Given a resource name, get the most recent rendering extent for the -- name (if any).-lookupExtent :: (Eq n) => n -> EventM n (Maybe (Extent n))+lookupExtent :: (Eq n) => n -> EventM n s (Maybe (Extent n)) lookupExtent n = EventM $ asks (find f . latestExtents)     where         f (Extent n' _ _) = n == n'@@ -432,28 +454,32 @@ -- the list is the most specific extent and the last extent is the most -- generic (top-level). So if two extents A and B both intersected the -- mouse click but A contains B, then they would be returned [B, A].-findClickedExtents :: (Int, Int) -> EventM n [Extent n]+findClickedExtents :: (Int, Int) -> EventM n s [Extent n] findClickedExtents pos = EventM $ asks (findClickedExtents_ pos . latestExtents)  findClickedExtents_ :: (Int, Int) -> [Extent n] -> [Extent n] findClickedExtents_ pos = reverse . filter (clickedExtent pos)  -- | Get the Vty handle currently in use.-getVtyHandle :: EventM n Vty-getVtyHandle = EventM $ asks eventVtyHandle+getVtyHandle :: EventM n s Vty+getVtyHandle = vtyContextHandle <$> getVtyContext +setVtyContext :: VtyContext -> EventM n s ()+setVtyContext ctx =+    EventM $ lift $ lift $ modify $ \s -> s { vtyContext = ctx }+ -- | Invalidate the rendering cache entry with the specified resource -- name.-invalidateCacheEntry :: (Ord n) => n -> EventM n ()+invalidateCacheEntry :: (Ord n) => n -> EventM n s () invalidateCacheEntry n = EventM $ do-    lift $ modify (\s -> s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })  -- | Invalidate the entire rendering cache.-invalidateCache :: (Ord n) => EventM n ()+invalidateCache :: (Ord n) => EventM n s () invalidateCache = EventM $ do-    lift $ modify (\s -> s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s })+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s }) -getRenderState :: EventM n (RenderState n)+getRenderState :: EventM n s (RenderState n) getRenderState = EventM $ asks oldState  resetRenderState :: RenderState n -> RenderState n@@ -461,9 +487,9 @@     s & observedNamesL .~ S.empty       & clickableNamesL .~ mempty -renderApp :: (Ord n) => Vty -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n])-renderApp vty app appState rs = do-    sz <- displayBounds $ outputIface vty+renderApp :: (Ord n) => VtyContext -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n])+renderApp vtyCtx app appState rs = do+    sz <- displayBounds $ outputIface $ vtyContextHandle vtyCtx     let (newRS, pic, theCursor, exts) = renderFinal (appAttrMap app appState)                                         (appDraw app appState)                                         sz@@ -478,7 +504,7 @@                                            (cloc^.locationRowL)                              } -    update vty picWithCursor+    update (vtyContextHandle vtyCtx) picWithCursor      return (newRS, exts) @@ -509,38 +535,38 @@     ViewportScroll { viewportName :: n                    -- ^ The name of the viewport to be controlled by                    -- this scrolling handle.-                   , hScrollPage :: Direction -> EventM n ()+                   , hScrollPage :: forall s. Direction -> EventM n s ()                    -- ^ Scroll the viewport horizontally by one page in                    -- the specified direction.-                   , hScrollBy :: Int -> EventM n ()+                   , hScrollBy :: forall s. Int -> EventM n s ()                    -- ^ Scroll the viewport horizontally by the                    -- specified number of rows or columns depending on                    -- the orientation of the viewport.-                   , hScrollToBeginning :: EventM n ()+                   , hScrollToBeginning :: forall s. EventM n s ()                    -- ^ Scroll horizontally to the beginning of the                    -- viewport.-                   , hScrollToEnd :: EventM n ()+                   , hScrollToEnd :: forall s. EventM n s ()                    -- ^ Scroll horizontally to the end of the viewport.-                   , vScrollPage :: Direction -> EventM n ()+                   , vScrollPage :: forall s. Direction -> EventM n s ()                    -- ^ Scroll the viewport vertically by one page in                    -- the specified direction.-                   , vScrollBy :: Int -> EventM n ()+                   , vScrollBy :: forall s. Int -> EventM n s ()                    -- ^ Scroll the viewport vertically by the specified                    -- number of rows or columns depending on the                    -- orientation of the viewport.-                   , vScrollToBeginning :: EventM n ()+                   , vScrollToBeginning :: forall s. EventM n s ()                    -- ^ Scroll vertically to the beginning of the viewport.-                   , vScrollToEnd :: EventM n ()+                   , vScrollToEnd :: forall s. EventM n s ()                    -- ^ Scroll vertically to the end of the viewport.-                   , setTop :: Int -> EventM n ()+                   , setTop :: forall s. Int -> EventM n s ()                    -- ^ Set the top row offset of the viewport.-                   , setLeft :: Int -> EventM n ()+                   , setLeft :: forall s. Int -> EventM n s ()                    -- ^ Set the left column offset of the viewport.                    } -addScrollRequest :: (n, ScrollRequest) -> EventM n ()+addScrollRequest :: (n, ScrollRequest) -> EventM n s () addScrollRequest req = EventM $ do-    lift $ modify (\s -> s { esScrollRequests = req : esScrollRequests s })+    lift $ lift $ modify (\s -> s { esScrollRequests = req : esScrollRequests s })  -- | Build a viewport scroller for the viewport with the specified name. viewportScroll :: n -> ViewportScroll n@@ -559,11 +585,6 @@                    }  -- | Continue running the event loop with the specified application--- state.-continue :: s -> EventM n (Next s)-continue = return . Continue---- | Continue running the event loop with the specified application -- 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@@ -571,30 +592,51 @@ -- '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.-continueWithoutRedraw :: s -> EventM n (Next s)-continueWithoutRedraw = return . ContinueWithoutRedraw+continueWithoutRedraw :: EventM n s ()+continueWithoutRedraw =+    EventM $ lift $ lift $ modify $ \es -> es { nextAction = ContinueWithoutRedraw }  -- | Halt the event loop and return the specified application state as -- the final state value.-halt :: s -> EventM n (Next s)-halt = return . Halt+halt :: EventM n s ()+halt =+    EventM $ lift $ lift $ modify $ \es -> es { nextAction = Halt }  -- | Suspend the event loop, save the terminal state, and run the -- specified action. When it returns an application state value, restore--- the terminal state, empty the rendering cache, redraw the application--- from the new state, and resume the event loop.+-- the terminal state, empty the rendering cache, update the application+-- state with the returned state, and continue execution of the event+-- handler that called this. -- -- Note that any changes made to the terminal's input state are ignored -- when Brick resumes execution and are not preserved in the final -- terminal input state after the Brick application returns the terminal -- to the user.-suspendAndResume :: IO s -> EventM n (Next s)-suspendAndResume = return . SuspendAndResume+suspendAndResume :: (Ord n) => IO s -> EventM n s ()+suspendAndResume act = suspendAndResume' act >>= put +-- | Suspend the event loop, save the terminal state, and run the+-- specified action. When it completes, restore the terminal state,+-- empty the rendering cache, return the result, and continue execution+-- of the event handler that called this.+--+-- Note that any changes made to the terminal's input state are ignored+-- when Brick resumes execution and are not preserved in the final+-- terminal input state after the Brick application returns the terminal+-- to the user.+suspendAndResume' :: (Ord n) => IO a -> EventM n s a+suspendAndResume' act = do+    ctx <- getVtyContext+    liftIO $ shutdownVtyContext ctx+    result <- liftIO act+    setVtyContext =<< (liftIO $ newVtyContextFrom ctx)+    invalidateCache+    return result+ -- | Request that the specified UI element be made visible on the -- next rendering. This is provided to allow event handlers to make -- visibility requests in the same way that the 'visible' function does -- at rendering time.-makeVisible :: (Ord n) => n -> EventM n ()+makeVisible :: (Ord n) => n -> EventM n s () makeVisible n = EventM $ do-    lift $ modify (\s -> s { requestedVisibleNames = S.insert n $ requestedVisibleNames s })+    lift $ lift $ modify (\s -> s { requestedVisibleNames = S.insert n $ requestedVisibleNames s })

@@ -1,7 +1,6 @@ -- | Basic types used by this library. {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Brick.Types   ( -- * The Widget type@@ -27,11 +26,11 @@   , ScrollbarRenderer(..)   , ClickableScrollbarElement(..) -  -- * Event-handling types-  , EventM(..)-  , Next+  -- * Event-handling types and functions+  , EventM   , BrickEvent(..)-  , handleEventLensed+  , nestEventM+  , nestEventM'    -- * Rendering infrastructure   , RenderM@@ -85,63 +84,72 @@    -- * Miscellaneous   , Size(..)-  , Padding(..)   , Direction(..)    -- * Renderer internals (for benchmarking)   , RenderState++  -- * Re-exports for convenience+  , get+  , gets+  , put+  , modify+  , zoom   ) where -import Lens.Micro (_1, _2, to, (^.), (&), (.~), Lens')+import Lens.Micro (_1, _2, to, (^.)) import Lens.Micro.Type (Getting)-import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)+import Lens.Micro.Mtl (zoom) #if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail) #endif-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader+import Control.Monad.State.Strict+import Control.Monad.Reader import Graphics.Vty (Attr)-import Control.Monad.IO.Class  import Brick.Types.TH import Brick.Types.Internal+import Brick.Types.EventM import Brick.AttrMap (AttrName, attrMapLookup) --- | The type of padding.-data Padding = Pad Int-             -- ^ Pad by the specified number of rows or columns.-             | Max-             -- ^ Pad up to the number of available rows or columns.+-- | Given a state value and an 'EventM' that mutates that state, run+-- the specified action and return resulting modified state.+nestEventM' :: a+           -- ^ The initial state to use in the nested action.+            -> EventM n a b+            -- ^ The action to run.+            -> EventM n s a+nestEventM' s act = fst <$> nestEventM s act --- | A convenience function for handling events intended for values--- that are targets of lenses in your application state. This function--- obtains the target value of the specified lens, invokes 'handleEvent'--- on it, and stores the resulting transformed value back in the state--- using the lens.-handleEventLensed :: a-                  -- ^ The state value.-                  -> Lens' a b-                  -- ^ The lens to use to extract and store the target-                  -- of the event.-                  -> (e -> b -> EventM n b)-                  -- ^ The event handler.-                  -> e-                  -- ^ The event to handle.-                  -> EventM n a-handleEventLensed v target handleEvent ev = do-    newB <- handleEvent ev (v^.target)-    return $ v & target .~ newB+-- | Given a state value and an 'EventM' that mutates that state, run+-- the specified action and return both the resulting modified state and+-- the result of the action itself.+nestEventM :: a+           -- ^ The initial state to use in the nested action.+           -> EventM n a b+           -- ^ The action to run.+           -> EventM n s (a, b)+nestEventM s' act = do+    ro <- EventM ask+    es <- EventM $ lift $ lift get+    vtyCtx <- getVtyContext+    let stInner = ES { nextAction = Continue+                     , esScrollRequests = esScrollRequests es+                     , cacheInvalidateRequests = cacheInvalidateRequests es+                     , requestedVisibleNames = requestedVisibleNames es+                     , vtyContext = vtyCtx+                     }+    ((actResult, newSt), stInnerFinal) <- liftIO $ runStateT (runStateT (runReaderT (runEventM act) ro) s') stInner --- | The monad in which event handlers run. Although it may be tempting--- to dig into the reader value yourself, just use--- 'Brick.Main.lookupViewport'.-newtype EventM n a =-    EventM { runEventM :: ReaderT (EventRO n) (StateT (EventState n) IO) a-           }-           deriving ( Functor, Applicative, Monad, MonadIO-                    , MonadThrow, MonadCatch, MonadMask, MonadFail-                    )+    EventM $ lift $ lift $ modify $+        \st -> st { nextAction = nextAction stInnerFinal+                  , esScrollRequests = esScrollRequests stInnerFinal+                  , cacheInvalidateRequests = cacheInvalidateRequests stInnerFinal+                  , requestedVisibleNames = requestedVisibleNames stInnerFinal+                  , vtyContext = vtyContext stInnerFinal+                  }+    return (newSt, actResult)  -- | The rendering context's current drawing attribute. attrL :: forall r n. Getting r (Context n) Attr

@@ -0,0 +1,45 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Brick.Types.EventM+  ( EventM(..)+  , getVtyContext+  )+where++import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif+import Control.Monad.Reader+import Control.Monad.State.Strict+import Lens.Micro.Mtl+import Lens.Micro.Mtl.Internal++import Brick.Types.Internal++-- | The monad in which event handlers run.+newtype EventM n s a =+    EventM { runEventM :: ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a+           }+           deriving ( Functor, Applicative, Monad, MonadIO+                    , MonadThrow, MonadCatch, MonadMask+#if !MIN_VERSION_base(4,13,0)+                    , MonadFail+#endif+                    )++instance MonadState s (EventM n s) where+    get = EventM $ lift get+    put = EventM . lift . put++getVtyContext :: EventM n s VtyContext+getVtyContext = EventM $ lift $ lift $ gets vtyContext++type instance Zoomed (EventM n s) = Zoomed (StateT s (StateT (EventState n) IO))++instance Zoom (EventM n s) (EventM n t) s t where+    zoom l (EventM m) = EventM (zoom l m)

@@ -45,8 +45,9 @@   , Size(..)    , EventState(..)+  , VtyContext(..)   , EventRO(..)-  , Next(..)+  , NextAction(..)   , Result(..)   , Extent(..)   , Edges(..)@@ -82,9 +83,9 @@   ) where -import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Reader-import Control.Monad.Trans.State.Lazy+import Control.Concurrent (ThreadId)+import Control.Monad.Reader+import Control.Monad.State.Strict import Lens.Micro (_1, _2, Lens') import Lens.Micro.Mtl (use) import Lens.Micro.TH (makeLenses)@@ -214,37 +215,47 @@  -- | The type of viewports that indicates the direction(s) in which a -- viewport is scrollable.-data ViewportType = Vertical-                  -- ^ Viewports of this type are scrollable only vertically.-                  | Horizontal-                  -- ^ Viewports of this type are scrollable only horizontally.-                  | Both-                  -- ^ Viewports of this type are scrollable vertically and horizontally.-                  deriving (Show, Eq)+data ViewportType =+    Vertical+    -- ^ Viewports of this type are scrollable only vertically.+    | Horizontal+    -- ^ Viewports of this type are scrollable only horizontally.+    | Both+    -- ^ Viewports of this type are scrollable vertically and horizontally.+    deriving (Show, Eq)  data CacheInvalidateRequest n =     InvalidateSingle n     | InvalidateEntire     deriving (Ord, Eq) -data EventState n = ES { esScrollRequests :: [(n, ScrollRequest)]-                       , cacheInvalidateRequests :: S.Set (CacheInvalidateRequest n)-                       , requestedVisibleNames :: S.Set n-                       }+data EventState n =+    ES { esScrollRequests :: ![(n, ScrollRequest)]+       , cacheInvalidateRequests :: !(S.Set (CacheInvalidateRequest n))+       , requestedVisibleNames :: !(S.Set n)+       , nextAction :: !NextAction+       , vtyContext :: VtyContext+       } +data VtyContext =+    VtyContext { vtyContextBuilder :: IO Vty+               , vtyContextHandle :: Vty+               , vtyContextThread :: ThreadId+               , vtyContextPutEvent :: Event -> IO ()+               }+ -- | An extent of a named area: its size, location, and origin.-data Extent n = Extent { extentName      :: n-                       , extentUpperLeft :: Location-                       , extentSize      :: (Int, Int)+data Extent n = Extent { extentName      :: !n+                       , extentUpperLeft :: !Location+                       , extentSize      :: !(Int, Int)                        }                        deriving (Show, Read, Generic, NFData)  -- | The type of actions to take upon completion of an event handler.-data Next a = Continue a-            | ContinueWithoutRedraw a-            | SuspendAndResume (IO a)-            | Halt a-            deriving Functor+data NextAction =+    Continue+    | ContinueWithoutRedraw+    | Halt  -- | Scrolling direction. data Direction = Up@@ -310,15 +321,15 @@ -- result provides the image, cursor positions, and visibility requests -- that resulted from the rendering process. data Result n =-    Result { image :: Image+    Result { image :: !Image            -- ^ The final rendered image for a widget-           , cursors :: [CursorLocation n]+           , cursors :: ![CursorLocation n]            -- ^ The list of reported cursor positions for the            -- application to choose from-           , visibilityRequests :: [VisibilityRequest]+           , visibilityRequests :: ![VisibilityRequest]            -- ^ The list of visibility requests made by widgets rendered            -- while rendering this one (used by viewports)-           , extents :: [Extent n]+           , extents :: ![Extent n]            -- Programmer's note: we don't try to maintain the invariant that            -- the size of the borders closely matches the size of the 'image'            -- field. Most widgets don't need to care about borders, and so they@@ -331,7 +342,7 @@            -- If you're writing a widget, this should make it easier for you to            -- do so; but beware this lack of invariant if you are consuming            -- widgets.-           , borders :: BorderMap DynBorder+           , borders :: !(BorderMap DynBorder)            -- ^ Places where we may rewrite the edge of the image when            -- placing this widget next to another one.            }@@ -362,7 +373,6 @@                     deriving (Show, Eq, Ord)  data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport-                         , eventVtyHandle :: Vty                          , latestExtents :: [Extent n]                          , oldState :: RenderState n                          }

@@ -39,7 +39,7 @@  -- | The top-level border attribute name. borderAttr :: AttrName-borderAttr = "border"+borderAttr = attrName "border"  -- | Draw the specified border element using the active border style -- using 'borderAttr'.

@@ -22,6 +22,7 @@   , hyperlink    -- * Padding+  , Padding(..)   , padLeft   , padRight   , padTop@@ -121,10 +122,8 @@  import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens') import Lens.Micro.Mtl (use, (%=))-import Control.Monad ((>=>),when)-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Class (lift)+import Control.Monad.State.Strict+import Control.Monad.Reader import qualified Data.Foldable as F import qualified Data.Text as T import qualified Data.DList as DL@@ -377,6 +376,12 @@         let attr = (c^.attrL) `V.withURL` url         withReaderT (ctxAttrMapL %~ setDefaultAttr attr) (render p) +-- | The type of padding.+data Padding = Pad Int+             -- ^ Pad by the specified number of rows or columns.+             | Max+             -- ^ Pad up to the number of available rows or columns.+ -- | Pad the specified widget on the left. If max padding is used, this -- grows greedily horizontally; otherwise it defers to the padded -- widget.@@ -863,13 +868,14 @@         render $ cropToContext p  -- | When drawing the specified widget, set the attribute used for--- drawing to the one with the specified name. Note that the widget--- may use further calls to 'withAttr' to change the active drawing--- attribute, so this only takes effect if nothing in the specified--- widget invokes 'withAttr'. If you want to prevent that, use--- 'forceAttr'. Attributes used this way still get merged hierarchically--- and still fall back to the attribute map's default attribute. If you--- want to change the default attribute, use 'withDefAttr'.+-- drawing to the one with the specified name. Note that the widget may+-- make further changes to the active drawing attribute, so this only+-- takes effect if nothing in the specified widget invokes 'withAttr'+-- or otherwise changes the rendering context's attribute setup. If you+-- want to prevent that, use 'forceAttr'. Attributes used this way still+-- get merged hierarchically and still fall back to the attribute map's+-- default attribute. If you want to change the default attribute, use+-- 'withDefAttr'. -- -- For example: --@@ -1539,17 +1545,17 @@  -- | The base attribute for scroll bars. scrollbarAttr :: AttrName-scrollbarAttr = "scrollbar"+scrollbarAttr = attrName "scrollbar"  -- | The attribute for scroll bar troughs. This attribute is a -- specialization of @scrollbarAttr@. scrollbarTroughAttr :: AttrName-scrollbarTroughAttr = scrollbarAttr <> "trough"+scrollbarTroughAttr = scrollbarAttr <> attrName "trough"  -- | The attribute for scroll bar handles. This attribute is a -- specialization of @scrollbarAttr@. scrollbarHandleAttr :: AttrName-scrollbarHandleAttr = scrollbarAttr <> "handle"+scrollbarHandleAttr = scrollbarAttr <> attrName "handle"  maybeClick :: (Ord n)            => n

@@ -72,9 +72,9 @@  suffixLenses ''Dialog -handleDialogEvent :: Event -> Dialog a -> EventM n (Dialog a)-handleDialogEvent ev d =-    return $ case ev of+handleDialogEvent :: Event -> EventM n (Dialog a) ()+handleDialogEvent ev = do+    modify $ \d -> case ev of         EvKey (KChar '\t') [] -> nextButtonBy 1 True d         EvKey KBackTab [] -> nextButtonBy (-1) True d         EvKey KRight [] -> nextButtonBy 1 False d@@ -99,15 +99,15 @@  -- | The default attribute of the dialog dialogAttr :: AttrName-dialogAttr = "dialog"+dialogAttr = attrName "dialog"  -- | The default attribute for all dialog buttons buttonAttr :: AttrName-buttonAttr = "button"+buttonAttr = attrName "button"  -- | The attribute for the selected dialog button (extends 'dialogAttr') buttonSelectedAttr :: AttrName-buttonSelectedAttr = buttonAttr <> "selected"+buttonSelectedAttr = buttonAttr <> attrName "selected"  -- | Render a dialog with the specified body widget. This renders the -- dialog as a layer, which makes this suitable as a top-level layer in

@@ -62,6 +62,7 @@  -- | Editor state.  Editors support the following events by default: --+-- * Mouse clicks: change cursor position -- * Meta-<: go to beginning of file -- * Meta->: go to end of file -- * Ctrl-a, Home: go to beginning of line@@ -118,11 +119,10 @@  handleEditorEvent :: (Eq n, DecodeUtf8 t, Eq t, Z.GenericTextZipper t)                   => BrickEvent n e-                  -> Editor t n-                  -> EventM n (Editor t n)-handleEditorEvent e ed = return $ applyEdit f ed-    where-        f = case e of+                  -> EventM n (Editor t n) ()+handleEditorEvent e = do+    ed <- get+    let f = case e of               VtyEvent ev ->                   handleVtyEvent ev               MouseDown n _ _ (Location pos) | n == getName ed ->@@ -156,6 +156,7 @@             EvKey (KChar '<') [MMeta] -> Z.gotoBOF             EvKey (KChar '>') [MMeta] -> Z.gotoEOF             _ -> id+    put $ applyEdit f ed  -- | Construct an editor over 'Text' values editorText :: n@@ -192,12 +193,12 @@  -- | The attribute assigned to the editor when it does not have focus. editAttr :: AttrName-editAttr = "edit"+editAttr = attrName "edit"  -- | The attribute assigned to the editor when it has focus. Extends -- 'editAttr'. editFocusedAttr :: AttrName-editFocusedAttr = editAttr <> "focused"+editFocusedAttr = editAttr <> attrName "focused"  -- | Get the contents of the editor. getEditContents :: Monoid t => Editor t n -> [t]

@@ -155,6 +155,7 @@ import qualified Data.Set as Set import qualified Data.Vector as V import Lens.Micro+import Lens.Micro.Mtl ((%=)) import Lens.Micro.TH (lensRules, generateUpdateableOptics) import qualified Graphics.Vty as Vty import qualified System.Directory as D@@ -164,7 +165,7 @@ import Text.Printf (printf)  import Brick.Types-import Brick.AttrMap (AttrName)+import Brick.AttrMap (AttrName, attrName) import Brick.Widgets.Core import Brick.Widgets.List @@ -356,10 +357,10 @@             Left (_::E.IOException) -> entries             Right parent -> parent : entries -    let b' = setEntries allEntries b-    return $ b' & fileBrowserWorkingDirectoryL .~ path-                & fileBrowserExceptionL .~ exc-                & fileBrowserSelectedFilesL .~ mempty+    return $ (setEntries allEntries b)+                 & fileBrowserWorkingDirectoryL .~ path+                 & fileBrowserExceptionL .~ exc+                 & fileBrowserSelectedFilesL .~ mempty  parentOf :: FilePath -> IO FileInfo parentOf path = getFileInfo ".." $ FP.takeDirectory path@@ -593,126 +594,120 @@ -- * @Esc@, @Ctrl-C@: cancel search mode -- * Text input: update search string -actionFileBrowserBeginSearch :: FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserBeginSearch b =-    return $ updateFileBrowserSearch (const $ Just "") b+actionFileBrowserBeginSearch :: EventM n (FileBrowser n) ()+actionFileBrowserBeginSearch =+    modify $ updateFileBrowserSearch (const $ Just "") -actionFileBrowserSelectEnter :: FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserSelectEnter b =-    maybeSelectCurrentEntry b+actionFileBrowserSelectEnter :: EventM n (FileBrowser n) ()+actionFileBrowserSelectEnter =+    maybeSelectCurrentEntry -actionFileBrowserSelectCurrent :: FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserSelectCurrent b =-    selectCurrentEntry b+actionFileBrowserSelectCurrent :: EventM n (FileBrowser n) ()+actionFileBrowserSelectCurrent =+    selectCurrentEntry -actionFileBrowserListPageUp :: Ord n => FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserListPageUp b = do-    let old = b ^. fileBrowserEntriesL-    new <- listMovePageUp old-    return $ b & fileBrowserEntriesL .~ new+actionFileBrowserListPageUp :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPageUp =+    zoom fileBrowserEntriesL listMovePageUp -actionFileBrowserListPageDown :: Ord n => FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserListPageDown b = do-    let old = b ^. fileBrowserEntriesL-    new <- listMovePageDown old-    return $ b & fileBrowserEntriesL .~ new+actionFileBrowserListPageDown :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPageDown =+    zoom fileBrowserEntriesL listMovePageDown -actionFileBrowserListHalfPageUp :: Ord n => FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserListHalfPageUp b = do-    let old = b ^. fileBrowserEntriesL-    new <- listMoveByPages (-0.5::Double) old-    return $ b & fileBrowserEntriesL .~ new+actionFileBrowserListHalfPageUp :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListHalfPageUp =+    zoom fileBrowserEntriesL (listMoveByPages (-0.5::Double)) -actionFileBrowserListHalfPageDown :: Ord n => FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserListHalfPageDown b = do-    let old = b ^. fileBrowserEntriesL-    new <- listMoveByPages (0.5::Double) old-    return $ b & fileBrowserEntriesL .~ new+actionFileBrowserListHalfPageDown :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListHalfPageDown =+    zoom fileBrowserEntriesL (listMoveByPages (0.5::Double)) -actionFileBrowserListTop :: Ord n => FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserListTop b =-    return $ b & fileBrowserEntriesL %~ listMoveTo 0+actionFileBrowserListTop :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListTop =+    fileBrowserEntriesL %= listMoveTo 0 -actionFileBrowserListBottom :: Ord n => FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserListBottom b = do+actionFileBrowserListBottom :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListBottom = do+    b <- get     let sz = length (listElements $ b^.fileBrowserEntriesL)-    return $ b & fileBrowserEntriesL %~ listMoveTo (sz - 1)+    fileBrowserEntriesL %= listMoveTo (sz - 1) -actionFileBrowserListNext :: Ord n => FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserListNext b =-    return $ b & fileBrowserEntriesL %~ listMoveBy 1+actionFileBrowserListNext :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListNext =+    fileBrowserEntriesL %= listMoveBy 1 -actionFileBrowserListPrev :: Ord n => FileBrowser n -> EventM n (FileBrowser n)-actionFileBrowserListPrev b =-    return $ b & fileBrowserEntriesL %~ listMoveBy (-1)+actionFileBrowserListPrev :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPrev =+    fileBrowserEntriesL %= listMoveBy (-1) -handleFileBrowserEvent :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)-handleFileBrowserEvent e b =+handleFileBrowserEvent :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEvent e = do+    b <- get     if fileBrowserIsSearching b-    then handleFileBrowserEventSearching e b-    else handleFileBrowserEventNormal e b+        then handleFileBrowserEventSearching e+        else handleFileBrowserEventNormal e  safeInit :: T.Text -> T.Text safeInit t | T.length t == 0 = t            | otherwise = T.init t -handleFileBrowserEventSearching :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)-handleFileBrowserEventSearching e b =+handleFileBrowserEventSearching :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventSearching e =     case e of         Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl] ->-            return $ updateFileBrowserSearch (const Nothing) b+            modify $ updateFileBrowserSearch (const Nothing)         Vty.EvKey Vty.KEsc [] ->-            return $ updateFileBrowserSearch (const Nothing) b+            modify $ updateFileBrowserSearch (const Nothing)         Vty.EvKey Vty.KBS [] ->-            return $ updateFileBrowserSearch (fmap safeInit) b-        Vty.EvKey Vty.KEnter [] ->-            updateFileBrowserSearch (const Nothing) <$>-                maybeSelectCurrentEntry b+            modify $ updateFileBrowserSearch (fmap safeInit)+        Vty.EvKey Vty.KEnter [] -> do+            maybeSelectCurrentEntry+            modify $ updateFileBrowserSearch (const Nothing)         Vty.EvKey (Vty.KChar c) [] ->-            return $ updateFileBrowserSearch (fmap (flip T.snoc c)) b+            modify $ updateFileBrowserSearch (fmap (flip T.snoc c))         _ ->-            handleFileBrowserEventCommon e b+            handleFileBrowserEventCommon e -handleFileBrowserEventNormal :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)-handleFileBrowserEventNormal e b =+handleFileBrowserEventNormal :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventNormal e =     case e of         Vty.EvKey (Vty.KChar '/') [] ->             -- Begin file search-            actionFileBrowserBeginSearch b+            actionFileBrowserBeginSearch         Vty.EvKey Vty.KEnter [] ->             -- Select file or enter directory-            actionFileBrowserSelectEnter b+            actionFileBrowserSelectEnter         Vty.EvKey (Vty.KChar ' ') [] ->             -- Select entry-            actionFileBrowserSelectCurrent b+            actionFileBrowserSelectCurrent         _ ->-            handleFileBrowserEventCommon e b+            handleFileBrowserEventCommon e -handleFileBrowserEventCommon :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)-handleFileBrowserEventCommon e b =+handleFileBrowserEventCommon :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventCommon e =     case e of         Vty.EvKey (Vty.KChar 'b') [Vty.MCtrl] ->-            actionFileBrowserListPageUp b+            actionFileBrowserListPageUp         Vty.EvKey (Vty.KChar 'f') [Vty.MCtrl] ->-            actionFileBrowserListPageDown b+            actionFileBrowserListPageDown         Vty.EvKey (Vty.KChar 'd') [Vty.MCtrl] ->-            actionFileBrowserListHalfPageDown b+            actionFileBrowserListHalfPageDown         Vty.EvKey (Vty.KChar 'u') [Vty.MCtrl] ->-            actionFileBrowserListHalfPageUp b+            actionFileBrowserListHalfPageUp         Vty.EvKey (Vty.KChar 'g') [] ->-            actionFileBrowserListTop b+            actionFileBrowserListTop         Vty.EvKey (Vty.KChar 'G') [] ->-            actionFileBrowserListBottom b+            actionFileBrowserListBottom         Vty.EvKey (Vty.KChar 'j') [] ->-            actionFileBrowserListNext b+            actionFileBrowserListNext         Vty.EvKey (Vty.KChar 'k') [] ->-            actionFileBrowserListPrev b+            actionFileBrowserListPrev         Vty.EvKey (Vty.KChar 'n') [Vty.MCtrl] ->-            actionFileBrowserListNext b+            actionFileBrowserListNext         Vty.EvKey (Vty.KChar 'p') [Vty.MCtrl] ->-            actionFileBrowserListPrev b+            actionFileBrowserListPrev         _ ->-            handleEventLensed b fileBrowserEntriesL handleListEvent e+            zoom fileBrowserEntriesL $ handleListEvent e  -- | If the browser's current entry is selectable according to -- @fileBrowserSelectable@, add it to the selection set and return.@@ -720,30 +715,32 @@ -- directory, set the browser's current path to the selected directory. -- -- Otherwise, return the browser state unchanged.-maybeSelectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n)-maybeSelectCurrentEntry b =+maybeSelectCurrentEntry :: EventM n (FileBrowser n) ()+maybeSelectCurrentEntry = do+    b <- get     case fileBrowserCursor b of-        Nothing -> return b+        Nothing -> return ()         Just entry ->             if fileBrowserSelectable b entry-            then return $ b & fileBrowserSelectedFilesL %~ Set.insert (fileInfoFilename entry)+            then fileBrowserSelectedFilesL %= Set.insert (fileInfoFilename entry)             else case fileInfoFileType entry of                 Just Directory ->-                    liftIO $ setWorkingDirectory (fileInfoFilePath entry) b+                    put =<< (liftIO $ setWorkingDirectory (fileInfoFilePath entry) b)                 Just SymbolicLink ->                     case fileInfoLinkTargetType entry of-                        Just Directory -> do-                            liftIO $ setWorkingDirectory (fileInfoFilePath entry) b+                        Just Directory ->+                            put =<< (liftIO $ setWorkingDirectory (fileInfoFilePath entry) b)                         _ ->-                            return b+                            return ()                 _ ->-                    return b+                    return () -selectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n)-selectCurrentEntry b =+selectCurrentEntry :: EventM n (FileBrowser n) ()+selectCurrentEntry = do+    b <- get     case fileBrowserCursor b of-        Nothing -> return b-        Just e -> return $ b & fileBrowserSelectedFilesL %~ Set.insert (fileInfoFilename e)+        Nothing -> return ()+        Just e -> fileBrowserSelectedFilesL %= Set.insert (fileInfoFilename e)  -- | Render a file browser. This renders a list of entries in the -- working directory, a cursor to select from among the entries, a@@ -840,49 +837,49 @@  -- | The base attribute for all file browser attributes. fileBrowserAttr :: AttrName-fileBrowserAttr = "fileBrowser"+fileBrowserAttr = attrName "fileBrowser"  -- | The attribute used for the current directory displayed at the top -- of the browser. fileBrowserCurrentDirectoryAttr :: AttrName-fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> "currentDirectory"+fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> attrName "currentDirectory"  -- | The attribute used for the entry information displayed at the -- bottom of the browser. fileBrowserSelectionInfoAttr :: AttrName-fileBrowserSelectionInfoAttr = fileBrowserAttr <> "selectionInfo"+fileBrowserSelectionInfoAttr = fileBrowserAttr <> attrName "selectionInfo"  -- | The attribute used to render directory entries. fileBrowserDirectoryAttr :: AttrName-fileBrowserDirectoryAttr = fileBrowserAttr <> "directory"+fileBrowserDirectoryAttr = fileBrowserAttr <> attrName "directory"  -- | The attribute used to render block device entries. fileBrowserBlockDeviceAttr :: AttrName-fileBrowserBlockDeviceAttr = fileBrowserAttr <> "block"+fileBrowserBlockDeviceAttr = fileBrowserAttr <> attrName "block"  -- | The attribute used to render regular file entries. fileBrowserRegularFileAttr :: AttrName-fileBrowserRegularFileAttr = fileBrowserAttr <> "regular"+fileBrowserRegularFileAttr = fileBrowserAttr <> attrName "regular"  -- | The attribute used to render character device entries. fileBrowserCharacterDeviceAttr :: AttrName-fileBrowserCharacterDeviceAttr = fileBrowserAttr <> "char"+fileBrowserCharacterDeviceAttr = fileBrowserAttr <> attrName "char"  -- | The attribute used to render named pipe entries. fileBrowserNamedPipeAttr :: AttrName-fileBrowserNamedPipeAttr = fileBrowserAttr <> "pipe"+fileBrowserNamedPipeAttr = fileBrowserAttr <> attrName "pipe"  -- | The attribute used to render symbolic link entries. fileBrowserSymbolicLinkAttr :: AttrName-fileBrowserSymbolicLinkAttr = fileBrowserAttr <> "symlink"+fileBrowserSymbolicLinkAttr = fileBrowserAttr <> attrName "symlink"  -- | The attribute used to render Unix socket entries. fileBrowserUnixSocketAttr :: AttrName-fileBrowserUnixSocketAttr = fileBrowserAttr <> "unixSocket"+fileBrowserUnixSocketAttr = fileBrowserAttr <> attrName "unixSocket"  -- | The attribute used for selected entries in the file browser. fileBrowserSelectedAttr :: AttrName-fileBrowserSelectedAttr = fileBrowserAttr <> "selected"+fileBrowserSelectedAttr = fileBrowserAttr <> attrName "selected"  -- | A file type filter for use with 'setFileBrowserEntryFilter'. This -- filter permits entries whose file types are in the specified list.

@@ -10,9 +10,8 @@  import Lens.Micro ((^.), (&), (%~)) import Lens.Micro.Mtl ((%=))-import Control.Monad (forM_)-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader+import Control.Monad.State.Strict+import Control.Monad.Reader import Data.Maybe (fromMaybe) import qualified Data.Map as M import qualified Data.Set as S

@@ -37,6 +37,7 @@   , listSelectedL   , listNameL   , listItemHeightL+  , listSelectedElementL    -- * Accessors   , listElements@@ -79,9 +80,9 @@  import Control.Applicative ((<|>)) import Data.Foldable (find, toList)-import Control.Monad.Trans.State (evalState, get, put)+import Control.Monad.State (evalState) -import Lens.Micro ((^.), (^?), (&), (.~), (%~), _2, _head, set)+import Lens.Micro (Traversal', (^.), (^?), (&), (.~), (%~), _2, set) import Data.Functor (($>)) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Maybe (fromMaybe)@@ -193,17 +194,16 @@ -- * Go to last element (End) handleListEvent :: (Foldable t, Splittable t, Ord n)                 => Event-                -> GenericList n t e-                -> EventM n (GenericList n t e)-handleListEvent e theList =+                -> EventM n (GenericList n t e) ()+handleListEvent e =     case e of-        EvKey KUp [] -> return $ listMoveUp theList-        EvKey KDown [] -> return $ listMoveDown theList-        EvKey KHome [] -> return $ listMoveToBeginning theList-        EvKey KEnd [] -> return $ listMoveToEnd theList-        EvKey KPageDown [] -> listMovePageDown theList-        EvKey KPageUp [] -> listMovePageUp theList-        _ -> return theList+        EvKey KUp [] -> modify listMoveUp+        EvKey KDown [] -> modify listMoveDown+        EvKey KHome [] -> modify listMoveToBeginning+        EvKey KEnd [] -> modify listMoveToEnd+        EvKey KPageDown [] -> listMovePageDown+        EvKey KPageUp [] -> listMovePageUp+        _ -> return ()  -- | Enable list movement with the vi keys with a fallback handler if -- none match. Use 'handleListEventVi' 'handleListEvent' in place of@@ -219,23 +219,22 @@ -- * Go to first element (g) -- * Go to last element (G) handleListEventVi :: (Foldable t, Splittable t, Ord n)-                  => (Event -> GenericList n t e -> EventM n (GenericList n t e))+                  => (Event -> EventM n (GenericList n t e) ())                   -- ^ Fallback event handler to use if none of the vi keys                   -- match.                   -> Event-                  -> GenericList n t e-                  -> EventM n (GenericList n t e)-handleListEventVi fallback e theList =+                  -> EventM n (GenericList n t e) ()+handleListEventVi fallback e =     case e of-        EvKey (KChar 'k') [] -> return $ listMoveUp theList-        EvKey (KChar 'j') [] -> return $ listMoveDown theList-        EvKey (KChar 'g') [] -> return $ listMoveToBeginning theList-        EvKey (KChar 'G') [] -> return $ listMoveToEnd theList-        EvKey (KChar 'f') [MCtrl] -> listMovePageDown theList-        EvKey (KChar 'b') [MCtrl] -> listMovePageUp theList-        EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double) theList-        EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double) theList-        _ -> fallback e theList+        EvKey (KChar 'k') []      -> modify listMoveUp+        EvKey (KChar 'j') []      -> modify listMoveDown+        EvKey (KChar 'g') []      -> modify listMoveToBeginning+        EvKey (KChar 'G') []      -> modify listMoveToEnd+        EvKey (KChar 'f') [MCtrl] -> listMovePageDown+        EvKey (KChar 'b') [MCtrl] -> listMovePageUp+        EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double)+        EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double)+        _                         -> fallback e  -- | Move the list selection to the first element in the list. listMoveToBeginning :: (Foldable t, Splittable t)@@ -251,17 +250,17 @@  -- | The top-level attribute used for the entire list. listAttr :: AttrName-listAttr = "list"+listAttr = attrName "list"  -- | The attribute used only for the currently-selected list item when -- the list does not have focus. Extends 'listAttr'. listSelectedAttr :: AttrName-listSelectedAttr = listAttr <> "selected"+listSelectedAttr = listAttr <> attrName "selected"  -- | The attribute used only for the currently-selected list item when -- the list has focus. Extends 'listSelectedAttr'. listSelectedFocusedAttr :: AttrName-listSelectedFocusedAttr = listSelectedAttr <> "focused"+listSelectedFocusedAttr = listSelectedAttr <> attrName "focused"  -- | Construct a list in terms of container 't' with element type 'e'. list :: (Foldable t)@@ -474,8 +473,7 @@  -- | Move the list selected index up by one page. listMovePageUp :: (Foldable t, Splittable t, Ord n)-               => GenericList n t e-               -> EventM n (GenericList n t e)+               => EventM n (GenericList n t e) () listMovePageUp = listMoveByPages (-1::Double)  -- | Move the list selected index down by one. (Moves the cursor down,@@ -487,23 +485,22 @@  -- | Move the list selected index down by one page. listMovePageDown :: (Foldable t, Splittable t, Ord n)-                 => GenericList n t e-                 -> EventM n (GenericList n t e)+                 => EventM n (GenericList n t e) () listMovePageDown = listMoveByPages (1::Double)  -- | Move the list selected index by some (fractional) number of pages. listMoveByPages :: (Foldable t, Splittable t, Ord n, RealFrac m)                 => m-                -> GenericList n t e-                -> EventM n (GenericList n t e)-listMoveByPages pages theList = do+                -> EventM n (GenericList n t e) ()+listMoveByPages pages = do+    theList <- get     v <- lookupViewport (theList^.listNameL)     case v of-        Nothing -> return theList+        Nothing -> return ()         Just vp -> do             let nElems = round $ pages * fromIntegral (vp^.vpSize._2) /                                  fromIntegral (theList^.listItemHeightL)-            return $ listMoveBy nElems theList+            modify $ listMoveBy nElems  -- | Move the list selected index. --@@ -602,6 +599,28 @@         result = tailResult <|> headResult     in maybe id (set listSelectedL . Just . fst) result l +-- | Traversal that targets the selected element, if any.+--+-- Complexity: depends on usage as well as the list's container type.+--+-- @+-- listSelectedElementL for 'List': O(1) -- preview, fold+--                                O(n) -- set, modify, traverse+-- listSelectedElementL for 'Seq.Seq': O(log(min(i, n - i)))  -- all operations+-- @+--+listSelectedElementL :: (Splittable t, Traversable t, Semigroup (t e))+                     => Traversal' (GenericList n t e) e+listSelectedElementL f l =+    case l ^. listSelectedL of+        Nothing -> pure l+        Just i -> listElementsL go l+            where+                go l' = let (left, rest) = splitAt i l'+                            -- middle contains the target element (if any)+                            (middle, right) = splitAt 1 rest+                        in (\m -> left <> m <> right) <$> (traverse f middle)+ -- | Return a list's selected element, if any. -- -- Only evaluates as much of the container as needed.@@ -612,13 +631,11 @@ -- listSelectedElement for 'List': O(1) -- listSelectedElement for 'Seq.Seq': O(log(min(i, n - i))) -- @-listSelectedElement :: (Splittable t, Foldable t)+listSelectedElement :: (Splittable t, Traversable t, Semigroup (t e))                     => GenericList n t e                     -> Maybe (Int, e)-listSelectedElement l = do-    sel <- l^.listSelectedL-    let (_, xs) = splitAt sel (l ^. listElementsL)-    (sel,) <$> toList xs ^? _head+listSelectedElement l =+    (,) <$> l^.listSelectedL <*> l^?listSelectedElementL  -- | Remove all elements from the list and clear the selection. --@@ -647,11 +664,16 @@ -- -- Complexity: same as 'traverse' for the container type (typically -- /O(n)/).-listModify :: (Traversable t)+--+-- Complexity: same as 'listSelectedElementL' for the list's container type.+--+-- @+-- listModify for 'List': O(n)+-- listModify for 'Seq.Seq': O(log(min(i, n - i)))+-- @+--+listModify :: (Traversable t, Splittable t, Semigroup (t e))            => (e -> e)            -> GenericList n t e            -> GenericList n t e-listModify f l =-    case l ^. listSelectedL of-        Nothing -> l-        Just j -> l & listElementsL %~ imap (\i e -> if i == j then f e else e)+listModify f = listSelectedElementL %~ f

@@ -22,11 +22,11 @@  -- | The attribute of the completed portion of the progress bar. progressCompleteAttr :: AttrName-progressCompleteAttr = "progressComplete"+progressCompleteAttr = attrName "progressComplete"  -- | The attribute of the incomplete portion of the progress bar. progressIncompleteAttr :: AttrName-progressIncompleteAttr = "progressIncomplete"+progressIncompleteAttr = attrName "progressIncomplete"  -- | Draw a progress bar with the specified (optional) label and -- progress value. This fills available horizontal space and is one row

@@ -1,14 +1,14 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances #-}- module List-  (-    main-  ) where+  ( main+  )+where  import Prelude hiding (reverse, splitAt) @@ -18,7 +18,9 @@ import Data.Maybe (isNothing) import Data.Monoid (Endo(..)) import Data.Proxy+#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>)))+#endif  import qualified Data.Sequence as Seq import qualified Data.Vector as V@@ -29,57 +31,56 @@ import Brick.Widgets.List  instance (Arbitrary n, Arbitrary a) => Arbitrary (List n a) where-  arbitrary = list <$> arbitrary <*> (V.fromList <$> arbitrary) <*> pure 1-+    arbitrary = list <$> arbitrary <*> (V.fromList <$> arbitrary) <*> pure 1  -- List move operations that never modify the underlying list-data ListMoveOp a-  = MoveUp-  | MoveDown-  | MoveBy Int-  | MoveTo Int-  | MoveToElement a-  | FindElement a-  deriving (Show)+data ListMoveOp a =+    MoveUp+    | MoveDown+    | MoveBy Int+    | MoveTo Int+    | MoveToElement a+    | FindElement a+    deriving (Show)  instance Arbitrary a => Arbitrary (ListMoveOp a) where-  arbitrary = oneof-    [ pure MoveUp-    , pure MoveDown-    , MoveBy <$> arbitrary-    , MoveTo <$> arbitrary-    , MoveToElement <$> arbitrary-    , FindElement <$> arbitrary-    ]+    arbitrary =+        oneof [ pure MoveUp+              , pure MoveDown+              , MoveBy <$> arbitrary+              , MoveTo <$> arbitrary+              , MoveToElement <$> arbitrary+              , FindElement <$> arbitrary+              ]  -- List operations.  We don't have "page"-based movement operations -- because these depend on render context (i.e. effect in EventM)-data ListOp a-  = Insert Int a-  | Remove Int-  | Replace Int [a]-  | Clear-  | Reverse-  | ListMoveOp (ListMoveOp a)-  deriving (Show)+data ListOp a =+    Insert Int a+    | Remove Int+    | Replace Int [a]+    | Clear+    | Reverse+    | ListMoveOp (ListMoveOp a)+    deriving (Show)  instance Arbitrary a => Arbitrary (ListOp a) where-  arbitrary = frequency-    [ (1, Insert <$> arbitrary <*> arbitrary)-    , (1, Remove <$> arbitrary)-    , (1, Replace <$> arbitrary <*> arbitrary)-    , (1, pure Clear)-    , (1, pure Reverse)-    , (6, arbitrary)-    ]+    arbitrary =+        frequency [ (1, Insert <$> arbitrary <*> arbitrary)+                  , (1, Remove <$> arbitrary)+                  , (1, Replace <$> arbitrary <*> arbitrary)+                  , (1, pure Clear)+                  , (1, pure Reverse)+                  , (6, arbitrary)+                  ]  -- Turn a ListOp into a List endomorphism op :: Eq a => ListOp a -> List n a -> List n a op (Insert i a) = listInsert i a op (Remove i) = listRemove i op (Replace i xs) =-  -- avoid setting index to Nothing-  listReplace (V.fromList xs) (Just i)+    -- avoid setting index to Nothing+    listReplace (V.fromList xs) (Just i) op Clear = listClear op Reverse = listReverse op (ListMoveOp mo) = moveOp mo@@ -93,63 +94,61 @@ moveOp (MoveToElement a) = listMoveToElement a moveOp (FindElement a) = listFindBy (== a) -applyListOps-  :: (Foldable t)-  => (op a -> List n a -> List n a) -> t (op a) -> List n a -> List n a+applyListOps :: (Foldable t)+             => (op a -> List n a -> List n a)+             -> t (op a)+             -> List n a+             -> List n a applyListOps f = appEndo . foldMap (Endo . f) - -- | Initial selection is always 0 (or Nothing for empty list) prop_initialSelection :: [a] -> Bool prop_initialSelection xs =-  list () (V.fromList xs) 1 ^. listSelectedL ==-    if null xs then Nothing else Just 0+    list () (V.fromList xs) 1 ^. listSelectedL ==+        if null xs then Nothing else Just 0  -- list operations keep the selected index in bounds-prop_listOpsMaintainSelectedValid-  :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_listOpsMaintainSelectedValid :: (Eq a)+                                  => [ListOp a]+                                  -> List n a+                                  -> Bool prop_listOpsMaintainSelectedValid ops l =-  let l' = applyListOps op ops l-  in-    case l' ^. listSelectedL of-      -- either there is no selection and list is empty-      Nothing -> null l'-      -- or the selected index is valid-      Just i -> i >= 0 && i < length l'+    let l' = applyListOps op ops l+    in case l' ^. listSelectedL of+        -- either there is no selection and list is empty+        Nothing -> null l'+        -- or the selected index is valid+        Just i -> i >= 0 && i < length l'  -- reversing a list keeps the selected element the same-prop_reverseMaintainsSelectedElement-  :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_reverseMaintainsSelectedElement :: (Eq a)+                                     => [ListOp a]+                                     -> List n a+                                     -> Bool prop_reverseMaintainsSelectedElement ops l =-  let     -- apply some random list ops to (probably) set a selected element-    l' = applyListOps op ops l-    l'' = listReverse l'-  in-    fmap snd (listSelectedElement l') == fmap snd (listSelectedElement l'')+    let l' = applyListOps op ops l+        l'' = listReverse l'+    in fmap snd (listSelectedElement l') == fmap snd (listSelectedElement l'')  -- reversing maintains size of list prop_reverseMaintainsSizeOfList :: List n a -> Bool prop_reverseMaintainsSizeOfList l =-  length l == length (listReverse l)+    length l == length (listReverse l)  -- an inserted element may always be found at the given index -- (when target index is clamped to 0 <= n <= len) prop_insert :: (Eq a) => Int -> a -> List n a -> Bool prop_insert i a l =-  let-    l' = listInsert i a l-    i' = clamp 0 (length l) i-  in-    listSelectedElement (listMoveTo i' l') == Just (i', a)+    let l' = listInsert i a l+        i' = clamp 0 (length l) i+    in listSelectedElement (listMoveTo i' l') == Just (i', a)  -- inserting anywhere always increases size of list by 1 prop_insertSize :: (Eq a) => Int -> a -> List n a -> Bool prop_insertSize i a l =-  let-    l' = listInsert i a l-  in-    length l' == length l + 1+    let l' = listInsert i a l+    in length l' == length l + 1  -- inserting an element and moving to it always succeeds and -- the selected element is the one we inserted.@@ -160,11 +159,9 @@ -- prop_insertMoveTo :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool prop_insertMoveTo ops l i a =-  let-    l' = listInsert i a (applyListOps op ops l)-    sel = listSelectedElement (listMoveToElement a l')-  in-    fmap snd sel == Just a+    let l' = listInsert i a (applyListOps op ops l)+        sel = listSelectedElement (listMoveToElement a l')+    in fmap snd sel == Just a  -- inserting an element and repeatedly seeking it always -- reaches the element we inserted, at the index where we@@ -172,47 +169,38 @@ -- prop_insertFindBy :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool prop_insertFindBy ops l i a =-  let-    l' = applyListOps op ops l-    l'' = set listSelectedL Nothing . listInsert i a $ l'-    seeks = converging ((==) `on` (^. listSelectedL)) (listFindBy (== a)) l''-    i' = clamp 0 (length l') i -- we can't have inserted past len-  in-    (find ((== Just i') . (^. listSelectedL)) seeks >>= listSelectedElement)-    == Just (i', a)+    let l' = applyListOps op ops l+        l'' = set listSelectedL Nothing . listInsert i a $ l'+        seeks = converging ((==) `on` (^. listSelectedL)) (listFindBy (== a)) l''+        i' = clamp 0 (length l') i -- we can't have inserted past len+    in (find ((== Just i') . (^. listSelectedL)) seeks >>= listSelectedElement) == Just (i', a)  -- inserting then deleting always yields a list with the original elems prop_insertRemove :: (Eq a) => Int -> a -> List n a -> Bool prop_insertRemove i a l =-  let-    i' = clamp 0 (length l) i-    l' = listInsert i' a l -- pre-clamped-    l'' = listRemove i' l'-  in-    l'' ^. listElementsL == l ^. listElementsL+    let i' = clamp 0 (length l) i+        l' = listInsert i' a l -- pre-clamped+        l'' = listRemove i' l'+    in l'' ^. listElementsL == l ^. listElementsL  -- deleting in-bounds always reduces size of list by 1 -- deleting out-of-bounds never changes list size prop_remove :: Int -> List n a -> Bool prop_remove i l =-  let-    len = length l-    i' = clamp 0 (len - 1) i-    test-      | len > 0 && i == i' = (== len - 1)  -- i is in bounds-      | otherwise = (== len)               -- i is out of bounds-  in-    test (length (listRemove i l))+    let len = length l+        i' = clamp 0 (len - 1) i+        test+            | len > 0 && i == i' = (== len - 1)  -- i is in bounds+            | otherwise = (== len)               -- i is out of bounds+    in test (length (listRemove i l))  -- deleting an element and re-inserting it at same position -- gives the original list elements prop_removeInsert :: (Eq a) => Int -> List n a -> Bool prop_removeInsert i l =-  let-    sel = listSelectedElement (listMoveTo i l)-    l' = maybe id (\(i', a) -> listInsert i' a . listRemove i') sel l-  in-    l' ^. listElementsL == l ^. listElementsL+    let sel = listSelectedElement (listMoveTo i l)+        l' = maybe id (\(i', a) -> listInsert i' a . listRemove i') sel l+    in l' ^. listElementsL == l ^. listElementsL  -- Apply @f@ until @test a (f a) == True@, then return @a@. converge :: (a -> a -> Bool) -> (a -> a) -> a -> a@@ -222,64 +210,57 @@ -- intermediate and final values as a list. converging :: (a -> a -> Bool) -> (a -> a) -> a -> [a] converging test f a-  | test a (f a) = [a]-  | otherwise = a : converging test f (f a)+    | test a (f a) = [a]+    | otherwise = a : converging test f (f a)  -- listMoveUp always reaches 0 (or list is empty) prop_moveUp :: (Eq a) => [ListOp a] -> List n a -> Bool prop_moveUp ops l =-  let-    l' = applyListOps op ops l-    l'' = converge ((==) `on` (^. listSelectedL)) listMoveUp l'-    len = length l''-  in-    maybe (len == 0) (== 0) (l'' ^. listSelectedL)+    let l' = applyListOps op ops l+        l'' = converge ((==) `on` (^. listSelectedL)) listMoveUp l'+        len = length l''+    in maybe (len == 0) (== 0) (l'' ^. listSelectedL)  -- listMoveDown always reaches end of list (or list is empty) prop_moveDown :: (Eq a) => [ListOp a] -> List n a -> Bool prop_moveDown ops l =-  let-    l' = applyListOps op ops l-    l'' = converge ((==) `on` (^. listSelectedL)) listMoveDown l'-    len = length l''-  in-    maybe (len == 0) (== len - 1) (l'' ^. listSelectedL)+    let l' = applyListOps op ops l+        l'' = converge ((==) `on` (^. listSelectedL)) listMoveDown l'+        len = length l''+    in maybe (len == 0) (== len - 1) (l'' ^. listSelectedL)  -- move ops never change the list prop_moveOpsNeverChangeList :: (Eq a) => [ListMoveOp a] -> List n a -> Bool prop_moveOpsNeverChangeList ops l =-  let-    l' = applyListOps moveOp ops l-  in-    l' ^. listElementsL == l ^. listElementsL+    let l' = applyListOps moveOp ops l+    in l' ^. listElementsL == l ^. listElementsL  -- If the list is empty, empty selection is used. -- Otherwise, if the specified selected index is not in list bounds, -- zero is used instead.-prop_replaceSetIndex-  :: (Eq a)-  => [ListOp a] -> List n a -> [a] -> Int -> Bool+prop_replaceSetIndex :: (Eq a)+                     => [ListOp a]+                     -> List n a+                     -> [a]+                     -> Int+                     -> Bool prop_replaceSetIndex ops l xs i =-  let-    v = V.fromList xs-    l' = applyListOps op ops l-    l'' = listReplace v (Just i) l'-    i' = clamp 0 (length v - 1) i-    inBounds = i == i'-  in-    l'' ^. listSelectedL == case (null v, inBounds) of-      (True, _) -> Nothing-      (False, True) -> Just i-      (False, False) -> Just 0+    let v = V.fromList xs+        l' = applyListOps op ops l+        l'' = listReplace v (Just i) l'+        i' = clamp 0 (length v - 1) i+        inBounds = i == i'+    in l'' ^. listSelectedL == case (null v, inBounds) of+        (True, _) -> Nothing+        (False, True) -> Just i+        (False, False) -> Just 0  -- Replacing with no index always clears the index prop_replaceNoIndex :: (Eq a) => [ListOp a] -> List n a -> [a] -> Bool prop_replaceNoIndex ops l xs =-  let-    v = V.fromList xs-    l' = applyListOps op ops l-  in-    isNothing (listReplace v Nothing l' ^. listSelectedL)+    let v = V.fromList xs+        l' = applyListOps op ops l+    in isNothing (listReplace v Nothing l' ^. listSelectedL)  -- | Move the list selected index. If the index is `Just x`, adjust by the -- specified amount; if it is `Nothing` (i.e. there is no selection) and the@@ -287,26 +268,19 @@ -- `Just (length - 1)` (last element). Subject to validation. prop_moveByWhenNoSelection :: List n a -> Int -> Property prop_moveByWhenNoSelection l amt =-  let-    l' = l & listSelectedL .~ Nothing-    len = length l-    expected = if amt > 0 then 0 else len - 1-  in-    len > 0 ==> listMoveBy amt l' ^. listSelectedL == Just expected-+    let l' = l & listSelectedL .~ Nothing+        len = length l+        expected = if amt > 0 then 0 else len - 1+    in len > 0 ==> listMoveBy amt l' ^. listSelectedL == Just expected  splitAtLength :: (Foldable t, Splittable t) => t a -> Int -> Bool splitAtLength l i =-  let-    len = length l-    (h, t) = splitAt i l-  in-    length h + length t == len-    && length h == clamp 0 len i+    let len = length l+        (h, t) = splitAt i l+    in length h + length t == len && length h == clamp 0 len i -splitAtAppend-  :: (Splittable t, Semigroup (t a), Eq (t a))-  => t a -> Int -> Bool+splitAtAppend :: (Splittable t, Semigroup (t a), Eq (t a))+              => t a -> Int -> Bool splitAtAppend l i = uncurry (<>) (splitAt i l) == l  prop_splitAtLength_Vector :: [a] -> Int -> Bool@@ -322,16 +296,14 @@ prop_splitAtAppend_Seq = splitAtAppend . Seq.fromList  -reverseSingleton-  :: forall t a. (Reversible t, Applicative t, Eq (t a))-  => Proxy t -> a -> Bool+reverseSingleton :: forall t a. (Reversible t, Applicative t, Eq (t a))+                 => Proxy t -> a -> Bool reverseSingleton _ a =-  let l = pure a :: t a-  in reverse l == l+    let l = pure a :: t a+    in reverse l == l -reverseAppend-  :: (Reversible t, Semigroup (t a), Eq (t a))-  => t a -> t a -> Bool+reverseAppend :: (Reversible t, Semigroup (t a), Eq (t a))+              => t a -> t a -> Bool reverseAppend l1 l2 =   reverse (l1 <> l2) == reverse l2 <> reverse l1 @@ -340,49 +312,54 @@  prop_reverseAppend_Vector :: (Eq a) => [a] -> [a] -> Bool prop_reverseAppend_Vector l1 l2 =-  reverseAppend (V.fromList l1) (V.fromList l2)+    reverseAppend (V.fromList l1) (V.fromList l2)  prop_reverseSingleton_Seq :: (Eq a) => a -> Bool prop_reverseSingleton_Seq = reverseSingleton (Proxy :: Proxy Seq.Seq)  prop_reverseAppend_Seq :: (Eq a) => [a] -> [a] -> Bool prop_reverseAppend_Seq l1 l2 =-  reverseAppend (Seq.fromList l1) (Seq.fromList l2)--+    reverseAppend (Seq.fromList l1) (Seq.fromList l2)  -- Laziness tests.  Here we create a custom container type -- that we use to ensure certain operations do not cause the -- whole container to be evaluated. -- newtype L a = L [a]-  deriving (Functor, Foldable, Traversable)+            deriving (Functor, Foldable, Traversable, Semigroup)  instance Splittable L where-  splitAt i (L xs) = over both L (Data.List.splitAt i xs)+    splitAt i (L xs) = over both L (Data.List.splitAt i xs)  -- moveBy positive amount does not evaluate 'length' prop_moveByPosLazy :: Bool prop_moveByPosLazy =-  let-    v = L (1:2:3:4:undefined) :: L Int-    l = list () v 1-    l' = listMoveBy 1 l-  in-    l' ^. listSelectedL == Just 1+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1+        l' = listMoveBy 1 l+    in l' ^. listSelectedL == Just 1  -- listFindBy is lazy prop_findByLazy :: Bool prop_findByLazy =-  let-    v = L (1:2:3:4:undefined) :: L Int-    l = list () v 1 & listSelectedL .~ Nothing-    l' = listFindBy even l-    l'' = listFindBy even l'-  in-    l' ^. listSelectedL == Just 1-    && l'' ^. listSelectedL == Just 3+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1 & listSelectedL .~ Nothing+        l' = listFindBy even l+        l'' = listFindBy even l'+    in l' ^. listSelectedL == Just 1 &&+       l'' ^. listSelectedL == Just 3 +prop_listSelectedElement_lazy :: Bool+prop_listSelectedElement_lazy =+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1 & listSelectedL .~ Just 3+    in listSelectedElement l == Just (3, 4)++prop_listSelectedElementL_lazy :: Bool+prop_listSelectedElementL_lazy =+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1 & listSelectedL .~ Just 3+    in over listSelectedElementL (*2) l ^? listSelectedElementL == Just 8  return []