packages feed

brick 0.17.2 → 2.12

raw patch · 78 files changed

Files

CHANGELOG.md view
@@ -2,429 +2,1877 @@ Brick changelog --------------- -0.17.2---------Package changes:- * Added programs/ReadmeDemo.hs and featured its output and code in the-   README to provide an early demonstration--Library changes:- * centerAbout now right- and bottom-pads its operand to behave-   consistently with h/vCenter--0.17.1---------Package changes:- * Use Extra-Doc-Files instead of Data-Files for documentation files--Bug fixes:- * List: correctly update selected index in listInsert- * Update example program in brick.cabal (thanks @timbod7)--0.17-------Package changes:-* Updated to depend on Vty 5.15.-* Updated to remove dependency on data-default.-* Discontinued support for GHC versions prior to 7.10.1.--API changes:-* Removed Data.Default instances for AttrName, AttrMap, Result, and-  BorderStyle (use Monoid instances instead where possible).-* Added defaultBorderStyle :: BorderStyle.-* Added emptyResult :: Result n.--0.16-------This release includes a breaking API change:-* Brick now uses bounded channels (Brick.BChan.BChan) for event-  communication rather than Control.Concurrent.Chan's unbounded channels-  to improve memory consumption for programs with runaway event-  production (thanks Joshua Chia)--Other API changes:-* Brick.List got a new function, listModify, for modifying the selected-  element (thanks @diegospd)--Performance improvements:-* hBox and vBox now use the more efficient DList data structure when-  rendering to improve performance for boxes with many elements (thanks-  Mitsutoshi Aoe)--0.15.2---------Bug fixes:-* viewport: do not cull cursor locations on empty viewport contents-  (fixes #105)-* User guide CounterEvent type fix (thanks @diegospd)--0.15.1---------Bug fixes:-* List: fixed empty list validation in listReplace (thanks Joshua Chia)--0.15-------Demo changes:-* MouseDemo: add an editor and use mouse events to move the cursor-* MouseDemo: Enhance MouseDemo to show interaction between 'clickable'-  and viewports (thanks Kevin Quick)--New features:-* Editors now report mouse click events--API changes:-* Rename TerminalLocation row/column fields to avoid commonplace name-  clashes; rename row/column to locationRow/locationColumn (fixes #96)--Bug fixes:-* Core: make cropToContext also crop extents (fixes #101)-* viewport: if the sub-widget is not rendered, also cull all extents and-  cursor locations--Documentation changes:-* User Guide updates: minor fixes, updates to content on custom widgets,-  wide character support, and examples (thanks skapazzo@inventati.org,-  Kevin Quick)--0.14-------This release added support for wide characters. In particular, wide-characters can now be entered into the text editor widget and used in-'str' and 'txt' widgets.--0.13-------API changes:- * Mouse mode is no longer enabled by default.- * customMain's event channel parameter is now optional- * FocusRing now provides a Functor instance (thanks Ian Jeffries)--0.12-------This release primarily adds support for mouse interaction. For details,-see the Mouse Support section of the User Guide. This release also-includes breaking API changes for the App type. Here's a migration-guide:-- * Event handlers now take "BrickEvent n e" instead of "e", where "e"-   was the custom event type used before this change. To recover your-   own custom events, pattern-match on "AppEvent"; to recover Vty input-   events, pattern-match on "VtyEvent".- * appLiftVtyEvent went away and can just be removed from your App-   record constructor.- * If you aren't using the custom event type or were just using Vty's-   "Event" type as your App's event type, you can set your event type to-   just "e" because you'll now be able to get Vty events regardless of-   whether you use a custom event type.--API changes:- * Added the Widget combinator "clickable" to indicate that a widget-   should generate mouse click events- * Added the Extent data type and the "reportExtent" widget combinator-   to report the positions and sizes of widgets- * Rendering "Result" values now include reported extents and update-   their offsets (adds "extents" field and "extentsL" lens)- * Added "lookupExtent", "findClickedExtents", and "clickedExtent" in-   EventM to find extents and check them for mouse clicks- * Removed appLiftVtyEvent. Instead of wrapping Vty's events in your own-   type, you now get a "BrickEvent" that always contains Vty events but-   has the ability to embed *your* custom events. See the User Guide for-   details.- * Added demo program MouseDemo.hs- * Added demo program ProgressBarDemo.hs (thanks Kevin Quick)- * Added mapAttrname, mapAttrNames, and overrideAttr functions (thanks-   Kevin Quick)- * Make handleEventLensed polymorphic over event type to allow use with-   custom events (thanks Kevin Quick)- * Added Ord constraint to some library startup functions--Bug fixes:- * Added Show instance for Editor, List (fixes #63)--Documentation changes:- * Updated documentation to use new "resource name" terminology to-   reduce confusion and better explain the purpose of names.- * Updated user guide with sections on mouse support, the rendering-   cache, resource names, paste mode, and extents--Package changes:- * Depend on Vty 5.11.3 to get mouse mode support--0.11-------API changes:- * Added getVtyHandle in EventM for obtaining the current Vty context.-   It returns Nothing when calling the appStartEvent handler but after-   that a context is always available.--0.10-------New features:- * Added a rendering cache. To use the rendering cache, use the 'cached'-   widget combinator. This causes drawings of the specified widget to-   re-use a cached rendering until the rendering cache is invalidated-   with 'invalidateCacheEntry' or 'invalidateCache'. This change also-   includes programs/CacheDemo.hs. This change introduced an Ord-   constraint on the name type variable 'n'.- * Added setTop and setLeft for setting viewport offsets directly in-   EventM.- * Dialog event handlers now support left and right arrow keys (thanks-   Grégoire Charvet)--Library changes:- * On resizes brick now draws the application twice before handling the-   resize event. This change makes it possible for event handlers to-   get the latest viewport states on a resize rather than getting the-   most recent (but stale) versions as before, at the cost of a second-   redraw.--Bug fixes:- * We now use the most recent rendering state when setting up event handler-   viewport data. This mostly won't matter to anyone except in cases-   where a viewport name was expected to be in the viewport map but-   wasn't due to using stale rendering state to set up EventM.--0.9------Package changes:- * Depend on text-zipper 0.7.1--API changes:- * The editor widget state value is now polymorphic over the type of-   "string" value that can be edited, so you can now create editors over-   Text values as well as Strings. This is a breaking change but it only-   requires the addition of the string type variable to any uses of-   Editor. (thanks Jason Dagit and Getty Ritter)- * Added some missing Eq and Show instances (thanks Grégoire Charvet)--New features:- * The editor now binds Control-U to delete to beginning of line (thanks-   Hans-Peter Deifel)--Bug fixes:- * List: avoid runtime exception by ensuring item height is always at-   least 1--0.8------API changes:- * Center: added layer-friendly centering functions centerLayer,-   hCenterLayer, and vCenterLayer.--Functionality changes:- * Dialog now uses new layer-friendly centering functions. This makes it-   possible to overlay a Dialog on top of your UI when you use a Dialog-   rendering as a separate layer.- * Updated the LayerDemo to demonstrate a centered layer.- * The renderer now uses a default Vty Picture background-   of spaces with the default attribute, rather than using-   ClearBackground (the Vty default). This is to compensate for an-   unexpected attribute behavior in Vty when ClearBackgrounds (see-   https://github.com/coreyoconnor/vty/issues/95)--0.7------NOTE: this release includes many API changes. Please see the "Widget-Names" section of the Brick User Guide for details on the fundamentals!--API changes:- * The "Name" type was removed. In its place we now have a name type-   variable ("n") attached to many types (including EventM,-   CursorLocation, App, Editor, List, and FocusRing). This change makes-   it possible to:-   * Avoid runtime errors due to name typos-   * Achieve compile-time guarantees about name matching and usage-   * Force widget functions to be name-agnostic by being polymorphic-     in their name type-   * Clean up focus handling by making it possible to pattern-match-     on cursor location names- * The EditDemo demonstration program was updated to use a FocusRing.- * Added the "Named" type class to Brick.Widgets.Core for types that-   store names. This type class is used to streamline the Focus-   interface; see Brick.Focus.withFocusRing and EditDemo.hs.- * The List and Editor types are now parameterized on names.- * The List widget is now focus-aware; its rendering function now takes-   a boolean indicating whether it should be rendered with focus. The-   List uses the following attributes now:-   * When not focused, the cursor is rendered with listSelectedAttr.-   * When focused, the cursor is rendered with listSelectedFocusedAttr.- * The Editor widget is now focus-aware; its rendering function now-   takes a boolean indicating whether it should be rendered with focus.-   The Editor uses the following attributes now:-   * When not focused, the widget is rendered with editAttr.-   * When focused, the widget is rendered with editFocusedAttr.- * The Dialog's name constructor parameter and lens were removed.- * The 'viewport' function was modified to raise a runtime exception if-   the widget name it receives is used more than once during the-   rendering of a single frame.--Miscellaneous:- * Many modules now use conditional imports to silence redundancy-   warnings on GHCs with newer Preludes (e.g. including Monoid,-   Foldable, Traversable, Applicative, etc.)--0.6.4--------Bug fixes:- * Add missing Functor instance for Next type (thanks Markus Hauck)--0.6.3--------Bug fixes:- * List: the list now properly renders when the available height is not-   a multiple of the item height. Previously the list size would-   decrease relative to the available height. Now the list renders-   enough items to fill the space even if the top-most or bottom-most-   item is partially visible, which is the expected behavior.--0.6.2--------Bug fixes:- * Editor: the 'editor' initial content parameter is now correctly split-   on newlines to ensure that the underlying editor zipper is-   initialized properly. (fixes #56; thanks @listx)--0.6.1--------Package changes:- * Added lower bound for microlens >= 0.3.0.0 to fix build failure due-   to Field1 not being defined (thanks Markus Hauck)--Documentation changes:- * Updated user guide and README to link to and mention microlens-   instead of lens--Misc:- * Fixed a qualified import in the List demo to avoid ambiguity (thanks-   Alan Gilbert)--0.6------API changes:- * Brick now uses the microlens family of packages instead of lens. This-   version of brick also depends on vty 5.5.0, which was modified to use-   microlens instead of lens. This change shouldn't impact functionality-   but will greatly reduce build times.--0.5.1--------Bug fixes:- * Fix negative cropping in hCenter, vCenter, and cropResultToContext-   (fixes #52)- * Remove unnecessary Eq constraint from listReplace (fixes #48; thanks-   sifmelcara)- * Mention Google Group in README--0.5------Functionality changes:- * Markup: make markup support multi-line strings (fixes #41)- * brick-edit-demo: support shift-tab to switch editors- * Core: improve box layout algorithm (when rendering boxes, track-   remaining space while rendering high-priority children to use-   successively more constrained primary dimensions)- * Core: make fixed padding take precedence over padded widgets (fixes #42)-   Prior to this commit, padding a widget meant that if there was room-   after rendering the widget, the specified amount of padding would be-   added. This meant that under tight layout constraints padding would-   disappear before a padded widget would. This is often a desirable-   outcome but it also led to unexpected behavior when adding padding-   to a widget that grows greedily: fixed padding would never show up-   because it was placed in a box adjacent to the widget in question,-   and boxes always render greedy children before fixed ones. As a-   result fixed padding would disappear under these conditions. Instead,-   in the case of fixed padding, since we often intend to *guarantee*-   that padding is present, all of the padding combinators have been-   modified so that when the padded widget is rendered with fixed-   padding in the amount V, the widget is given V fewer rows/columns-   when it is rendered so that the padding always has room.--0.4.1--------Bug fixes:-* Fixed a bug in the 'visible' combinator: If the size of the visibility-  request was larger than the available space, then the rendering of a-  viewport was toggling between two states, one with aligning on the-  end of the visibility request, and another one aligning on the start.-  This commit fixes it so that a visibility request is always aligned-  on the start if not enough space is available. (thanks Thomas Strobel-  <ts468@cam.ac.uk>)--Behavior changes:-* Honor multiple 'visible' markers in a single viewport with preference-  on the innermost request (thanks Thomas Strobel <ts468@cam.ac.uk>)--0.4------API changes:-* Added Brick.Widgets.Core.unsafeLookupViewport to make certain kinds-  of custom widget implementations easier when viewport states are needed-  (thanks Markus Hauck <markus1189@gmail.com>)-* List: added listClear and listReverse functions (thanks Markus Hauck)-* List: Derive instances for Functor, Foldable, Traversable (thanks-  Markus Hauck)--Documentation changes:-* Hyperlink "Data.Text.Markup" inside Brick.Markup haddock (thanks-  Markus Hauck)-* Fix typo in 'Attribute Management' section of user guide (thanks-  Markus Hauck)--0.3.1--------Bug fixes:-* EventM newtype again instances MonadIO (thanks Andrew Rademacher)--0.3------API changes:-* Made EventM a newtype instead of a type alias-* List: listReplace now takes the new selected index and no longer does-element diffing--Package changes:-* Removed the dependency on the Diff package--Misc:-* Applied some hlint hints (thanks Markus Hauck <markus1189@gmail.com>)-* Fixed a typo in the README (thanks Markus Hauck <markus1189@gmail.com>)-* Improved the renderList documentation (thanks Profpatsch <mail@profpatsch.de>)-* Types: added an explicit import of Applicative for older GHCs--0.2.3--------Bug fixes:-* Fixed viewport behavior when the image in a viewport reduces its size-  enough to render the viewport offsets invalid. Before, this behavior-  caused a crash during image croppin in vty; now the behavior is+2.12+----++Package changes:++* Raised upper bound on microlens to allow building with 0.5.++2.11+----++Bug fixes:++* Fixed a bug in FileBrowser: if a user pressed Enter when the cursor+  was on a selected entry, it was omitted from the list of+  selected browser entries. As part of this change, the function+  `actionFileBrowserSelectCurrent` previously toggled the selection+  of the entry at the cursor, but should have selected it instead.+  It now does so, and a new function for toggling was introduced:+  `actionFileBrowserToggleCurrent`.++Other changes:++* Upper bounds on `base` and `microlens` were adjusted.++2.10+----++* Updated `brick` to build with `microlens == 0.5.0.0` which moved its+  Field* classes to `Lens.Micro.FieldN`.++2.9+---++API changes:+* Added `Brick.Widgets.List.listFindFirst` function.++2.8.3+-----++Bug fixes:++* Fixed a bug that completely broke `makeVisible` that was introduced+  in brick 2.6.+* Fixed context cropping in `cropRightBy` and `cropBottomBy`.++2.8.2+-----++* Updated `Brick.Widgets.Core` functions `cropBottomBy`, `cropToBy`,+  `cropLeftBy`, and `cropRightBy` to properly perform result cropping to+  actually address the internal bug fixed in 2.8.1.++2.8.1+-----++* Fixed a long-standing bug in `cropToContext` that resulted in some+  extents getting left around when they should be dropped, possibly+  leading to application bugs when handling mouse clicks in extent+  regions that should have been removed from the rendering result.++2.8+---++Behavior changes:+* `FileBrowser` file marking with `Space` now honors the file browser's+  configured file selector predicate.+* `FileBrowser` file marking with `Space` and `Enter` now toggles file+  selection rather than just selecting files, allowing for selected+  files to be unselected.++2.7+---++This release adds `Brick.Animation`, a module providing infrastructure+for adding animations to Brick interfaces. See the Haddock documentation+in `Brick.Animation` for full details; see `programs/AnimationDemo.hs`+for a working example.++2.6+---++Behavior changes:+ * `Brick.Widgets.Core.relativeTo` now draws nothing if the requested+   extent is not found. Previously it would draw the specified widget in+   the upper-left corner of the layer.++Bug fixes:+ * Fixed the conditional import in `BorderMap` (#519)+ * `Brick.Widgets.Center.hCenterWith` now properly accounts for centered+   image width when computing additional right padding (#520)+ * The Brick renderer now properly resets some render-specific state+   in between renderings that was previously kept around, avoiding+   preservation of stale extents across renderings+ * `brick-tail-demo` and `brick-custom-event-demo` now shut down Vty+   properly++2.5+---++New features:+* `Brick.Widgets.ProgressBar` got a new function, `customProgressBar`,+  which allows the customization of the fill characters used to draw a+  progress bar. (Thanks @sectore)++2.4+---++Changes:+* The `Keybindings` API now normalizes keybindings+  to lowercase when modifiers are present. (See also+  https://github.com/jtdaugherty/brick/issues/512) This means that,+  for example, a constructed binding for `C-X` would be normalized to+  `C-x`, and a binding from a configuration file written `C-X` would be+  parsed and then normalized to `C-x`. This is because, in general, when+  modifiers are present, input events are received for the lowercase+  version of the character in question. Prior to changing this, Brick+  would silently parse (or permit the construction of) uppercase-mapped+  key bindings, but in practice those bindings were unusable because+  they are not generated by terminals.++2.3.2+-----++Bug fixes:+* `FileBrowser`: if the `FileBrowser` was initialized with a `FilePath`+  that ended in a slash, then if the user hit `Enter` on the `../` entry+  to move to the parent directory, the only effect was the removal of+  that trailing slash. This change trims the trailing slash so that the+  expected move occurs whenever the `../` entry is selected.+* `Brick.Keybindings.Pretty.keybindingHelpWidget`: fixed a problem where+  a key event with no name in a `KeyEvents` would cause a `fromJust`+  exception. The pretty-printer now falls back to a placeholder+  representation for such unnamed key events.++2.3.1+-----++Bug fixes:+* Form field rendering now correctly checks for form field focus when+  its visibility mode is `ShowAugmentedField`.++2.3+---++API changes:+* `FormFieldVisibilityMode`'s `ShowAugmentedField` was renamed to+  `ShowCompositeField` to be clearer about what it does, and a new+  `ShowAugmentedField` constructor was added to support a mode where+  field augmentations applied with `@@=` are made visible as well.++2.2+---++Enhancements:+* `Brick.Forms` got a new `FormFieldVisibilityMode` type and a+  `setFieldVisibilityMode` function to allow greater control over+  how form field collections are brought into view when forms are+  rendered in viewports. Form fields will default to using the+  `ShowFocusedFieldOnly` mode which preserves functionality prior to+  this release. To get the new behavior, set a field's visibility mode+  to `ShowAugmentedField`.++2.1.1+-----++Bug fixes:+* `defaultMain` now properly shuts down Vty before it returns, fixing+  a bug where the terminal would be in an unclean state on return from+  `defaultMain`.++2.1+---++API changes:++* Added `Brick.Main.customMainWithDefaultVty` as an alternative way to+  initialize Brick.++2.0+---++This release updates Brick to support Vty 6, which includes support for+Windows.++Package changes:+* Increased lower bound on `vty` to 6.0.+* Added dependency on `vty-crossplatform`.+* Migrated from `unix` dependency to `unix-compat`.++Other changes:+* Update core library and demo programs to use `vty-crossplatform` to+  initialize the terminal.++1.10+----++API changes:+* The `ScrollbarRenderer` type got split up into vertical and horizontal+  versions, `VScrollbarRenderer` and `HScrollbarRenderer`, respectively.+  Their fields are nearly identical to the original `ScrollbarRenderer`+  fields except that many fields now have a `V` or `H` in them as+  appropriate. As part of this change, the various `Brick.Widgets.Core`+  functions that deal with the renderers got their types updated, and+  the types of the default scroll bar renderers changed, too.+* The scroll bar renderers now have a field to control how much space+  is allocated to a scroll bar. Previously, all scroll bars were+  assumed to be exactly one row in height or one column in width. This+  change is motivated by a desire to be able to control how scroll+  bars are rendered adjacent to viewport contents. It isn't always+  desirable to render them right up against the contents; sometimes,+  spacing would be nice between the bar and contents, for example.+  As part of this change, `VScrollbarRenderer` got a field called+  `scrollbarWidthAllocation` and `HScrollbarRenderer` got a field called+  `scrollbarHeightAllocation`. The fields specify the height (for+  horizontal scroll bars) or width (for vertical ones) of the region+  in which the bar is rendered, allowing scroll bar element widgets+  to take up more than one row in height (for horizontal scroll bars)+  or more than one column in width (for vertical ones) as desired. If+  the widgets take up less space, padding is added between the scroll+  bar and the viewport contents to pad the scroll bar to take up the+  specified allocation.++1.9+---++API changes:+* `FocusRing` got a `Show` instance.++1.8+---++API changes:+* Added `Brick.Widgets.Core.forceAttrAllowStyle`, which is like+  `forceAttr` but allows styles to be preserved rather than overridden.++Other improvements:+* The `Brick.Forms` documentation was updated to clarify how attributes+  get used for form fields.++1.7+---++Package changes:+* Allow building with `base` 4.18 (GHC 9.6) (thanks Mario Lang)++API changes:+* Added a new function, `Brick.Util.style`, to create a Vty `Attr` from+  a style value (thanks Amir Dekel)++Other improvements:+* `Brick.Forms.renderForm` now issues a visibility request for the+  focused form field, which makes forms usable within viewports.++1.6+---++Package changes:+* Support `mtl` 2.3 (thanks Daniel Firth)++API changes:+* `Brick.Widgets.Table` got a new `alignColumns` function that can be+  used to do column layout of a list of widgets using `ColumnAlignment`+  values from the table API.+* `Brick.Widgets.Table` got a new low-level table-rendering API for use+  in applications that want to use the table layout machinery without+  using `Table` itself. This includes:+  * `tableCellLayout` - does table cell layout using table configuration+    settings,+  * `addBorders` - adds row, column, and surrounding borders using table+    border-drawing settings, and+  * `RenderedTableCells` and `BorderConfiguration` - the low-level types+    used for the new functions.++Other changes:+* Added a new `EditorLineNumbersDemo` demo program.++1.5+---++This release focuses on API improvements in `Brick.Widgets.Dialog`:++* `Dialog` got an additional type argument, `n`, for resource names.+* The `dialog` constructor now takes `[(String, n, a)]` rather than+  `[(String, a)]`; this allows the caller to associate a resource name+  with each dialog button.+* Dialog buttons now report click events under their associated resource+  names.+* Dialog buttons now `putCursor` when they are focused in order to work+  better with screen readers.+* The `Dialog` module got `getDialogFocus` and `setDialogFocus`+  functions to help with focus management, and as part of this change,+  the `dialogSelectedIndex` function and its lens `dialogSelectedIndexL`+  were removed.++1.4+---++API changes:+* `Brick.Widgets.Border` got `hBorderAttr` and `vBorderAttr` for use by+  `hBorder` and `vBorder` respectively. The new attributes inherit from+  `borderAttr`, so applications that just specify `borderAttr` will not+  see any change in behavior for those specific border elements.++Performance improvements:+* `Brick.Widgets.Core.txt` had its performance improved. (thanks Fraser+  Tweedale)+* `Brick.Widgets.Core.hBox` and `vBox` had their performance improved.+  (thanks Fraser Tweedale)++1.3+---++Package changes:+* Removed dependency on `dlist`.++Performance improvements:+* Improved the performance of `vBox` and `hBox` (thanks Fraser Tweedale)++1.2+---++Package changes:+* Supports base 4.17 (GHC 9.4).++Bug fixes:+* `newFileBrowser` now normalizes its initial path (#387).++1.1+---++API changes:+* `keyDispatcher` now returns `Either` to fail with collision+  information if collisions are detected due to overloaded keybindings.+  This fixes a critical problem in `KeyDispatcher` where it would+  previously silently ignore all but one handler for a specified key+  if the key configuration resulted in the same key being mapped to+  multiple handlers (either by event or by statically specified key).+* Added `Brick.Keybindings.KeyConfig.keyEventMappings` to allow+  applications to check for colliding bindings at the key configuration+  level.++Other changes:+* The User Guide got a new subsection on keybinding collisions.+* `programs/CustomKeybindingDemo.hs` got additional code to demonstrate+  how to check for and deal with keybinding collisions.+* `FileBrowser` got a `Named` instance.++1.0+---++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 working 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)+* The `MonadFail` derived instance for `EventM` was removed for GHC >=+  8.8.++0.73+----++API changes:+ * Added `Brick.Widgets.Edit.getCursorPosition` (thanks+   @TristanCacqueray)++0.72+----++Package changes:+ * Increased lower bound on `text-zipper` to `0.12`.++API changes:+ * `handleEditorEvent` now takes a `BrickEvent` rather than just a Vty+   `Event`.+ * Brick editors now handle mouse clicks to change their cursor+   positions.++0.71.1+------++Bug fixes:+ * Fixed an issue where `tests/Render.hs` did not gracefully exit in the+   presence of an unknown terminal.++0.71+----++Package changes:+ * Increased `vty` lower bound to `5.36`.++API changes:+ * Added `tests/Render.hs` to provide a simple test of+   `Brick.Main.renderWidget` (thanks @valyagolev)+ * Added `Brick.Main.renderWidget` to help in golden testing contexts+   (thanks @valyagolev)++Other changes:+ * Various `table` documentation improvements.++0.70.1+------++Build fixes:+ * Added a missing import for GHC 8.2.2.++0.70+----++Enhancements:+ * The table widget now behaves much better when some or all cells are+   empty.++Bug fixes:+ * BorderMaps got fixed to ensure that smart borders connect even in the+   presence of empty widgets (#370). Thanks to Daniel Wagner for this+   fix!++0.69.1+------++Bug fixes:+ * `table` can now deal properly with empty cells that are in left- and+   top-aligned settings. Previously, empty cells in those settings would+   break table rendering. (#369)++0.69+----++New features:+ * `Brick.Widgets.Core`: added `relativeTo` to support relative+   positioning across layers. This allows elements in higher layers+   to be positioned relative to elements in lower layers as long as+   those elements have had their extents reported with `reportExtent` or+   `clickable`.++0.68.1+------++Bug fixes:+ * Brick's internal book-keeping got a bug fix that caused mouse-click+   coordinates to be wrong for clickable regions that were translated+   partially off of the left or top edges of a rendered region.++0.68+----++API changes:+ * Removed the "markup" feature, which included `Data.Text.Markup`,+   `Brick.Markup`, and `brick-markup-demo`. This feature never performed+   well and was awkward to use. I considered it experimental from the+   initial release of this library. Some recent incompatibilities with+   Vty changes made me realize that it was time to finally get rid of+   this. If this affects you, please let me know and I am happy to work+   with you to figure out an alternative. Granted, anyone is welcome to+   dig up the previous code and re-use it in their own projects!++0.67+----++API changes:+ * `Brick.Widgets.FileBrowser` now exports getters for all+   `FileBrowser` fields. These getters are lens-like accessors+   with the `G` suffix.+ * `Brick.Widgets.FileBrowser` no longer exports the+   `fileBrowserEntryFilterL` lens. The lens broke the API+   because it allowed modification of internal state that could+   lead to inconsistency in the UI. Users who needed to use+   `fileBrowserEntryFilterL` before this change should use+   `setFileBrowserEntryFilter` instead.++0.66.1+------++Bug fixes:+ * `Brick.Widgets.Core.cached` no longer caches the visibility requests+   generated by the cached image. This fixes a bug where re-use of a+   cached rendering would cause undesired viewport scrolling of those+   requested regions into view when the cached renderings got re-used.++0.66+----++New features:+ * Added `Brick.Main.makeVisible`, a function to request visible regions+   from `EventM`. This, together with `Brick.Widgets.Core.reportExtent`,+   can be used to request that a viewport be scrolled to make a+   specified named region visible on the next redraw. The region must be+   known to the renderer with `reportExtent` (or something that calls+   it, like `clickable`). Due to the `Ord` constraint on some of the API+   calls required to implement this, an `Ord` constraint on the resource+   name type (`n`) got propagated to various places in the API. But that+   shouldn't present a problem since other fundamental API calls already+   required that instance.++0.65.1+------++Bug fixes:+ * `Brick.Widgets.Core.viewport`: fixed non-scroll+   direction width/height in the presence of scroll bars (see+   e41ad936ebe8b49e259a72ff7a34765d5a587aaa).++0.65+----++New features and API changes:+ * Viewports got support for built-in scroll bar rendering. This+   includes additions of types and functions to manage the feature+   behavior. These changes enable viewports to automatically get+   scroll bars drawn next to them (on any side) with customizable+   attributes and drawings. As part of this change, a new demo program,+   `ViewportScrollbarsDemo.hs`, was added to show off these new+   features. Here are the new types and functions that got added (mostly+   to `Brick.Widgets.Core`):+   * `withVScrollBars` - enable display of vertical scroll bars+   * `withHScrollBars` - enable display of horizontal scroll bars+   * `withClickableVScrollBars` - enable mouse click reporting on+     vertical scroll bar elements+   * `withClickableHScrollBars` - enable mouse click reporting on+     horizontal scroll bar elements+   * `ClickableScrollbarElement` - the type of elements of a scroll bar+     that can be clicked on and provided to the application+   * `withVScrollBarHandles` - enable vertical scroll bar handle drawing+   * `withHScrollBarHandles` - enable horizontal scroll bar handle+     drawing+   * `withVScrollBarRenderer` - customize the renderer used for vertical+     scroll bars+   * `withHScrollBarRenderer` - customize the renderer used for+     horizontal scroll bars+   * `ScrollbarRenderer(..)` - the type of scroll bar renderer+     implementations+   * `verticalScrollbarRenderer` - the default renderer for vertical+     scrollbars, customizable with `withVScrollBarRenderer`+   * `horizontalScrollbarRenderer` - the default renderer for horizontal+     scrollbars, customizable with `withHScrollBarRenderer`+   * `scrollbarAttr` - the base attribute of scroll bars+   * `scrollbarTroughAttr` - the attribute of scroll bar troughs+   * `scrollbarHandleAttr` - the attribute of scroll bar handles+ * The `Context` type got the `n` type argument that is used for+   `Result`, `EventM`, etc.++Package changes:+ * Raised `base` bounds to allow building with GHC 9.2.1 (thanks Mario+   Lang)+ * Stopped supporting GHC 7.10.++0.64.2+------++Bug fixes:+ * `Brick.Themes.saveTheme` now correctly saves background colors (#338)+ * `Brick.Widgets.List.listMoveToEnd` now uses the correct destination+   index (#337)++0.64.1+------++Bug fixes:+ * Fixed a bug where mouse clicks could fail to be noticed if+   "continueWithoutRedraw" was called.++0.64+----++API changes:+ * Added `Brick.Main.continueWithoutRedraw`, an alternative to+   `Brick.Main.continue` that does not trigger a screen redraw. See the+   Haddock and User Guide for details.+ * Added `Brick.Widgets.Core.putCursor` to support Vty's new (as of+   5.33) API for placing cursors without visually representing+   them. This change also updated `Brick.Forms.renderCheckbox` and+   `Brick.Forms.renderRadio` to use `putCursor` (thanks to Mario Lang+   for this work).++Other improvements:+ * `Brick.Widgets.Edit` now supports a few more Emacs-style keybindings+   (thanks Mario Lang):+    * `M-b` and `M-f` to navigate by word+    * `C-b` and `C-f` for consistency+    * `M-d` to delete word under cursor+    * `C-t` to transpose previous character with current character+    * `M-<` and `M->` to goto-beginning-of-file and end of file,+      respectively++0.63+----++API changes:+ * The `Viewport` type got a new field, `_vpContentSize` (and a+   corresponding lens `vpContentSize`) to get the size of the viewport's+   contents.++0.62+----++API changes:+ * `Brick.Widgets.Core` got new functions+   `crop{Left,Right,Bottom,Top}To`. Unlike the `crop...By` functions,+   which crop on the specified side by a particular amount, these+   `crop...To` functions crop on the specified side and take a desired+   overall width of the final result and use that to determine how much+   to crop. A widget `x` of width `w` could thus be cropped equivalently+   with `cropLeftBy a x` and `cropLeftTo (w - a) x`.++Other changes:+ * Added `programs/CroppingDemo.hs` to demonstrate the new (and+   preexisting) cropping functions.++0.61+----++API changes:+ * Brick.Forms got `editShowableFieldWithValidate`, a generalization+   of `editShowableField` that allows the caller to specify an+   additional validation function (thanks Ben Selfridge)++0.60.2+------++Bug fixes:+ * Widgets reported as `clickable` are now reported as clickable even+   when their renderings are cached with `cached` (#307; thanks Hari+   Menon)++0.60.1+------++Bug fixes:+ * `table []` no longer raises `TEUnequalRowSizes`.++0.60+----++New features:+ * Added `Brick.Widgets.Table` to support drawing basic tables. See+   `programs/TableDemo.hs` for a demonstration (`cabal new-run -f demos+   brick-table-demo`).++0.59+----++API changes:+ * `Brick.Widgets.List` got `listMoveToBeginning` and `listMoveToEnd`+   functions+ * `Extent`: removed the unused `extentOffset` field++Bug fixes:+ * Fixed a crash in the border rewriting code that attempted to rewrite+   empty images (#305) (thanks @dmwit)++0.58.1+------++Bug fixes:+ * Removed a defunct failing test from the List test suite++0.58+----++Package changes:+ * Updated dependency constraints to build on GHC 9.0.1 (thanks Ondřej+   Súkup)++API changes:+ * The FileBrowser module now exports individual functions for+   each of the events that it handles. This allows end users to+   trigger the behaviors directly rather than relying on the built-in+   `handleFileBrowserEvent` function. The documentation has been updated+   to indicate which functions are triggered by each key event. (Thanks+   David B. Lamkins)++Other changes:+ * The `List` module's `listFindBy` function now attempts to find a+   match anywhere in the list rather than just somewhere between the+   cursor and the end of the list.+ * The `FileBrowser` now positions a cursor at the beginning of the+   selected entry when the file browser is focused. (thanks Mario Lang)+ * The user guide's viewport visibility example got an important+   syntactic fix. (thanks Mario Lang)++0.57.1+------++Bug fixes:+ * Fixed a small space leak in the main rendering loop (#260)+ * Get `TailDemo` building on more versions of GHC++0.57+----++Package changes:+ * Raised lower bound on `vty` to 5.31 to get the new `strikethrough`+   style.++New features:+ * Added support for the `strikethrough` style in Brick theme+   customization files.++0.56+----++Package changes:+ * Increased upper bound for `base` to support GHC 8.10.2 (thanks Ryan+   Scott)++API changes:+ * Added `Brick.Forms.updateFormState` to update the state contained+   within (and managed by) a Form. This function takes care of the+   details of updating the form fields themselves to be consistent with+   the change in underlying state.+ * Added the overall window width (`windowWidth`) and height+   (`windowHeight`) to `Context`, the rendering context type (thanks Tom+   McLaughlin)++Other changes:+ * Added `brick-tail-demo`, a demonstration program for writing a+   `tail`-style output-following interface.+ * Updated `Brick.Widgets.ProgressBar` so that it handles near-endpoint+   cases more naturally (fixes #281)++0.55+----++Package changes:+ * Increased lower bound on `vty` dependency to 5.29.++Bug fixes:+ * `customMain` now restores the initial terminal input state on+   shutdown. This means that changes to the input state flags in the last+   `suspendAndResume` before program exit are no longer propagated to the+   end user's terminal environment (which could lead to broken or garbled+   terminal I/O).++0.54+----++API changes:+ * Exported `Brick.Widgets.FileBrowser.maybeSelectCurrentEntry` (thanks+   Róman Joost)++Other changes:+ * Added handlers for the `Home` and `End` keys to+   `Brick.Widgets.Edit.handleEditorEvent` (thanks Róman Joost)++0.53+----++Package changes:+ * Relaxed base bounds to allow building with GHC 8.10 (thanks Joshua+   Chia)++Bug fixes:+ * `vLimitPercent`: use correct horizontal size policy from child+   (thanks Janek Spaderna)+ * `str`: be more aggressive in determining how many characters to+   display (attempt to display as many zero-width characters as+   possible)++0.52.1+------++Bug fixes:+ * Attribute map lookups now merge styles in addition to merging colors+   (see `eb857e6bb176e119ac76f5e2af475f1b49812088`).+ * `txtWrapWith` now pads in the single-line case (see also+   `926d317c46b19d4e576748891a1702080287aa03`, #234, and #263)++0.52+----++API changes:+ * EventM now provides a MonadFail instance+ * EventM now provides MonadMask, MonadCatch, and MonadThrow instances+   (thanks Fraser Tweedale)++Other changes:+ * The FileBrowser now has support for vi-style bindings in addition to+   its previous bindings. New bindings include:+   * `j`/`k`: next/previous element+   * `C-n`/`C-p`: page down/up+   * `C-d`/`C-u`: half page down/up+   * `g`: select first entry+   * `G`: select last entry++0.51+----++API changes:+ * Added Brick.Focus.focusRingToList, which returns all of the elements+   in a focus ring as a list, starting with the focused entry and+   wrapping around (#257; thanks @4eUeP)++Bug fixes:+ * Fix Brick.Widgets.FileBrowser.fileExtensionMatch to match directories+   and also match symlinks that link to directories (thanks @YVee1)++Other changes:+ * Added demonstration program screenshot gallery (thanks @drola)++0.50.1+------++Bug fixes:+ * Fixed a bug where a self-referential symlink would cause the file+   browser to get into a loop and ultimately crash. (Thanks Kevin Quick)++API changes:+ * Added `Brick.Focus.focusRingLength` to get the size of a focus ring.+   (Thanks Róman Joost)++Other changes:+ * Updated Travis configuration and base dependency to support GHC+   8.8.1. (thanks Brandon Hamilton)++0.50+----++API changes:+ * Added `writeBChanNonBlocking`, which does a non-blocking write to a+   `BChan` and returns whether the write succeeded. This required+   raising the STM lower bound to 2.4.3.++0.49+----++New features:+ * The `FileBrowser` now supports navigation of directories via+   symlinks, so `Enter` on a symlink will descend into the target path+   of the symlink if that path is a directory. Part of this change is+   that the `FileInfo` type got a new file, `fileInfoLinkTargetType`,+   that indicates the type of file that the link points to, if any.++0.48+----++New features:+ * The `Edit` widget now supports `EvPaste` Vty events by default,+   assuming UTF-8 encoding of pasted bytes. If pasted bytes are not+   UTF-8-decodable, the pastes will be ignored. In any case, users can+   still intercept `EvPaste` events as before and handle them as desired+   if the default behavior is not desirable.++Other changes:+ * `txtWrapWith` now always pads its output to the available width to+   obey its `Greedy` requirement.++0.47.1+------++Bug fixes:+ * userguide: update stale Result construction+ * Added test case for List initial selection (thanks Fraser Tweedale)+ * Fixed build on GHC 7.10 due to RULES pragma formatting issue (thanks+   Fraser Tweedale)+ * Various CI-related fixes (thanks Fraser Tweedale)++0.47+----++API changes:+ * Changed `Brick.Main.customMain` so that it now takes an additional+   (first) argument: the initial `Vty` handle to use. This lets the+   caller have more control over the terminal state when, for example,+   they have previously set up Vty to do other work before calling+   `customMain`.+ * Added `Brick.Main.customMainWithVty`. This function is the same as+   `customMain` except that it also returns the final `Vty` handle that+   it used internally *without* shutting that Vty handle down. This+   allows the caller to continue using the terminal without resetting it+   after `customMainWithVty` finishes executing.++0.46+----++Performance improvements:+ * The box combinators `<=>`, `<+>`, `vBox`, and `hBox` got GHC rewrite+   rules that will optimize away redundant boxes. This change improves+   performance for chains of `<+>` or `<=>` as well as nested boxes+   using `hBox` and `vBox`. Previously chains of e.g. `<+>` produced+   binary trees of boxes that incurred more rendering overhead. Those+   are now optimized away.++API changes:+ * Data.Text.Markup: renamed `empty` to `isEmpty`++0.45+----++API changes:+ * List got a new `listFindBy` function (thanks Fraser Tweedale). This+   function uses a predicate to find a matching element in the list and+   move the cursor to that item.+ * Data.Text.Markup got a new `empty` function (#213)++0.44.1+------++Bug fixes:+ * `Brick.Markup` now properly renders empty lines in markup (#209)++0.44+----++API changes:+ * The `List` type got its container type generalized thanks to a lot of+   work by Fraser Tweedale. Note that this change is+   backwards-compatible with older Brick programs that use the `List`.+   Thanks to this work, the `List` now supports both `Data.Vector`+   and `Data.Sequence` as its container types out of the box and can+   be extended to support other sequence types with some simple type+   class instances. In addition, property tests are provided for `List`+   and its asymptotics are noted in the documentation. Along the way,+   various bugs in some of the list movement functions got fixed to+   bring them in line with the advertised behavior in the documentation.+   Thanks, Fraser!++0.43+----++API changes:+ * The FileBrowser module got the ability to select multiple files+   (#204). This means that the `fileBrowserSelection` function now+   returns a list of `FileInfo` rather than at most one via `Maybe`.+   The module also now uses a new attribute, `fileBrowserSelectedAttr`,+   to indicate entries that are currently selected (in addition to+   displaying an asterisk after their filenames). Lastly, the file+   size and type fields of `FileInfo` have been replaced with a+   new type, `FileStatus`, and `FileInfo` now carries an `Either+   IOException FileStatus`. As part of that safety improvement,+   `setWorkingDirectory` now no longer clobbers the entire entry listing+   if any of the listings fail to stat. In addition, the FileBrowser now+   uses the correct file stat routines to deal with symbolic links.++Package changes:+ * Added lower bound on `directory` (thanks Fraser Tweedale)++Test suite changes:+ * Test suite now propagates success/failure to exit status (thanks+   Fraser Tweedale)++0.42.1+------++Behavior changes:+ * File browsers in search mode now terminate search mode when `Enter`+   is pressed, resulting in better behavior.++0.42+----++New features:+ * Added `Brick.Widgets.FileBrowser`, which provides a filesystem+   browser for selecting files and directories. Read the Haddock+   module documentation and see the included demo program,+   `programs/FileBrowserDemo.hs`, for information on using the new+   functionality.++0.41.5+------++Miscellaneous:+ * `suspendAndResume` now empties the rendering cache when returning to+   the rendering event loop. This ensures that the state returned by the+   `IO` action is rendered completely rather than relying on potentially+   stale cache entries.++0.41.4+------++API changes:+ * Forms: added `setFormFocus` function to set focus for a form+ * Added `NFData` instances for `AttrMap` and `Theme` types (thanks+   Fraser Tweedale)++0.41.3+------++Bug fixes:+ * Lists now draw correctly without crashing due to a vector slice+   bounds check failure if their rendering area is too small (#195;+   thanks @andrevdm)++Other changes:+ * Relaxed base bounds to support GHC 8.6 (thanks @maoe)+ * Added towerHanoi to the featured projects list++0.41.2+------++Bug fixes:+ * Support STM 2.5 by allowing for `Natural` argument to `newTBQueue`+   (thanks @osa1)++0.41.1+------++New features:+ * `Forms`: added `checkboxCustomField` and `radioCustomField` to permit+   customization of characters used to draw selection state for such+   fields.++0.41+----++New features:+ * `Brick.Forms` got a new field constructor, `listField`, that provides+   a form field using a `List`.+ * `List`: added the `listMoveToElement` function for changing the list+   selection to the specified element, if it exists.++Package changes:+ * Now depends on vty >= 5.24.++Other changes:+ * `viewport`: fixed failable patterns for forward compatibility with+   GHC 8.6 (#183)+ * Add `Generic`, `NFData`, and `Read` instances for some types++0.40+----++New features:+ * Brick.Widgets.Core: added new functions `hLimitPercent` and+   `vLimitPercent`. These behave similarly to `hLimit` and `vLimit`+   except that instead of taking absolute numbers of columns or rows,+   they take percentages. (Thanks Roman Joost)++0.39+----++New features:+ * The `italic` keyword is now supported in theme customization file+   style lists. This requires `vty >= 5.23.1`++0.38+----++New features:+ * Added support for parsing `#RRGGBB` color values in theme+   customization files in addition to the color names already supported+   (thanks Brent Carmer). These values are mapped to the nearest+   reasonable entry in the 240-color space.++0.37.2+------++Bug fixes:+ * Theme customization files can now use empty lists for style+   customization.++0.37.1+------++API changes:+ * Exposed `Brick.Forms.renderFormFieldState`.++0.37+----++Behavior changes:+ * `listMoveBy` now automatically moves to the first or last position+   in the list if called when the list is non-empty but has no selected+   element (thanks Philip Kamenarsky)++API changes:+ * Added `Brick.Widgets.List.renderListWithIndex` that passes+   the index of each element to the item rendering function (thanks+   liam@magicseaweed.com)++0.36.3+------++Bug fixes:+ * Fixed a bug where mouse-up events in viewports were not translated+   into the global coordinate space, unlike mouse-down events (#173)++0.36.2+------++API changes:+ * The Forms API got two new functions, `setFormConcat` and+   `setFieldConcat`, used for controlling the previously hard-coded+   concatenation behavior of form fields. These are optional and both+   concatenation settings default to their former hard-coded values,+   `vBox` (#172).++0.36.1+------++Package changes:+ * Raised upper bound to support GHC 8.4.2 (#171)++Other changes:+ * Improved List accessor documentation (thanks liam <liam@magicseaweed.com>)+ * Brick.Main now uses a Set instead a list to track invalidation+   requests to avoid duplicates.++0.36+----++New features:+ * Dynamic border support: adjacent widgets that use borders can make+   those borders seamlessly connect to each other! Thanks+   so much to Daniel Wagner for this feature! Please see+   `programs/DynamicBorderDemo.hs` for a demonstration. Also see the+   "Joinable Borders" section of the User Guide.++0.35.1+------++ * Conditionally depend on semigroups for GHC before 8++0.35+----++ * Added support for GHC 8.4.+ * Updated travis build to test on all 8.x releases (thanks Peter+   Simons)++0.34.1+------++Bug fixes:+ * Fixed a bug where the "reverseVideo" style could not be parsed in a+   theme customization when it was all lowercase (thanks Yuriy Lazarev)++Documentation changes:+ * Guide: added more complete example of creating a default theme+   (thanks Mark Wales)+ * Guide: added offset to Extent pattern matching (thanks Mark Wales)++0.34+----++API changes:+ * Core: vLimit and hLimit now *bound* sizes rather than setting them.+   This was the original intention of these combinators. The change in+   behavior means that now `vLimit N` means that *at most* `N` rows will+   be available; if the context has less, then the smaller constraint in+   the context is used instead. Programs affected by this behavior will+   be those that assume that `vLimit` doesn't do this, but that should+   be very few or zero.++Other changes:+ * Dialog: now arrow keys no longer wrap around available buttons but+   stop at rightmost or leftmost button to avoid confusion when+   attempting to tell which button is selected in two-button dialogs+   (thanks to Karl Ostmo for this change)++Documentation changes:+ * Updated Haddocks for str/txt in Core to mention tab character+   considerations++0.33+----++API changes:+ * Forms: added support for external validation of form fields using+   `setFieldValid`. See the Haddock, User Guide, and FormDemo.hs for+   details.+ * Borders: removed all attribute names except `borderAttr` to simplify+   border attribute assignment.++0.32.1+------++Bug fixes:+ * Core: make all text wrap widgets Greedy horizontally++Miscellaneous:+ * Dialog: clarify purpose in documentation (w.r.t. #149)++0.32+----++API changes:+ * This release adds the new `Brick.Forms` module, which provides an API+   for type-safe input forms with automatic rendering, event handling,+   and state management! See the Haddock and the "Input Forms" section+   of the Brick User Guide for information on this killer feature! Many+   thanks to Kevin Quick for feedback on this new functionality.++0.31+----++Behavior changes:+ * `viewport` now implicitly causes generation of mouse events for the+   viewport when mouse mode is enabled. The mouse events are expressed+   in the coordinate system of the contents of the viewport. The+   consequence and intention of this change is to enable mouse event+   reporting for editors when clicks occur outside the known text area.++0.30+----++API changes:+ * `Brick.Focus`: added `focusSetCurrent` to make it easy to set the+    focus of a focus ring+ * `Brick.Main`: added a simple polymorphic `App` value, `simpleApp`++0.29.1+------++Bug fixes:+ * Mixed-case color names like "brightBlue" can now be parsed in theme+   customization files.++0.29+----++API changes:+ * Added Ord instances for `Location` and `BrickEvent` (thanks Tom+   Sydney Kerckhove)+ * `Brick.AttrMap`: attribute name components are now exposed via the+   `attrNameComponents` function. Also added a Read instance for+   AttrName.++New features:+ * This release adds user-customizable theme support. Please see the+   "Attribute Themes" section of the User Guide for an introduction; see+   the Haddock documentation for `Brick.Themes` for full details. Also,+   see the new `programs/ThemeDemo.hs` for a working demonstration.++0.28+----++API changes:+ * Brick.AttrMap.setDefault was renamed to setDefaultAttr.+ * Added Brick.AttrMap.getDefaultAttr: get the default attribute from an+   attribute map.+ * Added Brick.Widgets.Core.modifyDefAttr to modify the default+   attribute of the rendering context.++Other changes:+ * Updated AttrDemo to show usage of modifyDefAttr.++0.27+----++API changes:+ * Brick.Widgets.Core: added `hyperlink` combinator (thanks Getty Ritter+   for hyperlinking support)++Other changes:+ * Updated AttrDemo to show how to use hyperlinking+ * README: Added `herms` to featured projects++0.26.1+------++ * Fixed haddock for listHandleEventVi.++0.26+----++API changes:+ * Added Brick.Widgets.List.handleListEventVi to add support for+   vi-style movements to lists (thanks Richard Alex Hofer)++Other changes:+ * Added ListViDemo.hs to demonstrate the Vi-style handler for lists+   (thanks Richard Alex Hofer)++0.25+----++API changes:+ * List: added page movement functions `listMoveByPages`,+   `listMovePageUp`, and `listMovePageDown` (thanks Richard Alex Hofer)++Miscellaneous:+ * Fixed a spelling mistake in the AttrMap haddock (thanks Edward Betts)++0.24.2+------++Miscellaneous:+ * Minor documentation updates including a clarification for #135++0.24.1+------++Bug fixes:+ * vBox/hBox: when there is leftover space and all elements are greedy,+   spread it amongst the elements as evenly as possible instead of+   assigning it all to the first element (fixes #133)++Package changes:+ * Include Sam Tay's brick tutorial files in extra-doc-files++0.24+----++API changes:+ * Added Brick.Widgets.Core.setAvailableSize to control rendering+   context size in cases where the screen size is too constraining (e.g.+   for a floating layer that might be bigger than the screen).++Documentation changes:+ * Samuel Tay has contributed his wonderful Brick tutorial to this+   package in docs/samtay-tutorial.md. Thank you!++0.23+----++API changes:+ * getVtyHandle: always return a Vty handle rather than Maybe+   (Previously, in appStartEvent you'd get Nothing because Vty had+   not been initialized yet. This made various use cases impossible+   to satisfy because appStartEvent is a natural place to get initial+   terminal state from Vty. This change makes it so that a Vty handle is+   always available, even in appStartEvent.)+ * txtWrapWith: added missing haddock++0.22+----++API changes:+ * Core: added txtWrapWith and strWrapWith functions to provide control+   over wrapping behavior by specifying custom wrapping settings.++Other changes:+ * Updated TextWrapDemo.hs to demonstrate customizing wrapping settings.++0.21+----++Package changes:+ * Upgrade to word-wrap 0.2++Other changes:+ * Brick.Types.Internal: improve mouse constructor haddock+ * Add a basic fill demonstration program (FillDemo.hs)++0.20.1+------++Bug fixes:+ * str: fixed an IsString constraint confusion on GHC 7.10.1++0.20+----++Package changes:+ * Added a dependency on "word-wrap" for text-wrapping.+ * Added a new TextWrapDemo demo program to illustrate text wrapping+   support++API changes:+ * Brick.Widgets.Core: added new functions txtWrap and strWrap to do+   wrapping of long lines of text.++Miscellaneous:+ * Guide: fixed event type (#126)++0.19+----++API changes:+ * The editor content drawing function is now passed to renderEditor,+   not the constructor, to improve separation of presentation and+   representation concerns. The corresponding Editor drawing function+   lens and accessor were removed.++0.18+----++Package changes:+ * Added a dependency on data-clist.++API changes:+ * Brick.Focus: removed the Functor instance for FocusRing.+ * Brick.Focus: re-implemented FocusRing in terms of the circular list+   data structure from data-clist. In addition, this change introduced+   "focusRingModify", which permits the user to use the data-clist API+   to directly manipulate the FocusRing's internals. This way brick+   doesn't have to re-invent the wheel on the focus ring behavior.++0.17.2+------++Package changes:+ * Added programs/ReadmeDemo.hs and featured its output and code in the+   README to provide an early demonstration++Library changes:+ * centerAbout now right- and bottom-pads its operand to behave+   consistently with h/vCenter++0.17.1+------++Package changes:+ * Use Extra-Doc-Files instead of Data-Files for documentation files++Bug fixes:+ * List: correctly update selected index in listInsert+ * Update example program in brick.cabal (thanks @timbod7)++0.17+----++Package changes:+* Updated to depend on Vty 5.15.+* Updated to remove dependency on data-default.+* Discontinued support for GHC versions prior to 7.10.1.++API changes:+* Removed Data.Default instances for AttrName, AttrMap, Result, and+  BorderStyle (use Monoid instances instead where possible).+* Added defaultBorderStyle :: BorderStyle.+* Added emptyResult :: Result n.++0.16+----++This release includes a breaking API change:+* Brick now uses bounded channels (Brick.BChan.BChan) for event+  communication rather than Control.Concurrent.Chan's unbounded channels+  to improve memory consumption for programs with runaway event+  production (thanks Joshua Chia)++Other API changes:+* Brick.List got a new function, listModify, for modifying the selected+  element (thanks @diegospd)++Performance improvements:+* hBox and vBox now use the more efficient DList data structure when+  rendering to improve performance for boxes with many elements (thanks+  Mitsutoshi Aoe)++0.15.2+------++Bug fixes:+* viewport: do not cull cursor locations on empty viewport contents+  (fixes #105)+* User guide CounterEvent type fix (thanks @diegospd)++0.15.1+------++Bug fixes:+* List: fixed empty list validation in listReplace (thanks Joshua Chia)++0.15+----++Demo changes:+* MouseDemo: add an editor and use mouse events to move the cursor+* MouseDemo: Enhance MouseDemo to show interaction between 'clickable'+  and viewports (thanks Kevin Quick)++New features:+* Editors now report mouse click events++API changes:+* Rename TerminalLocation row/column fields to avoid commonplace name+  clashes; rename row/column to locationRow/locationColumn (fixes #96)++Bug fixes:+* Core: make cropToContext also crop extents (fixes #101)+* viewport: if the sub-widget is not rendered, also cull all extents and+  cursor locations++Documentation changes:+* User Guide updates: minor fixes, updates to content on custom widgets,+  wide character support, and examples (thanks skapazzo@inventati.org,+  Kevin Quick)++0.14+----++This release added support for wide characters. In particular, wide+characters can now be entered into the text editor widget and used in+'str' and 'txt' widgets.++0.13+----++API changes:+ * Mouse mode is no longer enabled by default.+ * customMain's event channel parameter is now optional+ * FocusRing now provides a Functor instance (thanks Ian Jeffries)++0.12+----++This release primarily adds support for mouse interaction. For details,+see the Mouse Support section of the User Guide. This release also+includes breaking API changes for the App type. Here's a migration+guide:++ * Event handlers now take "BrickEvent n e" instead of "e", where "e"+   was the custom event type used before this change. To recover your+   own custom events, pattern-match on "AppEvent"; to recover Vty input+   events, pattern-match on "VtyEvent".+ * appLiftVtyEvent went away and can just be removed from your App+   record constructor.+ * If you aren't using the custom event type or were just using Vty's+   "Event" type as your App's event type, you can set your event type to+   just "e" because you'll now be able to get Vty events regardless of+   whether you use a custom event type.++API changes:+ * Added the Widget combinator "clickable" to indicate that a widget+   should generate mouse click events+ * Added the Extent data type and the "reportExtent" widget combinator+   to report the positions and sizes of widgets+ * Rendering "Result" values now include reported extents and update+   their offsets (adds "extents" field and "extentsL" lens)+ * Added "lookupExtent", "findClickedExtents", and "clickedExtent" in+   EventM to find extents and check them for mouse clicks+ * Removed appLiftVtyEvent. Instead of wrapping Vty's events in your own+   type, you now get a "BrickEvent" that always contains Vty events but+   has the ability to embed *your* custom events. See the User Guide for+   details.+ * Added demo program MouseDemo.hs+ * Added demo program ProgressBarDemo.hs (thanks Kevin Quick)+ * Added mapAttrname, mapAttrNames, and overrideAttr functions (thanks+   Kevin Quick)+ * Make handleEventLensed polymorphic over event type to allow use with+   custom events (thanks Kevin Quick)+ * Added Ord constraint to some library startup functions++Bug fixes:+ * Added Show instance for Editor, List (fixes #63)++Documentation changes:+ * Updated documentation to use new "resource name" terminology to+   reduce confusion and better explain the purpose of names.+ * Updated user guide with sections on mouse support, the rendering+   cache, resource names, paste mode, and extents++Package changes:+ * Depend on Vty 5.11.3 to get mouse mode support++0.11+----++API changes:+ * Added getVtyHandle in EventM for obtaining the current Vty context.+   It returns Nothing when calling the appStartEvent handler but after+   that a context is always available.++0.10+----++New features:+ * Added a rendering cache. To use the rendering cache, use the 'cached'+   widget combinator. This causes drawings of the specified widget to+   re-use a cached rendering until the rendering cache is invalidated+   with 'invalidateCacheEntry' or 'invalidateCache'. This change also+   includes programs/CacheDemo.hs. This change introduced an Ord+   constraint on the name type variable 'n'.+ * Added setTop and setLeft for setting viewport offsets directly in+   EventM.+ * Dialog event handlers now support left and right arrow keys (thanks+   Grégoire Charvet)++Library changes:+ * On resizes brick now draws the application twice before handling the+   resize event. This change makes it possible for event handlers to+   get the latest viewport states on a resize rather than getting the+   most recent (but stale) versions as before, at the cost of a second+   redraw.++Bug fixes:+ * We now use the most recent rendering state when setting up event handler+   viewport data. This mostly won't matter to anyone except in cases+   where a viewport name was expected to be in the viewport map but+   wasn't due to using stale rendering state to set up EventM.++0.9+---++Package changes:+ * Depend on text-zipper 0.7.1++API changes:+ * The editor widget state value is now polymorphic over the type of+   "string" value that can be edited, so you can now create editors over+   Text values as well as Strings. This is a breaking change but it only+   requires the addition of the string type variable to any uses of+   Editor. (thanks Jason Dagit and Getty Ritter)+ * Added some missing Eq and Show instances (thanks Grégoire Charvet)++New features:+ * The editor now binds Control-U to delete to beginning of line (thanks+   Hans-Peter Deifel)++Bug fixes:+ * List: avoid runtime exception by ensuring item height is always at+   least 1++0.8+---++API changes:+ * Center: added layer-friendly centering functions centerLayer,+   hCenterLayer, and vCenterLayer.++Functionality changes:+ * Dialog now uses new layer-friendly centering functions. This makes it+   possible to overlay a Dialog on top of your UI when you use a Dialog+   rendering as a separate layer.+ * Updated the LayerDemo to demonstrate a centered layer.+ * The renderer now uses a default Vty Picture background+   of spaces with the default attribute, rather than using+   ClearBackground (the Vty default). This is to compensate for an+   unexpected attribute behavior in Vty when ClearBackgrounds (see+   https://github.com/coreyoconnor/vty/issues/95)++0.7+---++NOTE: this release includes many API changes. Please see the "Widget+Names" section of the Brick User Guide for details on the fundamentals!++API changes:+ * The "Name" type was removed. In its place we now have a name type+   variable ("n") attached to many types (including EventM,+   CursorLocation, App, Editor, List, and FocusRing). This change makes+   it possible to:+   * Avoid runtime errors due to name typos+   * Achieve compile-time guarantees about name matching and usage+   * Force widget functions to be name-agnostic by being polymorphic+     in their name type+   * Clean up focus handling by making it possible to pattern-match+     on cursor location names+ * The EditDemo demonstration program was updated to use a FocusRing.+ * Added the "Named" type class to Brick.Widgets.Core for types that+   store names. This type class is used to streamline the Focus+   interface; see Brick.Focus.withFocusRing and EditDemo.hs.+ * The List and Editor types are now parameterized on names.+ * The List widget is now focus-aware; its rendering function now takes+   a boolean indicating whether it should be rendered with focus. The+   List uses the following attributes now:+   * When not focused, the cursor is rendered with listSelectedAttr.+   * When focused, the cursor is rendered with listSelectedFocusedAttr.+ * The Editor widget is now focus-aware; its rendering function now+   takes a boolean indicating whether it should be rendered with focus.+   The Editor uses the following attributes now:+   * When not focused, the widget is rendered with editAttr.+   * When focused, the widget is rendered with editFocusedAttr.+ * The Dialog's name constructor parameter and lens were removed.+ * The 'viewport' function was modified to raise a runtime exception if+   the widget name it receives is used more than once during the+   rendering of a single frame.++Miscellaneous:+ * Many modules now use conditional imports to silence redundancy+   warnings on GHCs with newer Preludes (e.g. including Monoid,+   Foldable, Traversable, Applicative, etc.)++0.6.4+-----++Bug fixes:+ * Add missing Functor instance for Next type (thanks Markus Hauck)++0.6.3+-----++Bug fixes:+ * List: the list now properly renders when the available height is not+   a multiple of the item height. Previously the list size would+   decrease relative to the available height. Now the list renders+   enough items to fill the space even if the top-most or bottom-most+   item is partially visible, which is the expected behavior.++0.6.2+-----++Bug fixes:+ * Editor: the 'editor' initial content parameter is now correctly split+   on newlines to ensure that the underlying editor zipper is+   initialized properly. (fixes #56; thanks @listx)++0.6.1+-----++Package changes:+ * Added lower bound for microlens >= 0.3.0.0 to fix build failure due+   to Field1 not being defined (thanks Markus Hauck)++Documentation changes:+ * Updated user guide and README to link to and mention microlens+   instead of lens++Misc:+ * Fixed a qualified import in the List demo to avoid ambiguity (thanks+   Alan Gilbert)++0.6+---++API changes:+ * Brick now uses the microlens family of packages instead of lens. This+   version of brick also depends on vty 5.5.0, which was modified to use+   microlens instead of lens. This change shouldn't impact functionality+   but will greatly reduce build times.++0.5.1+-----++Bug fixes:+ * Fix negative cropping in hCenter, vCenter, and cropResultToContext+   (fixes #52)+ * Remove unnecessary Eq constraint from listReplace (fixes #48; thanks+   sifmelcara)+ * Mention Google Group in README++0.5+---++Functionality changes:+ * Markup: make markup support multi-line strings (fixes #41)+ * brick-edit-demo: support shift-tab to switch editors+ * Core: improve box layout algorithm (when rendering boxes, track+   remaining space while rendering high-priority children to use+   successively more constrained primary dimensions)+ * Core: make fixed padding take precedence over padded widgets (fixes #42)+   Prior to this commit, padding a widget meant that if there was room+   after rendering the widget, the specified amount of padding would be+   added. This meant that under tight layout constraints padding would+   disappear before a padded widget would. This is often a desirable+   outcome but it also led to unexpected behavior when adding padding+   to a widget that grows greedily: fixed padding would never show up+   because it was placed in a box adjacent to the widget in question,+   and boxes always render greedy children before fixed ones. As a+   result fixed padding would disappear under these conditions. Instead,+   in the case of fixed padding, since we often intend to *guarantee*+   that padding is present, all of the padding combinators have been+   modified so that when the padded widget is rendered with fixed+   padding in the amount V, the widget is given V fewer rows/columns+   when it is rendered so that the padding always has room.++0.4.1+-----++Bug fixes:+* Fixed a bug in the 'visible' combinator: If the size of the visibility+  request was larger than the available space, then the rendering of a+  viewport was toggling between two states, one with aligning on the+  end of the visibility request, and another one aligning on the start.+  This commit fixes it so that a visibility request is always aligned+  on the start if not enough space is available. (thanks Thomas Strobel+  <ts468@cam.ac.uk>)++Behavior changes:+* Honor multiple 'visible' markers in a single viewport with preference+  on the innermost request (thanks Thomas Strobel <ts468@cam.ac.uk>)++0.4+---++API changes:+* Added Brick.Widgets.Core.unsafeLookupViewport to make certain kinds+  of custom widget implementations easier when viewport states are needed+  (thanks Markus Hauck <markus1189@gmail.com>)+* List: added listClear and listReverse functions (thanks Markus Hauck)+* List: Derive instances for Functor, Foldable, Traversable (thanks+  Markus Hauck)++Documentation changes:+* Hyperlink "Data.Text.Markup" inside Brick.Markup haddock (thanks+  Markus Hauck)+* Fix typo in 'Attribute Management' section of user guide (thanks+  Markus Hauck)++0.3.1+-----++Bug fixes:+* EventM newtype again instances MonadIO (thanks Andrew Rademacher)++0.3+---++API changes:+* Made EventM a newtype instead of a type alias+* List: listReplace now takes the new selected index and no longer does+element diffing++Package changes:+* Removed the dependency on the Diff package++Misc:+* Applied some hlint hints (thanks Markus Hauck <markus1189@gmail.com>)+* Fixed a typo in the README (thanks Markus Hauck <markus1189@gmail.com>)+* Improved the renderList documentation (thanks Profpatsch <mail@profpatsch.de>)+* Types: added an explicit import of Applicative for older GHCs++0.2.3+-----++Bug fixes:+* Fixed viewport behavior when the image in a viewport reduces its size+  enough to render the viewport offsets invalid. Before, this behavior+  caused a crash during image cropping in vty; now the behavior is   handled sanely (fixes #22; reported by Hans-Peter Deifel)  0.2.2
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015, Jonathan Daugherty.+Copyright (c) 2015-2025, Jonathan Daugherty. All rights reserved.  Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,34 +1,29 @@-brick--------[![Build Status](https://travis-ci.org/jtdaugherty/brick.svg?branch=master)](https://travis-ci.org/jtdaugherty/brick)+![](logo/brick-final-clearbg-with-text.svg) -`brick` is a Haskell terminal user interface programming library in the-style of [gloss](http://hackage.haskell.org/package/gloss). This means-you write a function that describes how your user interface should look,-but the library takes care of a lot of the book-keeping that so commonly-goes into writing such programs.+`brick` is a Haskell terminal user interface (TUI) programming toolkit.+To use it, you write a pure function that describes how your user+interface should be drawn based on your current application state and+you provide a state transformation function to handle events.  `brick` exposes a declarative API. Unlike most GUI toolkits which-require you to write a long and tedious sequence of "create a widget,-now bind an event handler", `brick` just requires you to describe your-interface using a set of declarative combinators. Then you provide a-function to transform your application state when input or other kinds-of events arrive.+require you to write a long and tedious sequence of widget creations+and layout setup, `brick` just requires you to describe your interface+using a set of declarative layout combinators. Event-handling is done by+pattern-matching on incoming events and updating your application state.  Under the hood, this library builds upon [vty](http://hackage.haskell.org/package/vty), so some knowledge of Vty-will be helpful in using this library.--This library deprecates [vty-ui](https://github.com/jtdaugherty/vty-ui).+will be necessary to use this library. Brick depends on+`vty-crossplatform`, so Brick should work anywhere Vty works (Unix and+Windows). Brick releases prior to 2.0 only support Unix-based systems.  Example ------- -Here's an example interface that resizes automatically when the terminal-size changes (see `programs/ReadmeDemo.hs`):+Here's an example interface (see `programs/ReadmeDemo.hs`):  ```+joinBorders $ withBorderStyle unicode $ borderWithLabel (str "Hello!") $ (center (str "Left") <+> vBorder <+> center (str "Right"))@@ -43,90 +38,170 @@ │   Left    │   Right    │ │           │            │ │           │            │-└────────────────────────┘+└───────────┴────────────┘ ``` +Featured Projects+-----------------++To get an idea of what some people have done with `brick`, check out+these projects. If you have made something and would like me to include+it, get in touch!++| Project | Description |+| ------- | ----------- |+| [`2048Haskell`](https://github.com/8Gitbrix/2048Haskell) | An implementation of the 2048 game |+| [`babel-cards`](https://github.com/srhoulam/babel-cards) | A TUI spaced-repetition memorization tool. Similar to Anki. |+| [`bhoogle`](https://github.com/andrevdm/bhoogle) | A [Hoogle](https://www.haskell.org/hoogle/) client |+| [`bollama`](https://github.com/andrevdm/bollama) | A simple [Ollama](https://ollama.com/) TUI |+| [`brewsage`](https://github.com/gerdreiss/brewsage#readme) | A TUI for Homebrew |+| [`brick-trading-journal`](https://codeberg.org/amano.kenji/brick-trading-journal) | A TUI program that calculates basic statistics from trades |+| [`Brickudoku`](https://github.com/Thecentury/brickudoku) | A hybrid of Tetris and Sudoku |+| [`cbookview`](https://github.com/mlang/cbookview) | A TUI for exploring polyglot chess opening book files |+| [`clifm`](https://github.com/pasqu4le/clifm) | A file manager |+| [`codenames-haskell`](https://github.com/VigneshN1997/codenames-haskell) | An implementation of the Codenames game |+| [`fifteen`](https://github.com/benjaminselfridge/fifteen) | An implementation of the [15 puzzle](https://en.wikipedia.org/wiki/15_puzzle) |+| [`ghcup`](https://www.haskell.org/ghcup/) | A TUI for `ghcup`, the Haskell toolchain manager |+| [`git-brunch`](https://github.com/andys8/git-brunch) | A git branch checkout utility |+| [`Giter`](https://gitlab.com/refaelsh/giter) | A UI wrapper around Git CLI inspired by [Magit](https://magit.vc/). |+| [`gotta-go-fast`](https://github.com/callum-oakley/gotta-go-fast) | A typing tutor |+| [`haradict`](https://github.com/srhoulam/haradict) | A TUI Arabic dictionary powered by [ElixirFM](https://github.com/otakar-smrz/elixir-fm) |+| [`hascard`](https://github.com/Yvee1/hascard) | A program for reviewing "flash card" notes |+| [`haskell-player`](https://github.com/potomak/haskell-player) | An `afplay` frontend |+| [`herms`](https://github.com/jackkiefer/herms) | A command-line tool for managing kitchen recipes |+| [`hic-hac-hoe`](https://github.com/blastwind/hic-hac-hoe) | Play tic tac toe in terminal! |+| [`hledger-iadd`](http://github.com/rootzlevel/hledger-iadd) | An interactive terminal UI for adding hledger journal entries |+| [`hledger-ui`](https://github.com/simonmichael/hledger) | A terminal UI for the hledger accounting system. |+| [`homodoro`](https://github.com/c0nradLC/homodoro) | A terminal application to use the pomodoro technique and keep track of daily tasks |+| [`hskanban`](https://github.com/vincentaxhe/hskanban) | A Kanban organizer |+| [`htyper`](https://github.com/Simon-Hostettler/htyper) | A typing speed test program |+| [`hyahtzee2`](https://github.com/DamienCassou/hyahtzee2#readme) | Famous Yahtzee dice game |+| [`kpxhs`](https://github.com/akazukin5151/kpxhs) | An interactive [Keepass](https://github.com/keepassxreboot/keepassxc/) database viewer |+| [`matterhorn`](https://github.com/matterhorn-chat/matterhorn) | A client for [Mattermost](https://about.mattermost.com/) |+| [`maze`](https://github.com/benjaminselfridge/maze) | A Brick-based maze game |+| [`monad-torrent`](https://github.com/davorluc/monad-torrent) | A simple and minimal torrent client |+| [`monalog`](https://github.com/goosedb/Monalog) | Terminal logs observer |+| [`mushu`](https://github.com/elaye/mushu) | An `MPD` client |+| [`mywork`](https://github.com/kquick/mywork) [[Hackage]](https://hackage.haskell.org/package/mywork) | A tool to keep track of the projects you are working on |+| [`pboy`](https://github.com/2mol/pboy) | A tiny PDF organizer |+| [`purebred`](https://github.com/purebred-mua/purebred) | A mail user agent |+| [`sandwich`](https://codedownio.github.io/sandwich/) | A test framework with a TUI interface |+| [`silly-joy`](https://github.com/rootmos/silly-joy) | An interpreter for Joy |+| [`solitaire`](https://github.com/ambuc/solitaire) | The card game |+| [`sudoku-tui`](https://github.com/evanrelf/sudoku-tui) | A Sudoku implementation |+| [`summoner-tui`](https://github.com/kowainik/summoner/tree/master/summoner-tui) | An interactive frontend to the Summoner tool |+| [`swarm`](https://github.com/byorgey/swarm/) | A 2D programming and resource gathering game |+| [`tart`](https://github.com/jtdaugherty/tart) | A mouse-driven ASCII art drawing program |+| [`tick-tock-tui`](https://github.com/sectore/tick-tock-tui) | A stylish TUI app to handle Bitcoin data provided by [Mempool REST API](https://mempool.space/docs/api/rest) incl. blocks, fees and price converter. |+| [`tetris`](https://github.com/SamTay/tetris) | An implementation of the Tetris game |+| [`thock`](https://github.com/rmehri01/thock) | A modern TUI typing game featuring online racing against friends |+| [`timeloop`](https://github.com/cdupont/timeloop) | A time-travelling demonstrator |+| [`towerHanoi`](https://github.com/shajenM/projects/tree/master/towerHanoi) | Animated solutions to The Tower of Hanoi |+| [`ttyme`](https://github.com/evuez/ttyme) | A TUI for [Harvest](https://www.getharvest.com/) |+| [`ullekha`](https://github.com/ajithnn/ullekha) | An interactive terminal notes/todo app with file/redis persistence |+| [`viewprof`](https://github.com/maoe/viewprof) | A GHC profile viewer |+| [`VOIDSPACE`](https://github.com/ChrisPenner/void-space) | A space-themed typing-tutor game |+| [`wordle`](https://github.com/ivanjermakov/wordle) | An implementation of the Wordle game |+| [`wrapping-editor`](https://github.com/ta0kira/wrapping-editor) | An embeddable editor with support for Brick |+| [`youbrick`](https://github.com/florentc/youbrick) | A feed aggregator and launcher for Youtube channels |++These additional packages also extend `brick`:++| Project | Description | Hackage |+| ------- | ----------- | ------- |+| [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories | [Hackage](https://hackage.haskell.org/package/brick-filetree) |+| [`brick-panes`](https://github.com/kquick/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. | [Hackage](https://hackage.haskell.org/package/brick-panes) |+| [`brick-calendar`](https://github.com/ldgrp/brick-calendar) | A library providing a calendar widget for Brick-based applications. | [Hackage](https://hackage.haskell.org/package/brick-calendar) |+| [`brick-skylighting`](https://github.com/jtdaugherty/brick-skylighting) | A library providing integration support for [Skylighting](https://hackage.haskell.org/package/skylighting)-based syntax highlighting. | [Hackage](https://hackage.haskell.org/package/brick-skylighting) |+ Getting Started --------------- -TLDR:+Check out the many demo programs to get a feel for different aspects of+the library:  ```-$ cabal sandbox init-$ cabal install -j -f demos-$ .cabal-sandbox/bin/brick-???-demo+$ cabal new-build -f demos+$ find dist-newstyle -type f -name \*-demo ``` -To get started, see the [first few sections of the brick-user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst).+To get started, see the [user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst). +Documentation+-------------++Documentation for `brick` comes in a variety of forms:++* [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)+* [Haddock documentation](https://hackage.haskell.org/package/brick)+* [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs)+* [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md)+ Feature Overview ---------------- -`brick` comes with a bunch of widget types to get you started:+`brick` comes with a bunch of batteries included:   * Vertical and horizontal box layout widgets  * Basic single- and multi-line text editor widgets- * List widget+ * List and table widgets  * Progress bar widget  * Simple dialog box widget  * Border-drawing widgets (put borders around or in between things)- * Generic scrollable viewports+ * Animation support+ * Generic scrollable viewports and viewport scroll bars+ * General-purpose layout control combinators  * Extensible widget-building API- * (And many more general-purpose layout control combinators)--In addition, some of `brick`'s more powerful features may not be obvious-right away:-- * All widgets can be arranged in predictable layouts so you don't have-   to worry about terminal resizes.- * Attribute management is flexible and can be customized at runtime on-   a per-widget basis.--Brick-Users Discussion-------------------------The `brick-users` Google Group / e-mail list is a place to discuss-library changes, give feedback, and ask questions. You can subscribe at:--[https://groups.google.com/group/brick-users](https://groups.google.com/group/brick-users)+ * User-customizable attribute themes+ * Type-safe, validated input form API (see the `Brick.Forms` module)+ * A filesystem browser for file and directory selection+ * Borders can be configured to automatically connect! -Documentation--------------+Brick Discussion+---------------- -Your documentation options, in recommended order, are:+There are two forums for discussing brick-related things: -* [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md)-* [The brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-* Haddock (all modules)-* [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs)+1. The [Discussions page](https://github.com/jtdaugherty/brick/discussions) on the github repo, and+1. The `brick-users` Google Group / e-mail list. You can subscribe+   [here](https://groups.google.com/group/brick-users).  Status ------ -`brick` is young and may be missing some essential features. There are-some places were I have deliberately chosen to worry about performance-later for the sake of spending more time on the design (and to wait on-performance issues to arise first). `brick` is also something of an-experimental project of mine and some aspects of the design involve-trade-offs that are not entirely settled. In addition you can expect-this library to follow a principle of fearless improvement: new versions-will make (sometimes substantial) API changes if those changes really do-make the library better. I will place more importance on getting the API-right than on maintaining backwards compatibility.+There are some places were I have deliberately chosen to worry about+performance later for the sake of spending more time on the design+(and to wait on performance issues to arise first). `brick` is also+something of an experimental project of mine and some aspects of the+design involve trade-offs that might not be right for your application.+Brick is not intended to be all things to all people; rather, I want it+to provide a good foundation for building complex terminal interfaces+in a declarative style to take away specific headaches of building,+modifying, and working with such interfaces, all while seeing how far we+can get with a pure function to specify the interface.  `brick` exports an extension API that makes it possible to make your own packages and widgets. If you use that, you'll also be helping to test whether the exported interface is usable and complete! +A note on Windows support+-------------------------++Brick supports Windows implicitly by way of Vty's Windows support.+While I don't (and can't) personally test Brick on Windows hosts,+it should be possible to use Brick on Windows. If you have any+trouble, report any issues here. If needed, we'll migrate them to the+[vty-windows](https://github.com/chhackett/vty-windows) repository if+they need to be fixed there.+ Reporting bugs --------------  Please file bug reports as GitHub issues.  For best results:   - Include the versions of relevant software packages: your terminal-   emulator, `brick`, `ghc`, and `vty` will be the most important-   ones.+   emulator, `brick`, `ghc`, `vty`, and Vty platform packages will be+   the most important ones.   - Clearly describe the behavior you expected ... @@ -139,6 +214,8 @@ If you decide to contribute, that's great! Here are some guidelines you should consider to make submitting patches easier for all concerned: + - Patches written completely or partially by AI are unlikely to be+   accepted.  - If you want to take on big things, talk to me first; let's have a    design/vision discussion before you start coding. Create a GitHub    issue and we can use that as the place to hash things out.@@ -146,3 +223,13 @@    codebase.  - Please adjust or provide Haddock and/or user guide documentation    relevant to any changes you make.+ - Please ensure that commits are `-Wall` clean.+ - Please ensure that each commit makes a single, logical, isolated+   change as much as possible.+ - Please do not submit changes that your linter told you to make. I+   will probably decline them. Relatedly: please do not submit changes+   that change only style without changing functionality.+ - Please do NOT include package version changes in your patches.+   Package version changes are only done at release time when the full+   scope of a release's changes can be evaluated to determine the+   appropriate version change.
brick.cabal view
@@ -1,9 +1,10 @@ name:                brick-version:             0.17.2+version:             2.12 synopsis:            A declarative terminal user interface library description:-  Write terminal applications painlessly with 'brick'! You write an-  event handler and a drawing function and the library does the rest.+  Write terminal user interfaces (TUIs) painlessly with 'brick'! You+  write an event handler and a drawing function and the library does the+  rest.   .   .   > module Main where@@ -31,20 +32,34 @@ license-file:        LICENSE author:              Jonathan Daugherty <cygnus@foobox.com> maintainer:          Jonathan Daugherty <cygnus@foobox.com>-copyright:           (c) Jonathan Daugherty 2015-2016+copyright:           (c) Jonathan Daugherty 2015-2025 category:            Graphics build-type:          Simple-cabal-version:       >=1.10+cabal-version:       1.18 Homepage:            https://github.com/jtdaugherty/brick/ Bug-reports:         https://github.com/jtdaugherty/brick/issues+tested-with:         GHC == 8.2.2+                      || == 8.4.4+                      || == 8.6.5+                      || == 8.8.4+                      || == 8.10.7+                      || == 9.0.2+                      || == 9.2.8+                      || == 9.4.8+                      || == 9.6.7+                      || == 9.8.4+                      || == 9.10.3+                      || == 9.12.2  extra-doc-files:     README.md,                      docs/guide.rst,-                     CHANGELOG.md+                     docs/snake-demo.gif,+                     CHANGELOG.md,+                     programs/custom_keys.ini  Source-Repository head   type:     git-  location: git://github.com/jtdaugherty/brick.git+  location: http://github.com/jtdaugherty/brick  Flag demos     Description:     Build demonstration programs@@ -52,16 +67,26 @@  library   default-language:    Haskell2010-  ghc-options:         -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -Wall -Wcompat -O2 -Wunused-packages   default-extensions:  CPP   hs-source-dirs:      src   exposed-modules:     Brick+    Brick.Animation     Brick.AttrMap     Brick.BChan+    Brick.BorderMap+    Brick.Keybindings+    Brick.Keybindings.KeyConfig+    Brick.Keybindings.KeyEvents+    Brick.Keybindings.KeyDispatcher+    Brick.Keybindings.Normalize+    Brick.Keybindings.Parse+    Brick.Keybindings.Pretty     Brick.Focus+    Brick.Forms     Brick.Main-    Brick.Markup+    Brick.Themes     Brick.Types     Brick.Util     Brick.Widgets.Border@@ -70,260 +95,466 @@     Brick.Widgets.Core     Brick.Widgets.Dialog     Brick.Widgets.Edit+    Brick.Widgets.FileBrowser     Brick.Widgets.List     Brick.Widgets.ProgressBar-    Data.Text.Markup+    Brick.Widgets.Table+    Data.IMap   other-modules:+    Brick.Animation.Clock+    Brick.Types.Common     Brick.Types.TH+    Brick.Types.EventM     Brick.Types.Internal     Brick.Widgets.Internal -  build-depends:       base <= 5,-                       vty >= 5.15,-                       transformers,-                       dlist,-                       containers,-                       microlens >= 0.3.0.0,+  build-depends:       base >= 4.9.0.0 && < 4.23.0.0,+                       vty >= 6.0,+                       vty-crossplatform,+                       bimap >= 0.5 && < 0.6,+                       data-clist >= 0.1,+                       directory >= 1.2.5.0,+                       exceptions >= 0.10.0,+                       filepath,+                       containers >= 0.5.7,+                       microlens >= 0.3.0.0 && < 0.6,                        microlens-th,                        microlens-mtl,+                       mtl,+                       config-ini,                        vector,-                       contravariant,-                       stm >= 2.4,+                       stm >= 2.4.3,                        text,-                       text-zipper >= 0.7.1,+                       text-zipper >= 0.13,                        template-haskell,-                       deepseq >= 1.3 && < 1.5+                       deepseq >= 1.3 && < 1.6,+                       unix-compat,+                       bytestring,+                       word-wrap >= 0.2,+                       unordered-containers,+                       hashable,+                       time +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,+                       containers,+                       microlens,+                       microlens-mtl,+                       microlens-th++executable brick-table-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             TableDemo.hs+  build-depends:       base,+                       brick++executable brick-tail-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             TailDemo.hs+  build-depends:       base,+                       brick,+                       text,+                       vty,+                       random,+                       microlens-th,+                       microlens-mtl+ executable brick-readme-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   default-extensions:  CPP   main-is:             ReadmeDemo.hs   build-depends:       base,+                       brick++executable brick-file-browser-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             FileBrowserDemo.hs+  build-depends:       base,+                       vty,                        brick,-                       text+                       text,+                       mtl +executable brick-form-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             FormDemo.hs+  build-depends:       base,+                       brick,+                       text,+                       microlens,+                       microlens-th,+                       vty-crossplatform,+                       vty++executable brick-text-wrap-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             TextWrapDemo.hs+  build-depends:       base,+                       brick,+                       word-wrap+ executable brick-cache-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   default-extensions:  CPP   main-is:             CacheDemo.hs   build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       microlens >= 0.3.0.0,-                       microlens-th+                       vty,+                       mtl  executable brick-visibility-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             VisibilityDemo.hs   build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,+                       vty,                        microlens >= 0.3.0.0,+                       microlens-th,+                       microlens-mtl++executable brick-viewport-scrollbars-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             ViewportScrollbarsDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       vty-crossplatform,+                       microlens-mtl,                        microlens-th  executable brick-viewport-scroll-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   default-extensions:  CPP   main-is:             ViewportScrollDemo.hs   build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       microlens+                       vty  executable brick-dialog-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             DialogDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       microlens+                       vty  executable brick-mouse-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             MouseDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,+                       vty,                        microlens >= 0.3.0.0,                        microlens-th,-                       text-zipper+                       microlens-mtl,+                       mtl  executable brick-layer-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             LayerDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,+                       vty,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl  executable brick-suspend-resume-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             SuspendAndResumeDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,+                       vty,                        microlens >= 0.3.0.0,                        microlens-th +executable brick-cropping-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             CroppingDemo.hs+  build-depends:       base,+                       brick,+                       vty+ executable brick-padding-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             PaddingDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       microlens+                       vty +executable brick-theme-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             ThemeDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       mtl+ executable brick-attr-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             AttrDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       microlens+                       vty -executable brick-markup-demo+executable brick-tabular-list-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010-  main-is:             MarkupDemo.hs-  build-depends:       base <= 5,+  main-is:             TabularListDemo.hs+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       microlens+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-mtl,+                       microlens-th,+                       vector  executable brick-list-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             ListDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,+                       vty,                        microlens >= 0.3.0.0,+                       microlens-mtl,+                       mtl,                        vector +executable brick-list-vi-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             ListViDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-mtl,+                       mtl,+                       vector++executable brick-animation-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             AnimationDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       vty-crossplatform,+                       containers,+                       microlens-platform+ executable brick-custom-event-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             CustomEventDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,+                       vty,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl +executable brick-fill-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             FillDemo.hs+  build-depends:       base,+                       brick+ executable brick-hello-world-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             HelloWorldDemo.hs-  build-depends:       base <= 5,-                       brick,-                       vty >= 5.15,-                       text,-                       microlens+  build-depends:       base,+                       brick  executable brick-edit-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             EditDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       vector,+                       vty,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl +executable brick-editor-line-numbers-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             EditorLineNumbersDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-th,+                       microlens-mtl+ executable brick-border-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-extensions:  CPP   default-language:    Haskell2010   main-is:             BorderDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       microlens+                       vty,+                       text +executable brick-dynamic-border-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-extensions:  CPP+  default-language:    Haskell2010+  main-is:             DynamicBorderDemo.hs+  build-depends:       base <= 5,+                       brick+ executable brick-progressbar-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-extensions:  CPP   default-language:    Haskell2010   main-is:             ProgressBarDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.15,-                       text,-                       microlens+                       vty,+                       microlens-mtl,+                       microlens-th++test-suite brick-tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  ghc-options:         -Wall -Wcompat -Wno-orphans -O2+  default-language:    Haskell2010+  main-is:             Main.hs+  other-modules:       List Render+  build-depends:       base <=5,+                       brick,+                       containers,+                       microlens,+                       vector,+                       vty,+                       vty-crossplatform,+                       QuickCheck
docs/guide.rst view
@@ -11,1289 +11,2147 @@ and as direct as possible. ``brick`` builds on `vty`_; `vty` provides the terminal input and output interface and drawing primitives, while ``brick`` builds on those to provide a high-level application-abstraction and combinators for expressing user interface layouts.--This documentation is intended to provide a high-level overview of-the library's design along with guidance for using it, but details on-specific functions can be found in the Haddock documentation.--The process of writing an application using ``brick`` entails writing-two important functions:--- A *drawing function* that turns your application state into a-  specification of how your interface should look, and-- An *event handler* that takes your application state and an input-  event and decides whether to change the state or quit the program.--We write drawing functions in ``brick`` using an extensive set of-primitives and combinators to place text on the screen, set its-attributes (e.g. foreground color), and express layout constraints (e.g.-padding, centering, box layouts, scrolling viewports, etc.).--These functions get packaged into a structure that we hand off to the-``brick`` library's main event loop. We'll cover that in detail in `The-App Type`_.--Installation---------------``brick`` can be installed in the "usual way," either by installing-the latest `Hackage`_ release or by cloning the GitHub repository and-building locally.--To install from Hackage::--   $ cabal update-   $ cabal install brick--To clone and build locally::--   $ git clone https://github.com/jtdaugherty/brick.git-   $ cd brick-   $ cabal sandbox init-   $ cabal install -j--Building the Demonstration Programs--------------------------------------``brick`` includes a large collection of feature-specific demonstration-programs. These programs are not built by default but can be built by-passing the ``demos`` flag to ``cabal install``, e.g.::--   $ cabal install brick -f demos--Conventions-===========--``brick`` has some API conventions worth knowing about as you read this-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-  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`_).-- 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,-  hierarchical relationships between attributes are documented in-  Haddock documentation.-- Use of qualified Haskell identifiers: in this document, where-  sensible, I will use fully-qualified identifiers whenever I mention-  something for the first time or whenever I use something that is-  not part of ``brick``. Use of qualified names is not intended to-  produce executable examples, but rather to guide you in writing your-  ``import`` statements.--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-various functions:--.. code:: haskell--   data App s e n =-       App { appDraw         :: s -> [Widget n]-           , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)-           , appHandleEvent  :: s -> e -> EventM n (Next s)-           , appStartEvent   :: s -> EventM n s-           , appAttrMap      :: s -> AttrMap-           }--The ``App`` type is parameterized over three types. These type variables-will appear in the signatures of many library functions and types. They-are:--- The **application state type** ``s``: the type of data that will-  evolve over the course of the application's execution. Your-  application will provide the library with its starting value and event-  handling will transform it as the program executes. When a ``brick``-  application exits, the final application state will be returned.-- The **event type** ``e``: the type of custom application events-  that your application will need to produce and handle in-  ``appHandleEvent``. All applications will be provided with events from-  the underlying ``vty`` library, such as keyboard events or resize-  events; this type variable indicates the type of *additional* events-  the application will need. For more details, see `Using Your Own Event-  Type`_.-- The **resource name type** ``n``: during application execution we-  sometimes need a way to refer to rendering state, such as the space-  taken up by a given widget, the state for a scrollable viewport, a-  mouse click, or a cursor position. For these situations we need a-  unique handle called a *resource name*. The type ``n`` specifies the-  name type the application will use to identify these bits of state-  produced and managed by the renderer. The resource name type must be-  provided by your application; for more details, see `Resource Names`_.--The various fields of ``App`` will be described in the sections below.--Running an Application-------------------------To run an ``App``, we pass it to ``Brick.Main.defaultMain`` or-``Brick.Main.customMain`` along with an initial application state value:--.. code:: haskell--   main :: IO ()-   main = do-     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--------------------------------The value of ``appDraw`` is a function that turns the current-application state into a list of *layers* of type ``Widget``, listed-topmost first, that will make up the interface. Each ``Widget`` gets-turned into a ``vty`` layer and the resulting layers are drawn to the-terminal.--The ``Widget`` type is the type of *drawing instructions*.  The body of-your drawing function will use one or more drawing functions to build or-transform ``Widget`` values to describe your interface. These-instructions will then be executed with respect to three things:--- The size of the terminal: the size of the terminal determines how many-  ``Widget`` values behave. For example, fixed-size ``Widget`` values-  such as text strings behave the same under all conditions (and get-  cropped if the terminal is too small) but layout combinators such as-  ``Brick.Widgets.Core.vBox`` or ``Brick.Widgets.Center.center`` use the-  size of the terminal to determine how to lay other widgets out. See-  `How Widgets and Rendering Work`_.-- The application's attribute map (``appAttrMap``): drawing functions-  requesting the use of attributes cause the attribute map to be-  consulted. See `How Attributes Work`_.-- The state of scrollable viewports: the state of any scrollable-  viewports on the *previous* drawing will be considered. For more-  details, see `Viewports`_.--The ``appDraw`` function is called when the event loop begins to draw-the application as it initially appears. It is also called right after-an event is processed by ``appHandleEvent``. Even though the function-returns a specification of how to draw the entire screen, the underlying-``vty`` library goes to some trouble to efficiently update only the-parts of the screen that have changed so you don't need to worry about-this.--Where do I find drawing functions?-**********************************--The most important module providing drawing functions is-``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets``-namespace provides specific kinds of functionality.--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)--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.--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 return value type ``Next s`` value describes what should happen-after the event handler is finished. We have three choices:--* ``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.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).--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.--Widget Event Handlers-*********************--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``.--Since these event handlers run in ``EventM``, they have access to-rendering viewport states via ``Brick.Main.lookupViewport`` and the-``IO`` monad via ``liftIO``.--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``:--.. code:: haskell--   data Name = Edit1-   type MyState = Editor String Name--   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = continue =<< handleEditorEvent e s--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:--.. code:: haskell--   data Name = Edit1-   data MyState = MyState { _theEdit :: Editor String Name-                          }-   makeLenses ''MyState--   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = continue =<< handleEventLensed s theEdit handleEditorEvent e--You might consider that preferable to the desugared version:--.. 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--Using Your Own Event Type-*************************--Since we often need to communicate application-specific events beyond-Vty input events to the event handler, brick supports embedding your-application's custom events in the stream of ``BrickEvent``s that-your handler will receive. The type of these events is the type ``e``-mentioned in ``BrickEvent n e`` and ``App s e n``.--Note: ordinarily your application will not have its own custom event-type, so you can leave this type unused (e.g. ``App MyState e MyName``)-or just set it to unit (``App MyState () MyName``).--Here's an example of using a custom event type. Suppose that you'd like-to be able to handle counter events in your event handler. First we-define the counter event type:--.. code:: haskell--   data CounterEvent = Counter Int--With this type declaration we can now use counter events in our app by-using the application type ``App s CounterEvent n``. To handle these-events we'll just need to look for ``AppEvent`` values in the event-handler:--.. code:: haskell--   myEvent :: s -> BrickEvent n CounterEvent -> EventM n (Next s)-   myEvent s (AppEvent (CounterEvent 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-event handler. To do that we need to create a ``BChan`` for our-custom events, provide that ``BChan`` to ``brick``, and then send-our events over that channel. Once we've created the channel with-``Brick.BChan.newBChan``, we provide it to ``brick`` with-``customMain`` instead of ``defaultMain``:--.. code:: haskell--   main :: IO ()-   main = do-       eventChan <- Brick.BChan.newBChan 10-       finalState <- customMain-                       (Graphics.Vty.mkVty Data.Default.defaultConfig)-                       (Just eventChan) app initialState-       -- Use finalState and exit--The ``customMain`` function lets us have control over how the ``vty``-library is initialized *and* how ``brick`` gets custom events to give to-our event handler. ``customMain`` is the entry point into ``brick`` when-you need to use your own event type as shown here.--With all of this in place, sending our custom events to the event-handler is straightforward:--.. code:: haskell--   counterThread :: Brick.BChan.BChan CounterEvent -> IO ()-   counterThread chan = do-       Brick.BChan.writeBChan chan $ Counter 1--Bounded Channels-****************--A ``BChan``, or *bounded channel*, can hold a limited number of-items before attempts to write new items will block. In the call to-``newBChan`` above, the created channel has a capacity of 10 items.-Use of a bounded channel ensures that if the program cannot process-events quickly enough then there is a limit to how much memory will-be used to store unprocessed events. Thus the chosen capacity should-be large enough to buffer occasional spikes in event handling latency-without inadvertently blocking custom event producers. Each application-will have its own performance characteristics that determine the best-bound for the event channel. In general, consider the performance of-your event handler when choosing the channel capacity and design event-producers so that they can block if the channel is full.--Starting up: appStartEvent-**************************--When an application starts, it may be desirable to perform some of-the duties typically only possible when an event has arrived, such as-setting up initial scrolling viewport state. Since such actions can only-be performed in ``EventM`` and since we do not want to wait until the-first event arrives to do this work in ``appHandleEvent``, the ``App``-type provides ``appStartEvent`` function for this purpose:--.. code:: haskell--   appStartEvent :: s -> 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.--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-editor will need to report a cursor position. However, since a-``Widget`` may be a composite of many such cursor-placing widgets, we-have to have a way of choosing which of the reported cursor positions,-if any, is the one we actually want to honor.--To decide which cursor placement to use, or to decide not to show one at-all, we set the ``App`` type's ``appChooseCursor`` function:--.. code:: haskell--   appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)--The event loop renders the interface and collects the-``Brick.Types.CursorLocation`` values produced by the rendering process-and passes those, along with the current application state, to this-function. Using your application state (to track which text input box-is "focused," say) you can decide which of the locations to return or-return ``Nothing`` if you do not want to show a cursor.--Many widgets in the rendering process can request cursor placements, but-it is up to our application to determine which one (if any) should be-used. Since we can only show at most a single cursor in the terminal,-we need to decide which location to show. One way is by looking at the-resource name contained in the ``cursorLocationName`` field. The name-value associated with a cursor location will be the name used to request-the cursor position with ``Brick.Widgets.Core.showCursor``.--``Brick.Main`` provides various convenience functions to make cursor-selection easy in common cases:--* ``neverShowCursor``: never show any cursor.-* ``showFirstCursor``: always show the first cursor request given; good-  for applications with only one cursor-placing widget.-* ``showCursorNamed``: show the cursor with the specified resource name-  or show no cursor if the name was not associated with any requested-  cursor position.--For example, this widget requests a cursor placement on the first-"``o``" in "``foo``" associated with the cursor name "``myCursor``":--.. code:: haskell--   data MyName = CustomName--   let w = showCursor CustomName (Brick.Types.Location (1, 0))-             (Brick.Widgets.Core.str "foobar")--The event handler for this application would use ``MyName`` as its-resource name type ``n`` and would be able to pattern-match on-``CustomName`` to match cursor requests when this widget is rendered:--.. code:: haskell--   myApp = App { ...-               , appChooseCursor = showCursorNamed CustomName-               }--See the next section for more information on using names.--Resource Names-----------------We saw above in `appChooseCursor: Placing the Cursor`_ that resource-names are used to describe cursor locations. Resource names are also-used to name other kinds of resources:--* viewports (see `Viewports`_)-* rendering extents (see `Extents`_)-* mouse events (see `Mouse Support`_)--Assigning names to these resource types allows us to distinguish between-events based on the part of the interface to which an event is related.--Your application must provide some type of name. For simple applications-that don't make use of resource names, you may use ``()``. But if your-application has more than one named resource, you *must* provide a type-capable of assigning a unique name to every resource that needs one.--A Note of Caution-*****************--Resource names can be assigned to any of the resource types mentioned-above, but some resource types--viewports, extents, the render cache,-and cursor locations--form separate resource namespaces. So, for-example, the same name can be assigned to both a viewport and an extent,-since the ``brick`` API provides access to viewports and extents using-separate APIs and data structures. However, if the same name is used for-two resources of the same kind, it is undefined *which* of those you'll-be getting access to when you go to use one of those resources in your-event handler.--For example, if the same name is assigned to two viewports:--.. code:: haskell--   data Name = Viewport1--   ui :: Widget Name-   ui = (viewport Viewport1 Vertical $ str "Foo") <+>-        (viewport Viewport1 Vertical $ str "Bar") <+>--then in ``EventM`` when we attempt to scroll the viewport ``Viewport1``-we don't know which of the two uses of ``Viewport1`` will be affected:--.. code:: haskell--   do-     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.--.. code:: haskell--   data Name = Viewport1 | Viewport2--   ui :: Widget Name-   ui = (viewport Viewport1 Vertical $ str "Foo") <+>-        (viewport Viewport2 Vertical $ str "Bar") <+>--appAttrMap: Managing Attributes----------------------------------In ``brick`` we use an *attribute map* to assign attibutes to elements-of the interface. Rather than specifying specific attributes when-drawing a widget (e.g. red-on-black text) we specify an *attribute name*-that is an abstract name for the kind of thing we are drawing, e.g.-"keyword" or "e-mail address." We then provide an attribute map which-maps those attribute names to actual attributes.  This approach lets us:--* Change the attributes at runtime, letting the user change the-  attributes of any element of the application arbitrarily without-  forcing anyone to build special machinery to make this configurable;-* Write routines to load saved attribute maps from disk;-* Provide modular attribute behavior for third-party components, where-  we would not want to have to recompile third-party code just to change-  attributes, and where we would not want to have to pass in attribute-  arguments to third-party drawing functions.--This lets us put the attribute mapping for an entire app, regardless of-use of third-party widgets, in one place.--To create a map we use ``Brick.AttrMap.attrMap``, e.g.,--.. code:: haskell--   App { ...-       , appAttrMap = const $ attrMap Graphics.Vty.defAttr [(someAttrName, fg blue)]-       }--To use an attribute map, we specify the ``App`` field ``appAttrMap`` as-the function to return the current attribute map each time rendering-occurs. This function takes the current application state, so you may-choose to store the attribute map in your application state. You may-also choose not to bother with that and to just set ``appAttrMap = const-someMap``.--To draw a widget using an attribute name in the map, use-``Brick.Widgets.Core.withAttr``. For example, this draws a string with a-``blue`` background:--.. code:: haskell--   let w = withAttr blueBg $ str "foobar"-       blueBg = attrName "blueBg"-       myMap = attrMap defAttr [ (blueBg, Brick.Util.bg Graphics.Vty.blue)-                               ]--For complete details on how attribute maps and attribute names work, see-the Haddock documentation for the ``Brick.AttrMap`` module. See also-`How Attributes Work`_.--How Widgets and Rendering Work-==============================--When ``brick`` renders a ``Widget``, the widget's rendering routine is-evaluated to produce a ``vty`` ``Image`` of the widget. The widget's-rendering routine runs with some information called the *rendering-context* that contains:--* The size of the area in which to draw things-* The name of the current attribute to use to draw things-* The map of attributes to use to look up attribute names-* The active border style to use when drawing borders--Available Rendering Area---------------------------The most important element in the rendering context is the rendering-area: This part of the context tells the widget being drawn how many-rows and columns are available for it to consume. When rendering begins,-the widget being rendered (i.e. a layer returned by an ``appDraw``-function) gets a rendering context whose rendering area is the size of-the terminal. This size information is used to let widgets take up that-space if they so choose. For example, a string "Hello, world!" will-always take up one row and 13 columns, but the string "Hello, world!"-*centered* will always take up one row and *all available columns*.--How widgets use space when rendered is described in two pieces of-information in each ``Widget``: the widget's horizontal and vertical-growth policies. These fields have type ``Brick.Types.Size`` and can-have the values ``Fixed`` and ``Greedy``.--A widget advertising a ``Fixed`` size in a given dimension is a widget-that will always consume the same number of rows or columns no-matter how many it is given. Widgets can advertise different-vertical and horizontal growth policies for example, the-``Brick.Widgets.Border.hCenter`` function centers a widget and is-``Greedy`` horizontally and defers to the widget it centers for vertical-growth behavior.--These size policies govern the box layout algorithm that is at-the heart of every non-trivial drawing specification. When we use-``Brick.Widgets.Core.vBox`` and ``Brick.Widgets.Core.hBox`` to-lay things out (or use their binary synonyms ``<=>`` and ``<+>``,-respectively), the box layout algorithm looks at the growth policies of-the widgets it receives to determine how to allocate the available space-to them.--For example, imagine that the terminal window is currently 10 rows high-and 50 columns wide.  We wish to render the following widget:--.. code:: haskell--   let w = (str "Hello," <=> str "World!")--Rendering this to the terminal will result in "Hello," and "World!"-underneath it, with 8 rows unoccupied by anything. But if we wished to-render a vertical border underneath those strings, we would write:--.. code:: haskell--   let w = (str "Hello," <=> str "World!" <=> vBorder)--Rendering this to the terminal will result in "Hello," and "World!"-underneath it, with 8 rows remaining occupied by vertical border-characters ("``|``") one column wide. The vertical border widget is-designed to take up however many rows it was given, but rendering the-box layout algorithm has to be careful about rendering such ``Greedy``-widgets because they won't leave room for anything else. Since the box-widget cannot know the sizes of its sub-widgets until they are rendered,-the ``Fixed`` widgets get rendered and their sizes are used to determine-how much space is left for ``Greedy`` widgets.--When using widgets it is important to understand their horizontal and-vertical space behavior by knowing their ``Size`` values. Those should-be made clear in the Haddock documentation.--Limiting Rendering Area--------------------------If you'd like to use a ``Greedy`` widget but want to limit how much-space it consumes, you can turn it into a ``Fixed`` widget by using-one of the *limiting combinators*, ``Brick.Widgets.Core.hLimit`` and-``Brick.Widgets.Core.vLimit``. These combinators take widgets and turn-them into widgets with a ``Fixed`` size (in the relevant dimension) and-run their rendering functions in a modified rendering context with a-restricted rendering area.--For example, the following will center a string in 30 columns, leaving-room for something to be placed next to it as the terminal width-changes:--.. code:: haskell--   let w = hLimit 30 $ hCenter $ str "Hello, world!"--The Attribute Map--------------------The rendering context contains an attribute map (see `How Attributes-Work`_ and `appAttrMap: Managing Attributes`_) which is used to look up-attribute names from the drawing specification. The map originates from-``Brick.Main.appAttrMap`` and can be manipulated on a per-widget basis-using ``Brick.Widgets.Core.updateAttrMap``.--The Active Border Style--------------------------Widgets in the ``Brick.Widgets.Border`` module draw border characters-(horizontal, vertical, and boxes) between and around other widgets. To-ensure that widgets across your application share a consistent visual-style, border widgets consult the rendering context's *active border-style*, a value of type ``Brick.Widgets.Border.Style``, to get the-characters used to draw borders.--The default border style is ``Brick.Widgets.Border.Style.unicode``. To-change border styles, use the ``Brick.Widgets.Core.withBorderStyle``-combinator to wrap a widget and change the border style it uses when-rendering. For example, this will use the ``ascii`` border style instead-of ``unicode``:--.. code:: haskell--   let w = withBorderStyle Brick.Widgets.Border.Style.ascii $-             Brick.Widgets.Border.border $ str "Hello, world!"--How Attributes Work-===================--In addition to letting us map names to attributes, attribute maps-provide hierarchical attribute inheritance: a more specific attribute-derives any properties (e.g. background color) that it does not specify-from more general attributes in hierarchical relationship to it, letting-us customize only the parts of attributes that we want to change without-having to repeat ourselves.--For example, this draws a string with a foreground color of ``white`` on-a background color of ``blue``:--.. code:: haskell--   let w = withAttr specificAttr $ str "foobar"-       generalAttr = attrName "general"-       specificAttr = attrName "general" <> attrName "specific"-       myMap = attrMap defAttr [ (generalAttr, bg blue)-                               , (specificAttr, fg white)-                               ]--Functions ``Brick.Util.fg`` and ``Brick.Util.bg`` specify-partial attributes, and map lookups start with the desired name-(``general/specific`` in this case) and walk up the name hierarchy (to-``general``), merging partial attribute settings as they go, letting-already-specified attribute settings take precedence. Finally, any-attribute settings not specified by map lookups fall back to the map's-*default attribute*, specified above as ``Graphics.Vty.defAttr``. In-this way, if you want everything in your application to have a ``blue``-background color, you only need to specify it *once*: in the attribute-map's default attribute. Any other attribute names can merely customize-the foreground color.--In addition to using the attribute map provided by ``appAttrMap``,-the map can be customized on a per-widget basis by using the attribute-map combinators:--* ``Brick.Widgets.Core.updateAttrMap``-* ``Brick.Widgets.Core.forceAttr``-* ``Brick.Widgets.Core.withDefAttr``-* ``Brick.Widgets.Core.overrideAttr``--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.--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-to support wide characters in your application, this will not work:--.. code:: haskell--   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:--.. 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``.--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:--.. code:: haskell--   ui = center $ border $ str "Foo"--We don't want to have to care about the particulars of the layout to-find out where the bordered box got placed during rendering. To get this-information we request that the extent of the box be reported to us by-the renderer using a resource name:--.. code:: haskell--   data Name = FooBox--   ui = center $-        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``:--.. code:: haskell--   do-     mExtent <- Brick.Main.lookupExtent FooBox-     case mExtent of-       Nothing -> ...-       Just (Extent _ upperLeft (width, height)) -> ...--Paste Support-=============--Some terminal emulators support "bracketed paste" support. This feature-enables OS-level paste operations to send the pasted content as a-single chunk of data and bypass the usual input processing that the-application does. This enales more secure handling of pasted data since-the application can detect that a pasted occurred and avoid processing-the pasted data as ordinary keyboard input. For more information, see-`bracketed paste mode`_.--The Vty library used by brick provides support for bracketed pastes, but-this mode must be enabled. To enable paste mode, we need to get access-to the Vty library handle in ``EventM``:--.. code:: haskell--   do-     vty <- Brick.Main.getVtyHandle-     case vty of-       Nothing -> return ()-       Just v -> let output = outputIface v-                 in when (supportsMode output BracketedPaste) $-                      liftIO $ setMode output BracketedPaste True--Once enabled, paste mode will generate Vty ``EvPaste`` events. These-events will give you the entire pasted content as a ``ByteString`` which-you must decode yourself if, for example, you expect it to contain UTF-8-text data.--Mouse Support-=============--Some terminal emulators support mouse interaction. The Vty library used-by brick provides these low-level events if mouse mode has been enabled.-To enable mouse mode, we need to get access to the Vty library handle in-``EventM``:--.. code:: haskell--   do-     vty <- Brick.Main.getVtyHandle-     case vty of-       Nothing -> return ()-       Just v -> let output = outputIface vt-                 in 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-provide mouse events.--Also bear in mind that terminal users will usually expect to be able-to interact with your application entirely without a mouse, so if you-do choose to enable mouse interaction, consider using it to improve-existing interactions rather than provide new functionality that cannot-already be managed with a keyboard.--Low-level Mouse Events-------------------------Once mouse events have been enabled, Vty will generate ``EvMouseDown``-and ``EvMouseUp`` events containing the mouse button clicked, the-location in the terminal, and any modifier keys pressed.--.. code:: haskell--   handleEvent s (VtyEvent (EvMouseDown col row button mods) = ...--Brick Mouse Events---------------------Although these events may be adequate for your needs, ``brick`` provides-a higher-level mouse event interface that ties into the drawing-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*.--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.--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 ...--This approach works well enough if you know which extent you're-interested in checking, but what if there are many extents and you-want to know which one was clicked? And what if those extents are in-different layers? The next approach is to find all clicked extents:--.. 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.--This approach finds all clicked extents and returns them in a list with-the following properties:--* For extents ``A`` and ``B``, if ``A``'s layer is higher than ``B``'s-  layer, ``A`` comes before ``B`` in the list.-* For extents ``A`` and ``B``, if ``A`` and ``B`` are in the same layer-  and ``A`` is contained within ``B``, ``A`` comes before ``B`` in the-  list.--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-=========--A *viewport* is a scrollable window onto a widget. Viewports have a-*scrolling direction* of type ``Brick.Types.ViewportType`` which can be-one of:--* ``Horizontal``: the viewport can only scroll horizontally.-* ``Vertical``: the viewport can only scroll vertically.-* ``Both``: the viewport can scroll both horizontally and vertically.--The ``Brick.Widgets.Core.viewport`` combinator takes another widget-and embeds it in a named viewport. We name the viewport so that we can-keep track of its scrolling state in the renderer, and so that you can-make scrolling requests. The viewport's name is its handle for these-operations (see `Scrolling Viewports in Event Handlers`_ and `Resource-Names`_). **The viewport name must be unique across your application.**--For example, the following puts a string in a horizontally-scrollable-viewport:--.. code:: haskell--   -- Assuming that App uses 'Name' for its resource names:-   data Name = Viewport1-   let w = viewport Viewport1 Horizontal $ str "Hello, world!"--A ``viewport`` specification means that the widget in the viewport will-be placed in a viewport window that is ``Greedy`` in both directions-(see `Available Rendering Area`_). This is suitable if we want the-viewport size to be the size of the entire terminal window, but if-we want to limit the size of the viewport, we might use limiting-combinators (see `Limiting Rendering Area`_):--.. code:: haskell--   let w = hLimit 5 $-           vLimit 1 $-           viewport Viewport1 Horizontal $ str "Hello, world!"--Now the example produces a scrollable window one row high and five-columns wide initially showing "Hello". The next two sections discuss-the two ways in which this viewport can be scrolled.--Scrolling Viewports in Event Handlers----------------------------------------The most direct way to scroll a viewport is to make *scrolling requests*-in the ``EventM`` event-handling monad. Scrolling requests ask the-renderer to update the state of a viewport the next time the user-interface is rendered. Those state updates will be made with respect-to the *previous* viewport state, i.e., the state of the viewports as-of the end of the most recent rendering. This approach is the best-approach to use to scroll widgets that have no notion of a cursor.-For cursor-based scrolling, see `Scrolling Viewports With Visibility-Requests`_.--To make scrolling requests, we first create a-``Brick.Main.ViewportScroll`` from a viewport name with-``Brick.Main.viewportScroll``:--.. code:: haskell--   -- Assuming that App uses 'Name' for its resource names:-   data Name = Viewport1-   let vp = viewportScroll Viewport1--The ``ViewportScroll`` record type contains a number of scrolling-functions for making scrolling requests:--.. 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 ()--In each case the scrolling function scrolls the viewport by the-specified amount in the specified direction; functions prefixed with-``h`` scroll horizontally and functions prefixed with ``v`` scroll-vertically.--Scrolling operations do nothing when they don't make sense for the-specified viewport; scrolling a ``Vertical`` viewport horizontally is a-no-op, for example.--Using ``viewportScroll`` we can write an event handler that scrolls the-``Viewport1`` viewport one column to the right:--.. code:: haskell--   myHandler :: s -> e -> EventM n (Next s)-   myHandler s e = do-       let vp = viewportScroll Viewport1-       hScrollBy vp 1-       continue s--Scrolling Viewports With Visibility Requests-----------------------------------------------When we need to scroll widgets only when a cursor in the viewport-leaves the viewport's bounds, we need to use *visibility requests*. A-visibility request is a hint to the renderer that some element of a-widget inside a viewport should be made visible, i.e., that the viewport-should be scrolled to bring the requested element into view.--To use a visibility request to make a widget in a viewport visible, we-simply wrap it with ``visible``:--.. code:: haskell--   -- Assuming that App uses 'Name' for its resource names:-   data Name = Viewport1-   let w = viewport Viewport1 Horizontal $-           (visible $ str "Hello," <+> (str " world!")--This example requests that the ``Viewport1`` viewport be scrolled so-that "Hello," is visible. We could extend this example with a value-in the application state indicating which word in our string should-be visible and then use that to change which string gets wrapped with-``visible``; this is the basis of cursor-based scrolling.--Note that a visibility request does not change the state of a viewport-*if the requested widget is already visible*! This important detail is-what makes visibility requests so powerful, because they can be used to-capture various cursor-based scenarios:--* The ``Brick.Widgets.Edit`` widget uses a visibility request to make its-  1x1 cursor position visible, thus making the text editing widget fully-  scrollable *while being entirely scrolling-unaware*.-* The ``Brick.Widgets.List`` widget uses a visibility request to make-  its selected item visible regardless of its size, which makes-  the list widget scrolling-unaware.--Viewport Restrictions------------------------Viewports impose one restriction: a viewport that is scrollable in-some direction can only embed a widget that has a ``Fixed`` size in-that direction. This extends to ``Both`` type viewports: they can only-embed widgets that are ``Fixed`` in both directions. This restriction-is because when viewports embed a widget, they relax the rendering area-constraint in the rendering context, but doing so to a large enough-number for ``Greedy`` widgets would result in a widget that is too big-and not scrollable in a useful way.--Violating this restriction will result in a runtime exception.--The Rendering Cache-===================--When widgets become expensive to render, ``brick`` provides a *rendering-cache* that automatically caches and re-uses stored Vty images from-previous renderings to avoid expensive renderings. To cache the-rendering of a widget, just wrap it in the ``Brick.Widgets.Core.cached``-function:--.. code:: haskell--   data Name = ExpensiveThing--   ui :: Widget Name-   ui = center $-        cached ExpensiveThing $-        border $-        str "This will be cached"--In the example above, the first time the ``border $ str "This will be-cached"`` widget is rendered, the resulting Vty image will be stored-in the rendering cache under the key ``ExpensiveThing``. On subsequent-renderings the cached Vty image will be used instead of re-rendering the-widget. This example doesn't need caching to improve performance, but-more sophisticated widgets might.--Once ``cached`` has been used to store something in the rendering cache,-periodic cache invalidation may be required. For example, if the cached-widget is built from application state, the cache will need to be-invalidated when the relevant state changes. The cache may also need to-be invalidated when the terminal is resized. To invalidate the cache, we-use the cache invalidation functions in ``EventM``:--.. code:: haskell--   handleEvent s ... = do-     -- Invalidate just a single cache entry:-     Brick.Main.invalidateCacheEntry ExpensiveThing--     -- Invalidate the entire cache (useful on a resize):-     Brick.Main.invalidateCache--Implementing Custom Widgets-===========================--``brick`` exposes all of the internals you need to implement your-own widgets. Those internals, together with ``Graphics.Vty``, can be-used to create widgets from the ground up. You'll need to implement-your own widget if you can't write what you need in terms of existing-combinators. For example, an ordinary widget like--.. code:: haskell--   myWidget :: Widget n-   myWidget = str "Above" <=> str "Below"--can be expressed with ``<=>`` and ``str`` and needs no custom behavior.-But suppose we want to write a widget that renders some string followed-by the number of columns in the space available to the widget. We can't-do this without writing a custom widget because we need access to the-rendering context. We can write such a widget as follows:--.. code:: haskell--   customWidget :: String -> Widget n-   customWidget s =-       Widget Fixed Fixed $ do-           ctx <- getContext-           render $ str (s <> " " <> show (ctx^.availWidthL))--The ``Widget`` constructor takes the horizontal and vertical growth-policies as described in `How Widgets and Rendering Work`_. Here we just-provide ``Fixed`` for both because the widget will not change behavior-if we give it more space. We then get the rendering context and append-the context's available columns to the provided string. Lastly we call-``render`` to render the widget we made with ``str``. The ``render``-function returns a ``Brick.Types.Result`` value:--.. code:: haskell--    data Result n =-        Result { image              :: Graphics.Vty.Image-               , cursors            :: [Brick.Types.CursorLocation n]-               , visibilityRequests :: [Brick.Types.VisibilityRequest]-               , extents            :: [Extent n]-               }--The rendering function runs in the ``RenderM`` monad, which gives us-access to the rendering context (see `How Widgets and Rendering Work`_)-via the ``Brick.Types.getContext`` function as shown above. The context-tells us about the dimensions of the rendering area and the current-attribute state of the renderer, among other things:--.. code:: haskell--    data Context =-        Context { ctxAttrName    :: AttrName-                , availWidth     :: Int-                , availHeight    :: Int-                , ctxBorderStyle :: BorderStyle-                , ctxAttrMap     :: AttrMap-                }--and has lens fields exported as described in `Conventions`_.--As shown here, the job of the rendering function is to return a-rendering result which means producing a ``vty`` ``Image``. In addition,-if you so choose, you can also return one or more cursor positions in-the ``cursors`` field of the ``Result`` as well as visibility requests-(see `Viewports`_) in the ``visibilityRequests`` field. Returned-visibility requests and cursor positions should be relative to the-upper-left corner of your widget, ``Location (0, 0)``. When your widget-is placed in others, such as boxes, the ``Result`` data you returned-will be offset (as described in `Rendering Sub-Widgets`_) to result in-correct coordinates once the entire interface has been rendered.--Using the Rendering Context------------------------------The most important fields of the context are the rendering area fields-``availWidth`` and ``availHeight``. These fields must be used to-determine how much space your widget has to render.--To perform an attribute lookup in the attribute map for the context's-current attribute, use ``Brick.Types.attrL``.--For example, to build a widget that always fills the available width and-height with a fill character using the current attribute, we could-write:--.. code:: haskell--   myFill :: Char -> Widget n-   myFill ch =-       Widget Greedy Greedy $ do-           ctx <- getContext-           let a = ctx^.attrL-           return $ Result (Graphics.Vty.charFill a ch (ctx^.availWidthL) (ctx^.availHeightL))-                           [] []--Rendering Sub-Widgets------------------------If your custom widget wraps another, then in addition to rendering-the wrapped widget and augmenting its returned ``Result`` *it must-also translate the resulting cursor locations, visibility requests,-and extents*. This is vital to maintaining the correctness of-rendering metadata as widget layout proceeds. To do so, use the-``Brick.Widgets.Core.addResultOffset`` function to offset the elements-of a ``Result`` by a specified amount. The amount depends on the nature-of the offset introduced by your wrapper widget's logic.--Widgets are not required to respect the rendering context's width and-height restrictions. Widgets may be embedded in viewports or translated-so they must render without cropping to work in those scenarios.-However, widgets rendering other widgets *should* enforce the rendering-context's constraints to avoid using more space than is available. The-``Brick.Widgets.Core.cropToContext`` function is provided to make this-easy:--.. code:: haskell--   let w = cropToContext someWidget--Widgets wrapped with ``cropToContext`` can be safely embedded in other-widgets. If you don't want to crop in this way, you can use any of-``vty``'s cropping functions to operate on the ``Result`` image as-desired.--Sub-widgets may specify specific attribute name values influencing-that sub-widget.  If the custom widget utilizes its own attribute-names but needs to render the sub-widget, it can use ``overrideAttr``-or ``mapAttrNames`` to convert its custom names to the names that the-sub-widget uses for rendering its output.--.. _vty: https://github.com/coreyoconnor/vty-.. _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/+abstraction, combinators for expressing user interface layouts, and+infrastructure for handling events.++This documentation is intended to provide a high-level overview of+the library's design along with guidance for using it, but details on+specific functions can be found in the Haddock documentation.++The process of writing an application using ``brick`` entails writing+two important functions:++- A *drawing function* that turns your application state into a+  specification of how your interface should be drawn, and+- An *event handler* that takes your application state and an input+  event and decides whether to change the state or quit the program.++We write drawing functions in ``brick`` using an extensive set of+primitives and combinators to place text on the screen, set its+attributes (e.g. foreground color), and express layout constraints (e.g.+padding, centering, box layouts, scrolling viewports, etc.).++These functions get packaged into an ``App`` structure that we hand off+to the ``brick`` library's main event loop. We'll cover that in detail+in `The App Type`_.++Installation+------------++``brick`` can be installed in the "usual way," either by installing+the latest `Hackage`_ release or by cloning the GitHub repository and+building locally.++To install from Hackage::++   $ cabal update+   $ cabal install brick++To clone and build locally::++   $ git clone https://github.com/jtdaugherty/brick.git+   $ cd brick+   $ cabal new-build++Your package will need some dependencies:++* ``brick``,+* ``vty >= 6.0``, and+* ``vty-crossplatform`` or ``vty-unix`` or ``vty-windows``, depending+  on which platform(s) your application supports.++Building the Demonstration Programs+-----------------------------------++``brick`` includes a large collection of feature-specific demonstration+programs. These programs are not built by default but can be built by+passing the ``demos`` flag to ``cabal install``, e.g.::++   $ cabal install brick -f demos++Conventions+===========++``brick`` has some API conventions worth knowing about as you read this+documentation and as you explore the library source and write your own+programs.++- 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 if you use lenses+  to modify your application state once it 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,+  hierarchical relationships between attributes are documented in+  Haddock documentation.+- Use of qualified Haskell identifiers: in this document, where+  sensible, I will use fully-qualified identifiers whenever I mention+  something for the first time or whenever I use something that is+  not part of ``brick``. Use of qualified names is not intended to+  produce executable examples, but rather to guide you in writing your+  ``import`` statements.++Compiling Brick Applications+============================++Brick applications must be compiled with the threaded RTS using the GHC+``-threaded`` option.++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+various functions:++.. code:: haskell++   data App s e n =+       App { appDraw         :: s -> [Widget n]+           , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)+           , appHandleEvent  :: BrickEvent n e -> EventM n s ()+           , appStartEvent   :: EventM n s ()+           , appAttrMap      :: s -> AttrMap+           }++The ``App`` type is parameterized over three types. These type variables+will appear in the signatures of many library functions and types. They+are:++- The **application state type** ``s``: the type of data that will+  evolve over the course of the application's execution. Your+  application will provide the library with its starting value and event+  handling will transform it as the program executes. When a ``brick``+  application exits, the final application state will be returned.+- The **event type** ``e``: the type of custom application events+  that your application will need to produce and handle in+  ``appHandleEvent``. All applications will be provided with events from+  the underlying ``vty`` library, such as keyboard events or resize+  events; this type variable indicates the type of *additional* events+  the application will need. For more details, see `Using Your Own Event+  Type`_.+- The **resource name type** ``n``: during application execution we+  sometimes need a way to refer to rendering state, such as the space+  taken up by a given widget, the state for a scrollable viewport, a+  mouse click, or a cursor position. For these situations we need a+  unique handle called a *resource name*. The type ``n`` specifies the+  name type the application will use to identify these bits of state+  produced and managed by the renderer. The resource name type must be+  provided by your application; for more details, see `Resource Names`_.++The various fields of ``App`` will be described in the sections below.++Running an Application+----------------------++To run an ``App``, we pass it to ``Brick.Main.defaultMain`` or+``Brick.Main.customMain`` along with an initial application state value:++.. code:: haskell++   main :: IO ()+   main = do+       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+---------------------------------++The value of ``appDraw`` is a function that turns the current+application state into a list of *layers* of type ``Widget``, listed+topmost first, that will make up the interface. Each ``Widget`` gets+turned into a ``vty`` layer and the resulting layers are drawn to the+terminal.++The ``Widget`` type is the type of *drawing instructions*.  The body of+your drawing function will use one or more drawing functions to build or+transform ``Widget`` values to describe your interface. These+instructions will then be executed with respect to three things:++- The size of the terminal: the size of the terminal determines how many+  ``Widget`` values behave. For example, fixed-size ``Widget`` values+  such as text strings behave the same under all conditions (and get+  cropped if the terminal is too small) but layout combinators such as+  ``Brick.Widgets.Core.vBox`` or ``Brick.Widgets.Center.center`` use the+  size of the terminal to determine how to lay other widgets out. See+  `How Widgets and Rendering Work`_.+- The application's attribute map (``appAttrMap``): drawing functions+  requesting the use of attributes cause the attribute map to be+  consulted. See `How Attributes Work`_.+- The state of scrollable viewports: the state of any scrollable+  viewports on the *previous* drawing will be considered. For more+  details, see `Viewports`_.++The ``appDraw`` function is called when the event loop begins to draw+the application as it initially appears. It is also called right after+an event is processed by ``appHandleEvent``. Even though the function+returns a specification of how to draw the entire screen, the underlying+``vty`` library goes to some trouble to efficiently update only the+parts of the screen that have changed so you don't need to worry about+this.++Where do I find drawing functions?+**********************************++The most important module providing drawing functions is+``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets``+namespace provides specific kinds of functionality.++``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 :: BrickEvent n e -> EventM n s ()++``appHandleEvent`` is responsible for deciding how to change the state+based on incoming events. 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 ``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`_.++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.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 deal with rendering performance issues.)++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 handling an event would otherwise cause redraw+latency.++``EventM`` is also used to make scrolling requests to the renderer (see+`Viewports`_), obtain named extents (see `Extents`_), and other duties.++Event Handlers for Component State+**********************************++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.++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:++* 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.++To use the built-in editor, the application must:++* 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``.++An example application state using an editor might look like this:++.. code:: haskell++   data MyState n = MyState { _editor :: Editor Text n }+   makeLenses ''MyState++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.++To dispatch events to the ``editor`` we'd start by writing the+application event handler:++.. code:: haskell++   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+*************************++Since we often need to communicate application-specific events beyond+Vty input events to the event handler, brick supports embedding your+application's custom events in the stream of ``BrickEvent``-s that+your handler will receive. The type of these events is the type ``e``+mentioned in ``BrickEvent n e`` and ``App s e n``.++Note: ordinarily your application will not have its own custom event+type, so you can leave this type unused (e.g. ``App MyState e MyName``)+or just set it to unit (``App MyState () MyName``).++Here's an example of using a custom event type. Suppose that you'd like+to be able to handle counter events in your event handler. First we+define the counter event type:++.. code:: haskell++   data CounterEvent = Counter Int++With this type declaration we can now use counter events in our app by+using the application type ``App s CounterEvent n``. To handle these+events we'll just need to check for ``AppEvent`` values in the event+handler:++.. code:: haskell++   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+event handler. To do that we need to create a ``BChan`` for our+custom events, provide that ``BChan`` to ``brick``, and then send+our events over that channel. Once we've created the channel with+``Brick.BChan.newBChan``, we provide it to ``brick`` with+``customMain`` instead of ``defaultMain``:++.. code:: haskell++   main :: IO ()+   main = do+       eventChan <- Brick.BChan.newBChan 10+       let buildVty = Graphics.Vty.CrossPlatform.mkVty Graphics.Vty.Config.defaultConfig+       initialVty <- buildVty+       finalState <- customMain initialVty buildVty+                       (Just eventChan) app initialState+       -- Use finalState and exit++The ``customMain`` function lets us have control over how the ``vty``+library is initialized *and* how ``brick`` gets custom events to give to+our event handler. ``customMain`` is the entry point into ``brick`` when+you need to use your own event type as shown here. In this example we're+using ``mkVty`` provided by the ``vty-crossplatform`` package, which+provides build-time support for both Unix and Windows. If you prefer,+you can use either the ``vty-unix`` package or the ``vty-windows``+package directly instead if you only want to support one platform.++With all of this in place, sending our custom events to the event+handler is straightforward:++.. code:: haskell++   counterThread :: Brick.BChan.BChan CounterEvent -> IO ()+   counterThread chan = do+       Brick.BChan.writeBChan chan $ Counter 1++Bounded Channels+****************++A ``BChan``, or *bounded channel*, can hold a limited number of+items before attempts to write new items will block. In the call to+``newBChan`` above, the created channel has a capacity of 10 items.+Use of a bounded channel ensures that if the program cannot process+events quickly enough then there is a limit to how much memory will+be used to store unprocessed events. Thus the chosen capacity should+be large enough to buffer occasional spikes in event handling latency+without inadvertently blocking custom event producers. Each application+will have its own performance characteristics that determine the best+bound for the event channel. In general, consider the performance of+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+------------------------------++When an application starts, it may be desirable to perform some of+the duties typically only possible when an event has arrived, such as+setting up initial scrolling viewport state. Since such actions can only+be performed in ``EventM`` and since we do not want to wait until the+first event arrives to do this work in ``appHandleEvent``, the ``App``+type provides ``appStartEvent`` function for this purpose:++.. code:: haskell++   appStartEvent :: EventM n s ()++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+---------------------------------------++The rendering process for a ``Widget`` may return information about+where that widget would like to place the cursor. For example, a text+editor will need to report a cursor position. However, since a+``Widget`` may be a composite of many such cursor-placing widgets, we+have to have a way of choosing which of the reported cursor positions,+if any, is the one we actually want to honor.++To decide which cursor placement to use, or to decide not to show one at+all, we set the ``App`` type's ``appChooseCursor`` function:++.. code:: haskell++   appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)++The event loop renders the interface and collects the+``Brick.Types.CursorLocation`` values produced by the rendering process+and passes those, along with the current application state, to this+function. Using your application state (to track which text input box+is "focused," say) you can decide which of the locations to return or+return ``Nothing`` if you do not want to show a cursor.++Many widgets in the rendering process can request cursor placements, but+it is up to our application to determine which one (if any) should be+used. Since we can only show at most a single cursor in the terminal,+we need to decide which location to show. One way is by looking at the+resource name contained in the ``cursorLocationName`` field. The name+value associated with a cursor location will be the name used to request+the cursor position with ``Brick.Widgets.Core.showCursor``.++``Brick.Main`` provides various convenience functions to make cursor+selection easy in common cases:++* ``neverShowCursor``: never show any cursor.+* ``showFirstCursor``: always show the first cursor request given; good+  for applications with only one cursor-placing widget.+* ``showCursorNamed``: show the cursor with the specified resource name+  or show no cursor if the name was not associated with any requested+  cursor position.++For example, this widget requests a cursor placement on the first+"``o``" in "``foo``" associated with the cursor name ``CustomName``:++.. code:: haskell++   data MyName = CustomName++   let w = showCursor CustomName (Brick.Types.Location (1, 0))+             (Brick.Widgets.Core.str "foobar")++The event handler for this application would use ``MyName`` as its+resource name type ``n`` and would be able to pattern-match on+``CustomName`` to match cursor requests when this widget is rendered:++.. code:: haskell++   myApp =+       App { ...+           , appChooseCursor = \_ -> showCursorNamed CustomName+           }++See the next section for more information on using names.++Resource Names+--------------++We saw above in `appChooseCursor: Placing the Cursor`_ that resource+names are used to describe cursor locations. Resource names are also+used to name other kinds of resources:++* viewports (see `Viewports`_)+* rendering extents (see `Extents`_)+* mouse events (see `Mouse Support`_)++Assigning names to these resource types allows us to distinguish between+events based on the part of the interface to which an event is related.++Your application must provide some type of name. For simple applications+that don't make use of resource names, you may use ``()``. But if your+application has more than one named resource, you *must* provide a type+capable of assigning a unique name to every resource that needs one.++A Note of Caution+*****************++Resource names can be assigned to any of the resource types mentioned+above, but some resource types--viewports, extents, the render cache,+and cursor locations--form separate resource namespaces. So, for+example, the same name can be assigned to both a viewport and an extent,+since the ``brick`` API provides access to viewports and extents using+separate APIs and data structures. However, if the same name is used for+two resources of the same kind, it is undefined *which* of those you'll+be getting access to when you go to use one of those resources in your+event handler.++For example, if the same name is assigned to two viewports:++.. code:: haskell++   data Name = Viewport1++   ui :: Widget Name+   ui = (viewport Viewport1 Vertical $ str "Foo") <+>+        (viewport Viewport1 Vertical $ str "Bar") <+>++then in ``EventM`` when we attempt to scroll the viewport ``Viewport1``+we don't know which of the two uses of ``Viewport1`` will be affected:++.. code:: haskell++   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.++.. code:: haskell++   data Name = Viewport1 | Viewport2++   ui :: Widget Name+   ui = (viewport Viewport1 Vertical $ str "Foo") <+>+        (viewport Viewport2 Vertical $ str "Bar") <+>++``appAttrMap``: Managing Attributes+-----------------------------------++In ``brick`` we use an *attribute map* to assign attributes to elements+of the interface. Rather than specifying specific attributes when+drawing a widget (e.g. red-on-black text) we specify an *attribute name*+that is an abstract name for the kind of thing we are drawing, e.g.+"keyword" or "e-mail address." We then provide an attribute map which+maps those attribute names to actual attributes.  This approach lets us:++* Change the attributes at runtime, letting the user change the+  attributes of any element of the application arbitrarily without+  forcing anyone to build special machinery to make this configurable;+* Write routines to load saved attribute maps from disk;+* Provide modular attribute behavior for third-party components, where+  we would not want to have to recompile third-party code just to change+  attributes, and where we would not want to have to pass in attribute+  arguments to third-party drawing functions.++This lets us put the attribute mapping for an entire app, regardless of+use of third-party widgets, in one place.++To create a map we use ``Brick.AttrMap.attrMap``, e.g.,++.. code:: haskell++   App { ...+       , appAttrMap = const $ attrMap Graphics.Vty.defAttr [(someAttrName, fg blue)]+       }++To use an attribute map, we specify the ``App`` field ``appAttrMap`` as+the function to return the current attribute map each time rendering+occurs. This function takes the current application state, so you may+choose to store the attribute map in your application state. You may+also choose not to bother with that and to just set ``appAttrMap = const+someMap``.++To draw a widget using an attribute name in the map, use+``Brick.Widgets.Core.withAttr``. For example, this draws a string with a+``blue`` background:++.. code:: haskell++   let w = withAttr blueBg $ str "foobar"+       blueBg = attrName "blueBg"+       myMap = attrMap defAttr [ (blueBg, Brick.Util.bg Graphics.Vty.blue)+                               ]++For complete details on how attribute maps and attribute names work, see+the Haddock documentation for the ``Brick.AttrMap`` module. See also+`How Attributes Work`_.++How Widgets and Rendering Work+==============================++When ``brick`` renders a ``Widget``, the widget's rendering routine is+evaluated to produce a ``vty`` ``Image`` of the widget. The widget's+rendering routine runs with some information called the *rendering+context* that contains:++* The size of the area in which to draw things+* The name of the current attribute to use to draw things+* The map of attributes to use to look up attribute names+* The active border style to use when drawing borders++Available Rendering Area+------------------------++The most important element in the rendering context is the rendering+area: This part of the context tells the widget being drawn how many+rows and columns are available for it to consume. When rendering begins,+the widget being rendered (i.e. a layer returned by an ``appDraw``+function) gets a rendering context whose rendering area is the size of+the terminal. This size information is used to let widgets take up that+space if they so choose. For example, a string "Hello, world!" will+always take up one row and 13 columns, but the string "Hello, world!"+*centered* will always take up one row and *all available columns*.++How widgets use space when rendered is described in two pieces of+information in each ``Widget``: the widget's horizontal and vertical+growth policies. These fields have type ``Brick.Types.Size`` and can+have the values ``Fixed`` and ``Greedy``. Note that these values are+merely *descriptive hints* about the behavior of the rendering function,+so it's important that they accurately describe the widget's use of+space.++A widget advertising a ``Fixed`` size in a given dimension is a widget+that will always consume the same number of rows or columns no+matter how many it is given. Widgets can advertise different+vertical and horizontal growth policies for example, the+``Brick.Widgets.Center.hCenter`` function centers a widget and is+``Greedy`` horizontally and defers to the widget it centers for vertical+growth behavior.++These size policies govern the box layout algorithm that is at+the heart of every non-trivial drawing specification. When we use+``Brick.Widgets.Core.vBox`` and ``Brick.Widgets.Core.hBox`` to+lay things out (or use their binary synonyms ``<=>`` and ``<+>``,+respectively), the box layout algorithm looks at the growth policies of+the widgets it receives to determine how to allocate the available space+to them.++For example, imagine that the terminal window is currently 10 rows high+and 50 columns wide.  We wish to render the following widget:++.. code:: haskell++   let w = (str "Hello," <=> str "World!")++Rendering this to the terminal will result in "Hello," and "World!"+underneath it, with 8 rows unoccupied by anything. But if we wished to+render a vertical border underneath those strings, we would write:++.. code:: haskell++   let w = (str "Hello," <=> str "World!" <=> vBorder)++Rendering this to the terminal will result in "Hello," and "World!"+underneath it, with 8 rows remaining occupied by vertical border+characters ("``|``") one column wide. The vertical border widget is+designed to take up however many rows it was given, but rendering the+box layout algorithm has to be careful about rendering such ``Greedy``+widgets because they won't leave room for anything else. Since the box+widget cannot know the sizes of its sub-widgets until they are rendered,+the ``Fixed`` widgets get rendered and their sizes are used to determine+how much space is left for ``Greedy`` widgets.++When using widgets it is important to understand their horizontal and+vertical space behavior by knowing their ``Size`` values. Those should+be made clear in the Haddock documentation.++The rendering context's specification of available space will also+govern how widgets get cropped, since all widgets are required to render+to an image no larger than the rendering context specifies. If they do,+they will be forcibly cropped.++Limiting Rendering Area+-----------------------++If you'd like to use a ``Greedy`` widget but want to limit how much+space it consumes, you can turn it into a ``Fixed`` widget by using+one of the *limiting combinators*, ``Brick.Widgets.Core.hLimit`` and+``Brick.Widgets.Core.vLimit``. These combinators take widgets and turn+them into widgets with a ``Fixed`` size (in the relevant dimension) and+run their rendering functions in a modified rendering context with a+restricted rendering area.++For example, the following will center a string in 30 columns, leaving+room for something to be placed next to it as the terminal width+changes:++.. code:: haskell++   let w = hLimit 30 $ hCenter $ str "Hello, world!"++The Attribute Map+-----------------++The rendering context contains an attribute map (see `How Attributes+Work`_ and `appAttrMap: Managing Attributes`_) which is used to look up+attribute names from the drawing specification. The map originates from+``Brick.Main.appAttrMap`` and can be manipulated on a per-widget basis+using ``Brick.Widgets.Core.updateAttrMap``.++The Active Border Style+-----------------------++Widgets in the ``Brick.Widgets.Border`` module draw border characters+(horizontal, vertical, and boxes) between and around other widgets. To+ensure that widgets across your application share a consistent visual+style, border widgets consult the rendering context's *active border+style*, a value of type ``Brick.Widgets.Border.Style``, to get the+characters used to draw borders.++The default border style is ``Brick.Widgets.Border.Style.unicode``. To+change border styles, use the ``Brick.Widgets.Core.withBorderStyle``+combinator to wrap a widget and change the border style it uses when+rendering. For example, this will use the ``ascii`` border style instead+of ``unicode``:++.. code:: haskell++   let w = withBorderStyle Brick.Widgets.Border.Style.ascii $+             Brick.Widgets.Border.border $ str "Hello, world!"++By default, borders in adjacent widgets do not connect to each other.+This can lead to visual oddities, for example, when horizontal borders+are drawn next to vertical borders by leaving a small gap like this:++.. code:: text++    │─++You can request that adjacent borders connect to each other with+``Brick.Widgets.Core.joinBorders``. Two borders drawn with the+same attribute and border style, and both under the influence of+``joinBorders``, will produce a border like this instead:++.. code:: text++    ├─++See `Joining Borders`_ for further details.++How Attributes Work+===================++In addition to letting us map names to attributes, attribute maps+provide hierarchical attribute inheritance: a more specific attribute+derives any properties (e.g. background color) that it does not specify+from more general attributes in hierarchical relationship to it, letting+us customize only the parts of attributes that we want to change without+having to repeat ourselves.++For example, this draws a string with a foreground color of ``white`` on+a background color of ``blue``:++.. code:: haskell++   let w = withAttr specificAttr $ str "foobar"+       generalAttr = attrName "general"+       specificAttr = attrName "general" <> attrName "specific"+       myMap = attrMap defAttr [ (generalAttr, bg blue)+                               , (specificAttr, fg white)+                               ]++When drawing a widget, Brick keeps track of the current attribute it+is using to draw to the screen. The attribute it tracks is specified+by its *attribute name*, which is a hierarchical name referring to the+attribute in the attribute map. In the example above, the map contains+two attribute names: ``generalAttr`` and ``specificAttr``. Both names+are made up of segments: ``general`` is the first segment for both+names, and ``specific`` is the second segment for ``specificAttr``.+This tells Brick that ``specificAttr`` is a more specialized version+of ``generalAttr``. We'll see below how that affects the resulting+attributes that Brick uses.++When it comes to drawing something on the screen with either of these+attributes, Brick looks up the desired attribute name in the map+and uses the result to draw to the screen. In the example above,+``withAttr`` is used to tell Brick that when drawing ``str "foobar"``,+the attribute ``specificAttr`` should be used. Brick looks that name+up in the attribute map and finds a match: an attribute with a white+foreground color. However, what happens next is important: Brick then+looks up the more general attribute name derived from ``specificAttr``,+which it gets by removing the last segment in the name, ``specific``.+The resulting name, ``general``, is then looked up. The new result is+then *merged* with the initial lookup, yielding an attribute with a+white foreground color and a blue background color. This happens because+the ``specificAttr`` entry did not specify a background color. If it+had, that would have been used instead. In this way, we can create+inheritance relationships between attributes, much the same way CSS+supports inheritance of styles based on rule specificity.++Brick uses Vty's attribute type, ``Attr``, which has three components:+foreground color, background color, and style. These three components+can be independently specified to have an explicit value, and any+component not explicitly specified can default to whatever the terminal+is currently using. Vty styles can be combined together, e.g. underline+and bold, so styles are cumulative.++What if a widget attempts to draw with an attribute name that is not+specified in the map at all? In that case, the attribute map's "default+attribute" is used. In the example above, the default attribute for the+map is Vty's ``defAttr`` value, which means that the terminal's default+colors and style should be used. But that attribute can be customized+as well, and any attribute map lookup results will get merged with the+default attribute for the map. So, for example, if you'd like your+entire application background to be blue unless otherwise specified, you+could create an attribute map as follows:++.. code:: haskell++   let myMap = attrMap (bg blue) [ ... ]++This way, we can avoid repeating the desired background color and all of+the other map entries can just set foreground colors and styles where+needed.++In addition to using the attribute map provided by ``appAttrMap``, the+map and attribute lookup behavior can be customized on a per-widget+basis by using various functions from ``Brick.Widgets.Core``:++* ``updateAttrMap`` -- allows transformations of the attribute map,+* ``forceAttr`` -- forces all attribute lookups to map to the value of+  the specified attribute name,+* ``withDefAttr`` -- changes the default attribute for the attribute map+  to the one with the specified name, and+* ``overrideAttr`` -- creates attribute map lookup synonyms between+  attribute names.++Attribute Themes+================++Brick provides support for customizable attribute themes. This works as+follows:++* The application provides a default theme built in to the program.+* The application customizes the theme by loading theme customizations+  from a user-specified customization file.+* The application can save new customizations to files for later+  re-loading.++Customizations are written in an INI-style file. Here's an example:++.. code:: ini++   [default]+   default.fg = blue+   default.bg = black++   [other]+   someAttribute.fg = red+   someAttribute.style = underline+   otherAttribute.style = [underline, bold]+   otherAttribute.inner.fg = white++In the above example, the theme's *default attribute* -- the one that is+used when no other attributes are used -- is customized. Its foreground+and background colors are set. Then, other attributes specified by+the theme -- ``someAttribute`` and ``otherAttribute`` -- are also+customized. This example shows that styles can be customized, too, and+that a custom style can either be a single style (in this example,+``underline``) or a collection of styles to be applied simultaneously+(in this example, ``underline`` and ``bold``). Lastly, the hierarchical+attribute name ``otherAttribute.inner`` refers to an attribute name+with two components, ``otherAttribute <> inner``, similar to the+``specificAttr`` attribute described in `How Attributes Work`_. Full+documentation for the format of theme customization files can be found+in the module documentation for ``Brick.Themes``.++The above example can be used in a ``brick`` application as follows.+First, the application provides a default theme:++.. code:: haskell++   import Brick.Themes (Theme, newTheme)+   import Brick (attrName)+   import Brick.Util (fg, on)+   import Graphics.Vty (defAttr, white, blue, yellow, magenta)++   defaultTheme :: Theme+   defaultTheme =+       newTheme (white `on` blue)+                [ (attrName "someAttribute",  fg yellow)+                , (attrName "otherAttribute", fg magenta)+                ]++Notice that the attributes in the theme have defaults: ``someAttribute``+will default to a yellow foreground color if it is not customized. (And+its background will default to the theme's default background color,+blue, if it not customized either.) Then, the application can customize+the theme with the user's customization file:++.. code:: haskell++   import Brick.Themes (loadCustomizations)++   main :: IO ()+   main = do+       customizedTheme <- loadCustomizations "custom.ini" defaultTheme++Now we have a customized theme based on ``defaultTheme``. The next step+is to build an ``AttrMap`` from the theme:++.. code:: haskell++   import Brick.Themes (themeToAttrMap)++   main :: IO ()+   main = do+       customizedTheme <- loadCustomizations "custom.ini" defaultTheme+       let mapping = themeToAttrMap customizedTheme++The resulting ``AttrMap`` can then be returned by ``appAttrMap``+as described in `How Attributes Work`_ and `appAttrMap: Managing+Attributes`_.++If the theme is further customized at runtime, any changes can be saved+with ``Brick.Themes.saveCustomizations``.++Wide Character Support and the ``TextWidth`` class+==================================================++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.++Unfortunately, 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+to support wide characters in your application, this will not work:++.. code:: haskell++   let width = Data.Text.length t++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 to+compute the width by looking up the string's characters 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+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++   ui = center $ border $ str "Foo"++We don't want to have to care about the particulars of the layout to+find out where the bordered box got placed during rendering. To get this+information we request that the extent of the box be reported to us by+the renderer using a resource name:++.. code:: haskell++   data Name = FooBox++   ui = center $+        reportExtent FooBox $+        border $ str "Foo"++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++   mExtent <- Brick.Main.lookupExtent FooBox+   case mExtent of+       Nothing -> ...+       Just (Extent _ upperLeft (width, height)) -> ...++Paste Support+=============++Some terminal emulators support "bracketed paste" mode. This feature+enables OS-level paste operations to send the pasted content as a+single chunk of data and bypass the usual input processing that the+application does. This enables more secure handling of pasted data since+the application can detect that a paste occurred and avoid processing+the pasted data as ordinary keyboard input. For more information, see+`bracketed paste mode`_.++The Vty library used by brick provides support for bracketed pastes, but+this mode must be enabled. To enable paste mode, we need to get access+to the Vty library handle in ``EventM`` (in e.g. ``appHandleEvent``):++.. code:: haskell++   import Control.Monad (when)+   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++Once enabled, paste mode will generate Vty ``EvPaste`` events. These+events will give you the entire pasted content as a ``ByteString`` which+you must decode yourself if, for example, you expect it to contain UTF-8+text data.++Mouse Support+=============++Some terminal emulators support mouse interaction. The Vty library used+by brick provides these low-level events if mouse mode has been enabled.+To enable mouse mode, we need to get access to the Vty library handle in+``EventM``:++.. code:: haskell++   do+       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+provide mouse events.++Also bear in mind that terminal users will usually expect to be able+to interact with your application entirely without a mouse, so if you+do choose to enable mouse interaction, consider using it to improve+existing interactions rather than provide new functionality that cannot+already be managed with a keyboard.++Low-level Mouse Events+----------------------++Once mouse events have been enabled, Vty will generate ``EvMouseDown``+and ``EvMouseUp`` events containing the mouse button clicked, the+location in the terminal, and any modifier keys pressed.++.. code:: haskell++   handleEvent (VtyEvent (EvMouseDown col row button mods) = ...++Brick Mouse Events+------------------++Although these events may be adequate for your needs, ``brick`` provides+a higher-level mouse event interface that ties into the drawing+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 *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. 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 (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+want to know which one was clicked? And what if those extents are in+different layers? The next approach is to find all clicked extents:++.. code:: haskell++   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:++* For extents ``A`` and ``B``, if ``A``'s layer is higher than ``B``'s+  layer, ``A`` comes before ``B`` in the list.+* For extents ``A`` and ``B``, if ``A`` and ``B`` are in the same layer+  and ``A`` is contained within ``B``, ``A`` comes before ``B`` in the+  list.++As a result, the extents are ordered in a natural way, starting with the+most specific extents and proceeding to the most general.++Viewports+=========++A *viewport* is a scrollable window onto a widget. Viewports have a+*scrolling direction* of type ``Brick.Types.ViewportType`` which can be+one of:++* ``Horizontal``: the viewport can only scroll horizontally.+* ``Vertical``: the viewport can only scroll vertically.+* ``Both``: the viewport can scroll both horizontally and vertically.++The ``Brick.Widgets.Core.viewport`` combinator takes another widget+and embeds it in a named viewport. We name the viewport so that we can+keep track of its scrolling state in the renderer, and so that you can+make scrolling requests. The viewport's name is its handle for these+operations (see `Scrolling Viewports in Event Handlers`_ and `Resource+Names`_). **The viewport name must be unique across your application.**++For example, the following puts a string in a horizontally-scrollable+viewport:++.. code:: haskell++   -- Assuming that App uses 'Name' for its resource names:+   data Name = Viewport1+   let w = viewport Viewport1 Horizontal $ str "Hello, world!"++A ``viewport`` specification means that the widget in the viewport will+be placed in a viewport window that is ``Greedy`` in both directions+(see `Available Rendering Area`_). This is suitable if we want the+viewport size to be the size of the entire terminal window, but if+we want to limit the size of the viewport, we might use limiting+combinators (see `Limiting Rendering Area`_):++.. code:: haskell++   let w = hLimit 5 $+           vLimit 1 $+           viewport Viewport1 Horizontal $ str "Hello, world!"++Now the example produces a scrollable window one row high and five+columns wide initially showing "Hello". The next two sections discuss+the two ways in which this viewport can be scrolled.++Scrolling Viewports in Event Handlers+-------------------------------------++The most direct way to scroll a viewport is to make *scrolling requests*+in the ``EventM`` event-handling monad. Scrolling requests ask the+renderer to update the state of a viewport the next time the user+interface is rendered. Those state updates will be made with respect+to the *previous* viewport state, i.e., the state of the viewports as+of the end of the most recent rendering. This approach is the best+approach to use to scroll widgets that have no notion of a cursor.+For cursor-based scrolling, see `Scrolling Viewports With Visibility+Requests`_.++To make scrolling requests, we first create a+``Brick.Main.ViewportScroll`` from a viewport name with+``Brick.Main.viewportScroll``:++.. code:: haskell++   -- Assuming that App uses 'Name' for its resource names:+   data Name = Viewport1+   let vp = viewportScroll Viewport1++The ``ViewportScroll`` record type contains a number of scrolling+functions for making scrolling requests:++.. code:: haskell++   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+``h`` scroll horizontally and functions prefixed with ``v`` scroll+vertically.++Scrolling operations do nothing when they don't make sense for the+specified viewport; scrolling a ``Vertical`` viewport horizontally is a+no-op, for example.++Using ``viewportScroll`` we can write an event handler that scrolls the+``Viewport1`` viewport one column to the right:++.. code:: haskell++   myHandler :: e -> EventM n s ()+   myHandler e = do+       let vp = viewportScroll Viewport1+       hScrollBy vp 1++Scrolling Viewports With Visibility Requests+--------------------------------------------++When we need to scroll widgets only when a cursor in the viewport+leaves the viewport's bounds, we need to use *visibility requests*. A+visibility request is a hint to the renderer that some element of a+widget inside a viewport should be made visible, i.e., that the viewport+should be scrolled to bring the requested element into view.++To use a visibility request to make a widget in a viewport visible, we+simply wrap it with ``visible``:++.. code:: haskell++   -- Assuming that App uses 'Name' for its resource names:+   data Name = Viewport1+   let w = viewport Viewport1 Horizontal $+           (visible $ str "Hello,") <+> (str " world!")++This example requests that the ``Viewport1`` viewport be scrolled so+that "Hello," is visible. We could extend this example with a value+in the application state indicating which word in our string should+be visible and then use that to change which string gets wrapped with+``visible``; this is the basis of cursor-based scrolling.++Note that a visibility request does not change the state of a viewport+*if the requested widget is already visible*! This important detail is+what makes visibility requests so powerful, because they can be used to+capture various cursor-based scenarios:++* The ``Brick.Widgets.Edit`` widget uses a visibility request to make its+  1x1 cursor position visible, thus making the text editing widget fully+  scrollable *while being entirely scrolling-unaware*.+* The ``Brick.Widgets.List`` widget uses a visibility request to make+  its selected item visible regardless of its size, which makes+  the list widget scrolling-unaware.++Showing Scroll Bars on Viewports+--------------------------------++Brick supports drawing both vertical and horizontal scroll bars on+viewports. To enable scroll bars, wrap your call to ``viewport`` with+a call to ``withVScrollBars`` and/or ``withHScrollBars``. If you don't+like the appearance of the resulting scroll bars, you can customize+how they are drawn by making your own ``ScrollbarRenderer`` and using+``withVScrollBarRenderer`` and/or ``withHScrollBarRenderer``. Note that+when you enable scrollbars, the content of your viewport will lose one+column of available space if vertical scroll bars are enabled and one+row of available space if horizontal scroll bars are enabled.++Scroll bars can also be configured to draw "handles" with+``withHScrollBarHandles`` and ``withVScrollBarHandles``.++Lastly, scroll bars can be configured to report mouse events on+each scroll bar element. To enable mouse click reporting, use+``withClickableHScrollBars`` and ``withClickableVScrollBars``.++For a demonstration of the scroll bar API in action, see the+``ViewportScrollbarsDemo.hs`` demonstration program.++Viewport Restrictions+---------------------++Viewports impose one restriction: a viewport that is scrollable in+some direction can only embed a widget that has a ``Fixed`` size in+that direction. This extends to ``Both`` type viewports: they can only+embed widgets that are ``Fixed`` in both directions. This restriction+is because when viewports embed a widget, they relax the rendering area+constraint in the rendering context, but doing so to a large enough+number for ``Greedy`` widgets would result in a widget that is too big+and not scrollable in a useful way.++Violating this restriction will result in a runtime exception.++Input Forms+===========++While it's possible to construct interfaces with editors and other+interactive inputs manually, this process is somewhat tedious: all of+the event dispatching has to be written by hand, a focus ring or other+construct needs to be managed, and most of the rendering code needs to+be written. Furthermore, this process makes it difficult to follow some+common patterns:++* We typically want to validate the user's input, and only collect it+  once it has been validated.+* We typically want to notify the user when a particular field's+  contents are invalid.+* It is often helpful to be able to create a new data type to represent+  the fields in an input interface, and use it to initialize the input+  elements and later collect the (validated) results.+* A lot of the rendering and event-handling work to be done is+  repetitive.++The ``Brick.Forms`` module provides a high-level API to automate all of+the above work in a type-safe manner.++A Form Example+--------------++Let's consider an example data type that we'd want to use as the+basis for an input interface. This example comes directly from the+``FormDemo.hs`` demonstration program.++.. code:: haskell++   data UserInfo =+       FormState { _name      :: T.Text+                 , _age       :: Int+                 , _address   :: T.Text+                 , _ridesBike :: Bool+                 , _handed    :: Handedness+                 , _password  :: T.Text+                 } deriving (Show)++   data Handedness = LeftHanded+                   | RightHanded+                   | Ambidextrous+                   deriving (Show, Eq)++Suppose we want to build an input form for the above data. We might want+to use an editor to allow the user to enter a name and an age. We'll+need to ensure that the user's input for age is a valid integer. For+``_ridesBike`` we might want a checkbox-style input, and for ``_handed``+we might want a radio button input. For ``_password``, we'd definitely+like a password input box that conceals the input.++If we were to build an interface for this data manually, we'd need to+deal with converting the data above to the right types for inputs. For+example, for ``_age`` we'd need to convert an initial age value to+``Text``, put it in an editor with ``Brick.Widgets.Edit.editor``, and+then at a later time, parse the value and reconstruct an age from the+editor's contents. We'd also need to tell the user if the age value was+invalid.++Brick's ``Forms`` API provides input field types for all of the above+use cases. Here's the form that we can use to allow the user to edit a+``UserInfo`` value:++.. code:: haskell++   mkForm :: UserInfo -> Form UserInfo e Name+   mkForm =+       newForm [ editTextField name NameField (Just 1)+               , editTextField address AddressField (Just 3)+               , editShowableField age AgeField+               , editPasswordField password PasswordField+               , radioField handed [ (LeftHanded, LeftHandField, "Left")+                                   , (RightHanded, RightHandField, "Right")+                                   , (Ambidextrous, AmbiField, "Both")+                                   ]+               , checkboxField ridesBike BikeField "Do you ride a bicycle?"+               ]++A form is represented using a ``Form s e n`` value and is parameterized+with some types:++* ``s`` - the type of *form state* managed by the form (in this case+  ``UserInfo``)+* ``e`` - the event type of the application (must match the event type+  used with ``App``)+* ``n`` - the resource name type of the application (must match the+  resource name type used with ``App``)++First of all, the above code assumes we've derived lenses for+``UserInfo`` using ``Lens.Micro.TH.makeLenses``. Once we've done+that, each field that we specify in the form must provide a lens into+``UserInfo`` so that we can declare the particular field of ``UserInfo``+that will be edited by the field. For example, to edit the ``_name``+field we use the ``name`` lens to create a text field editor with+``editTextField``. All of the field constructors above are provided by+``Brick.Forms``.++Each form field also needs a resource name (see `Resource Names`_). The+resource names are assigned to the individual form inputs so the form+can automatically track input focus and handle mouse click events.++The form carries with it the value of ``UserInfo`` that reflects the+contents of the form. Whenever an input field in the form handles an+event, its contents are validated and rewritten to the form state (in+this case, a ``UserInfo`` record).++The ``mkForm`` function takes a ``UserInfo`` value, which is really+just an argument to ``newForm``. This ``UserInfo`` value will be used+to initialize all of the form fields. Each form field will use the lens+provided to extract the initial value from the ``UserInfo`` record,+convert it into an appropriate state type for the field in question, and+later validate that state and convert it back into the appropriate type+for storage in ``UserInfo``.++The form value itself -- of type ``Form`` -- must be stored in your+application state. You should only ever call ``newForm`` when you need+to initialize a totally new form. Once initialized, the form needs to be+kept around and updated by event handlers in order to work.++For example, if the initial ``UserInfo`` value's ``_age`` field has the+value ``0``, the ``editShowableField`` will call ``show`` on ``0``,+convert that to ``Text``, and initialize the editor for ``_age`` with+the text string ``"0"``. Later, if the user enters more text -- changing+the editor contents to ``"10"``, say -- the ``Read`` instance for+``Int`` (the type of ``_age``) will be used to parse ``"10"``. The+successfully-parsed value ``10`` will then be written to the ``_age``+field of the form's ``UserInfo`` state using the ``age`` lens. The use+of ``Show`` and ``Read`` here is a feature of the field type we have+chosen for ``_age``, ``editShowableField``.++For other field types we may have other needs. For instance,+``Handedness`` is a data type representing all the possible choices+we want to provide for a user's handedness. We wouldn't want the user+to have to type in a text string for this option. A more appropriate+input interface is a list of radio buttons to choose from amongst+the available options. For that we have ``radioField``. This field+constructor takes a list of all of the available options, and updates+the form state with the value of the currently-selected option.++Rendering Forms+---------------++Rendering forms is done easily using the ``Brick.Forms.renderForm``+function. However, as written above, the form will not look especially+nice. We'll see a few text editors followed by some radio buttons and a+check box. But we'll need to customize the output a bit to make the form+easier to use. For that, we have the ``Brick.Forms.@@=`` operator. This+operator lets us provide a function to augment the ``Widget`` generated+by the field's rendering function so we can do things like add labels,+control layout, or change attributes:++.. code:: haskell++    (str "Name: " <+>) @@=+        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+the ``_name`` field of ``UserInfo``.++Brick provides this interface to controlling per-field rendering because+many form fields either won't have labels or will have different layout+requirements, so an alternative API such as building the label into the+field API doesn't always make sense.++Brick defaults to rendering individual fields' inputs, and the entire+form, in a vertical box using ``vBox``. Use ``setFormConcat`` and+``setFieldConcat`` to change this behavior to, e.g., ``hBox``.++Form Attributes+---------------++The ``Brick.Forms`` module uses and exports two attribute names (see+`How Attributes Work`_):++* ``focusedFormInputAttr`` - this attribute is used to render the form+  field that has the focus.+* ``invalidFormInputAttr`` - this attribute is used to render any form+  field that has user input that has invalid validation.++Your application should set both of these. Some good mappings in the+attribute map are:++* ``focusedFormInputAttr`` - ``black `on` yellow``+* ``invalidFormInputAttr`` - ``white `on` red``++Handling Form Events+--------------------++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+type ``e`` above).++Once the application has decided that the user should be done with the+form editing session, the current state of the form can be obtained+with ``Brick.Forms.formState``. In the example above, this would+return a ``UserInfo`` record containing the values for each field in+the form *as of the last time it was valid input*. This means that+the user might have provided invalid input to a form field that is+not reflected in the form state due to failing validation.++Since the ``formState`` is always a valid set of values, it might+be surprising to the user if the values used do not match the last+values they saw on the screen; the ``Brick.Forms.allFieldsValid``+can be used to determine if the last visual state of the form had+any invalid entries and doesn't match the value of ``formState``. A+list of any fields which had invalid values can be retrieved with the+``Brick.Forms.invalidFields`` function.++While each form field type provides a validator function to validate+its current user input value, that function is pure. As a result it's+not suitable for doing validation that requires I/O such as searching+a database or making network requests. If your application requires+that kind of validation, you can use the ``Brick.Forms.setFieldValid``+function to set the validation state of any form field as you see+fit. The validation state set by that function will be considered by+``allFieldsValid`` and ``invalidFields``. See ``FormDemo.hs`` for an+example of this API.++Note that if mouse events are enabled in your application (see `Mouse+Support`_), all built-in form fields will respond to mouse interaction.+Radio buttons and check boxes change selection on mouse clicks and+editors change cursor position on mouse clicks.++Writing Custom Form Field Types+-------------------------------++If the built-in form field types don't meet your needs, ``Brick.Forms``+exposes all of the data types needed to implement your own field types.+For more details on how to do this, see the Haddock documentation for+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 to those of an application+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-matches 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.      |++---------------------+------------------------+-------------------------+++Keybinding Collisions+---------------------++An important issue to consider in using the custom keybinding API is+that it is possible for the user to map the same key to more than one+event. We refer to this situation as a *keybinding collision*. Whether+the collision represents a problem depends on how the events in question+are going to be handled by the application. This section provides an+example scenario and describes a way to deal with this situation.++Suppose an application has two key events:++.. code:: haskell++   data KeyEvent = QuitEvent+                 | CloseWindowEvent++   allKeyEvents :: KeyEvents KeyEvent+   allKeyEvents =+       K.keyEvents [ ("quit",         QuitEvent)+                   , ("close-window", CloseWindowEvent)+                   ]++   defaultBindings :: [(KeyEvent, [Binding])]+   defaultBindings =+       [ (QuitEvent,        [ctrl 'q'])+       , (CloseWindowEvent, [bind KEsc])+       ]++Suppose also that the application using the above key events has a+feature that opens a window, and that ``CloseWindowEvent`` is used to+close the window, while ``QuitEvent`` is used to quit the application.++A user might then provide a custom INI file to rebind keys as follows::++   [keybindings]+   quit = Esc+   close-window = Esc++While this is a valid configuration for the user to provide, it would+result in a keybinding collision for ``Esc`` since it is now bound+to two events. Whether that's a problem depends entirely on how+``QuitEvent`` and ``CloseWindowEvent`` are handled:++* If the application handles both events in the same event handler,+  the ``KeyDispatcher`` for those events would fail to construct since+  ``Esc`` maps to more than one event. Building a ``KeyDispatcher``+  from a ``KeyConfig`` with such a collision would fail and return+  information about the collisions.+* If the application handles the two events in different dispatchers+  then the collision has no effect and is not a problem since different+  ``KeyDispatcher`` values would be constructed to handle the events+  separately. This could happen, for instance, if the application only+  ever handled ``CloseWindowEvent`` when the window in question was+  open and only handled ``QuitEvent`` when the window had been closed.+  This kind of "modal" approach to handling events means that we only+  consider a key to have a collision if it is bound to two or more+  events that are handled in the same event handling context.++There's also another situation that would be problematic, which is+when an abstract event like ``QuitEvent`` has a key mapping that+collides with a key handler that is bound to a specific key using+``Brick.Keybindings.KeyDispatcher.onKey`` rather than an abstract event:++.. code:: haskell++    K.onKey (K.bind '\t') "Increment the counter by 10" $+        counter %= (+ 10)++If ``onKey`` is used, the handler it creates is only triggered by the+specified key (``Tab`` in the example above). But the handler may be+included alongside handlers in the same dispatcher that are *also*+triggered by ``Tab``, so if those event handlers were provided together+when creating a ``KeyDispatcher`` then it would fail to construct due to+the collision.++Brick provides ``Brick.Keybindings.KeyConfig.keyEventMappings`` to help+finding collisions at the key configuration level. Finding out about+collisions at the dispatcher level is possible by handling the failure+case when calling ``Brick.Keybindings.KeyDispatcher.keyDispatcher``.++Joining Borders+===============++Brick supports a feature called "joinable borders" which means that+borders drawn in adjacent widgets can be configured to automatically+"join" with each other using the appropriate intersection characters.+This feature is helpful for creating seamless connected borders without+the need for manual calculations to determine where to draw intersection+characters.++Under normal circumstances, widgets are self-contained in that their+renderings do not interact with the appearance of adjacent widgets. This+is unfortunate for borders: one often wants to draw a T-shaped character+at the intersection of a vertical and horizontal border, for example.+To facilitate automatically adding such characters, ``brick`` offers+some border-specific capabilities for widgets to re-render themselves+as information about neighboring widgets becomes available during the+rendering process.++Border-joining works by iteratively *redrawing* the edges of widgets as+those edges come into contact with other widgets during rendering. If+the adjacent edge locations of two widgets both use joinable borders,+the Brick will re-draw one of the characters so that it connects+seamlessly with the adjacent border.++How Joining Works+-----------------++When a widget is rendered, it can report supplementary information+about each position on its edges. Each position has four notional line+segments extending from its center, arranged like this:++.. code:: text++            top+             |+             |+    left ----+---- right+             |+             |+           bottom++These segments can independently be *drawn*, *accepting*, and+*offering*, as captured in the ``Brick.Types.BorderSegment`` type:++.. code:: haskell++    data BorderSegment = BorderSegment+        { bsAccept :: Bool+        , bsOffer :: Bool+        , bsDraw :: Bool+        }++If no information is reported for a position, it assumed that it is+not drawn, not accepting, and not offering -- and so it will never+be rewritten. This situation is the ordinary situation where an edge+location is not a border at all, or is a border that we don't want to+join to other borders.++Line segments that are *drawn* are used for deciding which part of the+``BorderStyle`` to use if this position needs to be updated. (See also+`The Active Border Style`_.) For example, suppose a position needs to+be redrawn, and already has the left and bottom segments drawn; then it+will replace the current character with the upper-right corner drawing+character ``bsCornerTR`` from its border style.++The *accepting* and *offering* properties are used to perform a small+handshake between neighboring widgets; when the handshake is successful,+one segment will transition to being drawn. For example, suppose a+horizontal and vertical border widget are drawn next to each other:++.. code:: text++            top+         (offering)                 top+             |+             |+    left     +     right    left ----+---- right+             |           (offering)     (offering)+             |+           bottom                  bottom+         (offering)++These borders are accepting in all directions, drawn in the directions+signified by visible lines, and offering in the directions written.+Since the horizontal border on the right is offering towards the+vertical border, and the vertical border is accepting from the direction+towards the horizontal border, the right segment of the vertical+border will transition to being drawn. This will trigger an update of+the ``Image`` associated with the left widget, overwriting whatever+character is there currently with a ``bsIntersectL`` character instead.+The state of the segments afterwards will be the same, but the fact that+there is one more segment drawn will be recorded:++.. code:: text++            top+         (offering)                 top+             |+             |+    left     +---- right    left ----+---- right+             |           (offering)     (offering)+             |+           bottom                  bottom+         (offering)++It is important that this be recorded: we may later place this combined+widget to the right of another horizontal border, in which case we+would want to transition again from a ``bsIntersectL`` character to a+``bsIntersectFull`` character that represents all four segments being+drawn.++Because this involves an interaction between multiple widgets, we+may find that the two widgets involved were rendered under different+rendering contexts. To avoid mixing and matching border styles and+drawing attributes, each location records not just the state of its+four segments but also the border style and attribute that were active+at the time the border was drawn. This information is stored in+``Brick.Types.DynBorder``.++.. code:: haskell++    data DynBorder = DynBorder+        { dbStyle :: BorderStyle+        , dbAttr :: Attr+        , dbSegments :: Edges BorderSegment+        }++The ``Brick.Types.Edges`` type has one field for each direction:++.. code:: haskell++    data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }++In addition to the offer/accept handshake described above, segments also+check that their neighbor's ``BorderStyle`` and ``Attr`` match their own+before transitioning from undrawn to drawn to avoid visual glitches from+trying to connect e.g. ``unicode`` borders to ``ascii`` ones or green+borders to red ones.++The above description applies to a single location; any given widget's+result may report information about any location on its border using the+``Brick.BorderMap.BorderMap`` type. A ``BorderMap a`` is close kin to a+``Data.Map.Map Location a`` except that each ``BorderMap`` has a fixed+rectangle on which keys are retained. Values inserted at other keys are+silently discarded.++For backwards compatibility, all the widgets that ship with ``brick``+avoid reporting any border information by default, but ``brick`` offers+three ways of modifying the border-joining behavior of a widget.++* ``Brick.Widgets.Core.joinBorders`` instructs any borders drawn in its+  child widget to report their edge information. It does this+  by setting a flag in the rendering context that tells the+  ``Brick.Widgets.Border`` widgets to report the information described+  above. Consequently, widgets drawn in this context will join their+  borders with neighbors.+* ``Brick.Widgets.Core.separateBorders`` does the opposite of+  ``joinBorders`` by unsetting the same context flag, preventing border+  widgets from attempting to connect.+* ``Brick.Widgets.Core.freezeBorders`` lets its child widget connect its+  borders internally but prevents it from connecting with anything+  outside the ``freezeBorders`` call. It does this by deleting the edge+  metadata about its child widget. This means that any connections+  already made within the child widget will stay as they are but no new+  connections will be made to adjacent widgets. For example, one might+  use this to create a box with internal but no external connections:++  .. code:: haskell++      joinBorders . freezeBorders . border . hBox $+          [str "left", vBorder, str "right"]++  Or to create a box that allows external connections but not internal+  ones:++  .. code:: haskell++      joinBorders . border . freezeBorders . hBox $+          [str "left", vBorder, str "right"]++When creating new widgets, if you would like ``joinBorders`` and+``separateBorders`` to affect the behavior of your widget, you may do+so by consulting the ``ctxDynBorders`` field of the rendering context+before writing to your ``Result``'s ``borders`` field.++Animations+==========++Brick provides animation support in ``Brick.Animation``. See the Haddock+documentation in that module for a complete explanation of the API; see+``programs/AnimationDemo.hs`` (``brick-animation-demo``) for a working+example.++The Rendering Cache+===================++When widgets become expensive to render, ``brick`` provides a *rendering+cache* that automatically caches and re-uses stored Vty images from+previous renderings to avoid expensive renderings. To cache the+rendering of a widget, just wrap it in the ``Brick.Widgets.Core.cached``+function:++.. code:: haskell++   data Name = ExpensiveThing++   ui :: Widget Name+   ui = center $+        cached ExpensiveThing $+        border $+        str "This will be cached"++In the example above, the first time the ``border $ str "This will be cached"``+widget is rendered, the resulting Vty image will be stored+in the rendering cache under the key ``ExpensiveThing``. On subsequent+renderings the cached Vty image will be used instead of re-rendering the+widget. This example doesn't need caching to improve performance, but+more sophisticated widgets might.++Once ``cached`` has been used to store something in the rendering cache,+periodic cache invalidation may be required. For example, if the cached+widget is built from application state, the cache will need to be+invalidated when the relevant state changes. The cache may also need to+be invalidated when the terminal is resized. To invalidate the cache, we+use the cache invalidation functions in ``EventM``:++.. code:: haskell++   handleEvent ... = do+       -- Invalidate just a single cache entry:+       Brick.Main.invalidateCacheEntry ExpensiveThing++       -- Invalidate the entire cache (useful on a resize):+       Brick.Main.invalidateCache++Implementing Custom Widgets+===========================++``brick`` exposes all of the internals you need to implement your+own widgets. Those internals, together with ``Graphics.Vty``, can be+used to create widgets from the ground up. You'll need to implement+your own widget if you can't write what you need in terms of existing+combinators. For example, an ordinary widget like++.. code:: haskell++   myWidget :: Widget n+   myWidget = str "Above" <=> str "Below"++can be expressed with ``<=>`` and ``str`` and needs no custom behavior.+But suppose we want to write a widget that renders some string followed+by the number of columns in the space available to the widget. We can't+do this without writing a custom widget because we need access to the+rendering context. We can write such a widget as follows:++.. code:: haskell++   customWidget :: String -> Widget n+   customWidget s =+       Widget Fixed Fixed $ do+           ctx <- getContext+           render $ str (s <> " " <> show (ctx^.availWidthL))++The ``Widget`` constructor takes the horizontal and vertical growth+policies as described in `How Widgets and Rendering Work`_. Here we just+provide ``Fixed`` for both because the widget will not change behavior+if we give it more space. We then get the rendering context and append+the context's available columns to the provided string. Lastly we call+``render`` to render the widget we made with ``str``. The ``render``+function returns a ``Brick.Types.Result`` value:++.. code:: haskell++    data Result n =+        Result { image              :: Graphics.Vty.Image+               , cursors            :: [Brick.Types.CursorLocation n]+               , visibilityRequests :: [Brick.Types.VisibilityRequest]+               , extents            :: [Extent n]+               , borders            :: BorderMap DynBorder+               }++The rendering function runs in the ``RenderM`` monad, which gives us+access to the rendering context (see `How Widgets and Rendering Work`_)+via the ``Brick.Types.getContext`` function as shown above. The context+tells us about the dimensions of the rendering area and the current+attribute state of the renderer, among other things:++.. code:: haskell++    data Context =+        Context { ctxAttrName    :: AttrName+                , availWidth     :: Int+                , availHeight    :: Int+                , ctxBorderStyle :: BorderStyle+                , ctxAttrMap     :: AttrMap+                , ctxDynBorders  :: Bool+                }++and has lens fields exported as described in `Conventions`_.++As shown here, the job of the rendering function is to return a+rendering result which means producing a ``vty`` ``Image``. In addition,+if you so choose, you can also return one or more cursor positions in+the ``cursors`` field of the ``Result`` as well as visibility requests+(see `Viewports`_) in the ``visibilityRequests`` field. Returned+visibility requests and cursor positions should be relative to the+upper-left corner of your widget, ``Location (0, 0)``. When your widget+is placed in others, such as boxes, the ``Result`` data you returned+will be offset (as described in `Rendering Sub-Widgets`_) to result in+correct coordinates once the entire interface has been rendered.++Using the Rendering Context+---------------------------++The most important fields of the context are the rendering area fields+``availWidth`` and ``availHeight``. These fields must be used to+determine how much space your widget has to render.++To perform an attribute lookup in the attribute map for the context's+current attribute, use ``Brick.Types.attrL``.++For example, to build a widget that always fills the available width and+height with a fill character using the current attribute, we could+write:++.. code:: haskell++   myFill :: Char -> Widget n+   myFill ch =+       Widget Greedy Greedy $ do+           ctx <- getContext+           let a = ctx^.attrL+           return $ Result (Graphics.Vty.charFill a ch (ctx^.availWidthL) (ctx^.availHeightL))+                           [] [] [] Brick.BorderMap.empty++Rendering Sub-Widgets+---------------------++If your custom widget wraps another, then in addition to rendering+the wrapped widget and augmenting its returned ``Result`` *it must+also translate the resulting cursor locations, visibility requests,+and extents*. This is vital to maintaining the correctness of+rendering metadata as widget layout proceeds. To do so, use the+``Brick.Widgets.Core.addResultOffset`` function to offset the elements+of a ``Result`` by a specified amount. The amount depends on the nature+of the offset introduced by your wrapper widget's logic.++Widgets are not required to respect the rendering context's width and+height restrictions. Widgets may be embedded in viewports or translated+so they must render without cropping to work in those scenarios.+However, widgets rendering other widgets *should* enforce the rendering+context's constraints to avoid using more space than is available. The+``Brick.Widgets.Core.cropToContext`` function is provided to make this+easy:++.. code:: haskell++   let w = cropToContext someWidget++Widgets wrapped with ``cropToContext`` can be safely embedded in other+widgets. If you don't want to crop in this way, you can use any of+``vty``'s cropping functions to operate on the ``Result`` image as+desired.++Sub-widgets may specify specific attribute name values influencing+that sub-widget.  If the custom widget utilizes its own attribute+names but needs to render the sub-widget, it can use ``overrideAttr``+or ``mapAttrNames`` to convert its custom names to the names that the+sub-widget uses for rendering its output.++.. _vty: https://github.com/jtdaugherty/vty+.. _Hackage: http://hackage.haskell.org/+.. _microlens: http://hackage.haskell.org/package/microlens+.. _bracketed paste mode: https://cirw.in/blog/bracketed-paste
+ docs/snake-demo.gif view

binary file changed (absent → 406517 bytes)

+ programs/AnimationDemo.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+module Main where++import Control.Monad (void)+import Lens.Micro.Platform+import Data.List (intersperse)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Data.Map as M+import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import Brick.BChan+import Brick.Util (fg)+import Brick.Main (App(..), neverShowCursor, customMain, halt)+import Brick.AttrMap (AttrName, AttrMap, attrMap, attrName)+import Brick.Types (Widget, EventM, BrickEvent(..), Location(..))+import Brick.Widgets.Border (border)+import Brick.Widgets.Center (center)+import Brick.Widgets.Core ((<+>), str, vBox, hBox, hLimit, vLimit, translateBy, withDefAttr)+import qualified Brick.Animation as A++data CustomEvent =+    AnimationUpdate (EventM () St ())+    -- ^ The state update constructor required by the animation API++data St =+    St { _stAnimationManager :: A.AnimationManager St CustomEvent ()+       -- ^ The animation manager that will run all of our animations+       , _animation1 :: Maybe (A.Animation St ())+       , _animation2 :: Maybe (A.Animation St ())+       , _animation3 :: Maybe (A.Animation St ())+       , _clickAnimations :: M.Map Location (A.Animation St ())+       -- ^ The various fields for storing animation states. For mouse+       -- animations, we store animations for each screen location that+       -- was clicked.+       }++makeLenses ''St++drawUI :: St -> [Widget ()]+drawUI st = drawClickAnimations st <> [drawAnimations st]++drawClickAnimations :: St -> [Widget ()]+drawClickAnimations st =+    drawClickAnimation st <$> M.toList (st^.clickAnimations)++drawClickAnimation :: St -> (Location, A.Animation St ()) -> Widget ()+drawClickAnimation st (l, a) =+    translateBy l $+    A.renderAnimation (const $ str " ") st (Just a)++drawAnimations :: St -> Widget ()+drawAnimations st =+    let animStatus label key a =+            str (label <> ": ") <+>+            maybe (str "Not running") (const $ str "Running") a <+>+            str (" (Press " <> key <> " to toggle)")+        statusMessages = statusMessage <$> zip [(0::Int)..] animations+        statusMessage (i, (c, config)) =+            animStatus ("Animation #" <> (show $ i + 1)) [c]+                       (st^.(animationTarget config))+        animationDrawings = hBox $ intersperse (str " ") $+                            drawSingleAnimation <$> animations+        drawSingleAnimation (_, config) =+            A.renderAnimation (const $ str " ") st (st^.(animationTarget config))+    in vBox [ str "Click and drag the mouse or press keys to start animations."+            , str " "+            , vBox statusMessages+            , animationDrawings+            ]++clip1 :: A.Clip a ()+clip1 = A.newClip_ $ str <$> [".", "o", "O", "^", " "]++clip2 :: A.Clip a ()+clip2 = A.newClip_ $ str <$> ["|", "/", "-", "\\"]++clip3 :: A.Clip a ()+clip3 =+    A.newClip_ $+    (hLimit 9 . vLimit 9 . border . center) <$>+    [ border $ str " "+    , border $ vBox $ replicate 3 $ str $ replicate 3 ' '+    , border $ vBox $ replicate 5 $ str $ replicate 5 ' '+    ]++mouseClickClip :: A.Clip a ()+mouseClickClip =+    A.newClip_+    [ withDefAttr attr6 $ str "0"+    , withDefAttr attr5 $ str "O"+    , withDefAttr attr4 $ str "o"+    , withDefAttr attr3 $ str "•"+    , withDefAttr attr2 $ str "*"+    , withDefAttr attr2 $ str "."+    ]++attr6 :: AttrName+attr6 = attrName "attr6"++attr5 :: AttrName+attr5 = attrName "attr5"++attr4 :: AttrName+attr4 = attrName "attr4"++attr3 :: AttrName+attr3 = attrName "attr3"++attr2 :: AttrName+attr2 = attrName "attr2"++attr1 :: AttrName+attr1 = attrName "attr1"++attrs :: AttrMap+attrs =+    attrMap V.defAttr+        [ (attr6, fg V.white)+        , (attr5, fg V.brightYellow)+        , (attr4, fg V.brightGreen)+        , (attr3, fg V.cyan)+        , (attr2, fg V.blue)+        , (attr1, fg V.black)+        ]++-- | Animation settings grouped together for lookup by keystroke.+data AnimationConfig =+    AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ()))+                    , animationClip :: A.Clip St ()+                    , animationFrameTime :: Integer+                    , animationMode :: A.RunMode+                    }++animations :: [(Char, AnimationConfig)]+animations =+    [ ('1', AnimationConfig animation1 clip1 1000 A.Loop)+    , ('2', AnimationConfig animation2 clip2 100 A.Loop)+    , ('3', AnimationConfig animation3 clip3 100 A.Once)+    ]++-- | Start the animation specified by this config.+startAnimationFromConfig :: AnimationConfig -> EventM () St ()+startAnimationFromConfig config = do+    mgr <- use stAnimationManager+    A.startAnimation mgr (animationClip config)+                         (animationFrameTime config)+                         (animationMode config)+                         (animationTarget config)++-- | If the animation specified in this config is not running, start it.+-- Otherwise stop it.+toggleAnimationFromConfig :: AnimationConfig -> EventM () St ()+toggleAnimationFromConfig config = do+    mgr <- use stAnimationManager+    mOld <- use (animationTarget config)+    case mOld of+        Just a -> A.stopAnimation mgr a+        Nothing -> startAnimationFromConfig config++-- | Start a new mouse click animation at the specified location if one+-- is not already running there.+startMouseClickAnimation :: Location -> EventM () St ()+startMouseClickAnimation l = do+    mgr <- use stAnimationManager+    a <- use (clickAnimations.at l)+    case a of+        Just {} -> return ()+        Nothing -> A.startAnimation mgr mouseClickClip 100 A.Once (clickAnimations.at l)++appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e = do+    case e of+        -- A mouse click starts an animation at the click location.+        VtyEvent (V.EvMouseDown col row _ _) ->+            startMouseClickAnimation (Location (col, row))++        -- If we got a character keystroke, see if there is a specific+        -- animation mapped to that character and toggle the resulting+        -- animation.+        VtyEvent (V.EvKey (V.KChar c) [])+            | Just aConfig <- lookup c animations ->+                toggleAnimationFromConfig aConfig++        -- Apply a state update from the animation manager.+        AppEvent (AnimationUpdate act) -> act++        VtyEvent (V.EvKey V.KEsc []) -> halt++        _ -> return ()++theApp :: App St CustomEvent ()+theApp =+    App { appDraw = drawUI+        , appChooseCursor = neverShowCursor+        , appHandleEvent = appEvent+        , appStartEvent = return ()+        , appAttrMap = const attrs+        }++main :: IO ()+main = do+    chan <- newBChan 10+    mgr <- A.startAnimationManager 50 chan AnimationUpdate++    let initialState =+            St { _stAnimationManager = mgr+               , _animation1 = Nothing+               , _animation2 = Nothing+               , _animation3 = Nothing+               , _clickAnimations = mempty+               }+        buildVty = do+            v <- mkVty V.defaultConfig+            V.setMode (V.outputIface v) V.Mouse True+            return v++    initialVty <- buildVty+    void $ customMain initialVty buildVty (Just chan) theApp initialState
programs/AttrDemo.hs view
@@ -1,10 +1,13 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Main where +#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import Graphics.Vty   ( Attr, white, blue, cyan, green, red, yellow-  , black+  , black, withURL   )  import Brick.Main@@ -16,28 +19,39 @@   , withAttr   , vBox   , str+  , hyperlink+  , 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" $-           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 "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 (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" $-           str "... or only you want to change and inherit the rest."+         , 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 "hierarchy levels, e.g. attrName \"window\" <> attrName \"title\"."+         , str " "+         , withAttr (attrName "linked") $+           str "This text is hyperlinked in terminals that support hyperlinking."+         , str " "+         , hyperlink "http://www.google.com/" $+           str "This text is also hyperlinked in terminals that support hyperlinking."+         , str " "+         , modifyDefAttr (`withURL` "http://www.google.com/") $+           str "This text is hyperlinked by modifying the default attribute."          ]  globalDefault :: Attr@@ -45,17 +59,19 @@  theMap :: AttrMap theMap = attrMap globalDefault-    [ ("foundFull",               white `on` green)-    , ("foundFgOnly",             fg red)-    , ("general",                 yellow `on` black)-    , ("general" <> "specific",   fg cyan)+    [ (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         }
programs/BorderDemo.hs view
@@ -1,30 +1,32 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>)) #endif -import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Graphics.Vty as V  import qualified Brick.Main as M-import Brick.Util (fg, bg, on)+import Brick.Util (fg, on) import qualified Brick.AttrMap as A import Brick.Types   ( Widget   ) import Brick.Widgets.Core-  ( (<=>)-  , (<+>)+  ( (<+>)+  , withAttr   , vLimit   , hLimit   , hBox+  , vBox   , updateAttrMap   , withBorderStyle   , txt   , str+  , padLeftRight   ) import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B@@ -64,24 +66,24 @@     B.borderWithLabel (str "label") $     vLimit 5 $     C.vCenter $-    txt $ "  " <> styleName <> " style  "+    padLeftRight 2 $+    txt $ styleName <> " style" -borderMappings :: [(A.AttrName, V.Attr)]-borderMappings =+titleAttr :: A.AttrName+titleAttr = A.attrName "title"++attrs :: [(A.AttrName, V.Attr)]+attrs =     [ (B.borderAttr,         V.yellow `on` V.black)-    , (B.vBorderAttr,        V.green `on` V.red)-    , (B.hBorderAttr,        V.white `on` V.green)-    , (B.hBorderLabelAttr,   fg V.blue)-    , (B.tlCornerAttr,       bg V.red)-    , (B.trCornerAttr,       bg V.blue)-    , (B.blCornerAttr,       bg V.yellow)-    , (B.brCornerAttr,       bg V.green)+    , (B.vBorderAttr,        fg V.cyan)+    , (B.hBorderAttr,        fg V.magenta)+    , (titleAttr,            fg V.cyan)     ]  colorDemo :: Widget () colorDemo =-    updateAttrMap (A.applyAttrMappings borderMappings) $-    B.borderWithLabel (str "title") $+    updateAttrMap (A.applyAttrMappings attrs) $+    B.borderWithLabel (withAttr titleAttr $ str "title") $     hLimit 20 $     vLimit 5 $     C.center $@@ -89,13 +91,14 @@  ui :: Widget () ui =-    hBox borderDemos-    <=> B.hBorder-    <=> colorDemo-    <=> B.hBorderWithLabel (str "horizontal border label")-    <=> (C.center (str "Left of vertical border")-         <+> B.vBorder-         <+> C.center (str "Right of vertical border"))+    vBox [ hBox borderDemos+         , B.hBorder+         , colorDemo+         , B.hBorderWithLabel (str "horizontal border label")+         , (C.center (str "Left of vertical border")+             <+> B.vBorder+             <+> C.center (str "Right of vertical border"))+         ]  main :: IO () main = M.simpleMain ui
programs/CacheDemo.hs view
@@ -1,12 +1,11 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Main where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- import Control.Monad (void)+import Control.Monad.State (modify)+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))+#endif import qualified Graphics.Vty as V  import qualified Brick.Types as T@@ -17,7 +16,8 @@   , BrickEvent(..)   ) import Brick.Widgets.Core-  ( vBox+  ( Padding(..)+  , vBox   , padTopBottom   , withDefAttr   , cached@@ -30,6 +30,7 @@   ) import Brick.AttrMap   ( AttrName+  , attrName   , attrMap   ) @@ -51,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
+ programs/CroppingDemo.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain)+import Brick.Types+  ( Widget+  )+import Brick.Widgets.Core+  ( vBox+  , hBox+  , txt+  , (<=>)+  , padRight+  , cropLeftBy+  , cropRightBy+  , cropTopBy+  , cropBottomBy+  , cropLeftTo+  , cropRightTo+  , cropTopTo+  , cropBottomTo+  , Padding(..)+  )+import Brick.Widgets.Border (border)+import Brick.AttrMap (attrMap)+import qualified Graphics.Vty as V++example :: Widget n+example =+    border+    (txt "Example" <=> txt "Widget")++mkExample :: Widget n -> Widget n+mkExample = padRight (Pad 2)++ui :: Widget ()+ui =+    vBox [ txt "Uncropped" <=> example+         , hBox [ mkExample $ txt "cropLeftBy 2"   <=> cropLeftBy 2 example+                , mkExample $ txt "cropRightBy 2"  <=> cropRightBy 2 example+                , mkExample $ txt "cropTopBy 2"    <=> cropTopBy 2 example+                , mkExample $ txt "cropBottomBy 2" <=> cropBottomBy 2 example+                ]+         , hBox [ mkExample $ txt "cropLeftTo 4"   <=> cropLeftTo 4 example+                , mkExample $ txt "cropRightTo 4"  <=> cropRightTo 4 example+                , mkExample $ txt "cropTopTo 1"    <=> cropTopTo 1 example+                , mkExample $ txt "cropBottomTo 1" <=> cropBottomTo 1 example+                ]+         ]++app :: App () e ()+app =+    App { appDraw = const [ui]+        , appHandleEvent = resizeOrQuit+        , appStartEvent = return ()+        , appAttrMap = const $ attrMap V.defAttr []+        , appChooseCursor = neverShowCursor+        }++main :: IO ()+main = defaultMain app ()
programs/CustomEventDemo.hs view
@@ -1,20 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# 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)) import Data.Monoid+#endif import qualified Graphics.Vty as V  import Brick.BChan import Brick.Main   ( App(..)   , showFirstCursor-  , customMain-  , continue+  , customMainWithDefaultVty   , halt   ) import Brick.AttrMap@@ -22,7 +25,6 @@   ) import Brick.Types   ( Widget-  , Next   , EventM   , BrickEvent(..)   )@@ -47,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 =@@ -67,7 +70,7 @@     App { appDraw = drawUI         , appChooseCursor = showFirstCursor         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         } @@ -75,8 +78,9 @@ main = do     chan <- newBChan 10 -    forkIO $ forever $ do+    void $ forkIO $ forever $ do         writeBChan chan Counter         threadDelay 1000000 -    void $ customMain (V.mkVty V.defaultConfig) (Just chan) theApp initialState+    (_, vty) <- customMainWithDefaultVty (Just chan) theApp initialState+    V.shutdown vty
+ programs/CustomKeybindingDemo.hs view
@@ -0,0 +1,253 @@+{-# 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, forM_, when)+import qualified Data.Set as S+import Data.Maybe (fromJust)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+#if !(MIN_VERSION_base(4,11,0))+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.+       , _dispatcher :: K.KeyDispatcher KeyEvent (T.EventM () St)+       -- ^ The key dispatcher we'll use to dispatch input events.+       }++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.+    d <- use dispatcher+    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++    -- Before starting the application, check on whether any events have+    -- colliding bindings. Exit if so.+    --+    -- Note that in a Real Application, we would more than likely+    -- want to check for collisions among specific sets of+    -- events. For example, if 'Esc' was bound to both 'quit' and+    -- 'close-dialog-box', we might not care about such a collision+    -- if the application only ever handled the 'close-dialog-box'+    -- event in a separate mode and only ever handled 'quit' at the+    -- top-level of the event handler. But if we had two events such as+    -- 'dialog-box-okay' and 'dialog-box-cancel' that were intended to+    -- be handled in the same mode, we might want to check that those+    -- two events did not have the same binding.+    forM_ (K.keyEventMappings kc) $ \(b, evs) -> do+        when (S.size evs > 1) $ do+            Text.putStrLn $ "Error: key '" <> K.ppBinding b <> "' is bound to multiple events:"+            forM_ evs $ \e ->+                Text.putStrLn $ "  " <> Text.pack (show e) <> " (" <> fromJust (K.keyEventName allKeyEvents e) <> ")"+            exitFailure++    -- Now build a key dispatcher for our event handlers. If this fails+    -- due to key collision detection, we'll print out info about the+    -- collisions.+    d <- case K.keyDispatcher kc handlers of+        Right d -> return d+        Left collisions -> do+            putStrLn "Error: some key events have the same keys bound to them."++            forM_ collisions $ \(b, hs) -> do+                Text.putStrLn $ "Handlers with the '" <> K.ppBinding b <> "' binding:"+                forM_ hs $ \h -> do+                    let trigger = case K.kehEventTrigger $ K.khHandler h of+                            K.ByKey k   -> "triggered by the key '" <> K.ppBinding k <> "'"+                            K.ByEvent e -> "triggered by the event '" <> fromJust (K.keyEventName allKeyEvents e) <> "'"+                        desc = K.handlerDescription $ K.kehHandler $ K.khHandler h++                    Text.putStrLn $ "  " <> desc <> " (" <> trigger <> ")"++            exitFailure++    void $ M.defaultMain app $ St { _keyConfig = kc+                                  , _lastKey = Nothing+                                  , _lastKeyHandled = False+                                  , _counter = 0+                                  , _customBindingsPath = customFile+                                  , _dispatcher = d+                                  }++    -- Now demonstrate how the library's generated key binding help text+    -- 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 a key config that doesn'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
programs/DialogDemo.hs view
@@ -1,7 +1,10 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Main where +#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import qualified Graphics.Vty as V  import qualified Brick.Main as M@@ -22,25 +25,31 @@ data Choice = Red | Blue | Green             deriving Show -drawUI :: D.Dialog Choice -> [Widget ()]+data Name =+    RedButton+    | BlueButton+    | GreenButton+    deriving (Show, Eq, Ord)++drawUI :: D.Dialog Choice Name -> [Widget Name] drawUI d = [ui]     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 Name e -> T.EventM Name (D.Dialog Choice Name) ()+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+initialState :: D.Dialog Choice Name+initialState = D.dialog (Just $ str "Title") (Just (RedButton, choices)) 50     where-        choices = [ ("Red", Red)-                  , ("Blue", Blue)-                  , ("Green", Green)+        choices = [ ("Red",   RedButton,   Red)+                  , ("Blue",  BlueButton,  Blue)+                  , ("Green", GreenButton, Green)                   ]  theMap :: A.AttrMap@@ -50,12 +59,12 @@     , (D.buttonSelectedAttr, bg V.yellow)     ] -theApp :: M.App (D.Dialog Choice) e ()+theApp :: M.App (D.Dialog Choice Name) e Name theApp =     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
+ programs/DynamicBorderDemo.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Brick.Main as M+import Brick.Types+  ( Widget+  )+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Core as C+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Border.Style as BS++doubleHorizontal :: BS.BorderStyle+doubleHorizontal = BS.BorderStyle+    { BS.bsCornerTL = '╒'+    , BS.bsCornerTR = '╕'+    , BS.bsCornerBR = '╛'+    , BS.bsCornerBL = '╘'+    , BS.bsIntersectL = '╞'+    , BS.bsIntersectR = '╡'+    , BS.bsIntersectT = '╤'+    , BS.bsIntersectB = '╧'+    , BS.bsIntersectFull = '╪'+    , BS.bsHorizontal = '═'+    , BS.bsVertical = '│'+    }++box1 :: Widget ()+box1+    = C.withBorderStyle doubleHorizontal . B.border+    . C.withBorderStyle BS.unicodeRounded . B.border+    $ C.str "25 kg"++weights :: Widget ()+weights = C.withBorderStyle doubleHorizontal $ C.hBox+    [ box1+    , C.str "\n\n" C.<=> B.hBorder+    , box1+    ]++box2 :: Widget ()+box2 = C.freezeBorders $ C.vBox+    [ C.hBox+        [ C.vLimit 3 B.vBorder+        , C.str "Resize horizontally to\nmove across the label\nbelow"+        , C.vLimit 3 B.vBorder+        ]+    , B.borderWithLabel (B.vBorder C.<+> C.str " Label " C.<+> B.vBorder) $ C.hBox+        [ C.str "               "+        , C.vBox [B.vBorder, C.str "L\na\nb\ne\nl", C.vLimit 3 B.vBorder]+        , C.str "\n\n\n Resize vertically to\n move across the label\n to the left\n\n\n\n\n" C.<=> B.hBorder+        ]+    ]++-- BYOB: build your own border+byob :: Widget ()+byob = C.vBox+    [              C.hBox [ corner   , top      , corner   ]+    , C.vLimit 6 $ C.hBox [ B.vBorder, mid      , B.vBorder]+    ,              C.hBox [ corner   , B.hBorder, corner   ]+    ]+    where+    top = B.hBorderWithLabel (C.str "BYOB")+    mid = C.center (C.str "If `border` is too easy,\nyou can build it yourself")+    corner = B.joinableBorder (pure False)++ui :: Widget ()+ui = C.vBox [weights, box2, byob]++main :: IO ()+main = M.simpleMain (C.joinBorders ui)
programs/EditDemo.hs view
@@ -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@@ -37,8 +38,8 @@ drawUI :: St -> [T.Widget Name] drawUI st = [ui]     where-        e1 = F.withFocusRing (st^.focusRing) E.renderEditor (st^.edit1)-        e2 = F.withFocusRing (st^.focusRing) E.renderEditor (st^.edit2)+        e1 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit1)+        e2 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit2)          ui = C.center $             (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 e1)) <=>@@ -47,24 +48,25 @@             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 ev) =-    case ev of-        V.EvKey V.KEsc [] -> M.halt st-        V.EvKey (V.KChar '\t') [] -> M.continue $ st & focusRing %~ F.focusNext-        V.EvKey V.KBackTab [] -> M.continue $ st & focusRing %~ F.focusPrev--        _ -> 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 st _ = M.continue 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 =     St (F.focusRing [Edit1, Edit2])-       (E.editor Edit1 (str . unlines) Nothing "")-       (E.editor Edit2 (str . unlines) (Just 2) "")+       (E.editor Edit1 Nothing "")+       (E.editor Edit2 (Just 2) "")  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -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           }
+ programs/EditorLineNumbersDemo.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Main where++import Control.Monad (void)+import Lens.Micro+import Lens.Micro.TH+import Lens.Micro.Mtl+import qualified Graphics.Vty as V+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif++import qualified Brick.Main as M+import qualified Brick.Types as T+import Brick.Widgets.Core+  ( (<+>)+  , vBox+  , hLimit+  , vLimit+  , str+  , visible+  , viewport+  , withDefAttr+  )+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Edit as E+import qualified Brick.AttrMap as A+import Brick.Util (on, fg)++data Name = Edit+          | EditLines+          deriving (Ord, Show, Eq)++data St =+    St { _edit :: E.Editor String Name+       }++makeLenses ''St++drawUI :: St -> [T.Widget Name]+drawUI st = [ui]+    where+        e = renderWithLineNumbers (st^.edit)+        ui = C.center $ hLimit 50 $ vLimit 10 e++-- | Given an editor, render the editor with line numbers to the left of+-- the editor.+--+-- This essentially exploits knowledge of how the editor is implemented:+-- we make a viewport containing line numbers that is just as high as+-- the editor, then request that the line number associated with the+-- editor's current line position be made visible, thus scrolling it+-- into view. This is slightly brittle, however, because it relies on+-- essentially keeping the line number viewport and the editor viewport+-- in the same vertical scrolling state; with direct scrolling requests+-- from EventM it is easily possible to put the two viewports into a+-- state where they do not have the same vertical scrolling offset. That+-- means that visibility requests made with 'visible' won't necessarily+-- have the same effect in each viewport in that case. So this is+-- only really usable in the case where you're sure that the editor's+-- viewport and the line number viewports will not be managed by direct+-- viewport operations in EventM. That's what I'd recommend anyway, but+-- still, this is an important caveat.+--+-- There's another important caveat here: this particular implementation+-- has @O(n)@ performance for editor height @n@ because we generate+-- the entire list of line numbers on each rendering depending on the+-- height of the editor. That means that for sufficiently large files,+-- it will get more expensive to render the line numbers. There is a way+-- around this problem, which is to take the approach that the @List@+-- implementation takes: only render a region of visible line numbers+-- around the currently-edited line that is just large enough to be+-- guaranteed to fill the viewport, then translate that so that it+-- appears at the right viewport offset, thus faking a viewport filled+-- with line numbers when in fact we'd only ever render at most @2 * K ++-- 1@ line numbers for a viewport height of @K@. That's more involved,+-- so I didn't do it here, but that would be the way to go for a Real+-- Application.+renderWithLineNumbers :: E.Editor String Name -> T.Widget Name+renderWithLineNumbers e =+    lineNumbersVp <+> editorVp+    where+        lineNumbersVp = hLimit (maxNumWidth + 1) $ viewport EditLines T.Vertical body+        editorVp = E.renderEditor (str . unlines) True e+        body = withDefAttr lineNumberAttr $ vBox numWidgets+        numWidgets = mkNumWidget <$> numbers+        mkNumWidget i = maybeVisible i $ str $ show i+        maybeVisible i+            | i == curLine + 1 =+                visible . withDefAttr currentLineNumberAttr+            | otherwise =+                id+        numbers = [1..h]+        contents = E.getEditContents e+        h = length contents+        curLine = fst $ E.getCursorPosition e+        maxNumWidth = length $ show h++appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    M.halt+appEvent ev = do+    zoom edit $ E.handleEditorEvent ev++initialState :: St+initialState =+    St (E.editor Edit Nothing "")++lineNumberAttr :: A.AttrName+lineNumberAttr = A.attrName "lineNumber"++currentLineNumberAttr :: A.AttrName+currentLineNumberAttr = lineNumberAttr <> A.attrName "current"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (E.editAttr,              V.white `on` V.blue)+    , (E.editFocusedAttr,       V.black `on` V.yellow)+    , (lineNumberAttr,          fg V.cyan)+    , (currentLineNumberAttr,   V.defAttr `V.withStyle` V.bold)+    ]++theApp :: M.App St e Name+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = const $ M.showCursorNamed Edit+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = do+    void $ M.defaultMain theApp initialState
+ programs/FileBrowserDemo.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+module Main where++import qualified Control.Exception as E+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#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, attrName)+import Brick.Types+  ( Widget+  , BrickEvent(..)+  )+import Brick.Widgets.Center+  ( center+  , hCenter+  )+import Brick.Widgets.Border+  ( borderWithLabel+  )+import Brick.Widgets.Core+  ( vBox, (<=>), padTop+  , hLimit, vLimit, txt+  , withDefAttr, emptyWidget+  , Padding(..)+  )+import qualified Brick.Widgets.FileBrowser as FB+import qualified Brick.AttrMap as A+import Brick.Util (on, fg)+import qualified Brick.Types as T++data Name = FileBrowser1+          deriving (Eq, Show, Ord)++drawUI :: FB.FileBrowser Name -> [Widget Name]+drawUI b = [center $ ui <=> help]+    where+        ui = hCenter $+             vLimit 15 $+             hLimit 50 $+             borderWithLabel (txt "Choose a file") $+             FB.renderFileBrowser True b+        help = padTop (Pad 1) $+               vBox [ case FB.fileBrowserException b of+                          Nothing -> emptyWidget+                          Just e -> hCenter $ withDefAttr errorAttr $+                                    txt $ Text.pack $ E.displayException e+                    , hCenter $ txt "Up/Down: select"+                    , hCenter $ txt "/: search, Ctrl-C or Esc: cancel search"+                    , hCenter $ txt "Enter: change directory or select file"+                    , hCenter $ txt "Esc: quit"+                    ]++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+        _ -> do+            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 [] -> do+                    b' <- get+                    case FB.fileBrowserSelection b' of+                        [] -> return ()+                        _ -> M.halt+                _ -> return ()+appEvent _ = return ()++errorAttr :: AttrName+errorAttr = attrName "error"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (L.listSelectedFocusedAttr, V.black `on` V.yellow)+    , (FB.fileBrowserCurrentDirectoryAttr, V.white `on` V.blue)+    , (FB.fileBrowserSelectionInfoAttr, V.white `on` V.blue)+    , (FB.fileBrowserDirectoryAttr, fg V.blue)+    , (FB.fileBrowserBlockDeviceAttr, fg V.magenta)+    , (FB.fileBrowserCharacterDeviceAttr, fg V.green)+    , (FB.fileBrowserNamedPipeAttr, fg V.yellow)+    , (FB.fileBrowserSymbolicLinkAttr, fg V.cyan)+    , (FB.fileBrowserUnixSocketAttr, fg V.red)+    , (FB.fileBrowserSelectedAttr, V.white `on` V.magenta)+    , (errorAttr, fg V.red)+    ]++theApp :: M.App (FB.FileBrowser Name) e Name+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = M.showFirstCursor+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = do+    b <- M.defaultMain theApp =<< FB.newFileBrowser FB.selectNonDirectories FileBrowser1 Nothing+    putStrLn $ "Selected entry: " <> show (FB.fileBrowserSelection b)
+ programs/FillDemo.hs view
@@ -0,0 +1,16 @@+module Main where++import Brick+import Brick.Widgets.Border++ui :: Widget ()+ui = vBox [ vLimitPercent 20 $ vBox [ str "This text is in the top 20% of the window due to a fill and vLimitPercent."+                                    , fill ' '+                                    , hBorder+                                    ]+          , str "This text is at the bottom with another fill beneath it."+          , fill 'x'+          ]++main :: IO ()+main = simpleMain ui
+ programs/FormDemo.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Data.Text as T+import Lens.Micro ((^.))+import Lens.Micro.TH+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif++import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import Brick+import Brick.Forms+  ( Form+  , newForm+  , formState+  , formFocus+  , setFieldValid+  , renderForm+  , handleFormEvent+  , invalidFields+  , allFieldsValid+  , focusedFormInputAttr+  , invalidFormInputAttr+  , checkboxField+  , radioField+  , editShowableField+  , editTextField+  , editPasswordField+  , (@@=)+  )+import Brick.Focus+  ( focusGetCurrent+  , focusRingCursor+  )+import qualified Brick.Widgets.Edit as E+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C++data Name = NameField+          | AgeField+          | BikeField+          | HandedField+          | PasswordField+          | LeftHandField+          | RightHandField+          | AmbiField+          | AddressField+          deriving (Eq, Ord, Show)++data Handedness = LeftHanded | RightHanded | Ambidextrous+                deriving (Show, Eq)++data UserInfo =+    UserInfo { _name      :: T.Text+             , _age       :: Int+             , _address   :: T.Text+             , _ridesBike :: Bool+             , _handed    :: Handedness+             , _password  :: T.Text+             }+             deriving (Show)++makeLenses ''UserInfo++-- This form is covered in the Brick User Guide; see the "Input Forms"+-- section.+mkForm :: UserInfo -> Form UserInfo e Name+mkForm =+    let label s w = padBottom (Pad 1) $+                    (vLimit 1 $ hLimit 15 $ str s <+> fill ' ') <+> w+    in newForm [ label "Name" @@=+                   editTextField name NameField (Just 1)+               , label "Address" @@=+                 B.borderWithLabel (str "Mailing") @@=+                   editTextField address AddressField (Just 3)+               , label "Age" @@=+                   editShowableField age AgeField+               , label "Password" @@=+                   editPasswordField password PasswordField+               , label "Dominant hand" @@=+                   radioField handed [ (LeftHanded, LeftHandField, "Left")+                                     , (RightHanded, RightHandField, "Right")+                                     , (Ambidextrous, AmbiField, "Both")+                                     ]+               , label "" @@=+                   checkboxField ridesBike BikeField "Do you ride a bicycle?"+               ]++theMap :: AttrMap+theMap = attrMap V.defAttr+  [ (E.editAttr, V.white `on` V.black)+  , (E.editFocusedAttr, V.black `on` V.yellow)+  , (invalidFormInputAttr, V.white `on` V.red)+  , (focusedFormInputAttr, V.black `on` V.yellow)+  ]++draw :: Form UserInfo e Name -> [Widget Name]+draw f = [C.vCenter $ C.hCenter form <=> C.hCenter help]+    where+        form = B.border $ padTop (Pad 1) $ hLimit 50 $ renderForm f+        help = padTop (Pad 1) $ B.borderWithLabel (str "Help") body+        body = str $ "- Name is free-form text\n" <>+                     "- Age must be an integer (try entering an\n" <>+                     "  invalid age!)\n" <>+                     "- Handedness selects from a list of options\n" <>+                     "- The last option is a checkbox\n" <>+                     "- Enter/Esc quit, mouse interacts with fields"++app :: App (Form UserInfo e Name) e Name+app =+    App { appDraw = draw+        , appHandleEvent = \ev -> do+            f <- gets formFocus+            case ev of+                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 f /= Just AddressField -> halt+                _ -> do+                    handleFormEvent ev++                    -- Example of external validation:+                    -- Require age field to contain a value that is at least 18.+                    st <- gets formState+                    modify $ setFieldValid (st^.age >= 18) AgeField++        , appChooseCursor = focusRingCursor formFocus+        , appStartEvent = return ()+        , appAttrMap = const theMap+        }++main :: IO ()+main = do+    let buildVty = do+          v <- mkVty V.defaultConfig+          V.setMode (V.outputIface v) V.Mouse True+          return v++        initialUserInfo = UserInfo { _name = ""+                                   , _address = ""+                                   , _age = 0+                                   , _handed = RightHanded+                                   , _ridesBike = False+                                   , _password = ""+                                   }+        f = setFieldValid False AgeField $+            mkForm initialUserInfo++    initialVty <- buildVty+    f' <- customMain initialVty buildVty Nothing app f++    putStrLn "The starting form state was:"+    print initialUserInfo++    putStrLn "The final form state was:"+    print $ formState f'++    if allFieldsValid f'+       then putStrLn "The final form inputs were valid."+       else putStrLn $ "The final form had invalid inputs: " <> show (invalidFields f')
programs/LayerDemo.hs view
@@ -1,80 +1,108 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Main where -import Lens.Micro ((^.), (&), (%~))+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void) import qualified Graphics.Vty as V  import qualified Brick.Types as T-import Brick.Types (locationRowL, locationColumnL, Widget)+import Brick.Types (locationRowL, locationColumnL, Location(..), Widget) import qualified Brick.Main as M import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Center as C import Brick.Widgets.Core   ( translateBy   , str+  , relativeTo+  , reportExtent+  , withDefAttr   )+import Brick.Util (fg) import Brick.AttrMap   ( attrMap+  , AttrName+  , attrName   )  data St =-    St { _topLayerLocation :: T.Location+    St { _middleLayerLocation :: T.Location        , _bottomLayerLocation :: T.Location        }  makeLenses ''St -drawUi :: St -> [Widget ()]+data Name =+    MiddleLayerElement+    deriving (Ord, Eq, Show)++drawUi :: St -> [Widget Name] drawUi st =     [ C.centerLayer $       B.border $ str "This layer is centered but other\nlayers are placed underneath it."-    , topLayer st-    , bottomLayer st+    , arrowLayer+    , middleLayer (st^.middleLayerLocation)+    , bottomLayer (st^.bottomLayerLocation)     ] -topLayer :: St -> Widget ()-topLayer st =-    translateBy (st^.topLayerLocation) $-    B.border $ str "Top layer\n(Arrow keys move)"+arrowLayer :: Widget Name+arrowLayer =+    let msg = "Relatively\n" <>+              "positioned\n" <>+              "arrow---->"+    in relativeTo MiddleLayerElement (Location (-10, -2)) $+       withDefAttr arrowAttr $+       str msg -bottomLayer :: St -> Widget ()-bottomLayer st =-    translateBy (st^.bottomLayerLocation) $+middleLayer :: Location -> Widget Name+middleLayer l =+    translateBy l $+    reportExtent MiddleLayerElement $+    B.border $ str "Middle layer\n(Arrow keys move)"++bottomLayer :: Location -> Widget Name+bottomLayer l =+    translateBy l $     B.border $ str "Bottom layer\n(Ctrl-arrow keys move)" -appEvent :: St -> T.BrickEvent () e -> T.EventM () (T.Next St)-appEvent st (T.VtyEvent (V.EvKey V.KDown []))  =-    M.continue $ st & topLayerLocation.locationRowL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp []))    =-    M.continue $ st & topLayerLocation.locationRowL %~ (subtract 1)-appEvent st (T.VtyEvent (V.EvKey V.KRight [])) =-    M.continue $ st & topLayerLocation.locationColumnL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft []))  =-    M.continue $ st & topLayerLocation.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 () -app :: M.App St e ()+arrowAttr :: AttrName+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 []+          , M.appAttrMap = const $ attrMap V.defAttr [(arrowAttr, fg V.cyan)]           , M.appChooseCursor = M.neverShowCursor           }  main :: IO ()-main = void $ M.defaultMain app $ St (T.Location (0, 0)) (T.Location (0, 0))+main = void $ M.defaultMain app $ St (T.Location (20, 5)) (T.Location (0, 0))
programs/ListDemo.hs view
@@ -1,9 +1,13 @@-{-# 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 import Data.Maybe (fromMaybe) import qualified Graphics.Vty as V @@ -45,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 =@@ -77,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@@ -91,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           }
+ programs/ListViDemo.hs view
@@ -0,0 +1,96 @@+{-# 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+import Brick.Types (Widget)+import qualified Brick.Types as T+import Brick.Util (fg, on)+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C+import Brick.Widgets.Core (hLimit, str, vBox, vLimit, withAttr, (<+>))+import qualified Brick.Widgets.List as L+import qualified Data.Vector as Vec++drawUI :: (Show a) => L.List () a -> [Widget ()]+drawUI l = [ui]+    where+        label = str "Item " <+> cur <+> str " of " <+> total+        cur = case l^.(L.listSelectedL) of+                Nothing -> str "-"+                Just i  -> str (show (i + 1))+        total = str $ show $ Vec.length $ l^.(L.listElementsL)+        box = B.borderWithLabel label $+              hLimit 25 $+              vLimit 15 $+              L.renderList listDrawElement True l+        ui = C.vCenter $ vBox [ C.hCenter box+                              , str " "+                              , C.hCenter $ str "Press +/- to add/remove list elements."+                              , C.hCenter $ str "Press Esc to exit."+                              ]++appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent (T.VtyEvent e) =+    case e of+        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 '-') [] -> do+            sel <- use L.listSelectedL+            case sel of+                Nothing -> return ()+                Just i  -> modify $ L.listRemove i++        V.EvKey V.KEsc [] -> M.halt++        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 _ = return ()++listDrawElement :: (Show a) => Bool -> a -> Widget ()+listDrawElement sel a =+    let selStr s = if sel+                   then withAttr customAttr (str $ "<" <> s <> ">")+                   else str s+    in C.hCenter $ str "Item " <+> (selStr $ show a)++initialState :: L.List () Char+initialState = L.list () (Vec.fromList ['a','b','c']) 1++customAttr :: A.AttrName+customAttr = L.listSelectedAttr <> A.attrName "custom"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (L.listAttr,            V.white `on` V.blue)+    , (L.listSelectedAttr,    V.blue `on` V.white)+    , (customAttr,            fg V.cyan)+    ]++theApp :: M.App (L.List () Char) e ()+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = M.showFirstCursor+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = void $ M.defaultMain theApp initialState
− programs/MarkupDemo.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main where--import Data.Monoid ((<>))-import qualified Graphics.Vty as V--import Brick.Main (App(..), defaultMain, resizeOrQuit, neverShowCursor)-import Brick.Types-  ( Widget-  , Padding(..)-  )-import Brick.Widgets.Core-  ( (<=>)-  , (<+>)-  , padLeft-  )-import Brick.Util (on, fg)-import Brick.Markup (markup, (@?))-import Brick.AttrMap (attrMap, AttrMap)-import Data.Text.Markup ((@@))--ui :: Widget ()-ui = (m1 <=> m2) <+> (padLeft (Pad 1) m3)-    where-        m1 = markup $ ("Hello" @@ fg V.blue) <> ", " <> ("world!" @@ fg V.red)-        m2 = markup $ ("Hello" @? "keyword1") <> ", " <> ("world!" @? "keyword2")-        m3 = markup $ ("Hello," @? "keyword1") <> "\n" <> ("world!" @? "keyword2")--theMap :: AttrMap-theMap = attrMap V.defAttr-    [ ("keyword1",      fg V.magenta)-    , ("keyword2",      V.white `on` V.blue)-    ]--app :: App () e ()-app =-    App { appDraw = const [ui]-        , appHandleEvent = resizeOrQuit-        , appAttrMap = const theMap-        , appStartEvent = return-        , appChooseCursor = neverShowCursor-        }--main :: IO ()-main = defaultMain app ()
programs/MouseDemo.hs view
@@ -1,12 +1,15 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Main where -import Control.Applicative ((<$>))-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 import qualified Graphics.Vty as V  import qualified Brick.Types as T@@ -18,8 +21,6 @@ import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B import Brick.Widgets.Core-import Data.Text.Zipper (moveCursor)-import Data.Tuple (swap)  data Name = Info | Button1 | Button2 | Button3 | Prose | TextBox           deriving (Show, Ord, Eq)@@ -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 True (st^.edit))+      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@@ -67,11 +68,7 @@   B.border $   C.hCenterLayer $   vLimit 8 $-  -- n.b. if clickable and viewport are inverted here, click event-  -- coordinates will only identify the viewable range, not the actual-  -- editor widget coordinates.   viewport Prose Vertical $-  clickable Prose $   vBox $ map str $ lines (st^.prose)  infoLayer :: St -> Widget Name@@ -79,38 +76,46 @@     c <- T.getContext     let h = c^.T.availHeightL         msg = case st^.lastReportedClick of-                Nothing -> "nothing"-                Just (name, T.Location l) -> show name <> " at " <> show l+                Nothing ->+                    "Click and hold/drag to report a mouse click"+                Just (name, T.Location l) ->+                    "Mouse down at " <> show name <> " @ " <> show l     T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $-               withDefAttr "info" $-               C.hCenter (str ("Last reported click: " <> msg))+               withDefAttr (attrName "info") $+               C.hCenter $ str msg -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.MouseDown n _ _ loc) = do-    let T.Location pos = loc-    M.continue $ st & lastReportedClick .~ Just (n, loc)-                    & edit %~ E.applyEdit (if n == TextBox then moveCursor (swap pos) else id)-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 (T.VtyEvent ev) = M.continue =<< T.handleEventLensed st edit E.handleEditorEvent ev-appEvent st _ = M.continue st+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@@ -118,29 +123,25 @@  main :: IO () main = do-    let buildVty = do-          v <- V.mkVty =<< V.standardIOConfig-          V.setMode (V.outputIface v) V.Mouse True-          return v--    void $ M.customMain buildVty Nothing app $ St [] Nothing-           "Press Ctrl-up and Ctrl-down arrow keys to scroll, ESC to quit.\n\-           \Observe the click coordinates identify the\n\-           \underlying widget coordinates.\n\-           \\n\-           \Lorem ipsum dolor sit amet,\n\-           \consectetur adipiscing elit,\n\-           \sed do eiusmod tempor incididunt ut labore\n\-           \et dolore magna aliqua.\n\-           \ \n\-           \Ut enim ad minim veniam\n\-           \quis nostrud exercitation ullamco laboris\n\-           \nisi ut aliquip ex ea commodo consequat.\n\-           \\n\-           \Duis aute irure dolor in reprehenderit\n\-           \in voluptate velit esse cillum dolore eu fugiat nulla pariatur.\n\-           \\n\-           \Excepteur sint occaecat cupidatat not proident,\n\-           \sunt in culpa qui officia deserunt mollit\n\-           \anim id est laborum.\n"-           (E.editor TextBox (str . unlines) Nothing "")+    void $ M.defaultMain app $ St [] Nothing+           (unlines [ "Try clicking on various UI elements."+                    , "Observe that the click coordinates identify the"+                    , "underlying widget coordinates."+                    , ""+                    , "Lorem ipsum dolor sit amet,"+                    , "consectetur adipiscing elit,"+                    , "sed do eiusmod tempor incididunt ut labore"+                    , "et dolore magna aliqua."+                    , ""+                    , "Ut enim ad minim veniam"+                    , "quis nostrud exercitation ullamco laboris"+                    , "isi ut aliquip ex ea commodo consequat."+                    , ""+                    , "Duis aute irure dolor in reprehenderit"+                    , "in voluptate velit esse cillum dolore eu fugiat nulla pariatur."+                    , ""+                    , "Excepteur sint occaecat cupidatat not proident,"+                    , "sunt in culpa qui officia deserunt mollit"+                    , "anim id est laborum."+                    ])+           (E.editor TextBox Nothing "")
programs/PaddingDemo.hs view
@@ -4,7 +4,6 @@ import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain) import Brick.Types   ( Widget-  , Padding(..)   ) import Brick.Widgets.Core   ( vBox@@ -17,22 +16,23 @@   , padBottom   , padTopBottom   , padLeftRight+  , Padding(..)   )-import Brick.Widgets.Border as B-import Brick.Widgets.Center as C+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C import Brick.AttrMap (attrMap) import qualified Graphics.Vty as V  ui :: Widget () ui =-    vBox [ hBox [ padLeft Max $ vCenter $ str "Left-padded"+    vBox [ hBox [ padLeft Max $ C.vCenter $ str "Left-padded"                 , B.vBorder-                , padRight Max $ vCenter $ str "Right-padded"+                , padRight Max $ C.vCenter $ str "Right-padded"                 ]          , B.hBorder-         , hBox [ padTop Max $ hCenter $ str "Top-padded"+         , hBox [ padTop Max $ C.hCenter $ str "Top-padded"                 , B.vBorder-                , padBottom Max $ hCenter $ str "Bottom-padded"+                , padBottom Max $ C.hCenter $ str "Bottom-padded"                 ]          , B.hBorder          , hBox [ padLeftRight 2 $ str "Padded by 2 on left/right"@@ -49,7 +49,7 @@ app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         , appChooseCursor = neverShowCursor         }
programs/ProgressBarDemo.hs view
@@ -1,9 +1,15 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} module Main where  import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0)) 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@@ -15,13 +21,16 @@ import Brick.Widgets.Core   ( (<+>), (<=>)   , str+  , strWrap   , updateAttrMap   , overrideAttr   ) import Brick.Util (fg, bg, on, clamp) -data MyAppState n = MyAppState { x, y, z :: Float }+data MyAppState n = MyAppState { _x, _y, _z :: Float, _showLabel :: Bool } +makeLenses ''MyAppState+ drawUI :: MyAppState () -> [Widget ()] drawUI p = [ui]     where@@ -30,37 +39,62 @@              (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-      lbl c = Just $ show $ fromEnum $ c * 100+             bar $ _z p+      -- custom bars+      cBar1 = overrideAttr P.progressCompleteAttr cDoneAttr1 $+              overrideAttr P.progressIncompleteAttr cToDoAttr1+              $ bar' '▰' '▱' $ _x p+      cBar2 = overrideAttr P.progressCompleteAttr cDoneAttr2 $+              overrideAttr P.progressIncompleteAttr cToDoAttr2+              $ bar' '|' '─' $ _y p+      cBar3 = overrideAttr P.progressCompleteAttr cDoneAttr $+              overrideAttr P.progressIncompleteAttr cToDoAttr+              $ bar' '⣿' '⠶' $ _z p+      lbl c = if _showLabel p+              then Just $ " " ++ (show $ fromEnum $ c * 100) ++ " "+              else Nothing       bar v = P.progressBar (lbl v) v+      bar' cc ic v = P.customProgressBar cc ic (lbl v) v       ui = (str "X: " <+> xBar) <=>            (str "Y: " <+> yBar) <=>            (str "Z: " <+> zBar) <=>+           (str "X: " <+> cBar1) <=>+           (str "Y: " <+> cBar2) <=>+           (str "Z: " <+> cBar3) <=>            str "" <=>-           str "Hit 'x', 'y', or 'z' to advance progress, or 'q' to quit"+           (strWrap $ concat [ "Hit 'x', 'y', or 'z' to advance progress,"+                             , "'t' to toggle labels, 'r' to revert values, "+                             , "'Ctrl + r' to reset values 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 't') [] -> showLabel %= not+         V.EvKey (V.KChar 'r') [V.MCtrl] -> do+           x .= 0+           y .= 0+           z .= 0+         V.EvKey (V.KChar 'r') [] -> T.put initialState+         V.EvKey (V.KChar 'q') [] -> M.halt+         _ -> return ()+appEvent _ = return ()  initialState :: MyAppState ()-initialState = MyAppState 0.25 0.18 0.63+initialState = MyAppState 0.25 0.18 0.63 True  theBaseAttr :: A.AttrName theBaseAttr = A.attrName "theBase"@@ -77,6 +111,18 @@ zDoneAttr = theBaseAttr <> A.attrName "Z:done" zToDoAttr = theBaseAttr <> A.attrName "Z:remaining" +cDoneAttr, cToDoAttr :: A.AttrName+cDoneAttr = A.attrName "C:done"+cToDoAttr = A.attrName "C:remaining"++cDoneAttr1, cToDoAttr1 :: A.AttrName+cDoneAttr1 = A.attrName "C1:done"+cToDoAttr1 = A.attrName "C1:remaining"++cDoneAttr2, cToDoAttr2 :: A.AttrName+cDoneAttr2 = A.attrName "C2:done"+cToDoAttr2 = A.attrName "C2:remaining"+ theMap :: A.AttrMap theMap = A.attrMap V.defAttr          [ (theBaseAttr,               bg V.brightBlack)@@ -85,6 +131,12 @@          , (yDoneAttr,                 V.magenta `on` V.yellow)          , (zDoneAttr,                 V.blue `on` V.green)          , (zToDoAttr,                 V.blue `on` V.red)+         , (cDoneAttr,                 fg V.blue)+         , (cToDoAttr,                 fg V.blue)+         , (cDoneAttr1,                fg V.red)+         , (cToDoAttr1,                fg V.brightWhite)+         , (cDoneAttr2,                fg V.green)+         , (cToDoAttr2,                fg V.brightGreen)          , (P.progressIncompleteAttr,  fg V.yellow)          ] @@ -93,7 +145,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
programs/ReadmeDemo.hs view
@@ -1,12 +1,13 @@ module Main where -import Brick-import Brick.Widgets.Center-import Brick.Widgets.Border-import Brick.Widgets.Border.Style+import Brick (Widget, simpleMain, (<+>), str, withBorderStyle, joinBorders)+import Brick.Widgets.Center (center)+import Brick.Widgets.Border (borderWithLabel, vBorder)+import Brick.Widgets.Border.Style (unicode)  ui :: Widget () ui =+    joinBorders $     withBorderStyle unicode $     borderWithLabel (str "Hello!") $     (center (str "Left") <+> vBorder <+> center (str "Right"))
programs/SuspendAndResumeDemo.hs view
@@ -1,16 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# 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)) import Data.Monoid+#endif import qualified Graphics.Vty as V  import Brick.Main   ( App(..), neverShowCursor, defaultMain-  , suspendAndResume, halt, continue+  , suspendAndResume, halt   ) import Brick.AttrMap   ( attrMap@@ -18,7 +21,6 @@ import Brick.Types   ( Widget   , EventM-  , Next   , BrickEvent(..)   ) import Brick.Widgets.Core@@ -39,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 =@@ -60,7 +62,7 @@     App { appDraw = drawUI         , appChooseCursor = neverShowCursor         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         }
+ programs/TableDemo.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+module Main where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Brick+import Brick.Widgets.Table+import Brick.Widgets.Center (center)++ui :: Widget ()+ui = center $ renderTable leftTable <+>+              padLeft (Pad 5) (renderTable rightTableA <=>+                               renderTable rightTableB <=>+                               renderTable rightTableC)++innerTable :: Table ()+innerTable =+    surroundingBorder False $+    table [ [txt "inner", txt "table"]+          , [txt "is",    txt "here"]+          ]++leftTable :: Table ()+leftTable =+    alignCenter 1 $+    alignRight 2 $+    alignMiddle 2 $+    table [ [txt "Left",             txt "Center",      txt "Right"]+          , [txt "X",                txt "Some things", txt "A"]+          , [renderTable innerTable, txt "are",         txt "B"]+          , [txt "Z",                txt "centered",    txt "C"]+          ]++rightTableA :: Table ()+rightTableA =+    rowBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",     txt "without"]+          , [txt "table", txt "row borders"]+          ]++rightTableB :: Table ()+rightTableB =+    columnBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",       txt "table"]+          , [txt "without", txt "column borders"]+          ]++rightTableC :: Table ()+rightTableC =+    surroundingBorder False $+    rowBorders False $+    columnBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",       txt "table"]+          , [txt "without", txt "any borders"]+          ]++main :: IO ()+main = simpleMain ui
+ programs/TabularListDemo.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.Mtl+import Lens.Micro.TH+import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V++import qualified Brick.Main as M+import qualified Brick.Types as T+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.List as L+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Table as Table+import qualified Brick.AttrMap as A+import qualified Data.Vector as Vec+import Brick.Types+  ( Widget+  )+import Brick.Widgets.Core+  ( (<=>)+  , str+  , vLimit+  , hLimit+  , vBox+  , hBox+  , withDefAttr+  )+import Brick.Util (on)++data Row = Row String String String++data AppState =+    AppState { _tabularList :: L.List () Row+             , _colIndex :: Int+             }++makeLenses ''AppState++drawUI :: AppState -> [Widget ()]+drawUI s = [ui]+    where+        l = s^.tabularList+        label = str $ "Row " <> cur <> " / col " <> show (s^.colIndex + 1)+        cur = case l^.(L.listSelectedL) of+                Nothing -> "-"+                Just i -> show (i + 1)+        box = B.borderWithLabel label $+              hLimit totalWidth $+              vLimit 15 $+              listDrawElement 0 False headerRow <=>+              L.renderList (listDrawElement (s^.colIndex)) True l+        ui = C.vCenter $ vBox [ C.hCenter box+                              , str " "+                              , C.hCenter $ str "Press +/- to add/remove list elements."+                              , C.hCenter $ str "Use arrow keys to change selection."+                              , C.hCenter $ str "Press Esc to exit."+                              ]++appEvent :: T.BrickEvent () e -> T.EventM () AppState ()+appEvent (T.VtyEvent e) =+    case e of+        V.EvKey (V.KChar '+') [] -> do+            els <- use (tabularList.L.listElementsL)+            let el = Row (show pos) (show $ pos * 3) (show $ pos * 9)+                pos = Vec.length els+            tabularList %= L.listInsert pos el++        V.EvKey (V.KChar '-') [] -> do+            sel <- use (tabularList.L.listSelectedL)+            case sel of+                Nothing -> return ()+                Just i -> tabularList %= L.listRemove i++        V.EvKey V.KLeft [] ->+            colIndex %= (\i -> max 0 (i - 1))+        V.EvKey V.KRight [] ->+            colIndex %= (\i -> min (length columnAlignments - 1) (i + 1))++        V.EvKey V.KEsc [] -> M.halt++        ev -> T.zoom tabularList $ L.handleListEvent ev+appEvent _ = return ()++listDrawElement :: Int -> Bool -> Row -> Widget ()+listDrawElement colIdx sel (Row a b c) =+    let ws = [str a, str b, str c]+        maybeSelect es = selectCell <$> zip [0..] es+        selectCell (i, w) = if sel && i == colIdx+                            then withDefAttr selectedCellAttr w+                            else w+    in hLimit totalWidth $+       hBox $+       maybeSelect $+       Table.alignColumns columnAlignments columnWidths ws++initialState :: AppState+initialState =+    AppState { _tabularList = L.list () (Vec.fromList initialRows) 1+             , _colIndex = 0+             }++selectedCellAttr :: A.AttrName+selectedCellAttr = A.attrName "selectedCell"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (L.listAttr,            V.white `on` V.blue)+    , (selectedCellAttr,      V.blue `on` V.white)+    ]++columnWidths :: [Int]+columnWidths = [10, 15, 20]++totalWidth :: Int+totalWidth = sum columnWidths++headerRow :: Row+headerRow = Row "Col 1" "Col 2" "Col 3"++columnAlignments :: [Table.ColumnAlignment]+columnAlignments = [Table.AlignLeft, Table.AlignCenter, Table.AlignRight]++initialRows :: [Row]+initialRows =+    [ Row "one" "two" "three"+    , Row "foo" "bar" "baz"+    , Row "stuff" "things" "blah"+    ]++theApp :: M.App AppState e ()+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = M.showFirstCursor+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = void $ M.defaultMain theApp initialState
+ programs/TailDemo.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+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+import Brick.BChan+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++header :: AppState -> Widget n+header st =+    padBottom (Pad 1) $+    hBox [ padRight (Pad 7) $+           (str $ "Max width: " <> show (_textAreaWidth st)) <=>+           (str "Left(-)/Right(+)")+         , (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))++-- | 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+-- bottom of the rendering area. Rendering stops when the rendering area+-- is full, i.e., items that cannot be rendered are never evaluated or+-- drawn.+renderBottomUp :: [Widget n] -> Widget n+renderBottomUp ws =+    Widget Greedy Greedy $ do+        let go _ [] = return V.emptyImage+            go remainingHeight (c:cs) = do+                cResult <- render c+                let img = image cResult+                    newRemainingHeight = remainingHeight - V.imageHeight img+                if newRemainingHeight == 0+                   then return img+                   else if newRemainingHeight < 0+                        then return $ V.cropTop remainingHeight img+                        else do+                            rest <- go newRemainingHeight cs+                            return $ V.vertCat [rest, img]++        ctx <- getContext+        img <- go (availHeight ctx) ws+        render $ fill ' ' <=> raw img++textLines :: [T.Text]+textLines =+    [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut"+    , "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco"+    , "laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit"+    , "in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat"+    , "cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."+    ]++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++app :: App AppState CustomEvent ()+app =+    App { appDraw = (:[]) . draw+        , appChooseCursor = neverShowCursor+        , appHandleEvent = handleEvent+        , appAttrMap = const $ attrMap V.defAttr []+        , appStartEvent = return ()+        }++initialState :: AppState+initialState =+    AppState { _textAreaHeight = 20+             , _textAreaWidth = 40+             , _textAreaContents = []+             }++-- | Run forever, generating new lines of text for the application+-- window, prefixed with a line number. This function simulates the kind+-- of behavior that you'd get from running 'tail -f' on a file.+generateLines :: BChan CustomEvent -> IO ()+generateLines chan = go (1::Integer)+    where+        go lineNum = do+            -- Wait a random amount of time (in milliseconds)+            let delayOptions = [500, 1000, 2000]+            delay <- randomVal delayOptions+            threadDelay $ delay * 1000++            -- Choose a random line of text from our collection+            l <- randomVal textLines++            -- Send it to the application to be added to the UI+            writeBChan chan $ NewLine $ (T.pack $ "Line " <> show lineNum <> " - ") <> l++            go $ lineNum + 1++randomVal :: [a] -> IO a+randomVal as = do+    idx <- randomRIO (0, length as - 1)+    return $ as !! idx++main :: IO ()+main = do+    chan <- newBChan 10++    -- Run thread to simulate incoming data+    void $ forkIO $ generateLines chan++    (_, vty) <- customMainWithDefaultVty (Just chan) app initialState+    V.shutdown vty
+ programs/TextWrapDemo.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE CPP #-}+module Main where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Brick+import Text.Wrap (defaultWrapSettings, preserveIndentation)++ui :: Widget ()+ui =+    t1 <=> (padTop (Pad 1) t2)+    where+      t1 = strWrap $ "Hello, world! This line is long enough that " <>+                     "it's likely to wrap on your terminal if your window " <>+                     "isn't especially wide. Try narrowing and widening " <>+                     "the window to see what happens to this text."+      settings = defaultWrapSettings { preserveIndentation = True }+      t2 = strWrapWith settings $+          "This text wraps\n" <>+          "   with different settings to preserve indentation\n" <>+          "   so that long lines wrap in nicer way."++main :: IO ()+main = simpleMain ui
+ programs/ThemeDemo.hs view
@@ -0,0 +1,86 @@+module Main where++import Control.Monad (void)+import Control.Monad.State (put)+import Graphics.Vty+  ( white, blue, green, yellow, black, magenta+  , Event(EvKey)+  , Key(KChar, KEsc)+  )++import Brick.Main+import Brick.Themes+  ( Theme+  , newTheme+  , themeToAttrMap+  )+import Brick.Types+  ( Widget+  , BrickEvent(VtyEvent)+  , EventM+  )+import Brick.Widgets.Center+  ( hCenter+  , center+  )+import Brick.Widgets.Core+  ( (<+>)+  , vBox+  , str+  , hLimit+  , withDefAttr+  )+import Brick.Util (on, fg)+import Brick.AttrMap (AttrName, attrName)++ui :: Widget n+ui =+    center $+    hLimit 40 $+    vBox $ hCenter <$>+         [ str "Press " <+> (withDefAttr keybindingAttr $ str "1") <+> str " to switch to theme 1."+         , str "Press " <+> (withDefAttr keybindingAttr $ str "2") <+> str " to switch to theme 2."+         ]++keybindingAttr :: AttrName+keybindingAttr = attrName "keybinding"++theme1 :: Theme+theme1 =+    newTheme (white `on` blue)+             [ (keybindingAttr, fg magenta)+             ]++theme2 :: Theme+theme2 =+    newTheme (green `on` black)+             [ (keybindingAttr, fg yellow)+             ]++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 ()+        , appAttrMap = \s ->+            -- Note that in practice this is not ideal: we don't want+            -- to build an attribute map from a theme every time this is+            -- invoked, because it gets invoked once per redraw. Instead+            -- we'd build the attribute map at startup and store it in+            -- the application state. Here I just use themeToAttrMap to+            -- show the mechanics of the API.+            themeToAttrMap $ if s == 1+                             then theme1+                             else theme2+        , appChooseCursor = neverShowCursor+        }++main :: IO ()+main = void $ defaultMain app 1
programs/ViewportScrollDemo.hs view
@@ -1,12 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))+#endif import qualified Graphics.Vty as V  import qualified Brick.Types as T@@ -60,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
+ programs/ViewportScrollbarsDemo.hs view
@@ -0,0 +1,176 @@+{-# 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 ((<>))+#endif+import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import qualified Brick.Types as T+import qualified Brick.Main as M+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Border as B+import Brick.Types+  ( Widget+  , ViewportType(Horizontal, Both)+  , VScrollBarOrientation(..)+  , HScrollBarOrientation(..)+  )+import Brick.Util+  ( fg+  )+import Brick.AttrMap+  ( AttrMap+  , attrMap+  )+import Brick.Widgets.Core+  ( Padding(..)+  , hLimit+  , vLimit+  , padRight+  , hBox+  , vBox+  , viewport+  , str+  , fill+  , withVScrollBars+  , withHScrollBars+  , withHScrollBarRenderer+  , withVScrollBarRenderer+  , withVScrollBarHandles+  , withHScrollBarHandles+  , withClickableHScrollBars+  , withClickableVScrollBars+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , scrollbarAttr+  , scrollbarHandleAttr+  )++customHScrollbars :: HScrollbarRenderer n+customHScrollbars =+    HScrollbarRenderer { renderHScrollbar = vLimit 1 $ fill '^'+                       , renderHScrollbarTrough = vLimit 1 $ fill ' '+                       , renderHScrollbarHandleBefore = str "<<"+                       , renderHScrollbarHandleAfter = str ">>"+                       , scrollbarHeightAllocation = 2+                       }++customVScrollbars :: VScrollbarRenderer n+customVScrollbars =+    VScrollbarRenderer { renderVScrollbar = C.hCenter $ hLimit 1 $ fill '*'+                       , renderVScrollbarTrough = fill ' '+                       , renderVScrollbarHandleBefore = C.hCenter $ str "-^-"+                       , renderVScrollbarHandleAfter = C.hCenter $ str "-v-"+                       , scrollbarWidthAllocation = 5+                       }++data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name+          deriving (Ord, Show, Eq)++data St = St { _lastClickedElement :: Maybe (T.ClickableScrollbarElement, Name) }++makeLenses ''St++drawUi :: St -> [Widget Name]+drawUi st = [ui]+    where+        ui = C.center $ hLimit 80 $ vLimit 21 $+             (vBox [ pair+                   , C.hCenter (str "Last clicked scroll bar element:")+                   , str $ show $ _lastClickedElement st+                   ])+        pair = hBox [ padRight (Pad 5) $+                      B.border $+                      withClickableHScrollBars SBClick $+                      withHScrollBars OnBottom $+                      withHScrollBarRenderer customHScrollbars $+                      withHScrollBarHandles $+                      viewport VP1 Horizontal $+                      str $ "Press left and right arrow keys to scroll this viewport.\n" <>+                            "This viewport uses a\n" <>+                            "custom scroll bar renderer!"+                    , B.border $+                      withClickableVScrollBars SBClick $+                      withVScrollBars OnLeft $+                      withVScrollBarRenderer customVScrollbars $+                      withVScrollBarHandles $+                      viewport VP2 Both $+                      vBox $+                      (str $ unlines $+                       [ "Press up and down arrow keys to"+                       , "scroll this viewport vertically."+                       , "This viewport uses a custom"+                       , "scroll bar renderer with"+                       , "a larger space allocation and"+                       , "even more fancy rendering."+                       ])+                      : (str <$> [ "Line " <> show i | i <- [2..55::Int] ])+                    ]++vp1Scroll :: M.ViewportScroll Name+vp1Scroll = M.viewportScroll VP1++vp2Scroll :: M.ViewportScroll Name+vp2Scroll = M.viewportScroll VP2++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+    lastClickedElement .= Just (el, n)+    case n of+        VP1 -> do+            let vp = M.viewportScroll VP1+            case el of+                T.SBHandleBefore -> M.hScrollBy vp (-1)+                T.SBHandleAfter  -> M.hScrollBy vp 1+                T.SBTroughBefore -> M.hScrollBy vp (-10)+                T.SBTroughAfter  -> M.hScrollBy vp 10+                T.SBBar          -> return ()+        VP2 -> do+            let vp = M.viewportScroll VP2+            case el of+                T.SBHandleBefore -> M.vScrollBy vp (-1)+                T.SBHandleAfter  -> M.vScrollBy vp 1+                T.SBTroughBefore -> M.vScrollBy vp (-10)+                T.SBTroughAfter  -> M.vScrollBy vp 10+                T.SBBar          -> return ()+        _ ->+            return ()+appEvent _ = return ()++theme :: AttrMap+theme =+    attrMap V.defAttr+    [ (scrollbarAttr,       fg V.white)+    , (scrollbarHandleAttr, fg V.brightYellow)+    ]++app :: M.App St e Name+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = return ()+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const theme+          , M.appChooseCursor = M.neverShowCursor+          }++main :: IO ()+main = do+    let buildVty = do+          v <- mkVty V.defaultConfig+          V.setMode (V.outputIface v) V.Mouse True+          return v++    initialVty <- buildVty+    void $ M.customMain initialVty buildVty Nothing app (St Nothing)
programs/VisibilityDemo.hs view
@@ -1,18 +1,21 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} module Main where  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 import qualified Graphics.Vty as V  import qualified Brick.Types as T 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@@ -52,7 +55,7 @@ vp3Size = (25, 25)  selectedAttr :: AttrName-selectedAttr = "selected"+selectedAttr = attrName "selected"  drawUi :: St -> [Widget Name] drawUi st = [ui]@@ -99,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@@ -119,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
+ programs/custom_keys.ini view
@@ -0,0 +1,4 @@+[keybindings]+quit = x+increment = i+decrement = d
src/Brick.hs view
@@ -1,5 +1,11 @@ -- | This module is provided as a convenience to import the most--- important parts of the API all at once.+-- important parts of the API all at once. If you are new to Brick and+-- are looking to learn it, the best place to start is the+-- [Brick User Guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst).+-- The README also has links to other learning resources. Unlike+-- most Haskell libraries that only have API documentation, Brick+-- is best learned by reading the User Guide and other materials and+-- referring to the API docs only as needed. Enjoy! module Brick   ( module Brick.Main   , module Brick.Types
+ src/Brick/Animation.hs view
@@ -0,0 +1,588 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+-- | This module provides some infrastructure for adding animations to+-- Brick applications. See @programs/AnimationDemo.hs@ for a complete+-- working example of this API.+--+-- At a high level, this works as follows:+--+-- This module provides a threaded animation manager that manages a set+-- of running animations. The application creates the manager and starts+-- animations, which automatically loop or run once, depending on their+-- configuration. Each animation has some state in the application's+-- state that is automatically managed by the animation manager using a+-- lens-based API. Whenever animations need to be redrawn, the animation+-- manager sends a custom event with a state update to the application,+-- which must be evaluated by the main event loop to update animation+-- states. Each animation is associated with a 'Clip' -- sequence of+-- frames -- which may be static or may be built from the application+-- state at rendering time.+--+-- To use this module:+--+-- * Use a custom event type @e@ in your 'Brick.Main.App' and give the+--   event type a constructor @EventM n s () -> e@ (where @s@ and+--   @n@ are those in @App s e n@). This will require the use of+--   'Brick.Main.customMain' and will also require the creation of a+--   'Brick.BChan.BChan' for custom events.+--+-- * Add an 'AnimationManager' field to the application state @s@.+--+-- * Create an 'AnimationManager' at startup with+--   'startAnimationManager', providing the custom event constructor and+--   'BChan' created above. Store the manager in the application state.+--+-- * For each animation you want to run at any given time, add a field+--   to the application state of type @Maybe (Animation s n)@,+--   initialized to 'Nothing'. A value of 'Nothing' indicates that the+--   animation is not running.+--+-- * Ensure that each animation state field in @s@ has a lens, usually+--   by using 'Lens.Micro.TH.makeLenses'.+--+-- * Start new animations in 'EventM' with 'startAnimation'; stop them+--   with 'stopAnimation'. Supply clips for new animations with+--   'newClip', 'newClip_', and the clip transformation functions.+--+-- * Call 'renderAnimation' in 'Brick.Main.appDraw' for each animation in the+--   application state.+--+-- * If needed, stop the animation manager with 'stopAnimationManager'.+--+-- See 'AnimationManager' and the docs for the rest of this module for+-- details.+module Brick.Animation+  ( -- * Animation managers+    AnimationManager+  , startAnimationManager+  , stopAnimationManager+  , minTickTime++  -- * Animations+  , Animation+  , animationFrameIndex++  -- * Starting and stopping animations+  , RunMode(..)+  , startAnimation+  , stopAnimation++  -- * Rendering animations+  , renderAnimation++  -- * Creating clips+  , Clip+  , newClip+  , newClip_+  , clipLength++  -- * Transforming clips+  , pingPongClip+  , reverseClip+  )+where++import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread, myThreadId)+import qualified Control.Concurrent.STM as STM+import Control.Monad (forever, when)+import Control.Monad.State.Strict+import Data.Foldable (foldrM)+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+import qualified Data.Vector as V+import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just)+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl++import Brick.BChan+import Brick.Types (EventM, Widget)+import qualified Brick.Animation.Clock as C++-- | A sequence of a animation frames.+newtype Clip s n = Clip (V.Vector (s -> Widget n))+                     deriving (Semigroup)++-- | Get the number of frames in a clip.+clipLength :: Clip s n -> Int+clipLength (Clip fs) = V.length fs++-- | Build a clip.+--+-- Each frame in a clip is represented by a function from a state to a+-- 'Widget'. This allows applications to determine on a per-frame basis+-- what should be drawn in an animation based on application state, if+-- desired, in the same style as 'Brick.Main.appDraw'.+--+-- If the provided list is empty, this calls 'error'.+newClip :: [s -> Widget n] -> Clip s n+newClip [] = error "clip: got an empty list"+newClip fs = Clip $ V.fromList fs++-- | Like 'newClip' but for static frames.+newClip_ :: [Widget n] -> Clip s n+newClip_ ws = newClip $ const <$> ws++-- | Extend a clip so that when the end of the original clip is reached,+-- it continues in reverse order to create a loop.+--+-- For example, if this is given a clip with frames A, B, C, and D, then+-- this returns a clip with frames A, B, C, D, C, and B.+--+-- If the given clip contains less than two frames, this is equivalent+-- to 'id'.+pingPongClip :: Clip s n -> Clip s n+pingPongClip (Clip fs) | V.length fs >= 2 =+    Clip $ fs <> V.reverse (V.init $ V.tail fs)+pingPongClip c = c++-- | Reverse a clip.+reverseClip :: Clip s n -> Clip s n+reverseClip (Clip fs) = Clip $ V.reverse fs++data AnimationManagerRequest s n =+    Tick C.Time+    | StartAnimation (Clip s n) Integer RunMode (Traversal' s (Maybe (Animation s n)))+    -- ^ Clip, frame duration in milliseconds, run mode, updater+    | StopAnimation (Animation s n)+    | Shutdown++-- | The running mode for an animation.+data RunMode =+    Once+    -- ^ Run the animation once and then end+    | Loop+    -- ^ Run the animation in a loop forever+    deriving (Eq, Show, Ord)++newtype AnimationID = AnimationID Int+                    deriving (Eq, Ord, Show, Hashable)++-- | The state of a running animation.+--+-- Put one of these (wrapped in 'Maybe') in your application state for+-- each animation that you'd like to run concurrently.+data Animation s n =+    Animation { animationFrameIndex :: Int+              -- ^ The animation's current frame index, provided for+              -- convenience. Applications won't need to access this in+              -- most situations; use 'renderAnimation' instead.+              , animationID :: AnimationID+              -- ^ The animation's internally-managed ID+              , animationClip :: Clip s n+              -- ^ The animation's clip+              }++-- | Render an animation.+renderAnimation :: (s -> Widget n)+                -- ^ The fallback function to use for drawing if the+                -- animation is not running+                -> s+                -- ^ The state to provide when rendering the animation's+                -- current frame+                -> Maybe (Animation s n)+                -- ^ The animation state itself+                -> Widget n+renderAnimation fallback input mAnim =+    draw input+    where+        draw = fromMaybe fallback $ do+            a <- mAnim+            let idx = animationFrameIndex a+                Clip fs = animationClip a+            fs V.!? idx++data AnimationState s n =+    AnimationState { _animationStateID :: AnimationID+                   , _animationNumFrames :: Int+                   , _animationCurrentFrame :: Int+                   , _animationFrameMilliseconds :: Integer+                   , _animationRunMode :: RunMode+                   , animationFrameUpdater :: Traversal' s (Maybe (Animation s n))+                   , _animationNextFrameTime :: C.Time+                   }++makeLenses ''AnimationState++-- | A manager for animations. The type variables for this type are the+-- same as those for 'Brick.Main.App'.+--+-- This asynchronously manages a set of running animations, advancing+-- each one over time. When a running animation's current frame needs+-- to be changed, the manager sends an 'EventM' update for that+-- animation to the application's event loop to perform the update to+-- the animation in the application state. The manager will batch such+-- updates if more than one animation needs to be changed at a time.+--+-- The manager has a /tick duration/ in milliseconds which is the+-- resolution at which animations are checked to see if they should+-- be updated. Animations also have their own frame duration in+-- milliseconds. For example, if a manager has a tick duration of 50+-- milliseconds and is running an animation with a frame duration of 100+-- milliseconds, then the manager will advance that animation by one+-- frame every two ticks. On the other hand, if a manager has a tick+-- duration of 100 milliseconds and is running an animation with a frame+-- duration of 50 milliseconds, the manager will advance that animation+-- by two frames on each tick.+--+-- Animation managers are started with 'startAnimationManager' and+-- stopped with 'stopAnimationManager'.+--+-- Animations are started with 'startAnimation' and stopped with+-- 'stopAnimation'. Each animation must be associated with an+-- application state field accessible with a traversal given to+-- 'startAnimation'.+--+-- When an animation is started, every time it advances a frame, and+-- when it is ended, the manager communicates these changes to the+-- application by using the custom event constructor provided to+-- 'startAnimationManager'. The manager uses that to schedule a state+-- update which the application is responsible for evaluating. The state+-- updates are built from the traversals provided to 'startAnimation'.+--+-- The manager-updated 'Animation' values in the application state are+-- then drawn with 'renderAnimation'.+--+-- Animations in 'Loop' mode are run forever until stopped with+-- 'stopAnimation'; animations in 'Once' mode run once and are removed+-- from the application state (set to 'Nothing') when they finish. All+-- state updates to the application state are performed by the manager's+-- custom event mechanism; the application never needs to directly+-- modify the 'Animation' application state fields except to initialize+-- them to 'Nothing'.+--+-- There is nothing here to prevent an application from running multiple+-- managers, each at a different tick rate. That may have performance+-- consequences, though, due to the loss of batch efficiency in state+-- updates, so we recommend using only one manager per application at a+-- sufficiently short tick duration.+data AnimationManager s e n =+    AnimationManager { animationMgrRequestThreadId :: ThreadId+                     , animationMgrTickThreadId :: ThreadId+                     , animationMgrOutputChan :: BChan e+                     , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s n)+                     , animationMgrEventConstructor :: EventM n s () -> e+                     , animationMgrRunning :: STM.TVar Bool+                     }++tickThreadBody :: Int+               -> STM.TChan (AnimationManagerRequest s n)+               -> IO ()+tickThreadBody tickMilliseconds outChan = do+    let nextTick = C.addOffset tickOffset+        tickOffset = C.offsetFromMs $ toInteger tickMilliseconds+        go targetTime = do+            now <- C.getTime+            STM.atomically $ STM.writeTChan outChan $ Tick now++            -- threadDelay does not guarantee that we will wake up on+            -- time; it only ensures that we won't wake up earlier than+            -- requested. Since we can therefore oversleep, instead of+            -- always sleeping for tickMilliseconds (which would cause+            -- us to drift off of schedule as delays accumulate) we+            -- determine sleep time by measuring the distance between+            -- now and the next scheduled tick. This is still unreliable+            -- as we can still oversleep, but it keeps the oversleeping+            -- under control over time. It means most ticks may be+            -- slightly late (about 1-2 milliseconds is common) but this+            -- will prevent that per-tick error from accumulating.+            let nextTickTime = nextTick targetTime+                sleepMs = fromInteger $+                          C.offsetToMs $+                          C.subtractTime nextTickTime now++            -- threadDelay works microseconds.+            threadDelay $ sleepMs * 1000+            go nextTickTime++    go =<< C.getTime++setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n+setNextFrameTime t a = a & animationNextFrameTime .~ t++data ManagerState s e n =+    ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n)+                 , _managerStateOutChan :: BChan e+                 , _managerStateEventBuilder :: EventM n s () -> e+                 , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s n)+                 , _managerStateIDVar :: STM.TVar AnimationID+                 }++makeLenses ''ManagerState++animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s n)+                           -> BChan e+                           -> (EventM n s () -> e)+                           -> IO ()+animationManagerThreadBody inChan outChan mkEvent = do+    idVar <- STM.newTVarIO $ AnimationID 1+    let initial = ManagerState { _managerStateInChan = inChan+                               , _managerStateOutChan = outChan+                               , _managerStateEventBuilder = mkEvent+                               , _managerStateAnimations = mempty+                               , _managerStateIDVar = idVar+                               }+    evalStateT runManager initial++type ManagerM s e n a = StateT (ManagerState s e n) IO a++getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s n)+getNextManagerRequest = do+    inChan <- use managerStateInChan+    liftIO $ STM.atomically $ STM.readTChan inChan++sendApplicationStateUpdate :: EventM n s () -> ManagerM s e n ()+sendApplicationStateUpdate act = do+    outChan <- use managerStateOutChan+    mkEvent <- use managerStateEventBuilder+    liftIO $ writeBChan outChan $ mkEvent act++removeAnimation :: AnimationID -> ManagerM s e n ()+removeAnimation aId =+    managerStateAnimations %= HM.delete aId++lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s n))+lookupAnimation aId =+    HM.lookup aId <$> use managerStateAnimations++insertAnimation :: AnimationState s n -> ManagerM s e n ()+insertAnimation a =+    managerStateAnimations %= HM.insert (a^.animationStateID) a++getNextAnimationID :: ManagerM s e n AnimationID+getNextAnimationID = do+    var <- use managerStateIDVar+    liftIO $ STM.atomically $ do+        AnimationID i <- STM.readTVar var+        let next = AnimationID $ i + 1+        STM.writeTVar var next+        return $ AnimationID i++runManager :: ManagerM s e n ()+runManager = forever $ do+    getNextManagerRequest >>= handleManagerRequest++handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n ()+handleManagerRequest (StartAnimation clip frameMs runMode updater) = do+    aId <- getNextAnimationID+    now <- liftIO C.getTime+    let next = C.addOffset frameOffset now+        frameOffset = C.offsetFromMs frameMs+        a = AnimationState { _animationStateID = aId+                           , _animationNumFrames = clipLength clip+                           , _animationCurrentFrame = 0+                           , _animationFrameMilliseconds = frameMs+                           , _animationRunMode = runMode+                           , animationFrameUpdater = updater+                           , _animationNextFrameTime = next+                           }++    insertAnimation a+    sendApplicationStateUpdate $ updater .= Just (Animation { animationID = aId+                                                            , animationFrameIndex = 0+                                                            , animationClip = clip+                                                            })+handleManagerRequest (StopAnimation a) = do+    let aId = animationID a+    mA <- lookupAnimation aId+    case mA of+        Nothing -> return ()+        Just aState -> do+            -- Remove the animation from the manager+            removeAnimation aId++            -- Set the current animation state in the application state+            -- to none+            sendApplicationStateUpdate $ clearStateAction aState+handleManagerRequest Shutdown = do+    as <- HM.elems <$> use managerStateAnimations++    let updater = sequence_ $ clearStateAction <$> as+    when (not $ null as) $ do+        sendApplicationStateUpdate updater++    liftIO $ myThreadId >>= killThread+handleManagerRequest (Tick tickTime) = do+    -- Check all animation states for frame advances+    -- based on the relationship between the tick time+    -- and each animation's next frame time+    mUpdateAct <- checkAnimations tickTime+    case mUpdateAct of+        Nothing -> return ()+        Just act -> sendApplicationStateUpdate act++clearStateAction :: AnimationState s n -> EventM n s ()+clearStateAction a = animationFrameUpdater a .= Nothing++frameUpdateAction :: AnimationState s n -> EventM n s ()+frameUpdateAction a =+    animationFrameUpdater a._Just %=+        (\an -> an { animationFrameIndex = a^.animationCurrentFrame })++updateAnimationState :: C.Time -> AnimationState s n -> AnimationState s n+updateAnimationState now a =+    let differenceMs = C.offsetToMs $+                       C.subtractTime now (a^.animationNextFrameTime)+        numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds))+        newNextTime = C.addOffset (C.offsetFromMs $ numFrames * (a^.animationFrameMilliseconds))+                                  (a^.animationNextFrameTime)++    -- The new frame is obtained by advancing from the current frame by+    -- numFrames.+    in setNextFrameTime newNextTime $ advanceBy numFrames a++checkAnimations :: C.Time -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimations now = do+    let go a updaters = do+          result <- checkAnimation now a+          return $ case result of+              Nothing -> updaters+              Just u  -> u : updaters++    anims <- use managerStateAnimations+    updaters <- foldrM go [] anims++    case updaters of+        [] -> return Nothing+        _ -> return $ Just $ sequence_ updaters++-- For each active animation, check to see if the animation's next frame+-- time has passed. If it has, advance its frame counter as appropriate+-- and schedule its frame index to be updated in the application state.+checkAnimation :: C.Time -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimation now a+    | isFinished a = do+        -- This animation completed in a previous check, so clear it+        -- from the manager and the application state.+        removeAnimation (a^.animationStateID)+        return $ Just $ clearStateAction a+    | (now < a^.animationNextFrameTime) =+        -- This animation is not due for an update, so don't do+        -- anything.+        return Nothing+    | otherwise = do+        -- This animation is still running, so determine how many frames+        -- have elapsed for it and then advance the frame index based+        -- the elapsed time. Also set its next frame time.+        let a' = updateAnimationState now a+        managerStateAnimations %= HM.insert (a'^.animationStateID) a'+        return $ Just $ frameUpdateAction a'++isFinished :: AnimationState s n -> Bool+isFinished a =+    case a^.animationRunMode of+        Once -> a^.animationCurrentFrame == a^.animationNumFrames - 1+        Loop -> False++advanceBy :: Integer -> AnimationState s n -> AnimationState s n+advanceBy n a+    | n <= 0 = a+    | otherwise =+        advanceBy (n - 1) $+        advanceByOne a++advanceByOne :: AnimationState s n -> AnimationState s n+advanceByOne a =+    if a^.animationCurrentFrame == a^.animationNumFrames - 1+    then case a^.animationRunMode of+        Loop -> a & animationCurrentFrame .~ 0+        Once -> a+    else a & animationCurrentFrame %~ (+ 1)++-- | The minimum tick duration in milliseconds allowed by+-- 'startAnimationManager'.+minTickTime :: Int+minTickTime = 25++-- | Start a new animation manager. For full details about how managers+-- work, see 'AnimationManager'.+--+-- If the specified tick duration is less than 'minTickTime', this will+-- call 'error'. This bound is in place to prevent API misuse leading to+-- ticking so fast that the terminal can't keep up with redraws.+startAnimationManager :: (MonadIO m)+                      => Int+                      -- ^ The tick duration for this manager in milliseconds+                      -> BChan e+                      -- ^ The event channel to use to send updates to+                      -- the application (i.e. the same one given to+                      -- e.g. 'Brick.Main.customVty')+                      -> (EventM n s () -> e)+                      -- ^ A constructor for building custom events+                      -- that perform application state updates. The+                      -- application must evaluate these custom events'+                      -- 'EventM' actions in order to record animation+                      -- updates in the application state.+                      -> m (AnimationManager s e n)+startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime =+    error $ "startAnimationManager: tick duration too small (minimum is " <> show minTickTime <> ")"+startAnimationManager tickMilliseconds outChan mkEvent = liftIO $ do+    inChan <- STM.newTChanIO+    reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent+    tickTid <- forkIO $ tickThreadBody tickMilliseconds inChan+    runningVar <- STM.newTVarIO True+    return $ AnimationManager { animationMgrRequestThreadId = reqTid+                              , animationMgrTickThreadId = tickTid+                              , animationMgrEventConstructor = mkEvent+                              , animationMgrOutputChan = outChan+                              , animationMgrInputChan = inChan+                              , animationMgrRunning = runningVar+                              }++-- | Execute the specified action only when this manager is running.+whenRunning :: (MonadIO m) => AnimationManager s e n -> IO () -> m ()+whenRunning mgr act = do+    running <- liftIO $ STM.atomically $ STM.readTVar (animationMgrRunning mgr)+    when running $ liftIO act++-- | Stop the animation manager, ending all running animations.+stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m ()+stopAnimationManager mgr =+    whenRunning mgr $ do+        tellAnimationManager mgr Shutdown+        killThread $ animationMgrTickThreadId mgr+        STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False++-- | Send a request to an animation manager.+tellAnimationManager :: (MonadIO m)+                     => AnimationManager s e n+                     -- ^ The manager+                     -> AnimationManagerRequest s n+                     -- ^ The request to send+                     -> m ()+tellAnimationManager mgr req =+    liftIO $+    STM.atomically $+    STM.writeTChan (animationMgrInputChan mgr) req++-- | Start a new animation at its first frame.+--+-- This will result in an application state update to initialize the+-- animation state at the provided traversal's location.+startAnimation :: (MonadIO m)+               => AnimationManager s e n+               -- ^ The manager to run the animation+               -> Clip s n+               -- ^ The frames for the animation+               -> Integer+               -- ^ The animation's frame duration in milliseconds+               -> RunMode+               -- ^ The animation's run mode+               -> Traversal' s (Maybe (Animation s n))+               -- ^ Where in the application state to manage this+               -- animation's state+               -> m ()+startAnimation mgr frames frameMs runMode updater =+    tellAnimationManager mgr $ StartAnimation frames frameMs runMode updater++-- | Stop an animation.+--+-- This will result in an application state update to remove the+-- animation state.+stopAnimation :: (MonadIO m)+              => AnimationManager s e n+              -> Animation s n+              -> m ()+stopAnimation mgr a =+    tellAnimationManager mgr $ StopAnimation a
+ src/Brick/Animation/Clock.hs view
@@ -0,0 +1,64 @@+-- | This module provides an API for working with+-- 'Data.Time.Clock.System.SystemTime' values similar to that of+-- 'Data.Time.Clock.UTCTime'. @SystemTime@s are more efficient to+-- obtain than @UTCTime@s, which is important to avoid animation+-- tick thread delays associated with expensive clock reads. In+-- addition, the @UTCTime@-based API provides unpleasant @Float@-based+-- conversions. Since the @SystemTime@-based API doesn't provide some+-- of the operations we need, and since it is easier to work with at+-- millisecond granularity, it is extended here for internal use.+module Brick.Animation.Clock+  ( Time+  , getTime+  , addOffset+  , subtractTime++  , Offset+  , offsetFromMs+  , offsetToMs+  )+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Time.Clock.System as C++newtype Time = Time C.SystemTime+             deriving (Ord, Eq)++-- | Signed difference in milliseconds+newtype Offset = Offset Integer+               deriving (Ord, Eq)++offsetFromMs :: Integer -> Offset+offsetFromMs = Offset++offsetToMs :: Offset -> Integer+offsetToMs (Offset ms) = ms++getTime :: (MonadIO m) => m Time+getTime = Time <$> liftIO C.getSystemTime++addOffset :: Offset -> Time -> Time+addOffset (Offset ms) (Time (C.MkSystemTime s ns)) =+    Time $ C.MkSystemTime (fromInteger s') (fromInteger ns')+    where+        -- Note that due to the behavior of divMod, this works even when+        -- the offset is negative: the number of seconds is decremented+        -- and the remainder of nanoseconds is correct.+        s' = newSec + toInteger s+        (newSec, ns') = (nsPerMs * ms + toInteger ns)+                          `divMod` (msPerS * nsPerMs)++subtractTime :: Time -> Time -> Offset+subtractTime t1 t2 = Offset $ timeToMs t1 - timeToMs t2++timeToMs :: Time -> Integer+timeToMs (Time (C.MkSystemTime s ns)) =+    (toInteger s) * msPerS ++    (toInteger ns) `div` nsPerMs++nsPerMs :: Integer+nsPerMs = 1000000++msPerS :: Integer+msPerS = 1000
src/Brick/AttrMap.hs view
@@ -1,8 +1,7 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# 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@@ -15,7 +14,7 @@ -- Attribute names are mapped to attributes, but some attributes may -- be partial (specify only a foreground or background color). When -- attribute name lookups occur, the attribute corresponding to a more--- specific name ('parent <> child' as above) is sucessively merged with+-- specific name ('parent <> child' as above) is successively merged with -- the parent attribute ('parent' as above) all the way to the "root" -- of the attribute map, the map's default attribute. In this way, more -- specific attributes inherit what they don't specify from more general@@ -28,11 +27,15 @@   -- * Construction   , attrMap   , forceAttrMap+  , forceAttrMapAllowStyle   , attrName+  -- * Inspection+  , attrNameComponents   -- * Finding attributes from names   , attrMapLookup   -- * Manipulating attribute maps-  , setDefault+  , setDefaultAttr+  , getDefaultAttr   , applyAttrMappings   , mergeWithDefault   , mapAttrName@@ -40,49 +43,53 @@   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-import Data.Monoid-#endif+import qualified Data.Semigroup as Sem +import Control.DeepSeq+import Data.Bits ((.|.)) import qualified Data.Map as M-import Data.Maybe (catMaybes)+import Data.Maybe (mapMaybe) import Data.List (inits)-import Data.String (IsString(..))+import GHC.Generics (Generic) -import Graphics.Vty (Attr(..), MaybeDefault(..))+import Graphics.Vty (Attr(..), MaybeDefault(..), Style)  -- | An attribute name. Attribute names are hierarchical; use 'mappend'--- ('<>') to assemble them. Hierachy in an attribute name is used to+-- ('<>') to assemble them. Hierarchy in an attribute name is used to -- represent increasing levels of specificity in referring to the -- attribute you want to use for a visual element, with names to the -- left being general and names to the right being more specific. For -- 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, Eq, Ord)+              deriving (Show, Read, Eq, Ord, Generic, NFData) +instance Sem.Semigroup AttrName where+    (AttrName as) <> (AttrName bs) = AttrName $ as `mappend` bs+ instance Monoid AttrName where     mempty = AttrName []-    mappend (AttrName as) (AttrName bs) = AttrName $ as `mappend` bs--instance IsString AttrName where-    fromString = AttrName . (:[])+    mappend = (Sem.<>)  -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr)              | ForceAttr Attr-             deriving Show+             | ForceAttrAllowStyle Attr AttrMap+             deriving (Show, Generic, NFData)  -- | Create an attribute name from a string. attrName :: String -> AttrName attrName = AttrName . (:[]) +-- | Get the components of an attribute name.+attrNameComponents :: AttrName -> [String]+attrNameComponents (AttrName cs) = cs+ -- | Create an attribute map. attrMap :: Attr         -- ^ The map's default attribute to be returned when a name@@ -94,10 +101,15 @@ attrMap theDefault pairs = AttrMap theDefault (M.fromList pairs)  -- | Create an attribute map in which all lookups map to the same--- attribute.+-- attribute. This is functionally equivalent to @attrMap attr []@. forceAttrMap :: Attr -> AttrMap forceAttrMap = ForceAttr +-- | Create an attribute map in which all lookups map to the same+-- attribute. This is functionally equivalent to @attrMap attr []@.+forceAttrMapAllowStyle :: Attr -> AttrMap -> AttrMap+forceAttrMapAllowStyle = ForceAttrAllowStyle+ -- | Given an attribute and a map, merge the attribute with the map's -- default attribute. If the map is forcing all lookups to a specific -- attribute, the forced attribute is returned without merging it with@@ -117,53 +129,80 @@ -- @ mergeWithDefault :: Attr -> AttrMap -> Attr mergeWithDefault _ (ForceAttr a) = a+mergeWithDefault _ (ForceAttrAllowStyle f _) = f mergeWithDefault a (AttrMap d _) = combineAttrs d a  -- | Look up the specified attribute name in the map. Map lookups -- proceed as follows. If the attribute map is forcing all lookups to a--- specific attribute, that attribute is returned. If the attribute name--- is empty, the map's default attribute is returned. If the attribute--- name is non-empty, very subsequence of names from the specified name--- are used to perform a lookup, and the results are combined as in--- 'mergeWithDefault', with more specific results taking precedence over--- less specific ones.+-- specific attribute, that attribute is returned along with its style+-- settings. If the attribute name is empty, the map's default attribute+-- is returned. If the attribute name is non-empty, every subsequence of+-- names from the specified name are used to perform a lookup and the+-- results are combined as in 'mergeWithDefault', with more specific+-- results taking precedence over less specific ones. As attributes are+-- merged, styles are also merged. If a more specific attribute name+-- introduces a style (underline, say) and a less specific attribute+-- name introduces an additional style (bold, say) then the final result+-- will include both styles. -- -- For example: -- -- @--- attrMapLookup ("foo" <> "bar") (attrMap a []) == a--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red)]) == red \`on\` blue--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", red `on` cyan)]) == red \`on\` cyan--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red), ("foo", bg cyan)]) == red \`on\` cyan--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo", fg red)]) == red \`on\` blue+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap a []) == a+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", fg red)]) == red \`on\` blue+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", red `on` cyan)]) == red \`on\` cyan+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", fg red), ("foo", bg cyan)]) == red \`on\` cyan+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo", fg red)]) == red \`on\` blue -- @ attrMapLookup :: AttrName -> AttrMap -> Attr attrMapLookup _ (ForceAttr a) = a+attrMapLookup a (ForceAttrAllowStyle forced m) =+    -- Look up the attribute in the contained map, then keep only its+    -- style.+    let result = attrMapLookup a m+    in forced { attrStyle = attrStyle forced `combineStyles` attrStyle result+              } attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault attrMapLookup (AttrName ns) (AttrMap theDefault m) =-    let results = catMaybes $ (\n -> M.lookup n m) <$> (AttrName <$> (inits ns))+    let results = mapMaybe (\n -> M.lookup (AttrName n) m) (inits ns)     in foldl combineAttrs theDefault results  -- | Set the default attribute value in an attribute map.-setDefault :: Attr -> AttrMap -> AttrMap-setDefault _ (ForceAttr a) = ForceAttr a-setDefault newDefault (AttrMap _ m) = AttrMap newDefault m+setDefaultAttr :: Attr -> AttrMap -> AttrMap+setDefaultAttr _ (ForceAttr a) = ForceAttr a+setDefaultAttr newDefault (ForceAttrAllowStyle a m) =+    ForceAttrAllowStyle a (setDefaultAttr newDefault m)+setDefaultAttr newDefault (AttrMap _ m) = AttrMap newDefault m +-- | Get the default attribute value in an attribute map.+getDefaultAttr :: AttrMap -> Attr+getDefaultAttr (ForceAttr a) = a+getDefaultAttr (ForceAttrAllowStyle _ m) = getDefaultAttr m+getDefaultAttr (AttrMap d _) = d+ combineAttrs :: Attr -> Attr -> Attr-combineAttrs (Attr s1 f1 b1) (Attr s2 f2 b2) =-    Attr (s1 `combineMDs` s2)+combineAttrs (Attr s1 f1 b1 u1) (Attr s2 f2 b2 u2) =+    Attr (s1 `combineStyles` s2)          (f1 `combineMDs` f2)          (b1 `combineMDs` b2)+         (u1 `combineMDs` u2)  combineMDs :: MaybeDefault a -> MaybeDefault a -> MaybeDefault a combineMDs _ (SetTo v) = SetTo v combineMDs (SetTo v) _ = SetTo v combineMDs _ v = v +combineStyles :: MaybeDefault Style -> MaybeDefault Style -> MaybeDefault Style+combineStyles (SetTo a) (SetTo b) = SetTo $ a .|. b+combineStyles _ (SetTo v) = SetTo v+combineStyles (SetTo v) _ = SetTo v+combineStyles _ v = v+ -- | Insert a set of attribute mappings to an attribute map. applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap applyAttrMappings _ (ForceAttr a) = ForceAttr a applyAttrMappings ms (AttrMap d m) = AttrMap d ((M.fromList ms) `M.union` m)+applyAttrMappings ms (ForceAttrAllowStyle a m) = ForceAttrAllowStyle a (applyAttrMappings ms m)  -- | Update an attribute map such that a lookup of 'ontoName' returns -- the attribute value specified by 'fromName'.  This is useful for
src/Brick/BChan.hs view
@@ -2,36 +2,43 @@   ( BChan   , newBChan   , writeBChan+  , writeBChanNonBlocking   , readBChan   , readBChan2   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif- import Control.Concurrent.STM.TBQueue import Control.Monad.STM (atomically, orElse)  -- | @BChan@ is an abstract type representing a bounded FIFO channel. data BChan a = BChan (TBQueue a) --- |Builds and returns a new instance of @BChan@.+-- | Builds and returns a new instance of @BChan@. newBChan :: Int   -- ^ maximum number of elements the channel can hold           -> IO (BChan a)-newBChan size = atomically $ BChan <$> newTBQueue size+newBChan size = atomically $ BChan <$> newTBQueue (fromIntegral size) --- |Writes a value to a @BChan@; blocks if the channel is full.+-- | Writes a value to a @BChan@; blocks if the channel is full. writeBChan :: BChan a -> a -> IO () writeBChan (BChan q) a = atomically $ writeTBQueue q a --- |Reads the next value from the @BChan@; blocks if necessary.+-- | Attempts to write a value to a @BChan@. If the channel has room,+-- the value is written and this returns 'True'. Otherwise this returns+-- 'False' and returns immediately.+writeBChanNonBlocking :: BChan a -> a -> IO Bool+writeBChanNonBlocking (BChan q) a = atomically $ do+    f <- isFullTBQueue q+    if f+       then return False+       else writeTBQueue q a >> return True++-- | Reads the next value from the @BChan@; blocks if necessary. readBChan :: BChan a -> IO a readBChan (BChan q) = atomically $ readTBQueue q --- |Reads the next value from either @BChan@, prioritizing the first @BChan@;--- blocks if necessary.+-- | Reads the next value from either @BChan@, prioritizing the first+-- @BChan@; blocks if necessary. readBChan2 :: BChan a -> BChan b -> IO (Either a b) readBChan2 (BChan q1) (BChan q2) = atomically $   (Left <$> readTBQueue q1) `orElse` (Right <$> readTBQueue q2)
+ src/Brick/BorderMap.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+module Brick.BorderMap+    ( BorderMap+    , Edges(..)+    , eTopL, eBottomL, eRightL, eLeftL+    , empty, clear, emptyCoordinates, singleton+    , insertH, insertV, insert+    , unsafeUnion+    , coordinates, bounds+    , values+    , lookupRow, lookupCol, lookupH, lookupV, lookup+    , setCoordinates, crop, expand+    , translate+    ) where++import Brick.Types.Common (Edges(..), Location(..), eTopL, eBottomL, eRightL, eLeftL, origin)+#if !(MIN_VERSION_base(4,18,0))+import Control.Applicative (liftA2)+#endif+import Data.IMap (IMap, Run(Run))+import GHC.Generics+import Control.DeepSeq+import Prelude hiding (lookup)+import qualified Data.IMap as IM++-- | Internal use only.+neighbors :: Edges a -> Edges (a, a)+neighbors (Edges vt vb vl vr) = Edges horiz horiz vert vert where+    horiz = (vl, vr)+    vert  = (vt, vb)++-- Invariant: corner values are present on all the edges incident on that+-- corner. Widthless or heightless rectangles replicate the IMaps exactly on+-- the two coincident edges.+--+-- Practically speaking, this means for lookup you can look on any edge that+-- could contain the key you care about, while for insertion you must insert on+-- every edge that could contain the keys being inserted.++-- | A @BorderMap a@ is like a @Map Location a@, except that there is a+-- rectangle, and only 'Location's on the border of this rectangle are+-- retained. The 'BorderMap' can be queried for the position and size of the+-- rectangle. There are also efficient bulk query and bulk update operations+-- for adjacent positions on the border.+data BorderMap a = BorderMap+    { _coordinates :: Edges Int+    , _values :: Edges (IMap a)+    } deriving (Eq, Ord, Show, Functor, Read, Generic, NFData)++-- | Given a rectangle (specified as the coordinates of the top, left, bottom,+-- and right sides), initialize an empty 'BorderMap'.+emptyCoordinates :: Edges Int -> BorderMap a+emptyCoordinates cs = BorderMap { _coordinates = cs, _values = pure IM.empty }++-- | An empty 'BorderMap' that tracks the same points as the input.+clear :: BorderMap a -> BorderMap b+clear = emptyCoordinates . coordinates++-- | An empty 'BorderMap' that does not track any points.+empty :: BorderMap a+empty = emptyCoordinates Edges+    { eTop = 0+    , eBottom = -1+    , eLeft = 0+    , eRight = -1+    }++-- | A 'BorderMap' that tracks only the given the point (and initially maps it+-- to the given value).+singleton :: Location -> a -> BorderMap a+singleton l v = translate l . insert origin v . emptyCoordinates $ pure 0++{-# INLINE coordinates #-}+-- | The positions of the edges of the rectangle whose border is retained in a+-- 'BorderMap'. For example, if @coordinates m = e@, then the top border+-- contains the 'Location's on row @eTop e@ and between columns @eLeft e@ to+-- @eRight e@ inclusive.+coordinates :: BorderMap a -> Edges Int+coordinates = _coordinates++-- | A complementary way to query the edges of the rectangle whose border is+-- retained in a 'BorderMap'. For example, if @bounds m = b@, then a+-- 'Location'\'s column must be between @fst (eTop b)@ and @snd (eTop b)@ to be+-- retained. See also 'coordinates', which is in most cases a more natural+-- border query.+bounds :: BorderMap a -> Edges (Int, Int)+bounds = neighbors . coordinates++{-# INLINE values #-}+-- | Maps giving the values along each edge. Corner values are replicated in+-- all relevant edges.+values :: BorderMap a -> Edges (IMap a)+values = _values++-- | Bulk insertion of horizontally-adjacent values. The 'Location' gives the+-- start point, and the 'Run' extends in the "larger columns" direction.+insertH :: Location -> Run a -> BorderMap a -> BorderMap a+insertH = insertDirAgnostic (Edges insertPar insertPar insertPerp insertPerp) . swapLoc+    where+    swapLoc (Location (col, row)) = Location (row, col)++-- | Bulk insertion of vertically-adjacent values. The 'Location' gives the+-- start point, and the 'Run' extends in the "larger rows" direction.+insertV :: Location -> Run a -> BorderMap a -> BorderMap a+insertV = insertDirAgnostic (Edges insertPerp insertPerp insertPar insertPar)++insertDirAgnostic+    :: Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)+    -> Location -> Run a -> BorderMap a -> BorderMap a+insertDirAgnostic insertions l r m =+    m { _values = insertions <*> pure l <*> pure r <*> coordinates m <*> bounds m <*> _values m }++insertPar, insertPerp :: Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a+insertPar (Location (kPar, kPerp)) r herePar (loPerp, hiPerp)+    | kPar == herePar && loPerp <= kPerp + IM.len r - 1 && kPerp <= hiPerp+        = IM.insert beg r { IM.len = end - beg + 1 }+    | otherwise = id+    where+    beg = max kPerp loPerp+    end = min (kPerp + IM.len r - 1) hiPerp+insertPerp (Location (kPar, kPerp)) r herePerp (loPar, hiPar)+    | loPar <= kPar && kPar <= hiPar && kPerp <= herePerp && herePerp <= kPerp + IM.len r - 1+        = IM.insert kPar r { IM.len = 1 }+    | otherwise = id++-- | Insert a single value at the given location.+insert :: Location -> a -> BorderMap a -> BorderMap a+insert l = insertV l . Run 1++-- | Look up all values on a given row. The 'IMap' returned maps columns to+-- values.+lookupRow :: Int -> BorderMap a -> IMap a+lookupRow row m+    | row == eTop    (coordinates m) = eTop    (_values m)+    | row == eBottom (coordinates m) = eBottom (_values m)+    | otherwise = IM.fromList+        $  [(eLeft   (coordinates m), Run 1 a) | Just a <- [IM.lookup row (eLeft   (_values m))]]+        ++ [(eRight  (coordinates m), Run 1 a) | Just a <- [IM.lookup row (eRight  (_values m))]]++-- | Look up all values on a given column. The 'IMap' returned maps rows to+-- values.+lookupCol :: Int -> BorderMap a -> IMap a+lookupCol col m+    | col == eLeft   (coordinates m) = eLeft   (_values m)+    | col == eRight  (coordinates m) = eRight  (_values m)+    | otherwise = IM.fromList+        $  [(eTop    (coordinates m), Run 1 a) | Just a <- [IM.lookup col (eTop    (_values m))]]+        ++ [(eBottom (coordinates m), Run 1 a) | Just a <- [IM.lookup col (eBottom (_values m))]]++-- | Bulk lookup of horizontally-adjacent values. The 'Location' gives the+-- starting point, and the 'Run' extends in the "larger columns" direction. The+-- 'IMap' returned maps columns to values.+lookupH :: Location -> Run ignored -> BorderMap a -> IMap a+lookupH (Location (col, row)) r = IM.restrict col r . lookupRow row++-- | Bulk lookup of vertically-adjacent values. The 'Location' gives the+-- starting point, and the 'Run' extends in the "larger rows" direction. The+-- 'IMap' returned maps rows to values.+lookupV :: Location -> Run ignored -> BorderMap a -> IMap a+lookupV (Location (col, row)) r = IM.restrict row r . lookupCol col++-- | Look up a single position.+lookup :: Location -> BorderMap a -> Maybe a+lookup (Location (col, row)) = IM.lookup row . lookupCol col++-- | Set the rectangle being tracked by this 'BorderMap', throwing away any+-- values that do not lie on this new rectangle.+setCoordinates :: Edges Int -> BorderMap a -> BorderMap a+setCoordinates coordinates' m = BorderMap+    { _values = values'+    , _coordinates = coordinates'+    }+    where+    bounds' = neighbors coordinates'+    values' = gc+        <$> _coordinates m+        <*> coordinates'+        <*> bounds'+        <*> _values m+        <*> Edges { eTop = lookupRow, eBottom = lookupRow, eLeft = lookupCol, eRight = lookupCol }+    gc oldPar newPar (loPerp, hiPerp) imPar lookupPerp+        | oldPar == newPar = IM.restrict loPerp (Run (hiPerp-loPerp+1) ()) imPar+        | otherwise = lookupPerp newPar m++-- | Ensure that the rectangle being tracked by this 'BorderMap' extends no+-- farther than the given one.+crop :: Edges Int -> BorderMap a -> BorderMap a+crop cs m = setCoordinates (shrink <*> cs <*> coordinates m) m where+    shrink = Edges+        { eTop    = max+        , eBottom = min+        , eLeft   = max+        , eRight  = min+        }++-- | Ensure that the rectangle being tracked by this 'BorderMap' extends at+-- least as far as the given one.+expand :: Edges Int -> BorderMap a -> BorderMap a+expand cs m = setCoordinates (grow <*> cs <*> coordinates m) m where+    grow = Edges+        { eTop    = min+        , eBottom = max+        , eLeft   = min+        , eRight  = max+        }++-- | Move a 'BorderMap' by adding the given 'Location' to all keys in the map.+translate :: Location -> BorderMap a -> BorderMap a+-- fast path: do nothing for (0,0)+translate (Location (0, 0)) m = m+translate (Location (c, r)) m = BorderMap+    { _coordinates = liftA2 (+)          cOffsets (_coordinates m)+    , _values      = liftA2 IM.addToKeys vOffsets (_values      m)+    }+    where+    cOffsets = Edges { eTop = r, eBottom = r, eLeft = c, eRight = c }+    vOffsets = Edges { eTop = c, eBottom = c, eLeft = r, eRight = r }++-- | Assumes the two 'BorderMap's are tracking the same rectangles, but have+-- disjoint keys. This property is not checked.+unsafeUnion :: BorderMap a -> BorderMap a -> BorderMap a+unsafeUnion m m' = m { _values = liftA2 IM.unsafeUnion (_values m) (_values m') }
src/Brick/Focus.hs view
@@ -1,54 +1,47 @@-{-# LANGUAGE DeriveFunctor #-}- -- | This module provides a type and functions for handling focus rings--- of widgets. Note that this interface is merely provided for managing--- the focus state for a sequence of resource names; it does not do--- anything beyond keep track of that.------ This interface is experimental.+-- of values. module Brick.Focus   ( FocusRing   , focusRing   , focusNext   , focusPrev   , focusGetCurrent+  , focusSetCurrent+  , focusRingLength+  , focusRingToList   , focusRingCursor   , withFocusRing+  , focusRingModify   ) where  import Lens.Micro ((^.))-import Data.Maybe (listToMaybe)+import Data.List (find)+import qualified Data.CircularList as C  import Brick.Types import Brick.Widgets.Core (Named(..))  -- | A focus ring containing a sequence of resource names to focus and a -- currently-focused name.-data FocusRing n = FocusRingEmpty-                 | FocusRingNonempty ![n] !Int-                 deriving Functor+newtype FocusRing n = FocusRing (C.CList n)+                    deriving (Show)  -- | Construct a focus ring from the list of resource names. focusRing :: [n] -> FocusRing n-focusRing [] = FocusRingEmpty-focusRing names = FocusRingNonempty names 0+focusRing = FocusRing . C.fromList --- | Advance focus to the next widget in the ring.+-- | Advance focus to the next value in the ring. focusNext :: FocusRing n -> FocusRing n-focusNext FocusRingEmpty = FocusRingEmpty-focusNext fr@(FocusRingNonempty [_] _) = fr-focusNext (FocusRingNonempty ns i) = FocusRingNonempty ns i'-    where-        i' = (i + 1) `mod` (length ns)+focusNext r@(FocusRing l)+    | C.isEmpty l = r+    | otherwise = FocusRing $ C.rotR l --- | Advance focus to the previous widget in the ring.+-- | Advance focus to the previous value in the ring. focusPrev :: FocusRing n -> FocusRing n-focusPrev FocusRingEmpty = FocusRingEmpty-focusPrev fr@(FocusRingNonempty [_] _) = fr-focusPrev (FocusRingNonempty ns i) = FocusRingNonempty ns i'-    where-        i' = (i + (length ns) - 1) `mod` (length ns)+focusPrev r@(FocusRing l)+    | C.isEmpty l = r+    | otherwise = FocusRing $ C.rotL l  -- | This function is a convenience function to look up a widget state -- value's resource name in a focus ring and set its focus setting@@ -66,17 +59,42 @@               -> (Bool -> a -> b)               -- ^ A function that takes a value and its focus state.               -> a-              -- ^ The wiget state value that we need to check for focus.+              -- ^ The widget state value that we need to check for focus.               -> b               -- ^ The rest of the computation. withFocusRing ring f a = f (focusGetCurrent ring == Just (getName a)) a  -- | Get the currently-focused resource name from the ring. If the ring--- is emtpy, return 'Nothing'.+-- is empty, return 'Nothing'. focusGetCurrent :: FocusRing n -> Maybe n-focusGetCurrent FocusRingEmpty = Nothing-focusGetCurrent (FocusRingNonempty ns i) = Just $ ns !! i+focusGetCurrent (FocusRing l) = C.focus l +-- | Set the currently-focused resource name in the ring, provided the+-- name is in the ring. Otherwise return the ring unmodified.+focusSetCurrent :: (Eq n) => n -> FocusRing n -> FocusRing n+focusSetCurrent n r@(FocusRing l) =+    case C.rotateTo n l of+        Nothing -> r+        Just l' -> FocusRing l'++-- | Get the size of the FocusRing.+focusRingLength :: FocusRing n -> Int+focusRingLength (FocusRing l) = C.size l++-- | Return all of the entries in the focus ring, starting with the+-- currently-focused entry and wrapping around the ring.+--+-- For example, if a ring contains A, B, C, and D, and the current entry+-- is B, the result will be [B, C, D, A].+focusRingToList :: FocusRing n -> [n]+focusRingToList (FocusRing l) = C.rightElements l++-- | Modify the internal circular list structure of a focus ring+-- directly. This function permits modification of the circular list+-- using the rich Data.CircularList API.+focusRingModify :: (C.CList n -> C.CList n) -> FocusRing n -> FocusRing n+focusRingModify f (FocusRing l) = FocusRing $ f l+ -- | Cursor selection convenience function for use as an -- 'Brick.Main.appChooseCursor' value. focusRingCursor :: (Eq n)@@ -90,8 +108,5 @@                 -> Maybe (CursorLocation n)                 -- ^ The cursor position, if any, that matches the                 -- resource name currently focused by the 'FocusRing'.-focusRingCursor getRing st ls =-    listToMaybe $ filter isCurrent ls-    where-        isCurrent cl = cl^.cursorLocationNameL ==-                       (focusGetCurrent $ getRing st)+focusRingCursor getRing st = find $ \cl ->+    cl^.cursorLocationNameL == focusGetCurrent (getRing st)
+ src/Brick/Forms.hs view
@@ -0,0 +1,970 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# 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+-- event handling for input fields.+--+-- For a fuller introduction to this API, see the "Input Forms" section+-- of the Brick User Guide. Also see the demonstration programs for+-- examples of forms in action.+--+-- This module provides an input form API. This API allows you to+-- construct an input interface based on a data type of your choice.+-- Each input in the form corresponds to a field in your data type. This+-- API then automatically dispatches keyboard and mouse input events to+-- each form input field, manages rendering of the form, notifies the+-- user when a form field's value is invalid, and stores valid inputs in+-- your data type when possible.+--+-- A form has both a visual representation and a corresponding data+-- structure representing the latest valid values for that form+-- (referred to as the "state" of the form). A 'FormField' is a single+-- input component in the form and a 'FormFieldState' defines the+-- linkage between that visual input and the corresponding portion+-- of the state represented by that visual; there may be multiple+-- 'FormField's combined for a single 'FormFieldState' (e.g. a radio+-- button sequence).+--+-- To use a 'Form', you must include it within your application state+-- type. You can use 'formState' to access the underlying state whenever+-- you need it. See @programs/FormDemo.hs@ for a complete working+-- example.+--+-- Also note that, by default, forms and their field inputs are+-- concatenated together in a 'vBox'. This can be customized on a+-- per-field basis and for the entire form by using the functions+-- 'setFieldConcat' and 'setFormConcat', respectively.+--+-- Bear in mind that for most uses, the 'FormField' and 'FormFieldState'+-- types will not be used directly. Instead, the constructors for+-- various field types (such as 'editTextField') will be used instead.+module Brick.Forms+  ( -- * Data types+    Form+  , FormFieldState(..)+  , FormField(..)+  , FormFieldVisibilityMode(..)++  -- * Creating and using forms+  , newForm+  , formFocus+  , formState+  , handleFormEvent+  , renderForm+  , renderFormFieldState+  , (@@=)+  , allFieldsValid+  , invalidFields+  , setFieldValid+  , setFormConcat+  , setFieldConcat+  , setFormFocus+  , updateFormState+  , setFieldVisibilityMode++  -- * Simple form field constructors+  , editTextField+  , editShowableField+  , editShowableFieldWithValidate+  , editPasswordField+  , radioField+  , checkboxField+  , listField++  -- * Advanced form field constructors+  , editField+  , radioCustomField+  , checkboxCustomField++  -- * Attributes+  , formAttr+  , invalidFormInputAttr+  , focusedFormInputAttr+  )+where++import Graphics.Vty hiding (showCursor)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import Data.Maybe (fromJust, isJust, isNothing)+import Data.List (elemIndex)+import Data.Vector (Vector)++import Brick+import Brick.Focus+import Brick.Widgets.Edit+import Brick.Widgets.List+import qualified Data.Text.Zipper as Z++import qualified Data.Text as T+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+-- your choosing.+--+-- Type variables are as follows:+--+--  * @a@ - the type of the field in your form state that this field+--    manipulates+--  * @b@ - the form field's internal state type+--  * @e@ - your application's event type+--  * @n@ - your application's resource name type+data FormField a b e n =+    FormField { formFieldName :: n+              -- ^ The name identifying this form field.+              , formFieldValidate :: b -> Maybe a+              -- ^ A validation function converting this field's state+              -- into a value of your choosing. @Nothing@ indicates a+              -- validation failure. For example, this might validate+              -- an 'Editor' state value by parsing its text contents as+              -- an integer and return 'Maybe' 'Int'. This is for pure+              -- value validation; if additional validation is required+              -- (e.g. via 'IO'), use this field's state value in an+              -- external validation routine and use 'setFieldValid' to+              -- feed the result back into the form.+              , formFieldExternallyValid :: Bool+              -- ^ Whether the field is valid according to an external+              -- validation source. Defaults to always being 'True' and+              -- can be set with 'setFieldValid'. The value of this+              -- field also affects the behavior of 'allFieldsValid' and+              -- 'getInvalidFields'.+              , formFieldRender :: Bool -> b -> Widget n+              -- ^ A function to render this form field. Parameters are+              -- whether the field is currently focused, followed by the+              -- field state.+              , formFieldHandleEvent :: BrickEvent n e -> EventM n b ()+              -- ^ An event handler for this field.+              }++-- | How to bring form fields into view when a form is rendered in a+-- viewport with 'viewport'.+data FormFieldVisibilityMode =+    ShowFocusedFieldOnly+    -- ^ Make only the focused field's selected input visible. For+    -- composite fields this will not bring all options into view.+    | ShowCompositeField+    -- ^ Make all inputs in the focused field visible. For composite+    -- fields this will bring all options into view as long as the+    -- viewport is large enough to show them all.+    | ShowAugmentedField+    -- ^ Like 'ShowCompositeField' but includes rendering augmentations+    -- applied with '@@='.+    deriving (Eq, Show)++-- | A form field state accompanied by the fields that manipulate that+-- state. The idea is that some record field in your form state has+-- one or more form fields that manipulate that value. This data type+-- maps that state field (using a lens into your state) to the form+-- input fields responsible for managing that state field, along with+-- a current value for that state field and an optional function to+-- control how the form inputs are rendered.+--+-- Most form fields will just have one input, such as text editors, but+-- others, such as radio button collections, will have many, which is+-- why this type supports more than one input corresponding to a state+-- field.+--+-- Type variables are as follows:+--+--  * @s@ - the data type containing the value manipulated by these form+--    fields.+--  * @e@ - your application's event type+--  * @n@ - your application's resource name type+data FormFieldState s e n where+    FormFieldState :: { formFieldState :: b+                      -- ^ The current state value associated with+                      -- the field collection. Note that this type is+                      -- existential. All form fields in the collection+                      -- must validate to this type.+                      , formFieldLens :: Lens' s a+                      -- ^ A lens to extract and store a+                      -- successfully-validated form input back into+                      -- your form state.+                      , formFieldUpdate :: a -> b -> b+                      -- ^ Given a new form state value, update the form+                      -- field state in place.+                      , formFields :: [FormField a b e n]+                      -- ^ The form fields, in order, that the user will+                      -- interact with to manipulate this state value.+                      , formFieldRenderHelper :: Widget n -> Widget n+                      -- ^ A helper function to augment the rendered+                      -- representation of this collection of form+                      -- fields. It receives the default representation+                      -- and can augment it, for example, by adding a+                      -- label on the left.+                      , formFieldConcat :: [Widget n] -> Widget n+                      -- ^ Concatenation function for this field's input+                      -- renderings.+                      , formFieldVisibilityMode :: FormFieldVisibilityMode+                      -- ^ This field's visibility mode for use in+                      -- viewports.+                      } -> FormFieldState s e n++-- | A form: a sequence of input fields that manipulate the fields of an+-- underlying state that you choose. This value must be stored in the+-- Brick application's state.+--+-- Type variables are as follows:+--+--  * @s@ - the data type of your choosing containing the values+--    manipulated by the fields in this form.+--  * @e@ - your application's event type+--  * @n@ - your application's resource name type+data Form s e n =+    Form { formFieldStates  :: [FormFieldState s e n]+         , formFocus :: FocusRing n+         -- ^ The focus ring for the form, indicating which form field+         -- has input focus.+         , formState :: s+         -- ^ The current state of the form. Forms guarantee that only+         -- valid inputs ever get stored in the state, and that after+         -- each input event on a form field, if that field contains a+         -- valid state value then the value is immediately saved to its+         -- corresponding field in this state value using the form+         -- field's lens over @s@.+         , formConcatAll :: [Widget n] -> Widget n+         -- ^ 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:+--+-- > (str "Please check: " <+>) @@= checkboxField alive AliveField "Alive?"+--+-- This can also be used to add multiple augmentations and associates+-- right:+--+-- > (withDefAttr someAttribute) @@=+-- > (str "Please check: " <+>) @@=+-- >   checkboxField alive AliveField "Alive?"+infixr 5 @@=+(@@=) :: (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n+(@@=) h mkFs s =+    let v = mkFs s+    in v { formFieldRenderHelper = h . (formFieldRenderHelper v) }++-- | Update the state contained in a form.+--+-- This updates all form fields to be consistent with the new form+-- state. Where possible, this attempts to maintain other input state,+-- such as text editor cursor position.+--+-- Note that since this updates the form fields, this means that any+-- field values will be completely overwritten! This may or may not+-- be what you want, since a user actively using the form could get+-- confused if their edits go away. Use carefully.+updateFormState :: s -> Form s e n -> Form s e n+updateFormState newState f =+    let updateField fs = case fs of+            FormFieldState st l upd s rh concatAll visMode ->+                FormFieldState (upd (newState^.l) st) l upd s rh concatAll visMode+    in f { formState = newState+         , formFieldStates = updateField <$> formFieldStates f+         }++-- | Set the focused field of a form.+setFormFocus :: (Eq n) => n -> Form s e n -> Form s e n+setFormFocus n f = f { formFocus = focusSetCurrent n $ formFocus f }++-- | Set a form field's concatenation function.+setFieldConcat :: ([Widget n] -> Widget n) -> FormFieldState s e n -> FormFieldState s e n+setFieldConcat f s = s { formFieldConcat = f }++-- | Set a form's concatenation function.+setFormConcat :: ([Widget n] -> Widget n) -> Form s e n -> Form s e n+setFormConcat func f = f { formConcatAll = func }++-- | Create a new form with the specified input fields and an initial+-- form state. The fields are initialized from the state using their+-- state lenses and the first form input is focused initially.+newForm :: [s -> FormFieldState s e n]+        -- ^ The form field constructors. This is intended to be+        -- populated using the various field constructors in this+        -- module.+        -> s+        -- ^ The initial form state used to populate the fields.+        -> Form s e n+newForm mkEs s =+    let es = mkEs <*> pure s+    in Form { formFieldStates = es+            , formFocus       = focusRing $ concatMap formFieldNames es+            , formState       = s+            , formConcatAll   = vBox+            }++formFieldNames :: FormFieldState s e n -> [n]+formFieldNames (FormFieldState _ _ _ fields _ _ _) = formFieldName <$> fields++-- | A form field for manipulating a boolean value. This represents+-- 'True' as @[X] label@ and 'False' as @[ ] label@.+--+-- This field responds to `Space` keypresses to toggle the checkbox and+-- to mouse clicks.+checkboxField :: (Ord n, Show n)+              => Lens' s Bool+              -- ^ The state lens for this value.+              -> n+              -- ^ The resource name for the input field.+              -> T.Text+              -- ^ The label for the check box, to appear at its right.+              -> s+              -- ^ The initial form state.+              -> FormFieldState s e n+checkboxField = checkboxCustomField '[' 'X' ']'++-- | A form field for manipulating a boolean value. This represents+-- 'True' as @[X] label@ and 'False' as @[ ] label@. This function+-- permits the customization of the @[X]@ notation characters.+--+-- This field responds to `Space` keypresses to toggle the checkbox and+-- to mouse clicks.+checkboxCustomField :: (Ord n, Show n)+                    => Char+                    -- ^ Left bracket character.+                    -> Char+                    -- ^ Checkmark character.+                    -> Char+                    -- ^ Right bracket character.+                    -> Lens' s Bool+                    -- ^ The state lens for this value.+                    -> n+                    -- ^ The resource name for the input field.+                    -> T.Text+                    -- ^ The label for the check box, to appear at its right.+                    -> s+                    -- ^ The initial form state.+                    -> FormFieldState s e n+checkboxCustomField lb check rb stLens name label initialState =+    let initVal = initialState ^. stLens++        handleEvent (MouseDown n _ _ _) | n == name = modify not+        handleEvent (VtyEvent (EvKey (KChar ' ') [])) = modify not+        handleEvent _ = return ()++    in FormFieldState { formFieldState = initVal+                      , formFields = [ FormField name Just True+                                                 (renderCheckbox lb check rb label name)+                                                 handleEvent+                                     ]+                      , formFieldLens = stLens+                      , formFieldUpdate =+                          \val _ -> val+                      , formFieldRenderHelper = id+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly+                      }++renderCheckbox :: (Ord n) => Char -> Char -> Char -> T.Text -> n -> Bool -> Bool -> Widget n+renderCheckbox lb check rb label n foc val =+    let addAttr = if foc then withDefAttr focusedFormInputAttr else id+        csr = if foc then putCursor n (Location (1,0)) else id+    in clickable n $+       addAttr $ csr $+       (txt $ T.singleton lb <> (if val then T.singleton check else " ") <>+              T.singleton rb <> " ") <+> txt label++-- | A form field for selecting a single choice from a set of possible+-- choices in a scrollable list. This uses a 'List' internally.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.List'.+--+-- This field responds to the same input events that a 'List' does.+listField :: forall s e n a . (Ord n, Show n, Eq a)+          => (s -> Vector a)+          -- ^ Possible choices.+          -> Lens' s (Maybe a)+          -- ^ The state lens for the initially/finally selected+          -- element.+          -> (Bool -> a -> Widget n)+          -- ^ List item rendering function.+          -> Int+          -- ^ List item height in rows.+          -> n+          -- ^ The resource name for the input field.+          -> s+          -- ^ The initial form state.+          -> FormFieldState s e n+listField options stLens renderItem itemHeight name initialState =+    let optionsVector = options initialState+        initVal = initialState ^. customStLens++        customStLens :: Lens' s (List n a)+        customStLens = lens getList setList+            where+               getList s = let l = list name optionsVector itemHeight+                           in case s ^. stLens of+                               Nothing -> l+                               Just e -> listMoveToElement e l+               setList s l = s & stLens .~ (snd <$> listSelectedElement l)++        handleEvent (VtyEvent e) = handleListEvent e+        handleEvent _ = return ()++    in FormFieldState { formFieldState = initVal+                      , formFields = [ FormField name Just True+                                                 (renderList renderItem)+                                                 handleEvent+                                     ]+                      , formFieldLens = customStLens+                      , formFieldUpdate = \listState l ->+                           case listSelectedElement listState of+                               Nothing -> l+                               Just (_, e) -> listMoveToElement e l+                      , formFieldRenderHelper = id+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly+                      }++-- | A form field for selecting a single choice from a set of possible+-- choices. Each choice has an associated value and text label.+--+-- This field responds to `Space` keypresses to select a radio button+-- option and to mouse clicks.+radioField :: (Ord n, Show n, Eq a)+           => Lens' s a+           -- ^ The state lens for this value.+           -> [(a, n, T.Text)]+           -- ^ The available choices, in order. Each choice has a value+           -- of type @a@, a resource name, and a text label.+           -> s+           -- ^ The initial form state.+           -> FormFieldState s e n+radioField = radioCustomField '[' '*' ']'++-- | A form field for selecting a single choice from a set of possible+-- choices. Each choice has an associated value and text label. This+-- function permits the customization of the @[*]@ notation characters.+--+-- This field responds to `Space` keypresses to select a radio button+-- option and to mouse clicks.+radioCustomField :: (Ord n, Show n, Eq a)+                 => Char+                 -- ^ Left bracket character.+                 -> Char+                 -- ^ Checkmark character.+                 -> Char+                 -- ^ Right bracket character.+                 -> Lens' s a+                 -- ^ The state lens for this value.+                 -> [(a, n, T.Text)]+                 -- ^ The available choices, in order. Each choice has a value+                 -- of type @a@, a resource name, and a text label.+                 -> s+                 -- ^ The initial form state.+                 -> FormFieldState s e n+radioCustomField lb check rb stLens options initialState =+    let initVal = initialState ^. stLens++        lookupOptionValue n =+            let results = filter (\(_, n', _) -> n' == n) options+            in case results of+                [(val, _, _)] -> Just val+                _ -> Nothing++        handleEvent _ (MouseDown n _ _ _) =+            case lookupOptionValue n of+                Nothing -> return ()+                Just v -> put v+        handleEvent new (VtyEvent (EvKey (KChar ' ') [])) = put new+        handleEvent _ _ = return ()++        optionFields = mkOptionField <$> options+        mkOptionField (val, name, label) =+            FormField name+                      Just+                      True+                      (renderRadio lb check rb val name label)+                      (handleEvent val)++    in FormFieldState { formFieldState = initVal+                      , formFields = optionFields+                      , formFieldLens = stLens+                      , formFieldUpdate = \val _ -> val+                      , formFieldRenderHelper = id+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly+                      }++renderRadio :: (Eq a, Ord n) => Char -> Char -> Char -> a -> n -> T.Text -> Bool -> a -> Widget n+renderRadio lb check rb val name label foc cur =+    let addAttr = if foc+                  then withDefAttr focusedFormInputAttr+                  else id+        isSet = val == cur+        csr = if foc then putCursor name (Location (1,0)) else id+    in clickable name $+       addAttr $ csr $+       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+-- this function.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editField :: (Ord n, Show n)+          => Lens' s a+          -- ^ The state lens for this value.+          -> n+          -- ^ The resource name for the input field.+          -> Maybe Int+          -- ^ The optional line limit for the editor (see 'editor').+          -> (a -> T.Text)+          -- ^ The initialization function that turns your value into+          -- the editor's initial contents. The resulting text may+          -- contain newlines.+          -> ([T.Text] -> Maybe a)+          -- ^ The validation function that converts the editor's+          -- contents into a valid value of type @a@.+          -> ([T.Text] -> Widget n)+          -- ^ The rendering function for the editor's contents (see+          -- 'renderEditor').+          -> (Widget n -> Widget n)+          -- ^ A rendering augmentation function to adjust the+          -- representation of the rendered editor.+          -> s+          -- ^ The initial form state.+          -> FormFieldState s e n+editField stLens n limit ini val renderText wrapEditor initialState =+    let initVal = applyEdit gotoEnd $+                  editor n limit initialText+        gotoEnd = let ls = T.lines initialText+                      pos = (length ls - 1, T.length (last ls))+                  in if null ls+                     then id+                     else Z.moveCursor pos+        initialText = ini $ initialState ^. stLens++    in FormFieldState { formFieldState = initVal+                      , formFields = [ FormField n+                                                 (val . getEditContents)+                                                 True+                                                 (\b e -> wrapEditor $ renderEditor renderText b e)+                                                 handleEditorEvent+                                     ]+                      , formFieldLens = stLens+                      , formFieldUpdate = \newVal e ->+                          let newTxt = ini newVal+                          in if newTxt == (T.unlines $ getEditContents e)+                             then e+                             else applyEdit (Z.insertMany newTxt . Z.clearZipper) e+                      , formFieldRenderHelper = id+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly+                      }++-- | A form field using a single-line editor to edit the 'Show'+-- representation of a state field value of type @a@. This automatically+-- uses its 'Read' instance to validate the input. This field is mostly+-- useful in cases where the user-facing representation of a value+-- matches the 'Show' representation exactly, such as with 'Int'.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editShowableField :: (Ord n, Show n, Read a, Show a)+                  => Lens' s a+                  -- ^ The state lens for this value.+                  -> n+                  -- ^ The resource name for the input field.+                  -> s+                  -- ^ The initial form state.+                  -> FormFieldState s e n+editShowableField stLens n =+    editShowableFieldWithValidate stLens n (const True)++-- | A form field using a single-line editor to edit the 'Show' representation+-- of a state field value of type @a@. This automatically uses its 'Read'+-- instance to validate the input, and also accepts an additional user-defined+-- pass for validation. This field is mostly useful in cases where the+-- user-facing representation of a value matches the 'Show' representation+-- exactly, such as with 'Int', but you don't want to accept just /any/ 'Int'.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editShowableFieldWithValidate :: (Ord n, Show n, Read a, Show a)+                              => Lens' s a+                              -- ^ The state lens for this value.+                              -> n+                              -- ^ The resource name for the input field.+                              -> (a -> Bool)+                              -- ^ Additional validation step for input.+                              -- 'True' indicates that the value is+                              -- valid.+                              -> s+                              -- ^ The initial form state.+                              -> FormFieldState s e n+editShowableFieldWithValidate stLens n isValid =+    let ini = T.pack . show+        val ls = do+            v <- readMaybe $ T.unpack $ T.intercalate "\n" ls+            if isValid v+               then return v+               else Nothing+        limit = Just 1+        renderText = txt . T.unlines+    in editField stLens n limit ini val renderText id++-- | A form field using an editor to edit a text value. Since the value+-- is free-form text, it is always valid.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editTextField :: (Ord n, Show n)+              => Lens' s T.Text+              -- ^ The state lens for this value.+              -> n+              -- ^ The resource name for the input field.+              -> Maybe Int+              -- ^ The optional line limit for the editor (see 'editor').+              -> s+              -- ^ The initial form state.+              -> FormFieldState s e n+editTextField stLens n limit =+    let ini = id+        val = Just . T.intercalate "\n"+        renderText = txt . T.intercalate "\n"+    in editField stLens n limit ini val renderText id++-- | A form field using a single-line editor to edit a free-form text+-- value represented as a password. The value is always considered valid+-- and is always represented with one asterisk per password character.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editPasswordField :: (Ord n, Show n)+                  => Lens' s T.Text+                  -- ^ The state lens for this value.+                  -> n+                  -- ^ The resource name for the input field.+                  -> s+                  -- ^ The initial form state.+                  -> FormFieldState s e n+editPasswordField stLens n =+    let ini = id+        val = Just . T.concat+        limit = Just 1+        renderText = toPassword+    in editField stLens n limit ini val renderText id++toPassword :: [T.Text] -> Widget a+toPassword s = txt $ T.replicate (T.length $ T.concat s) "*"++-- | The namespace for the other form attributes.+formAttr :: AttrName+formAttr = attrName "brickForm"++-- | The attribute for form input fields with invalid values. Note that+-- this attribute will affect any field considered invalid and will take+-- priority over any attributes that the field uses to render itself.+invalidFormInputAttr :: AttrName+invalidFormInputAttr = formAttr <> attrName "invalidInput"++-- | The attribute for form input fields that have the focus. Note that+-- this attribute only affects fields that do not already use their own+-- attributes when rendering, such as editor- and list-based fields.+-- Those need to be styled by setting the appropriate attributes; see+-- the documentation for field constructors to find out which attributes+-- need to be configured.+focusedFormInputAttr :: AttrName+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+-- when we need to decide whether the form state is up to date with+-- respect to the form input fields.+allFieldsValid :: Form s e n -> Bool+allFieldsValid = null . invalidFields++-- | Returns the resource names associated with all form input fields+-- that currently have invalid inputs. This is useful when we need to+-- force the user to repair invalid inputs before moving on from a form+-- editing session.+invalidFields :: Form s e n -> [n]+invalidFields f = concatMap getInvalidFields (formFieldStates f)++-- | Set the visibility mode of the specified form field's collection+-- when the form is rendered in viewport. This is used to change how+-- focused fields are brought into view when they're outside of view+-- in a viewport and gain focus. In practice, this means this function+-- need only be called on one form field name in a collection in order+-- to affect the visibility behavior of that field's entire input+-- collection.+--+-- There are two visibility modes:+--+-- * 'ShowFocusedFieldOnly' - this is the default behavior. In this+--   mode, when a field receives focus, it is brought into view but+--   other inputs in the same field collection (e.g. a set of radio+--   buttons) will not be brought into view along with it.+--+-- * 'ShowCompositeField' - in this mode, when a field receives focus,+--   all of the inputs in its collection (e.g. a set of radio buttons)+--   are brought into view as long as the viewport is large enough to+--   show them all. If it isn't, the viewport will show as many as space+--   allows.+--+-- * 'ShowAugmentedField' - in this mode, when a field receives focus,+--   all of the inputs in its collection (e.g. a set of radio buttons)+--   and its rendering augmentations (as applied with '@@=') are brought+--   into view as long as the viewport is large enough to show them all.+setFieldVisibilityMode :: (Eq n)+                       => n+                       -- ^ The name of the form field whose visibility mode is to be set.+                       -> FormFieldVisibilityMode+                       -- ^ The mode to set.+                       -> Form s e n+                       -- ^ The form to modify.+                       -> Form s e n+setFieldVisibilityMode n mode form =+    let go1 [] = []+        go1 (s:ss) =+            let s' = case s of+                       FormFieldState st l upd fs rh concatAll _ ->+                           if n `elem` formFieldNames s+                           then FormFieldState st l upd fs rh concatAll mode+                           else s+            in s' : go1 ss++    in form { formFieldStates = go1 (formFieldStates form) }++-- | Manually indicate that a field has invalid contents. This can be+-- useful in situations where validation beyond the form element's+-- validator needs to be performed and the result of that validation+-- needs to be fed back into the form state.+setFieldValid :: (Eq n)+              => Bool+              -- ^ Whether the field is considered valid.+              -> n+              -- ^ The name of the form field to set as (in)valid.+              -> Form s e n+              -- ^ The form to modify.+              -> Form s e n+setFieldValid v n form =+    let go1 [] = []+        go1 (s:ss) =+            let s' = case s of+                       FormFieldState st l upd fs rh concatAll visMode ->+                           let go2 [] = []+                               go2 (f@(FormField fn val _ r h):ff)+                                   | n == fn = FormField fn val v r h : ff+                                   | otherwise = f : go2 ff+                           in FormFieldState st l upd (go2 fs) rh concatAll visMode+            in s' : go1 ss++    in form { formFieldStates = go1 (formFieldStates form) }++getInvalidFields :: FormFieldState s e n -> [n]+getInvalidFields (FormFieldState st _ _ fs _ _ _) =+    let gather (FormField n validate extValid _ _) =+            if not extValid || isNothing (validate st) then [n] else []+    in concatMap gather fs++-- | Render a form.+--+-- For each form field, each input for the field is rendered using+-- the implementation provided by its 'FormField'. The inputs are+-- then concatenated with the field's concatenation function (see+-- 'setFieldConcat') and are then augmented using the form field's+-- rendering augmentation function (see '@@='). Fields with invalid+-- inputs (either due to built-in validator failure or due to external+-- validation failure via 'setFieldValid') will be displayed using the+-- 'invalidFormInputAttr' attribute.+--+-- Finally, all of the resulting field renderings are concatenated with+-- the form's concatenation function (see 'setFormConcat'). A visibility+-- request is also issued for the currently-focused form field in case+-- the form is rendered within a viewport.+renderForm :: (Eq n) => Form s e n -> Widget n+renderForm (Form es fr _ concatAll) =+    concatAll $ renderFormFieldState fr <$> es++-- | Render a single form field collection. This is called internally by+-- 'renderForm' but is exposed in cases where a form field state needs+-- to be rendered outside of a 'Form', so 'renderForm' is probably what+-- you want.+renderFormFieldState :: (Eq n)+                     => FocusRing n+                     -> FormFieldState s e n+                     -> Widget n+renderFormFieldState fr (FormFieldState st _ _ fields helper concatFields visMode) =+    let curFocus = focusGetCurrent fr+        foc = case curFocus of+                  Nothing -> False+                  Just n -> n `elem` fieldNames+        maybeVisible = if foc && visMode == ShowCompositeField then visible else id+        renderFields [] = []+        renderFields ((FormField n validate extValid renderField _):fs) =+            let maybeInvalid = if (isJust $ validate st) && extValid+                               then id+                               else forceAttr invalidFormInputAttr+                fieldFoc = Just n == curFocus+                maybeFieldVisible = if fieldFoc && visMode == ShowFocusedFieldOnly then visible else id+            in (n, maybeFieldVisible $ maybeInvalid $ renderField fieldFoc st) : renderFields fs+        (fieldNames, renderedFields) = unzip $ renderFields fields+        maybeHelperVisible =+            if foc && visMode == ShowAugmentedField then visible else id+    in maybeHelperVisible $ helper $ maybeVisible $ concatFields renderedFields++-- | 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.+-- * On @Shift-Tab@ keypresses, this changes the focus to the previous+--   field in the form.+-- * On mouse button presses (regardless of button or modifier), the+--   focus is changed to the clicked form field and the event is+--   forwarded to the event handler for the clicked form field.+-- * On @Left@ or @Up@, if the currently-focused field is part of a+--   collection (e.g. radio buttons), the previous entry in the+--   collection is focused.+-- * On @Right@ or @Down@, if the currently-focused field is part of a+--   collection (e.g. radio buttons), the next entry in the collection+--   is focused.+-- * All other events are forwarded to the currently focused form field.+--+-- In all cases where an event is forwarded to a form field, validation+-- of the field's input state is performed immediately after the+-- event has been handled. If the form field's input state succeeds+-- validation using the field's validator function, its value is+-- immediately stored in the form state using the form field's state+-- 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 -> 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)+    where+        findGroup [] = Nothing+        findGroup (e:es) =+            let ns = formFieldNames e+            in if n `elem` ns && length ns > 1+               then Just ns+               else findGroup es++entryAfter :: (Eq a) => [a] -> a -> a+entryAfter as a =+    let i = fromJust $ elemIndex a as+        i' = if i == length as - 1 then 0 else i + 1+    in as !! i'++entryBefore :: (Eq a) => [a] -> a -> a+entryBefore as a =+    let i = fromJust $ elemIndex a as+        i' = if i == 0 then length as - 1 else i - 1+    in as !! i'++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++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 visMode -> do+                    let findField [] = return Nothing+                        findField (field:rest) =+                            case field of+                                FormField n' validate _ _ handleFunc | n == n' -> do+                                    (nextSt, ()) <- nestEventM st (handleFunc ev)+                                    -- If the new state validates, go ahead and update+                                    -- the form state with it.+                                    case validate nextSt of+                                        Nothing -> return $ Just (nextSt, Nothing)+                                        Just newSt -> return $ Just (nextSt, Just newSt)+                                _ -> findField rest++                    result <- findField fields+                    case result of+                        Nothing -> findFieldState (prev <> [e]) es+                        Just (newSt, maybeSt) -> do+                            let newFieldState = FormFieldState newSt stLens upd fields helper concatAll visMode+                            formFieldStatesL .= prev <> [newFieldState] <> es+                            case maybeSt of+                              Nothing -> return ()+                              Just s  -> formStateL.stLens .= s++    states <- gets formFieldStates+    findFieldState [] states
+ src/Brick/Keybindings.hs view
@@ -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
+ src/Brick/Keybindings/KeyConfig.hs view
@@ -0,0 +1,258 @@+-- | 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'.+--+-- Since a key configuration can have keys bound to multiple events, it+-- is the application author's responsibility to check for collisions+-- since the nature of the collisions will depend on how the application+-- is implemented. To check for collisions, use the result of+-- 'keyEventMappings'.+module Brick.Keybindings.KeyConfig+  ( KeyConfig+  , newKeyConfig+  , BindingState(..)++  -- * Specifying bindings+  , Binding(..)+  , ToBinding(..)+  , binding+  , fn+  , meta+  , ctrl+  , shift++  -- * Querying KeyConfigs+  , firstDefaultBinding+  , firstActiveBinding+  , allDefaultBindings+  , allActiveBindings+  , keyEventMappings++  -- * Misc+  , keyConfigEvents+  , lookupKeyConfigBindings+  )+where++import Data.List (nub)+import qualified Data.Map.Strict as M+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Set as S+import Data.Maybe (fromMaybe, listToMaybe, catMaybes)+import qualified Graphics.Vty as Vty++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.Normalize++-- | 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. If modifiers+-- are given and the binding is for a character key, it is forced to+-- lowercase.+binding :: Vty.Key -> [Vty.Modifier] -> Binding+binding k mods =+    Binding { kbKey = normalizeKey mods 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 { keyConfigCustomBindings :: [(k, BindingState)]+              -- ^ The list of custom binding states for events with+              -- custom bindings. We use a list to ensure that we+              -- preserve key bindings for keys that are mapped to more+              -- than one event. This may be valid or invalid depending+              -- on the events in question; whether those bindings+              -- constitute a collision is up to the application+              -- developer to check.+              , keyConfigEvents :: KeyEvents k+              -- ^ The base mapping of events and their names that is+              -- used in this configuration.+              , 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. Note that this+             -- function does not check for collisions since it is up to+             -- the application to determine whether a key bound to more+             -- than one event constitutes a collision!+             -> KeyConfig k+newKeyConfig evs defaults bindings =+    KeyConfig { keyConfigCustomBindings = bindings+              , keyConfigEvents = evs+              , keyConfigDefaultBindings = M.fromList defaults+              }++-- | Return a list of mappings including each key bound to any event+-- combined with the list of events to which it is bound. This is useful+-- for identifying problematic key binding collisions. Since key binding+-- collisions cannot be determined in general, we leave it up to the+-- application author to determine which key-to-event bindings are+-- problematic.+keyEventMappings :: (Ord k, Eq k) => KeyConfig k -> [(Binding, S.Set k)]+keyEventMappings kc = M.toList resultMap+    where+        -- Get all default bindings+        defaultBindings = M.toList $ keyConfigDefaultBindings kc+        -- Get all explicitly unbound events+        explicitlyUnboundEvents = fmap fst $ filter ((== Unbound) . snd) $ keyConfigCustomBindings kc+        -- Remove explicitly unbound events from the default set of+        -- bindings+        defaultBindingsWithoutUnbound = filter ((`notElem` explicitlyUnboundEvents) . fst) defaultBindings+        -- Now get customized binding lists+        customizedKeybindingLists = catMaybes $ (flip fmap) (keyConfigCustomBindings kc) $ \(k, bState) -> do+            case bState of+                Unbound -> Nothing+                BindingList bs -> Just (k, bs)+        -- Now build a map from binding to event list+        allPairs = defaultBindingsWithoutUnbound <>+                   customizedKeybindingLists+        addBindings m (ev, bs) =+            M.unionWith S.union m $ M.fromList [(b, S.singleton ev) | b <- bs]+        resultMap = foldl addBindings mempty allPairs++-- | Look up the binding state for the specified event. This returns+-- 'Nothing' when the event has no explicitly configured custom+-- 'BindingState'.+lookupKeyConfigBindings :: (Ord k) => KeyConfig k -> k -> Maybe BindingState+lookupKeyConfigBindings kc e = lookup e $ keyConfigCustomBindings 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+        newMods = S.insert m $ kbMods b+    in b { kbMods = newMods+         , kbKey = normalizeKey (S.toList newMods) $ kbKey b+         }++-- | Add Meta to a binding. If the binding is for a character key, force+-- it to lowercase.+meta :: (ToBinding a) => a -> Binding+meta = addModifier Vty.MMeta++-- | Add Ctrl to a binding. If the binding is for a character key, force+-- it to lowercase.+ctrl :: (ToBinding a) => a -> Binding+ctrl = addModifier Vty.MCtrl++-- | Add Shift to a binding. If the binding is for a character key, force+-- it to lowercase.+shift :: (ToBinding a) => a -> Binding+shift = addModifier Vty.MShift++-- | Function key binding.+fn :: Int -> Binding+fn = bind . Vty.KFun
+ src/Brick/Keybindings/KeyDispatcher.hs view
@@ -0,0 +1,241 @@+-- | This is the entry point into the keybinding infrastructure in+-- this library. Note that usage of this API is not required to create+-- working Brick applications; this API is provided for applications+-- that need to support custom keybindings that are less tightly coupled+-- to application behavior.+--+-- The workflow for this API is as follows:+--+-- * Create a data type @k@ with a constructor for each abstract+--   application event that you want to trigger with an input key.+-- * To each event @k@, assign a unique user-readable name (such as a+--   name you could imagine using in a configuration file to refer to+--   the event) and a list of default key bindings.+-- * Use the resulting data to create a 'KeyConfig' with 'newKeyConfig'.+--   If desired, provide custom keybindings to 'newKeyConfig' from+--   within the program or load them from an INI file with routines like+--   'Brick.Keybindings.Parse.keybindingsFromFile'.+-- * Optionally check for configuration-wide keybinding collisions with+--   'Brick.Keybindings.KeyConfig.keyEventMappings'.+-- * Implement application event handlers that will be run in response+--   to either specific hard-coded keys or events @k@, both in some+--   monad @m@ of your choosing, using constructors 'onKey' and+--   'onEvent'.+-- * Use the created 'KeyConfig' and handlers to create a+--   'KeyDispatcher' with 'keyDispatcher', dealing with collisions if+--   they arise.+-- * As user input events arrive, dispatch them to the appropriate+--   handler in the dispatcher using 'handleKey'.+module Brick.Keybindings.KeyDispatcher+  ( -- * Key dispatching+    KeyDispatcher+  , keyDispatcher+  , handleKey++  -- * Building handlers+  , onEvent+  , onKey++  -- * Handlers and triggers+  , Handler(..)+  , KeyHandler(..)+  , KeyEventHandler(..)+  , EventTrigger(..)++  -- * Misc+  , keyDispatcherToList+  , lookupVtyEvent+  )+where++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Graphics.Vty as Vty+import Data.Function (on)+import Data.List (groupBy, sortBy)++import Brick.Keybindings.KeyConfig++-- | A dispatcher keys that map to abstract events @k@ and whose+-- handlers run in the monad @m@.+newtype KeyDispatcher k m = KeyDispatcher (M.Map Binding (KeyHandler k m))++-- | A 'Handler' represents a handler implementation to be invoked in+-- response to some event that runs in the monad @m@.+--+-- In general, you should never need to make one of these manually.+-- Instead, use 'onEvent' and 'onKey'. This type's internals are exposed+-- for easy inspection, not construction.+data Handler m =+    Handler { 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 manually.+-- The internals are exposed to make inspection easy.+data KeyHandler k m =+    KeyHandler { khHandler :: KeyEventHandler k m+               -- ^ The handler to invoke. Note that this maintains+               -- 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@. If any collisions are detected,+-- this fails with 'Left' and returns the list of colliding event+-- handlers for each overloaded binding. (Each returned 'KeyHandler'+-- contains the original 'KeyEventHandler' that was used to build it so+-- those can be inspected to understand which handlers are mapped to the+-- same key, either via an abstract key event using 'onEvent' or via a+-- statically configured key using 'onKey'.)+--+-- This works by taking a list of abstract 'KeyEventHandler's and+-- building a 'KeyDispatcher' of event handlers based on specific Vty+-- keys using the provided 'KeyConfig' to map between abstract key+-- events of type @k@ and Vty keys. Event handlers triggered by an event+-- @k@ are set up to be triggered by either the customized bindings for+-- @k@ in the 'KeyConfig', no bindings at all if the 'KeyConfig' has+-- marked @k@ as 'Unbound', or the default bindings for @k@ otherwise.+--+-- Once you have a 'KeyDispatcher', you can dispatch an input key event+-- to it and invoke the corresponding handler (if any) with 'handleKey'.+keyDispatcher :: (Ord k)+              => KeyConfig k+              -> [KeyEventHandler k m]+              -> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)+keyDispatcher conf ks =+    let pairs = buildKeyDispatcherPairs ks conf+        groups = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) pairs+        badGroups = filter ((> 1) . length) groups+        combine :: [(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])+        combine as =+            let b = fst $ head as+            in (b, snd <$> as)+    in if null badGroups+       then Right $ KeyDispatcher $ M.fromList pairs+       else Left $ combine <$> badGroups++-- | Convert a key dispatcher to a list of pairs of bindings and their+-- handlers.+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 = concatMap (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.+                    }
+ src/Brick/Keybindings/KeyEvents.hs view
@@ -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
+ src/Brick/Keybindings/Normalize.hs view
@@ -0,0 +1,14 @@+module Brick.Keybindings.Normalize+  ( normalizeKey+  )+where++import Data.Char (toLower)+import qualified Graphics.Vty as Vty++-- | A keybinding involving modifiers should have its key character+-- normalized to lowercase since it's impossible to get uppercase keys+-- from the terminal when modifiers are present.+normalizeKey :: [Vty.Modifier] -> Vty.Key -> Vty.Key+normalizeKey (_:_) (Vty.KChar c) = Vty.KChar $ toLower c+normalizeKey _ k = k
+ src/Brick/Keybindings/Parse.hs view
@@ -0,0 +1,182 @@+{-# 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+  , normalizeKey++  , keybindingsFromIni+  , keybindingsFromFile+  , keybindingIniParser+  )+where++import Control.Monad (forM)+import Data.Maybe (catMaybes)+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+import Brick.Keybindings.Normalize++-- | 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 k' mods+        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 bindings 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
+ src/Brick/Keybindings/Pretty.hs view
@@ -0,0 +1,248 @@+{-# 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)+#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 = maybe (Comment "(unnamed)") Verbatim $ keyEventName (keyConfigEvents kc) ev+              in case lookupKeyConfigBindings kc ev of+                  Nothing ->+                      if not (null (allDefaultBindings kc ev))+                      then (name, Verbatim <$> ppBinding <$> allDefaultBindings kc ev)+                      else (name, unbound)+                  Just Unbound ->+                      (name, unbound)+                  Just (BindingList bs) ->+                      let result = if not (null bs)+                                   then Verbatim <$> ppBinding <$> bs+                                   else unbound+                      in (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+            Verbatim s -> 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"
src/Brick/Main.hs view
@@ -1,14 +1,21 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-} module Brick.Main   ( App(..)   , defaultMain   , customMain+  , customMainWithVty+  , customMainWithDefaultVty   , simpleMain   , resizeOrQuit+  , simpleApp    -- * Event handler functions-  , continue+  , continueWithoutRedraw   , halt   , suspendAndResume+  , suspendAndResume'+  , makeVisible   , lookupViewport   , lookupExtent   , findClickedExtents@@ -37,20 +44,23 @@   -- * Rendering cache management   , invalidateCacheEntry   , invalidateCache++  -- * Renderer internals (for benchmarking)+  , renderFinal+  , getRenderState+  , resetRenderState+  , renderWidget   ) where -import Control.Exception (finally)-import Lens.Micro ((^.), (&), (.~))-import Control.Monad (forever)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State-import Control.Monad.Trans.Reader+import qualified Control.Exception as E+import Lens.Micro ((^.), (&), (.~), (%~), _1, _2)+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader import Control.Concurrent (forkIO, killThread)-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-import Data.Monoid (mempty)-#endif+import qualified Data.Foldable as F+import Data.List (find) import Data.Maybe (listToMaybe) import qualified Data.Map as M import qualified Data.Set as S@@ -64,27 +74,31 @@   , displayBounds   , shutdown   , nextEvent-  , mkVty-  , defaultConfig+  , restoreInputState+  , inputIface   )+import Graphics.Vty.CrossPlatform (mkVty)+import Graphics.Vty.Config (defaultConfig) import Graphics.Vty.Attributes (defAttr)  import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan)-import Brick.Types (Widget, EventM(..))+import Brick.Types.EventM import Brick.Types.Internal import Brick.Widgets.Internal import Brick.AttrMap  -- | The library application abstraction. Your application's operations--- are represented here and passed to one of the various main functions--- in this module. An application is in terms of an application state--- type 's', an application event type 'e', and a resource name type--- 'n'. In the simplest case 'e' is unused (left polymorphic or set to--- '()'), but you may define your own event type and use 'customMain'--- to provide custom events. The state type is the type of application--- state to be provided by you and iteratively modified by event--- handlers. The resource name type is the type of names you can assign--- to rendering resources such as viewports and cursor locations.+-- are provided in an @App@ and then the @App@ is provided to one of the+-- various main functions in this module. An application @App s e n@+-- is in terms of an application state type @s@, an application event+-- type @e@, and a resource name type @n@. In the simplest case 'e' is+-- unused (left polymorphic or set to @()@), but you may define your own+-- event type and use 'customMain' to provide custom events. The state+-- type @s@ is the type of application state to be provided by you and+-- iteratively modified by event handlers. The resource name type @n@+-- is the type of names you can assign to rendering resources such as+-- viewports and cursor locations. Your application must define this+-- type. data App s e n =     App { appDraw :: s -> [Widget n]         -- ^ This function turns your application state into a list of@@ -97,12 +111,10 @@         -- 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)-        -- ^ 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', 'suspendAndResume', and 'halt'.-        , appStartEvent :: s -> EventM n s+        , appHandleEvent :: BrickEvent n e -> EventM n s ()+        -- ^ This function handles an event and updates the current+        -- application state.+        , appStartEvent :: EventM n s ()         -- ^ This function gets called once just prior to the first         -- drawing of your application. Here is where you can make         -- initial scrolling requests, for example.@@ -111,8 +123,8 @@         }  -- | The default main entry point which takes an application and an--- initial state and returns the final state returned by a 'halt'--- operation.+-- initial state and returns the final state from 'EventM' once the+-- program exits. defaultMain :: (Ord n)             => App s e n             -- ^ The application.@@ -120,7 +132,9 @@             -- ^ The initial application state.             -> IO s defaultMain app st = do-    customMain (mkVty defaultConfig) Nothing app st+    (s, vty) <- customMainWithDefaultVty Nothing app st+    shutdown vty+    return s  -- | A simple main entry point which takes a widget and renders it. This -- event loop terminates when the user presses any key, but terminal@@ -129,64 +143,79 @@            => Widget n            -- ^ The widget to draw.            -> IO ()-simpleMain w =-    let app = App { appDraw = const [w]-                  , appHandleEvent = resizeOrQuit-                  , appStartEvent = return-                  , appAttrMap = const $ attrMap defAttr []-                  , appChooseCursor = neverShowCursor-                  }-    in defaultMain app ()+simpleMain w = defaultMain (simpleApp w) () +-- | A simple application with reasonable defaults to be overridden as+-- desired:+--+-- * Draws only the specified widget+-- * Quits on any event other than resizes+-- * Has no start event handler+-- * Provides no attribute map+-- * Never shows any cursors+simpleApp :: Widget n -> App s e n+simpleApp w =+    App { appDraw = const [w]+        , appHandleEvent = resizeOrQuit+        , appStartEvent = return ()+        , appAttrMap = const $ attrMap defAttr []+        , appChooseCursor = neverShowCursor+        }+ -- | An event-handling function which continues execution of the event -- loop only when resize events occur; all other types of events trigger -- 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 -runWithNewVty :: (Ord n)-              => IO Vty-              -> BChan (BrickEvent n e)-              -> Maybe (BChan e)-              -> App s e n-              -> RenderState n-              -> s-              -> IO (InternalNext n s)-runWithNewVty buildVty brickChan mUserChan app initialRS initialSt =-    withVty buildVty $ \vty -> do-        pid <- forkIO $ supplyVtyEvents vty brickChan-        let readEvent = case mUserChan of-              Nothing -> readBChan brickChan-              Just uc -> readBrickEvent brickChan uc-            runInner rs st = do-              (result, newRS) <- runVty vty readEvent app st (rs & observedNamesL .~ S.empty-                                                                 & clickableNamesL .~ mempty)-              case result of-                  SuspendAndResume act -> do-                      killThread pid-                      return $ InternalSuspendAndResume newRS act-                  Halt s -> do-                      killThread pid-                      return $ InternalHalt s-                  Continue s -> runInner newRS s-        runInner initialRS initialSt+runWithVty :: (Ord n)+           => VtyContext+           -> BChan (BrickEvent n e)+           -> Maybe (BChan e)+           -> App s e n+           -> RenderState n+           -> s+           -> 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 ctx rs es draw st = do+          let nextRS = if draw+                       then resetRenderState rs+                       else rs+          (nextSt, result, newRS, newExtents, newCtx) <- runVty ctx readEvent app st nextRS es draw+          case result of+              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.+-- don't permit enough control. Returns the final application state+-- after the application halts.+--+-- Note that this function guarantees that the terminal input state+-- prior to the first Vty initialization is the terminal input state+-- that is restored on shutdown (regardless of exceptions). customMain :: (Ord n)-           => IO Vty-           -- ^ An IO action to build a Vty handle. This is used to-           -- build a Vty handle whenever the event loop begins or is-           -- resumed after suspension.+           => Vty+           -- ^ The initial Vty handle to use.+           -> IO Vty+           -- ^ An IO action to build a Vty handle. This is used+           -- to build a Vty handle whenever the event loop needs+           -- to reinitialize the terminal, e.g. on resume after+           -- suspension.            -> Maybe (BChan e)            -- ^ An event channel for sending custom events to the event            -- loop (you write to this channel, the event loop reads from@@ -197,37 +226,136 @@            -> s            -- ^ The initial application state.            -> IO s-customMain buildVty mUserChan app initialAppState = do-    let run rs st brickChan = do-            result <- runWithNewVty buildVty brickChan mUserChan app rs st-            case result of-                InternalHalt s -> return s-                InternalSuspendAndResume newRS action -> do-                    newAppState <- action-                    run newRS newAppState brickChan+customMain initialVty buildVty mUserChan app initialAppState = do+    let restoreInitialState = restoreInputState $ inputIface initialVty -        emptyES = ES [] []-        eventRO = EventRO M.empty Nothing mempty-    (st, eState) <- runStateT (runReaderT (runEventM (appStartEvent app initialAppState)) eventRO) emptyES-    let initialRS = RS M.empty (esScrollRequests eState) S.empty mempty []+    (s, vty) <- customMainWithVty initialVty buildVty mUserChan app initialAppState+        `E.catch` (\(e::E.SomeException) -> restoreInitialState >> E.throw e)++    shutdown vty+    restoreInitialState+    return s++-- | Like 'customMainWithVty', except that Vty is initialized with the+-- default configuration.+--+-- The returned 'Vty' handle still has control of the terminal. The+-- caller is responsible for calling 'shutdown' to restore the terminal+-- state.+customMainWithDefaultVty :: (Ord n)+                         => Maybe (BChan e)+                         -- ^ An event channel for sending custom+                         -- events to the event loop (you write to this+                         -- channel, the event loop reads from it).+                         -- Provide 'Nothing' if you don't plan on+                         -- sending custom events.+                         -> App s e n+                         -- ^ The application.+                         -> s+                         -- ^ The initial application state.+                         -> IO (s, Vty)+customMainWithDefaultVty mUserChan app initialAppState = do+    let builder = mkVty defaultConfig+    vty <- builder+    customMainWithVty vty builder mUserChan app initialAppState++-- | Like 'customMain', except the last 'Vty' handle used by the+-- application is returned without being shut down with 'shutdown'. This+-- allows the caller to re-use the 'Vty' handle for something else, such+-- as another Brick application.+customMainWithVty :: (Ord n)+                  => Vty+                  -- ^ The initial Vty handle to use.+                  -> IO Vty+                  -- ^ An IO action to build a Vty handle. This is used+                  -- to build a Vty handle whenever the event loop needs+                  -- to reinitialize the terminal, e.g. on resume after+                  -- suspension.+                  -> Maybe (BChan e)+                  -- ^ An event channel for sending custom events to the event+                  -- loop (you write to this channel, the event loop reads from+                  -- it). Provide 'Nothing' if you don't plan on sending custom+                  -- events.+                  -> App s e n+                  -- ^ The application.+                  -> s+                  -- ^ The initial application state.+                  -> IO (s, Vty)+customMainWithVty initialVty buildVty mUserChan app initialAppState = do     brickChan <- newBChan 20-    run initialRS st brickChan+    vtyCtx <- newVtyContext buildVty (Just initialVty) (writeBChan brickChan . VtyEvent) -supplyVtyEvents :: Vty -> BChan (BrickEvent n e) -> IO ()-supplyVtyEvents vty chan =-    forever $ do-        e <- nextEvent vty-        writeBChan chan $ VtyEvent e+    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 mempty emptyRS +    (((), appState), eState) <- runStateT (runStateT (runReaderT (runEventM (appStartEvent app)) eventRO) initialAppState) emptyES+    let initialRS = RS { viewportMap = M.empty+                       , rsScrollRequests = esScrollRequests eState+                       , observedNames = S.empty+                       , renderCache = mempty+                       , clickableNames = []+                       , requestedVisibleNames_ = requestedVisibleNames eState+                       , reportedExtents = mempty+                       }++    (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-       -> IO (Next s, RenderState n)-runVty vty readEvent app appState rs = do-    (firstRS, exts) <- renderApp vty app appState rs+       -> [Extent n]+       -> Bool+       -> IO (s, NextAction, RenderState n, [Extent n], VtyContext)+runVty vtyCtx readEvent app appState rs prevExtents draw = do+    (firstRS, exts) <- if draw+                       then renderApp vtyCtx app appState rs+                       else return (rs, prevExtents)+     e <- readEvent      (e', nextRS, nextExts) <- case e of@@ -236,112 +364,154 @@         -- 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             case matching of-                (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) ->+                (Extent n (Location (ec, er)) _:_) ->                     -- If the clicked extent was registered as                     -- clickable, send a click event. Otherwise, just                     -- send the raw mouse event-                    case n `elem` firstRS^.clickableNamesL of-                        True -> do-                            let localCoords = Location (lc, lr)-                                lc = c - ec + oC-                                lr = r - er + oR-                            return (MouseDown n button mods localCoords, firstRS, exts)-                        False -> return (e, firstRS, exts)+                    if n `elem` firstRS^.clickableNamesL+                    then do+                        let localCoords = Location (lc, lr)+                            lc = c - ec+                            lr = r - er++                            -- If the clicked extent was a viewport,+                            -- adjust the local coordinates by+                            -- adding the viewport upper-left corner+                            -- offset.+                            newCoords = case M.lookup n (viewportMap firstRS) of+                              Nothing -> localCoords+                              Just vp -> localCoords & _1 %~ (+ (vp^.vpLeft))+                                                     & _2 %~ (+ (vp^.vpTop))++                        return (MouseDown n button mods newCoords, firstRS, exts)+                    else return (e, firstRS, exts)                 _ -> return (e, firstRS, exts)         VtyEvent (EvMouseUp c r button) -> do             let matching = findClickedExtents_ (c, r) exts             case matching of-                (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) ->+                (Extent n (Location (ec, er)) _:_) ->                     -- If the clicked extent was registered as                     -- clickable, send a click event. Otherwise, just                     -- send the raw mouse event-                    case n `elem` firstRS^.clickableNamesL of-                        True -> do-                            let localCoords = Location (lc, lr)-                                lc = c - ec + oC-                                lr = r - er + oR-                            return (MouseUp n button localCoords, firstRS, exts)-                        False -> return (e, firstRS, exts)+                    if n `elem` firstRS^.clickableNamesL+                    then do+                        let localCoords = Location (lc, lr)+                            lc = c - ec+                            lr = r - er+                            -- If the clicked extent was a viewport,+                            -- adjust the local coordinates by+                            -- adding the viewport upper-left corner+                            -- offset.+                            newCoords = case M.lookup n (viewportMap firstRS) of+                              Nothing -> localCoords+                              Just vp -> localCoords & _1 %~ (+ (vp^.vpLeft))+                                                     & _2 %~ (+ (vp^.vpTop))+                        return (MouseUp n button newCoords, firstRS, exts)+                    else return (e, firstRS, exts)                 _ -> return (e, firstRS, exts)         _ -> return (e, firstRS, exts) -    let emptyES = ES [] []-        eventRO = EventRO (viewportMap nextRS) (Just vty) nextExts+    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, nextRS { rsScrollRequests = esScrollRequests eState-                         , renderCache = applyInvalidations (cacheInvalidateRequests eState) $-                                         renderCache nextRS-                         })+    (((), 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) => [CacheInvalidateRequest n] -> M.Map n v -> M.Map n v-applyInvalidations ns cache = foldr (.) id (mkFunc <$> ns) cache+applyInvalidations :: (Ord n) => S.Set (CacheInvalidateRequest n) -> M.Map n v -> M.Map n v+applyInvalidations ns cache =+    if InvalidateEntire `S.member` ns+    then mempty+    else foldr (.) id (mkFunc <$> F.toList ns) cache     where-    mkFunc InvalidateEntire = const mempty-    mkFunc (InvalidateSingle n) = M.delete n+        mkFunc InvalidateEntire = const mempty+        mkFunc (InvalidateSingle n) = M.delete n  -- | Given a viewport name, get the viewport's size and offset -- information from the most recent rendering. Returns 'Nothing' if -- no such state could be found, either because the name was invalid -- or because no rendering has occurred (e.g. in an 'appStartEvent'--- handler).-lookupViewport :: (Ord n) => n -> EventM n (Maybe Viewport)+-- handler). An important consequence of this behavior is that if this+-- function is called before a viewport is rendered for the first+-- time, no state will be found because the renderer only knows about+-- viewports it has rendered in the most recent rendering. As a result,+-- if you need to make viewport transformations before they are drawn+-- for the first time, you may need to use 'viewportScroll' and its+-- 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 s (Maybe Viewport) lookupViewport n = EventM $ asks (M.lookup n . eventViewportMap)  -- | Did the specified mouse coordinates (column, row) intersect the -- specified extent? clickedExtent :: (Int, Int) -> Extent n -> Bool-clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h) _) =+clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h)) =    c >= lc && c < (lc + w) &&    r >= lr && r < (lr + h)  -- | 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 n = EventM $ asks (listToMaybe . filter f . latestExtents)+lookupExtent :: (Eq n) => n -> EventM n s (Maybe (Extent n))+lookupExtent n = EventM $ asks (find f . latestExtents)     where-        f (Extent n' _ _ _) = n == n'+        f (Extent n' _ _) = n == n'  -- | Given a mouse click location, return the extents intersected by the -- click. The returned extents are sorted such that the first extent in -- 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 (Maybe 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 :: n -> EventM n ()+invalidateCacheEntry :: (Ord n) => n -> EventM n s () invalidateCacheEntry n = EventM $ do-    lift $ modify (\s -> s { cacheInvalidateRequests = InvalidateSingle n : cacheInvalidateRequests s })+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })  -- | Invalidate the entire rendering cache.-invalidateCache :: EventM n ()+invalidateCache :: (Ord n) => EventM n s () invalidateCache = EventM $ do-    lift $ modify (\s -> s { cacheInvalidateRequests = InvalidateEntire : cacheInvalidateRequests s })+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s }) -withVty :: IO Vty -> (Vty -> IO a) -> IO a-withVty buildVty useVty = do-    vty <- buildVty-    useVty vty `finally` shutdown vty+getRenderState :: EventM n s (RenderState n)+getRenderState = EventM $ asks oldState -renderApp :: Vty -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n])-renderApp vty app appState rs = do-    sz <- displayBounds $ outputIface vty+resetRenderState :: RenderState n -> RenderState n+resetRenderState s =+    s & observedNamesL .~ S.empty+      & clickableNamesL .~ mempty++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@@ -349,11 +519,14 @@                                         rs         picWithCursor = case theCursor of             Nothing -> pic { picCursor = NoCursor }-            Just cloc -> pic { picCursor = AbsoluteCursor (cloc^.locationColumnL)-                                                          (cloc^.locationRowL)+            Just cloc -> pic { picCursor = (if cursorLocationVisible cloc+                                            then AbsoluteCursor+                                            else PositionOnly True)+                                           (cloc^.locationColumnL)+                                           (cloc^.locationRowL)                              } -    update vty picWithCursor+    update (vtyContextHandle vtyCtx) picWithCursor      return (newRS, exts) @@ -376,7 +549,7 @@ showCursorNamed :: (Eq n) => n -> [CursorLocation n] -> Maybe (CursorLocation n) showCursorNamed name locs =     let matches l = l^.cursorLocationNameL == Just name-    in listToMaybe $ filter matches locs+    in find matches locs  -- | A viewport scrolling handle for managing the scroll state of -- viewports.@@ -384,38 +557,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@@ -434,18 +607,59 @@                    }  -- | Continue running the event loop with the specified application--- state.-continue :: s -> EventM n (Next s)-continue = return . Continue+-- state without redrawing the screen. This is faster than 'continue'+-- because it skips the redraw, but the drawback is that you need to+-- be really sure that you don't want a screen redraw. If your state+-- changed in a way that needs to be reflected on the screen, just don't+-- call this; 'EventM' blocks default to triggering redraws when they+-- finish executing. This function is for cases where you know that you+-- did something that won't have an impact on the screen state and you+-- want to save on redraw cost.+continueWithoutRedraw :: EventM n s ()+continueWithoutRedraw =+    EventM $ lift $ lift $ modify $ \es -> es { nextAction = ContinueWithoutRedraw }  -- | 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, redraw the application from the new state, and--- resume the event loop.-suspendAndResume :: IO s -> EventM n (Next s)-suspendAndResume = return . SuspendAndResume+-- 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 :: (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 s ()+makeVisible n = EventM $ do+    lift $ lift $ modify (\s -> s { requestedVisibleNames = S.insert n $ requestedVisibleNames s })
− src/Brick/Markup.hs 
@@ -1,56 +0,0 @@--- | This module provides an API for turning "markup" values into--- widgets. This module uses the "Data.Text.Markup" interface in this--- package to assign attributes to substrings in a text string; to--- manipulate markup using (for example) syntax highlighters, see that--- module.-module Brick.Markup-  ( Markup-  , markup-  , (@?)-  , GetAttr(..)-  )-where--import Lens.Micro ((.~), (&), (^.))-import Control.Monad (forM)-import qualified Data.Text as T-import Data.Text.Markup--import Graphics.Vty (Attr, vertCat, horizCat, string)--import Brick.AttrMap-import Brick.Types---- | A type class for types that provide access to an attribute in the--- rendering monad.  You probably won't need to instance this.-class GetAttr a where-    -- | Where to get the attribute for this attribute metadata.-    getAttr :: a -> RenderM n Attr--instance GetAttr Attr where-    getAttr a = do-        c <- getContext-        return $ mergeWithDefault a (c^.ctxAttrMapL)--instance GetAttr AttrName where-    getAttr = lookupAttrName---- | Build a piece of markup from text with an assigned attribute name.--- When the markup is rendered, the attribute name will be looked up in--- the rendering context's 'AttrMap' to determine the attribute to use--- for this piece of text.-(@?) :: T.Text -> AttrName -> Markup AttrName-(@?) = (@@)---- | Build a widget from markup.-markup :: (Eq a, GetAttr a) => Markup a -> Widget n-markup m =-    Widget Fixed Fixed $ do-      let markupLines = markupToList m-          mkLine pairs = do-              is <- forM pairs $ \(t, aSrc) -> do-                  a <- getAttr aSrc-                  return $ string a $ T.unpack t-              return $ horizCat is-      lineImgs <- mapM mkLine markupLines-      return $ emptyResult & imageL .~ vertCat lineImgs
+ src/Brick/Themes.hs view
@@ -0,0 +1,410 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}+-- | Support for representing attribute themes and loading and saving+-- theme customizations in INI-style files.+--+-- Customization files are INI-style files with two sections, both+-- optional: @"default"@ and @"other"@.+--+-- The @"default"@ section specifies three optional fields:+--+--  * @"default.fg"@ - a color specification+--  * @"default.bg"@ - a color specification+--  * @"default.style"@ - a style specification+--+-- A color specification can be any of the strings @black@, @red@,+-- @green@, @yellow@, @blue@, @magenta@, @cyan@, @white@, @brightBlack@,+-- @brightRed@, @brightGreen@, @brightYellow@, @brightBlue@,+-- @brightMagenta@, @brightCyan@, @brightWhite@, or @default@.+--+-- We also support color specifications in the common hex format @#RRGGBB@, but+-- note that this specification is lossy: terminals can only display 256 colors,+-- but hex codes can specify @256^3 = 16777216@ colors.+--+-- A style specification can be either one of the following values+-- (without quotes) or a comma-delimited list of one or more of the+-- following values (e.g. @"[bold,underline]"@) indicating that all+-- of the specified styles be used. Valid styles are @standout@,+-- @underline@, @reverseVideo@, @blink@, @dim@, @italic@,+-- @strikethrough@, and @bold@.+--+-- The @other@ section specifies for each attribute name in the theme+-- the same @fg@, @bg@, and @style@ settings as for the default+-- attribute. Furthermore, if an attribute name has multiple components,+-- the fields in the INI file should use periods as delimiters. For+-- example, if a theme has an attribute name (@attrName "foo" <> attrName "bar"@), then+-- the file may specify three fields:+--+--  * @foo.bar.fg@ - a color specification+--  * @foo.bar.bg@ - a color specification+--  * @foo.bar.style@ - a style specification+--+-- Any color or style specifications omitted from the file mean that+-- those attribute or style settings will use the theme's default value+-- instead.+--+-- Attribute names with multiple components (e.g. @attr1 <> attr2@) can+-- be referenced in customization files by separating the names with+-- a dot. For example, the attribute name @attrName "list" <> attrName "selected"@ can be+-- referenced by using the string "list.selected".+module Brick.Themes+  ( CustomAttr(..)+  , customFgL+  , customBgL+  , customStyleL++  , Theme(..)+  , newTheme+  , themeDefaultAttrL+  , themeDefaultMappingL+  , themeCustomMappingL+  , themeCustomDefaultAttrL++  , ThemeDocumentation(..)+  , themeDescriptionsL++  , themeToAttrMap+  , applyCustomizations+  , loadCustomizations+  , saveCustomizations+  , saveTheme+  )+where++import GHC.Generics (Generic)+import Graphics.Vty hiding ((<|>))+import Control.DeepSeq+import Control.Monad (forM, join)+import Control.Applicative ((<|>))+import qualified Data.Text as T+import qualified Data.Text.Read as T+import qualified Data.Text.IO as T+import qualified Data.Map as M+import qualified Data.Semigroup as Sem+import Data.Tuple (swap)+import Data.List (intercalate)+import Data.Bits ((.|.), (.&.))+import Data.Maybe (fromMaybe, isNothing, catMaybes, mapMaybe)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Foldable as F++import Data.Ini.Config++import Brick.AttrMap (AttrMap, AttrName, attrMap, attrNameComponents)+import Brick.Types.TH (suffixLenses)++import Text.Printf++-- | An attribute customization can specify which aspects of an+-- attribute to customize.+data CustomAttr =+    CustomAttr { customFg    :: Maybe (MaybeDefault Color)+               -- ^ The customized foreground, if any.+               , customBg    :: Maybe (MaybeDefault Color)+               -- ^ The customized background, if any.+               , customStyle :: Maybe Style+               -- ^ The customized style, if any.+               }+               deriving (Eq, Read, Show, Generic, NFData)++instance Sem.Semigroup CustomAttr where+    a <> b =+        CustomAttr { customFg    = customFg a    <|> customFg b+                   , customBg    = customBg a    <|> customBg b+                   , customStyle = customStyle a <|> customStyle b+                   }++instance Monoid CustomAttr where+    mempty = CustomAttr Nothing Nothing Nothing+    mappend = (Sem.<>)++-- | Documentation for a theme's attributes.+data ThemeDocumentation =+    ThemeDocumentation { themeDescriptions :: M.Map AttrName T.Text+                       -- ^ The per-attribute documentation for a theme+                       -- so e.g. documentation for theme customization+                       -- can be generated mechanically.+                       }+                       deriving (Eq, Read, Show, Generic, NFData)++-- | A theme provides a set of default attribute mappings, a default+-- attribute, and a set of customizations for the default mapping+-- and default attribute. The idea here is that the application will+-- always need to provide a complete specification of its attribute+-- mapping, but if the user wants to customize any aspect of that+-- default mapping, it can be contained here and then built into an+-- 'AttrMap' (see 'themeToAttrMap'). We keep the defaults separate+-- from customizations to permit users to serialize themes and their+-- customizations to, say, disk files.+data Theme =+    Theme { themeDefaultAttr :: Attr+          -- ^ The default attribute to use.+          , themeDefaultMapping :: M.Map AttrName Attr+          -- ^ The default attribute mapping to use.+          , themeCustomDefaultAttr :: Maybe CustomAttr+          -- ^ Customization for the theme's default attribute.+          , themeCustomMapping :: M.Map AttrName CustomAttr+          -- ^ Customizations for individual entries of the default+          -- mapping. Note that this will only affect entries in the+          -- default mapping; any attributes named here that are not+          -- present in the default mapping will not be considered.+          }+          deriving (Eq, Read, Show, Generic, NFData)++suffixLenses ''CustomAttr+suffixLenses ''Theme+suffixLenses ''ThemeDocumentation++defaultSectionName :: T.Text+defaultSectionName = "default"++otherSectionName :: T.Text+otherSectionName = "other"++-- | Create a new theme with the specified default attribute and+-- attribute mapping. The theme will have no customizations.+newTheme :: Attr -> [(AttrName, Attr)] -> Theme+newTheme def mapping =+    Theme { themeDefaultAttr       = def+          , themeDefaultMapping    = M.fromList mapping+          , themeCustomDefaultAttr = Nothing+          , themeCustomMapping     = mempty+          }++-- | Build an 'AttrMap' from a 'Theme'. This applies all customizations+-- in the returned 'AttrMap'.+themeToAttrMap :: Theme -> AttrMap+themeToAttrMap t =+    attrMap (customizeAttr (themeCustomDefaultAttr t) (themeDefaultAttr t)) customMap+    where+        customMap = F.foldr f [] (M.toList $ themeDefaultMapping t)+        f (aName, attr) mapping =+            let a' = customizeAttr (M.lookup aName (themeCustomMapping t)) attr+            in (aName, a'):mapping++customizeAttr :: Maybe CustomAttr -> Attr -> Attr+customizeAttr Nothing a = a+customizeAttr (Just c) a =+    let fg = fromMaybe (attrForeColor a) (customFg c)+        bg = fromMaybe (attrBackColor a) (customBg c)+        sty = maybe (attrStyle a) SetTo (customStyle c)+    in a { attrForeColor = fg+         , attrBackColor = bg+         , attrStyle = sty+         }++isNullCustomization :: CustomAttr -> Bool+isNullCustomization c =+    isNothing (customFg c) &&+    isNothing (customBg c) &&+    isNothing (customStyle c)++-- |  This function is lossy in the sense that we only internally support 240 colors but+-- the #RRGGBB format supports 16^3 colors.+parseColor :: T.Text -> Either String (MaybeDefault Color)+parseColor s =+    let stripped = T.strip $ T.toLower s+        normalize (t, c) = (T.toLower t, c)+    in if stripped == "default"+          then Right Default+          else case parseRGB stripped of+              Just c  -> Right (SetTo c)+              Nothing -> maybe (Left $ "Invalid color: " <> show stripped) (Right . SetTo) $+                             lookup stripped (normalize <$> swap <$> allColors)+  where+    parseRGB t = if T.head t /= '#'+                    then Nothing+                    else case mapMaybe readHex (T.chunksOf 2 (T.tail t)) of+                            [r,g,b] -> Just (rgbColor r g b)+                            _ -> Nothing++    readHex :: T.Text -> Maybe Int+    readHex t = either (const Nothing) (Just . fst) (T.hexadecimal t)++allColors :: [(Color, T.Text)]+allColors =+    [ (black, "black")+    , (red, "red")+    , (green, "green")+    , (yellow, "yellow")+    , (blue, "blue")+    , (magenta, "magenta")+    , (cyan, "cyan")+    , (white, "white")+    , (brightBlack, "brightBlack")+    , (brightRed, "brightRed")+    , (brightGreen, "brightGreen")+    , (brightYellow, "brightYellow")+    , (brightBlue, "brightBlue")+    , (brightMagenta, "brightMagenta")+    , (brightCyan, "brightCyan")+    , (brightWhite, "brightWhite")+    ]++allStyles :: [(T.Text, Style)]+allStyles =+    [ ("standout", standout)+    , ("underline", underline)+    , ("strikethrough", strikethrough)+    , ("reversevideo", reverseVideo)+    , ("blink", blink)+    , ("dim", dim)+    , ("bold", bold)+    , ("italic", italic)+    ]++parseStyle :: T.Text -> Either String Style+parseStyle s =+    let lookupStyle "" = Right Nothing+        lookupStyle n = case lookup n normalizedStyles of+            Just sty -> Right $ Just sty+            Nothing  -> Left $ T.unpack $ "Invalid style: " <> n+        stripped = T.strip $ T.toLower s+        normalize (n, a) = (T.toLower n, a)+        normalizedStyles = normalize <$> allStyles+        bracketed = "[" `T.isPrefixOf` stripped &&+                    "]" `T.isSuffixOf` stripped+        unbracketed = T.tail $ T.init stripped+        parseStyleList = do+            ss <- mapM lookupStyle $ T.strip <$> T.splitOn "," unbracketed+            return $ foldr (.|.) 0 $ catMaybes ss++    in if bracketed+       then parseStyleList+       else do+           result <- lookupStyle stripped+           case result of+               Nothing -> Left $ "Invalid style: " <> show stripped+               Just sty -> Right sty++themeParser :: Theme -> IniParser (Maybe CustomAttr, M.Map AttrName CustomAttr)+themeParser t = do+    let parseCustomAttr basename = do+          c <- CustomAttr <$> fieldMbOf (basename <> ".fg")    parseColor+                          <*> fieldMbOf (basename <> ".bg")    parseColor+                          <*> fieldMbOf (basename <> ".style") parseStyle+          return $ if isNullCustomization c then Nothing else Just c++    defCustom <- sectionMb defaultSectionName $ do+        parseCustomAttr "default"++    customMap <- sectionMb otherSectionName $ do+        catMaybes <$> (forM (M.keys $ themeDefaultMapping t) $ \an ->+            (fmap (an,)) <$> parseCustomAttr (makeFieldName $ attrNameComponents an)+            )++    return (join defCustom, M.fromList $ fromMaybe [] customMap)++-- | Apply customizations using a custom lookup function. Customizations+-- are obtained for each attribute name in the theme. Any customizations+-- already set are lost.+applyCustomizations :: Maybe CustomAttr+                    -- ^ An optional customization for the theme's+                    -- default attribute.+                    -> (AttrName -> Maybe CustomAttr)+                    -- ^ A function to obtain a customization for the+                    -- specified attribute.+                    -> Theme+                    -- ^ The theme to customize.+                    -> Theme+applyCustomizations customDefAttr lookupAttr t =+    let customMap = foldr nextAttr mempty (M.keys $ themeDefaultMapping t)+        nextAttr an m = case lookupAttr an of+            Nothing     -> m+            Just custom -> M.insert an custom m+    in t { themeCustomDefaultAttr = customDefAttr+         , themeCustomMapping = customMap+         }++-- | Load an INI file containing theme customizations. Use the specified+-- theme to determine which customizations to load. Return the specified+-- theme with customizations set. See the module documentation for the+-- theme file format.+loadCustomizations :: FilePath -> Theme -> IO (Either String Theme)+loadCustomizations path t = do+    content <- T.readFile path+    case parseIniFile content (themeParser t) of+        Left e -> return $ Left e+        Right (customDef, customMap) ->+            return $ Right $ applyCustomizations customDef (flip M.lookup customMap) t++vtyColorName :: Color -> T.Text+vtyColorName c@(Color240 n) = case color240CodeToRGB (fromIntegral n) of+    Just (r,g,b) -> T.pack (printf "#%02x%02x%02x" r g b)+    Nothing -> (error $ "Invalid color: " <> show c)+vtyColorName c =+    fromMaybe (error $ "Invalid color: " <> show c)+              (lookup c allColors)++makeFieldName :: [String] -> T.Text+makeFieldName cs = T.pack $ intercalate "." cs++serializeCustomColor :: [String] -> MaybeDefault Color -> T.Text+serializeCustomColor cs cc =+    let cName = case cc of+          Default -> "default"+          SetTo c -> vtyColorName c+          KeepCurrent -> error "serializeCustomColor does not support KeepCurrent"+    in makeFieldName cs <> " = " <> cName++serializeCustomStyle :: [String] -> Style -> T.Text+serializeCustomStyle cs s =+    let activeStyles = filter (\(_, a) -> a .&. s == a) allStyles+        styleStr = case activeStyles of+            [(single, _)] -> single+            many -> "[" <> (T.intercalate ", " $ fst <$> many) <> "]"+    in makeFieldName cs <> " = " <> styleStr++serializeCustomAttr :: [String] -> CustomAttr -> [T.Text]+serializeCustomAttr cs c =+    catMaybes [ serializeCustomColor (cs <> ["fg"]) <$> customFg c+              , serializeCustomColor (cs <> ["bg"]) <$> customBg c+              , serializeCustomStyle (cs <> ["style"]) <$> customStyle c+              ]++emitSection :: T.Text -> [T.Text] -> [T.Text]+emitSection _ [] = []+emitSection secName ls = ("[" <> secName <> "]") : ls++-- | Save an INI file containing theme customizations. Use the specified+-- theme to determine which customizations to save. See the module+-- documentation for the theme file format.+saveCustomizations :: FilePath -> Theme -> IO ()+saveCustomizations path t = do+    let defSection = fromMaybe [] $+                     serializeCustomAttr ["default"] <$> themeCustomDefaultAttr t+        mapSection = concat $ flip map (M.keys $ themeDefaultMapping t) $ \an ->+            maybe [] (serializeCustomAttr (attrNameComponents an)) $+                     M.lookup an $ themeCustomMapping t+        content = T.unlines $ (emitSection defaultSectionName defSection) <>+                              (emitSection otherSectionName mapSection)+    T.writeFile path content++-- | Save an INI file containing all attributes from the specified+-- theme. Customized attributes are saved, but if an attribute is not+-- customized, its default is saved instead. The file can later be+-- re-loaded as a customization file.+saveTheme :: FilePath -> Theme -> IO ()+saveTheme path t = do+    let defSection = serializeCustomAttr ["default"] $+                     fromMaybe (attrToCustom $ themeDefaultAttr t) (themeCustomDefaultAttr t)+        mapSection = concat $ flip map (M.toList $ themeDefaultMapping t) $ \(an, def) ->+            serializeCustomAttr (attrNameComponents an) $+                fromMaybe (attrToCustom def) (M.lookup an $ themeCustomMapping t)+        content = T.unlines $ (emitSection defaultSectionName defSection) <>+                              (emitSection otherSectionName mapSection)+    T.writeFile path content++attrToCustom :: Attr -> CustomAttr+attrToCustom a =+    CustomAttr { customFg    = Just $ attrForeColor a+               , customBg    = Just $ attrBackColor a+               , customStyle = case attrStyle a of+                   SetTo s -> Just s+                   _       -> Nothing+               }
src/Brick/Types.hs view
@@ -1,7 +1,5 @@ -- | Basic types used by this library.-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Brick.Types   ( -- * The Widget type@@ -21,25 +19,38 @@   , vpSize   , vpTop   , vpLeft+  , vpContentSize+  , VScrollBarOrientation(..)+  , HScrollBarOrientation(..)+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , ClickableScrollbarElement(..) -  -- * Event-handling types-  , EventM(..)-  , Next+  -- * Event-handling types and functions+  , EventM   , BrickEvent(..)-  , handleEventLensed+  , nestEventM+  , nestEventM'    -- * Rendering infrastructure   , RenderM   , getContext    -- ** The rendering context-  , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap)+  , Context(ctxAttrName, availWidth, availHeight, windowWidth, windowHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)   , attrL   , availWidthL   , availHeightL+  , windowWidthL+  , windowHeightL+  , ctxVScrollBarOrientationL+  , ctxVScrollBarRendererL+  , ctxHScrollBarOrientationL+  , ctxHScrollBarRendererL   , ctxAttrMapL   , ctxAttrNameL   , ctxBorderStyleL+  , ctxDynBordersL    -- ** Rendering results   , Result(..)@@ -60,98 +71,88 @@    -- * Making lenses   , suffixLenses+  , suffixLensesWith +  -- * Dynamic borders+  , bordersL+  , DynBorder(..)+  , dbStyleL, dbAttrL, dbSegmentsL+  , BorderSegment(..)+  , bsAcceptL, bsOfferL, bsDrawL+  , Edges(..)+  , eTopL, eBottomL, eRightL, eLeftL+   -- * Miscellaneous   , Size(..)-  , Padding(..)   , Direction(..) +  -- * Renderer internals (for benchmarking)+  , RenderState++  -- * Re-exports for convenience+  , get+  , gets+  , put+  , modify+  , zoom   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-import Data.Monoid (Monoid(..))-#endif--import Lens.Micro (_1, _2, to, (^.), (&), (.~), Lens')+import Lens.Micro (_1, _2, to, (^.)) import Lens.Micro.Type (Getting)-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader+import Lens.Micro.Mtl (zoom)+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif+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.---- | 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---- | 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)---- | Widget growth policies. These policies communicate to layout--- algorithms how a widget uses space when being rendered. These--- policies influence rendering order and space allocation in the box--- layout algorithm.-data Size = Fixed-          -- ^ Fixed widgets take up the same amount of space no matter-          -- how much they are given (non-greedy).-          | Greedy-          -- ^ Greedy widgets take up all the space they are given.-          deriving (Show, Eq, Ord)---- | The type of widgets.-data Widget n =-    Widget { hSize :: Size-           -- ^ This widget's horizontal growth policy-           , vSize :: Size-           -- ^ This widget's vertical growth policy-           , render :: RenderM n (Result n)-           -- ^ This widget's rendering function-           }---- | The type of the rendering monad. This monad is used by the--- library's rendering routines to manage rendering state and--- communicate rendering parameters to widgets' rendering functions.-type RenderM n a = ReaderT Context (State (RenderState n)) a+-- | 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 --- | Get the current rendering context.-getContext :: RenderM n Context-getContext = ask+-- | 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 -suffixLenses ''Context+    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. Getting r Context Attr+attrL :: forall r n. Getting r (Context n) Attr attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL))  instance TerminalLocation (CursorLocation n) where
+ src/Brick/Types/Common.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE CPP #-}+module Brick.Types.Common+  ( Location(..)+  , locL+  , origin+  , Edges(..)+  , eTopL, eBottomL, eRightL, eLeftL+  ) where++import Brick.Types.TH (suffixLenses)+import qualified Data.Semigroup as Sem+import GHC.Generics+import Control.DeepSeq+import Lens.Micro (_1, _2)+#if MIN_VERSION_microlens(0,5,0)+import Lens.Micro.FieldN (Field1, Field2)+#else+import Lens.Micro.Internal (Field1, Field2)+#endif++-- | A terminal screen location.+data Location = Location { loc :: !(Int, Int)+                         -- ^ (Column, Row)+                         }+                deriving (Show, Eq, Ord, Read, Generic, NFData)++suffixLenses ''Location++instance Field1 Location Location Int Int where+    _1 = locL._1++instance Field2 Location Location Int Int where+    _2 = locL._2++-- | The origin (upper-left corner).+origin :: Location+origin = Location (0, 0)++instance Sem.Semigroup Location where+    (Location (w1, h1)) <> (Location (w2, h2)) = Location (w1+w2, h1+h2)++instance Monoid Location where+    mempty = origin+    mappend = (Sem.<>)++data Edges a = Edges { eTop, eBottom, eLeft, eRight :: !a }+    deriving (Eq, Ord, Read, Show, Functor, Generic, NFData)++suffixLenses ''Edges++instance Applicative Edges where+    pure a = Edges a a a a+    Edges ft fb fl fr <*> Edges vt vb vl vr =+        Edges (ft vt) (fb vb) (fl vl) (fr vr)++instance Monad Edges where+    Edges vt vb vl vr >>= f = Edges+        (eTop    (f vt))+        (eBottom (f vb))+        (eLeft   (f vl))+        (eRight  (f vr))
+ src/Brick/Types/EventM.hs view
@@ -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)
src/Brick/Types/Internal.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Brick.Types.Internal   ( ScrollRequest(..)   , VisibilityRequest(..)@@ -17,131 +19,286 @@   , CursorLocation(..)   , cursorLocationL   , cursorLocationNameL+  , cursorLocationVisibleL+  , VScrollBarOrientation(..)+  , HScrollBarOrientation(..)+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , ClickableScrollbarElement(..)   , Context(..)+  , ctxAttrMapL+  , ctxAttrNameL+  , ctxBorderStyleL+  , ctxDynBordersL+  , ctxVScrollBarOrientationL+  , ctxVScrollBarRendererL+  , ctxHScrollBarOrientationL+  , ctxHScrollBarRendererL+  , ctxVScrollBarShowHandlesL+  , ctxHScrollBarShowHandlesL+  , ctxVScrollBarClickableConstrL+  , ctxHScrollBarClickableConstrL+  , availWidthL+  , availHeightL+  , windowWidthL+  , windowHeightL++  , Size(..)+   , EventState(..)+  , VtyContext(..)   , EventRO(..)-  , Next(..)+  , NextAction(..)   , Result(..)   , Extent(..)+  , Edges(..)+  , eTopL, eBottomL, eRightL, eLeftL+  , BorderSegment(..)+  , bsAcceptL, bsOfferL, bsDrawL+  , DynBorder(..)+  , dbStyleL, dbAttrL, dbSegmentsL   , CacheInvalidateRequest(..)   , BrickEvent(..)+  , RenderM+  , getContext+  , lookupReportedExtent+  , Widget(..)    , rsScrollRequestsL   , viewportMapL   , clickableNamesL+  , reportedExtentsL   , renderCacheL   , observedNamesL+  , requestedVisibleNames_L   , vpSize   , vpLeft   , vpTop+  , vpContentSize   , imageL   , cursorsL   , extentsL+  , bordersL   , visibilityRequestsL   , emptyResult   ) where -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif-+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)-import Lens.Micro.Internal (Field1, Field2) import qualified Data.Set as S import qualified Data.Map as M-import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, emptyImage)+import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, Attr, emptyImage)+import GHC.Generics+import Control.DeepSeq (NFData) +import Brick.BorderMap (BorderMap)+import qualified Brick.BorderMap as BM+import Brick.Types.Common import Brick.Types.TH import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) -data ScrollRequest = HScrollBy Int-                   | HScrollPage Direction+data ScrollRequest = HScrollBy !Int+                   | HScrollPage !Direction                    | HScrollToBeginning                    | HScrollToEnd-                   | VScrollBy Int-                   | VScrollPage Direction+                   | VScrollBy !Int+                   | VScrollPage !Direction                    | VScrollToBeginning                    | VScrollToEnd-                   | SetTop Int-                   | SetLeft Int+                   | SetTop !Int+                   | SetLeft !Int+                   deriving (Read, Show, Generic, NFData) +-- | Widget size policies. These policies communicate how a widget uses+-- space when being rendered. These policies influence rendering order+-- and space allocation in the box layout algorithm for 'hBox' and+-- 'vBox'.+data Size = Fixed+          -- ^ Widgets advertising this size policy should take up the+          -- same amount of space no matter how much they are given,+          -- i.e. their size depends on their contents alone rather than+          -- on the size of the rendering area.+          | Greedy+          -- ^ Widgets advertising this size policy must take up all the+          -- space they are given.+          deriving (Show, Eq, Ord)++-- | The type of widgets.+data Widget n =+    Widget { hSize :: !Size+           -- ^ This widget's horizontal growth policy+           , vSize :: !Size+           -- ^ This widget's vertical growth policy+           , render :: RenderM n (Result n)+           -- ^ This widget's rendering function+           }++data RenderState n =+    RS { viewportMap :: !(M.Map n Viewport)+       , rsScrollRequests :: ![(n, ScrollRequest)]+       , observedNames :: !(S.Set n)+       , renderCache :: !(M.Map n ([n], Result n))+       , clickableNames :: ![n]+       , requestedVisibleNames_ :: !(S.Set n)+       , reportedExtents :: !(M.Map n (Extent n))+       } deriving (Read, Show, Generic, NFData)++-- | The type of the rendering monad. This monad is used by the+-- library's rendering routines to manage rendering state and+-- communicate rendering parameters to widgets' rendering functions.+type RenderM n a = ReaderT (Context n) (State (RenderState n)) a++-- | Get the current rendering context.+getContext :: RenderM n (Context n)+getContext = ask++-- | Orientations for vertical scroll bars.+data VScrollBarOrientation = OnLeft | OnRight+                           deriving (Show, Eq)++-- | Orientations for horizontal scroll bars.+data HScrollBarOrientation = OnBottom | OnTop+                           deriving (Show, Eq)++-- | A vertical scroll bar renderer.+data VScrollbarRenderer n =+    VScrollbarRenderer { renderVScrollbar :: Widget n+                       -- ^ How to render the body of the scroll bar.+                       -- This should provide a widget that expands in+                       -- whatever direction(s) this renderer will be+                       -- used for. So, for example, this widget would+                       -- need to be one that expands vertically such as+                       -- @fill@. The same goes for the trough widget.+                       , renderVScrollbarTrough :: Widget n+                       -- ^ How to render the "trough" of the scroll bar+                       -- (the area to either side of the scroll bar+                       -- body). This should expand as described in the+                       -- documentation for the scroll bar field.+                       , renderVScrollbarHandleBefore :: Widget n+                       -- ^ How to render the handle that appears at+                       -- the top or left of the scrollbar. The result+                       -- will be allowed to be at most one row high.+                       , renderVScrollbarHandleAfter :: Widget n+                       -- ^ How to render the handle that appears at the+                       -- bottom or right of the scrollbar. The result+                       -- will be allowed to be at most one row high.+                       , scrollbarWidthAllocation :: Int+                       -- ^ The number of columns that will be allocated+                       -- to the scroll bar. This determines how much+                       -- space the widgets of the scroll bar elements+                       -- can take up. If they use less than this+                       -- amount, padding will be applied between the+                       -- scroll bar and the viewport contents.+                       }++-- | A horizontal scroll bar renderer.+data HScrollbarRenderer n =+    HScrollbarRenderer { renderHScrollbar :: Widget n+                       -- ^ How to render the body of the scroll bar.+                       -- This should provide a widget that expands+                       -- in whatever direction(s) this renderer will+                       -- be used for. So, for example, this widget+                       -- would need to be one that expands horizontally+                       -- such as @fill@. The same goes for the trough+                       -- widget.+                       , renderHScrollbarTrough :: Widget n+                       -- ^ How to render the "trough" of the scroll bar+                       -- (the area to either side of the scroll bar+                       -- body). This should expand as described in the+                       -- documentation for the scroll bar field.+                       , renderHScrollbarHandleBefore :: Widget n+                       -- ^ How to render the handle that appears at the+                       -- top or left of the scrollbar. The result will+                       -- be allowed to be at most one column wide.+                       , renderHScrollbarHandleAfter :: Widget n+                       -- ^ How to render the handle that appears at the+                       -- bottom or right of the scrollbar. The result+                       -- will be allowed to be at most one column wide.+                       , scrollbarHeightAllocation :: Int+                       -- ^ The number of rows that will be allocated to+                       -- the scroll bar. This determines how much space+                       -- the widgets of the scroll bar elements can+                       -- take up. If they use less than this amount,+                       -- padding will be applied between the scroll bar+                       -- and the viewport contents.+                       }+ data VisibilityRequest =-    VR { vrPosition :: Location-       , vrSize :: DisplayRegion+    VR { vrPosition :: !Location+       , vrSize :: !DisplayRegion        }-       deriving (Show, Eq)+       deriving (Show, Eq, Read, Generic, NFData)  -- | Describes the state of a viewport as it appears as its most recent -- rendering. data Viewport =-    VP { _vpLeft :: Int+    VP { _vpLeft :: !Int        -- ^ The column offset of left side of the viewport.-       , _vpTop :: Int+       , _vpTop :: !Int        -- ^ The row offset of the top of the viewport.-       , _vpSize :: DisplayRegion+       , _vpSize :: !DisplayRegion        -- ^ The size of the viewport.+       , _vpContentSize :: !DisplayRegion+       -- ^ The size of the contents of the viewport.        }-       deriving Show+       deriving (Show, Read, Generic, NFData)  -- | 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+data CacheInvalidateRequest n =+    InvalidateSingle n+    | InvalidateEntire+    deriving (Ord, Eq) -data EventState n = ES { esScrollRequests :: [(n, ScrollRequest)]-                       , cacheInvalidateRequests :: [CacheInvalidateRequest 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)-                       , extentOffset    :: Location+data Extent n = Extent { extentName      :: !n+                       , extentUpperLeft :: !Location+                       , extentSize      :: !(Int, Int)                        }-              deriving (Show)--data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport-                         , eventVtyHandle :: Maybe Vty-                         , latestExtents :: [Extent n]-                         }+                       deriving (Show, Read, Generic, NFData)  -- | The type of actions to take upon completion of an event handler.-data Next a = Continue a-            | SuspendAndResume (IO a)-            | Halt a-            deriving Functor+data NextAction =+    Continue+    | ContinueWithoutRedraw+    | Halt  -- | Scrolling direction. data Direction = Up                -- ^ Up/left                | Down                -- ^ Down/right-               deriving (Show, Eq)---- | A terminal screen location.-data Location = Location { loc :: (Int, Int)-                         -- ^ (Column, Row)-                         }-                deriving (Show, Eq)--suffixLenses ''Location--instance Field1 Location Location Int Int where-    _1 = locL._1--instance Field2 Location Location Int Int where-    _2 = locL._2+               deriving (Show, Eq, Read, Generic, NFData)  -- | The class of types that behave like terminal locations. class TerminalLocation a where@@ -159,79 +316,150 @@     locationRowL = _2     locationRow (Location t) = snd t --- | The origin (upper-left corner).-origin :: Location-origin = Location (0, 0)--instance Monoid Location where-    mempty = origin-    mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)- -- | A cursor location.  These are returned by the rendering process. data CursorLocation n =     CursorLocation { cursorLocation :: !Location                    -- ^ The location                    , cursorLocationName :: !(Maybe n)                    -- ^ The name of the widget associated with the location+                   , cursorLocationVisible :: !Bool+                   -- ^ Whether the cursor should actually be visible                    }-                   deriving Show+                   deriving (Read, Show, Generic, NFData) +-- | A border character has four segments, one extending in each direction+-- (horizontally and vertically) from the center of the character.+data BorderSegment = BorderSegment+    { bsAccept :: !Bool+    -- ^ Would this segment be willing to be drawn if a neighbor wanted to+    -- connect to it?+    , bsOffer :: !Bool+    -- ^ Does this segment want to connect to its neighbor?+    , bsDraw :: !Bool+    -- ^ Should this segment be represented visually?+    } deriving (Eq, Ord, Read, Show, Generic, NFData)++-- | Information about how to redraw a dynamic border character when it abuts+-- another dynamic border character.+data DynBorder = DynBorder+    { dbStyle :: !BorderStyle+    -- ^ The 'Char's to use when redrawing the border. Also used to filter+    -- connections: only dynamic borders with equal 'BorderStyle's will connect+    -- to each other.+    , dbAttr :: !Attr+    -- ^ What 'Attr' to use to redraw the border character. Also used to filter+    -- connections: only dynamic borders with equal 'Attr's will connect to+    -- each other.+    , dbSegments :: !(Edges BorderSegment)+    } deriving (Eq, Read, Show, Generic, NFData)+ -- | The type of result returned by a widget's rendering function. The -- 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+           -- use the empty 'BorderMap' that has a degenerate rectangle. Only+           -- border-drawing widgets and the hbox/vbox stuff try to set this+           -- carefully. Even then, in the boxes, we only make sure that the+           -- 'BorderMap' is no larger than the entire concatenation of boxes,+           -- and it's certainly possible for it to be smaller. (Resizing+           -- 'BorderMap's is lossy, so we try to do it as little as possible.)+           -- 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)+           -- ^ Places where we may rewrite the edge of the image when+           -- placing this widget next to another one.            }-           deriving Show--suffixLenses ''Result+           deriving (Show, Read, Generic, NFData)  emptyResult :: Result n-emptyResult = Result emptyImage [] [] []+emptyResult =+    Result { image = emptyImage+           , cursors = []+           , visibilityRequests = []+           , extents = []+           , borders = BM.empty+           }  -- | The type of events.-data BrickEvent n e = VtyEvent Event+data BrickEvent n e = VtyEvent !Event                     -- ^ The event was a Vty event.-                    | AppEvent e+                    | AppEvent !e                     -- ^ The event was an application event.-                    | MouseDown n Button [Modifier] Location-                    -- ^ A mouse-down event on the specified region was-                    -- received.-                    | MouseUp n (Maybe Button) Location+                    | MouseDown !n !Button ![Modifier] !Location                     -- ^ A mouse-down event on the specified region was-                    -- received.-                    deriving (Show, Eq)+                    -- received. The 'n' value is the resource name of+                    -- the clicked widget (see 'clickable').+                    | MouseUp !n !(Maybe Button) !Location+                    -- ^ A mouse-up event on the specified region was+                    -- received. The 'n' value is the resource name of+                    -- the clicked widget (see 'clickable').+                    deriving (Show, Eq, Ord) -data RenderState n =-    RS { viewportMap :: M.Map n Viewport-       , rsScrollRequests :: [(n, ScrollRequest)]-       , observedNames :: !(S.Set n)-       , renderCache :: M.Map n (Result n)-       , clickableNames :: [n]-       }+data EventRO n = EventRO { eventViewportMap :: !(M.Map n Viewport)+                         , latestExtents :: ![Extent n]+                         , oldState :: !(RenderState n)+                         } +-- | Clickable elements of a scroll bar.+data ClickableScrollbarElement =+    SBHandleBefore+    -- ^ The handle at the beginning (left/top) of the scroll bar.+    | SBHandleAfter+    -- ^ The handle at the end (right/bottom) of the scroll bar.+    | SBBar+    -- ^ The scroll bar itself.+    | SBTroughBefore+    -- ^ The trough before the scroll bar.+    | SBTroughAfter+    -- ^ The trough after the scroll bar.+    deriving (Eq, Show, Ord)+ -- | The rendering context. This tells widgets how to render: how much -- space they have in which to render, which attribute they should use -- to render, which bordering style should be used, and the attribute map -- available for rendering.-data Context =-    Context { ctxAttrName :: AttrName-            , availWidth :: Int-            , availHeight :: Int-            , ctxBorderStyle :: BorderStyle-            , ctxAttrMap :: AttrMap+data Context n =+    Context { ctxAttrName :: !AttrName+            , availWidth :: !Int+            , availHeight :: !Int+            , windowWidth :: !Int+            , windowHeight :: !Int+            , ctxBorderStyle :: !BorderStyle+            , ctxAttrMap :: !AttrMap+            , ctxDynBorders :: !Bool+            , ctxVScrollBarOrientation :: !(Maybe VScrollBarOrientation)+            , ctxVScrollBarRenderer :: !(Maybe (VScrollbarRenderer n))+            , ctxHScrollBarOrientation :: !(Maybe HScrollBarOrientation)+            , ctxHScrollBarRenderer :: !(Maybe (HScrollbarRenderer n))+            , ctxVScrollBarShowHandles :: !Bool+            , ctxHScrollBarShowHandles :: !Bool+            , ctxVScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n))+            , ctxHScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n))             }-            deriving Show  suffixLenses ''RenderState suffixLenses ''VisibilityRequest suffixLenses ''CursorLocation+suffixLenses ''Context+suffixLenses ''DynBorder+suffixLenses ''Result+suffixLenses ''BorderSegment makeLenses ''Viewport++lookupReportedExtent :: (Ord n) => n -> RenderM n (Maybe (Extent n))+lookupReportedExtent n = do+    m <- lift $ use reportedExtentsL+    return $ M.lookup n m
src/Brick/Types/TH.hs view
@@ -1,5 +1,6 @@ module Brick.Types.TH   ( suffixLenses+  , suffixLensesWith   ) where @@ -7,13 +8,18 @@ import qualified Language.Haskell.TH.Lib as TH  import Lens.Micro ((&), (.~))-import Lens.Micro.TH (DefName(..), makeLensesWith, lensRules, lensField)+import Lens.Micro.TH (DefName(..), LensRules, makeLensesWith, lensRules, lensField)  -- | A template haskell function to build lenses for a record type. This--- function differs from the 'Control.Lens.makeLenses' function in that+-- function differs from the 'Lens.Micro.TH.makeLenses' function in that -- it does not require the record fields to be prefixed with underscores -- and it adds an "L" suffix to lens names to make it clear that they -- are lenses. suffixLenses :: TH.Name -> TH.DecsQ-suffixLenses = makeLensesWith $-  lensRules & lensField .~ (\_ _ name -> [TopName $ TH.mkName $ TH.nameBase name ++ "L"])+suffixLenses = suffixLensesWith "L" lensRules++-- | A more general version of 'suffixLenses' that allows customization+-- of the lens-building rules and allows customization of the suffix.+suffixLensesWith :: String -> LensRules -> TH.Name -> TH.DecsQ+suffixLensesWith suffix rs = makeLensesWith $+    rs & lensField .~ (\_ _ name -> [TopName $ TH.mkName $ TH.nameBase name ++ suffix])
src/Brick/Util.hs view
@@ -4,12 +4,15 @@   , on   , fg   , bg+  , style   , clOffset   ) where  import Lens.Micro ((&), (%~))+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))+#endif import Graphics.Vty  import Brick.Types.Internal (Location(..), CursorLocation(..), cursorLocationL)@@ -50,9 +53,14 @@ fg = (defAttr `withForeColor`)  -- | Create an attribute from the specified background color (the--- background color is the "default").+-- foreground color is the "default"). bg :: Color -> Attr bg = (defAttr `withBackColor`)++-- | Create an attribute from the specified style (the colors are the+-- "default").+style :: Style -> Attr+style = (defAttr `withStyle`)  -- | Add a 'Location' offset to the specified 'CursorLocation'. clOffset :: CursorLocation n -> Location -> CursorLocation n
src/Brick/Widgets/Border.hs view
@@ -18,67 +18,48 @@   -- * Drawing single border elements   , borderElem -  -- * Border attribute names+  -- * Attribute names   , borderAttr-  , vBorderAttr   , hBorderAttr-  , hBorderLabelAttr-  , tlCornerAttr-  , trCornerAttr-  , blCornerAttr-  , brCornerAttr+  , vBorderAttr++  -- * Utility+  , joinableBorder   ) where +#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>)) #endif--import Lens.Micro ((^.), to)+import Lens.Micro ((^.), (&), (.~), to) import Graphics.Vty (imageHeight, imageWidth)  import Brick.AttrMap import Brick.Types import Brick.Widgets.Core-import Brick.Widgets.Center (hCenterWith) import Brick.Widgets.Border.Style (BorderStyle(..))+import Brick.Widgets.Internal (renderDynBorder)+import Data.IMap (Run(..))+import qualified Brick.BorderMap as BM  -- | The top-level border attribute name. borderAttr :: AttrName-borderAttr = "border"---- | The vertical border attribute name.-vBorderAttr :: AttrName-vBorderAttr = borderAttr <> "vertical"+borderAttr = attrName "border" --- | The horizontal border attribute name.+-- | The horizontal border attribute name. Inherits from 'borderAttr'. hBorderAttr :: AttrName-hBorderAttr = borderAttr <> "horizontal"---- | The attribute used for horizontal border labels.-hBorderLabelAttr :: AttrName-hBorderLabelAttr = hBorderAttr <> "label"---- | The attribute used for border box top-left corners.-tlCornerAttr :: AttrName-tlCornerAttr = borderAttr <> "corner" <> "tl"---- | The attribute used for border box top-right corners.-trCornerAttr :: AttrName-trCornerAttr = borderAttr <> "corner" <> "tr"---- | The attribute used for border box bottom-left corners.-blCornerAttr :: AttrName-blCornerAttr = borderAttr <> "corner" <> "bl"+hBorderAttr = borderAttr <> attrName "horizontal" --- | The attribute used for border box bottom-right corners.-brCornerAttr :: AttrName-brCornerAttr = borderAttr <> "corner" <> "br"+-- | The vertical border attribute name. Inherits from 'borderAttr'.+vBorderAttr :: AttrName+vBorderAttr = borderAttr <> attrName "vertical"  -- | Draw the specified border element using the active border style -- using 'borderAttr'.+--+-- Does not participate in dynamic borders (due to the difficulty of+-- introspecting on the first argument); consider using 'joinableBorder'+-- instead. borderElem :: (BorderStyle -> Char) -> Widget n borderElem f =     Widget Fixed Fixed $ do@@ -91,6 +72,13 @@  -- | Put a border around the specified widget with the specified label -- widget placed in the middle of the top horizontal border.+--+-- Note that a border will wrap its child widget as tightly as possible,+-- which means that if the child widget is narrower than the label+-- widget, the label widget will be truncated. If you want to avoid+-- this behavior, add a 'fill' or other space-filling wrapper to the+-- bordered widget so that it takes up enough room to make the border+-- horizontally able to avoid truncating the label. borderWithLabel :: Widget n                 -- ^ The label widget                 -> Widget n@@ -101,19 +89,18 @@ border_ :: Maybe (Widget n) -> Widget n -> Widget n border_ label wrapped =     Widget (hSize wrapped) (vSize wrapped) $ do-      bs <- ctxBorderStyle <$> getContext       c <- getContext        middleResult <- render $ hLimit (c^.availWidthL - 2)                              $ vLimit (c^.availHeightL - 2)                              $ wrapped -      let top = (withAttr tlCornerAttr $ str [bsCornerTL bs])-                <+> hBorder_ label <+>-                (withAttr trCornerAttr $ str [bsCornerTR bs])-          bottom = (withAttr blCornerAttr $ str [bsCornerBL bs])-                   <+> hBorder <+>-                   (withAttr brCornerAttr $ str [bsCornerBR bs])+      let tl = joinableBorder (Edges False True False True)+          tr = joinableBorder (Edges False True True False)+          bl = joinableBorder (Edges True False False True)+          br = joinableBorder (Edges True False True False)+          top = tl <+> maybe hBorder hBorderWithLabel label <+> tr+          bottom = bl <+> hBorder <+> br           middle = vBorder <+> (Widget Fixed Fixed $ return middleResult) <+> vBorder           total = top <=> middle <=> bottom @@ -121,27 +108,76 @@              $ vLimit (middleResult^.imageL.to imageHeight + 2)              $ total --- | A horizontal border.  Fills all horizontal space.+-- | A horizontal border. Fills all horizontal space. Draws using+-- 'hBorderAttr'. hBorder :: Widget n-hBorder = hBorder_ Nothing+hBorder =+    withAttr borderAttr $ Widget Greedy Fixed $ do+      ctx <- getContext+      let bs = ctxBorderStyle ctx+          w = availWidth ctx+      db <- dynBorderFromDirections (Edges False False True True)+      let dynBorders = BM.insertH mempty (Run w db)+                     $ BM.emptyCoordinates (Edges 0 0 0 (w-1))+      setDynBorders dynBorders $ render $ withAttr hBorderAttr+                               $ vLimit 1 $ fill (bsHorizontal bs)  -- | A horizontal border with a label placed in the center of the -- border. Fills all horizontal space. hBorderWithLabel :: Widget n                  -- ^ The label widget                  -> Widget n-hBorderWithLabel label = hBorder_ (Just label)--hBorder_ :: Maybe (Widget n) -> Widget n-hBorder_ label =+hBorderWithLabel label =     Widget Greedy Fixed $ do-      bs <- ctxBorderStyle <$> getContext-      let msg = maybe (str [bsHorizontal bs]) (withAttr hBorderLabelAttr) label-      render $ vLimit 1 $ withAttr hBorderAttr $ hCenterWith (Just $ bsHorizontal bs) msg+      res <- render $ vLimit 1 label+      render $ hBox [hBorder, Widget Fixed Fixed (return res), hBorder] --- | A vertical border.  Fills all vertical space.+-- | A vertical border. Fills all vertical space. Draws using+-- 'vBorderAttr'. vBorder :: Widget n vBorder =-    Widget Fixed Greedy $ do-      bs <- ctxBorderStyle <$> getContext-      render $ hLimit 1 $ withAttr vBorderAttr $ fill (bsVertical bs)+    withAttr borderAttr $ Widget Fixed Greedy $ do+      ctx <- getContext+      let bs = ctxBorderStyle ctx+          h = availHeight ctx+      db <- dynBorderFromDirections (Edges True True False False)+      let dynBorders = BM.insertV mempty (Run h db)+                     $ BM.emptyCoordinates (Edges 0 (h-1) 0 0)+      setDynBorders dynBorders $ render $ withAttr vBorderAttr+                               $ hLimit 1 $ fill (bsVertical bs)++-- | Initialize a 'DynBorder'. It will be 'bsDraw'n and 'bsOffer'ing+-- in the given directions to begin with, and accept join offers from+-- all directions. We consult the context to choose the 'dbStyle' and+-- 'dbAttr'.+--+-- This is likely to be useful only for custom widgets that need more+-- complicated dynamic border behavior than 'border', 'vBorder', or+-- 'hBorder' offer.+dynBorderFromDirections :: Edges Bool -> RenderM n DynBorder+dynBorderFromDirections dirs = do+    ctx <- getContext+    return DynBorder+        { dbStyle = ctxBorderStyle ctx+        , dbAttr = attrMapLookup (ctxAttrName ctx) (ctxAttrMap ctx)+        , dbSegments = (\draw -> BorderSegment True draw draw) <$> dirs+        }++-- | Replace the 'Result'\'s dynamic borders with the given one,+-- provided the context says to use dynamic borders at all.+setDynBorders :: BM.BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)+setDynBorders newBorders act = do+    dyn <- ctxDynBorders <$> getContext+    res <- act+    return $ if dyn+        then res & bordersL .~ newBorders+        else res++-- | A single-character dynamic border that will react to neighboring+-- borders, initially connecting in the given directions.+joinableBorder :: Edges Bool -> Widget n+joinableBorder dirs = withAttr borderAttr . Widget Fixed Fixed $ do+    db <- dynBorderFromDirections dirs+    setDynBorders+        (BM.singleton mempty db)+        (render (raw (renderDynBorder db)))
src/Brick/Widgets/Border/Style.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} -- | This module provides styles for borders as used in terminal -- applications. Your mileage may vary on some of the fancier styles -- due to varying support for some border characters in the fonts your@@ -8,8 +9,7 @@ -- -- To use these in your widgets, see -- 'Brick.Widgets.Core.withBorderStyle'. By default, widgets rendered--- without a specified border style use 'unicode' via the 'Default'--- instance provided by 'BorderStyle'.+-- without a specified border style use 'unicode' style. module Brick.Widgets.Border.Style   ( BorderStyle(..)   , borderStyleFromChar@@ -21,6 +21,9 @@   ) where +import GHC.Generics+import Control.DeepSeq+ -- | A border style for use in any widget that needs to render borders -- in a consistent style. data BorderStyle =@@ -47,7 +50,7 @@                 , bsVertical :: Char                 -- ^ Vertical border character                 }-                deriving (Show, Read, Eq)+                deriving (Show, Read, Eq, Generic, NFData)  defaultBorderStyle :: BorderStyle defaultBorderStyle = unicode
src/Brick/Widgets/Center.hs view
@@ -60,7 +60,7 @@            c <- getContext            let rWidth = result^.imageL.to imageWidth                rHeight = result^.imageL.to imageHeight-               remainder = max 0 $ c^.availWidthL - (leftPaddingAmount * 2)+               remainder = max 0 $ c^.availWidthL - (rWidth + (leftPaddingAmount * 2))                leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2                rightPaddingAmount = max 0 $ leftPaddingAmount + remainder                leftPadding = charFill (c^.attrL) ch leftPaddingAmount rHeight
src/Brick/Widgets/Core.hs view
@@ -2,920 +2,1985 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}--- | This module provides the core widget combinators and rendering--- routines. Everything this library does is in terms of these basic--- primitives.-module Brick.Widgets.Core-  ( -- * Basic rendering primitives-    TextWidth(..)-  , emptyWidget-  , raw-  , txt-  , str-  , fill--  -- * Padding-  , padLeft-  , padRight-  , padTop-  , padBottom-  , padLeftRight-  , padTopBottom-  , padAll--  -- * Box layout-  , (<=>)-  , (<+>)-  , hBox-  , vBox--  -- * Limits-  , hLimit-  , vLimit--  -- * Attribute management-  , withDefAttr-  , withAttr-  , forceAttr-  , overrideAttr-  , updateAttrMap--  -- * Border style management-  , withBorderStyle--  -- * Cursor placement-  , showCursor--  -- * Naming-  , Named(..)--  -- * Translation-  , translateBy--  -- * Cropping-  , cropLeftBy-  , cropRightBy-  , cropTopBy-  , cropBottomBy--  -- * Extent reporting-  , reportExtent-  , clickable--  -- * Scrollable viewports-  , viewport-  , visible-  , visibleRegion-  , unsafeLookupViewport-  , cached--  -- ** Adding offsets to cursor positions and visibility requests-  , addResultOffset--  -- ** Cropping results-  , cropToContext-  )-where--#if MIN_VERSION_base(4,8,0)-import Data.Monoid ((<>))-#else-import Control.Applicative-import Data.Monoid ((<>), mempty)-#endif--import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, ix, 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 qualified Data.Foldable as F-import qualified Data.Text as T-import qualified Data.DList as DL-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Function as DF-import Data.List (sortBy, partition)-import qualified Graphics.Vty as V-import Control.DeepSeq--import Brick.Types-import Brick.Types.Internal-import Brick.Widgets.Border.Style-import Brick.Util (clOffset, clamp)-import Brick.AttrMap-import Brick.Widgets.Internal---- | The class of text types that have widths measured in terminal--- columns. NEVER use 'length' etc. to measure the length of a string if--- you need to compute how much screen space it will occupy; always use--- 'textWidth'.-class TextWidth a where-    textWidth :: a -> Int--instance TextWidth T.Text where-    textWidth = V.wcswidth . T.unpack--instance (F.Foldable f) => TextWidth (f Char) where-    textWidth = V.wcswidth . F.toList---- | The class of types that store interface element names.-class Named a n where-    -- | Get the name of the specified value.-    getName :: a -> n---- | When rendering the specified widget, use the specified border style--- for any border rendering.-withBorderStyle :: BorderStyle -> Widget n -> Widget n-withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p)---- | The empty widget.-emptyWidget :: Widget n-emptyWidget = raw V.emptyImage---- | Add an offset to all cursor locations, visbility requests, and--- extents in the specified rendering result. This function is critical--- for maintaining correctness in the rendering results as they are--- processed successively by box layouts and other wrapping combinators,--- since calls to this function result in converting from widget-local--- coordinates to (ultimately) terminal-global ones so they can be--- used by other combinators. You should call this any time you render--- something and then translate it or otherwise offset it from its--- original origin.-addResultOffset :: Location -> Result n -> Result n-addResultOffset off = addCursorOffset off .-                      addVisibilityOffset off .-                      addExtentOffset off--addVisibilityOffset :: Location -> Result n -> Result n-addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)--addExtentOffset :: Location -> Result n -> Result n-addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz o) -> Extent n (off <> l) sz o)---- | Render the specified widget and record its rendering extent using--- the specified name (see also 'lookupExtent').-reportExtent :: n -> Widget n -> Widget n-reportExtent n p =-    Widget (hSize p) (vSize p) $ do-        result <- render p-        let ext = Extent n (Location (0, 0)) sz (Location (0, 0))-            sz = ( result^.imageL.to V.imageWidth-                 , result^.imageL.to V.imageHeight-                 )-        return $ result & extentsL %~ (ext:)---- | Request mouse click events on the specified widget.-clickable :: n -> Widget n -> Widget n-clickable n p =-    Widget (hSize p) (vSize p) $ do-        clickableNamesL %= (n:)-        render $ reportExtent n p--addCursorOffset :: Location -> Result n -> Result n-addCursorOffset off r =-    let onlyVisible = filter isVisible-        isVisible l = l^.locationColumnL >= 0 && l^.locationRowL >= 0-    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)--unrestricted :: Int-unrestricted = 100000---- | Take a substring capable of fitting into the number of specified--- columns. This function takes character column widths into--- consideration.-takeColumns :: Int -> String -> String-takeColumns _ "" = ""-takeColumns numCols (c:cs) =-    let w = V.safeWcwidth c-    in if w == numCols-       then [c]-       else if w < numCols-            then c : takeColumns (numCols - w) cs-            else ""---- | Build a widget from a 'String'. Breaks newlines up and space-pads--- short lines out to the length of the longest line.-str :: String -> Widget n-str s =-    Widget Fixed Fixed $ do-      c <- getContext-      let theLines = fixEmpty <$> (dropUnused . lines) s-          fixEmpty [] = " "-          fixEmpty l = l-          dropUnused l = takeColumns (availWidth c) <$> take (availHeight c) l-      case force theLines of-          [] -> return emptyResult-          [one] -> return $ emptyResult & imageL .~ (V.string (c^.attrL) one)-          multiple ->-              let maxLength = maximum $ V.safeWcswidth <$> multiple-                  lineImgs = lineImg <$> multiple-                  lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - V.safeWcswidth lStr) ' ')-              in return $ emptyResult & imageL .~ (V.vertCat lineImgs)---- | Build a widget from a one-line 'T.Text' value. Behaves the same as--- 'str'.-txt :: T.Text -> Widget n-txt = str . T.unpack---- | Pad the specified widget on the left. If max padding is used, this--- grows greedily horizontally; otherwise it defers to the padded--- widget.-padLeft :: Padding -> Widget n -> Widget n-padLeft padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (hLimit i, hSize p)-    in Widget sz (vSize p) $ do-        c <- getContext-        let lim = case padding of-              Max -> c^.availWidthL-              Pad i -> c^.availWidthL - i-        result <- render $ hLimit lim p-        render $ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') <+>-                 (Widget Fixed Fixed $ return result)---- | Pad the specified widget on the right. If max padding is used,--- this grows greedily horizontally; otherwise it defers to the padded--- widget.-padRight :: Padding -> Widget n -> Widget n-padRight padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (hLimit i, hSize p)-    in Widget sz (vSize p) $ do-        c <- getContext-        let lim = case padding of-              Max -> c^.availWidthL-              Pad i -> c^.availWidthL - i-        result <- render $ hLimit lim p-        render $ (Widget Fixed Fixed $ return result) <+>-                 (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ')---- | Pad the specified widget on the top. If max padding is used, this--- grows greedily vertically; otherwise it defers to the padded widget.-padTop :: Padding -> Widget n -> Widget n-padTop padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (vLimit i, vSize p)-    in Widget (hSize p) sz $ do-        c <- getContext-        let lim = case padding of-              Max -> c^.availHeightL-              Pad i -> c^.availHeightL - i-        result <- render $ vLimit lim p-        render $ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') <=>-                 (Widget Fixed Fixed $ return result)---- | Pad the specified widget on the bottom. If max padding is used,--- this grows greedily vertically; otherwise it defers to the padded--- widget.-padBottom :: Padding -> Widget n -> Widget n-padBottom padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (vLimit i, vSize p)-    in Widget (hSize p) sz $ do-        c <- getContext-        let lim = case padding of-              Max -> c^.availHeightL-              Pad i -> c^.availHeightL - i-        result <- render $ vLimit lim p-        render $ (Widget Fixed Fixed $ return result) <=>-                 (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ')---- | Pad a widget on the left and right. Defers to the padded widget for--- growth policy.-padLeftRight :: Int -> Widget n -> Widget n-padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w---- | Pad a widget on the top and bottom. Defers to the padded widget for--- growth policy.-padTopBottom :: Int -> Widget n -> Widget n-padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w---- | Pad a widget on all sides. Defers to the padded widget for growth--- policy.-padAll :: Int -> Widget n -> Widget n-padAll v w = padLeftRight v $ padTopBottom v w---- | Fill all available space with the specified character. Grows both--- horizontally and vertically.-fill :: Char -> Widget n-fill ch =-    Widget Greedy Greedy $ do-      c <- getContext-      return $ emptyResult & imageL .~ (V.charFill (c^.attrL) ch (c^.availWidthL) (c^.availHeightL))---- | Vertical box layout: put the specified widgets one above the other--- in the specified order (uppermost first). Defers growth policies to--- the growth policies of the contained widgets (if any are greedy, so--- is the box).-vBox :: [Widget n] -> Widget n-vBox [] = emptyWidget-vBox pairs = renderBox vBoxRenderer pairs---- | Horizontal box layout: put the specified widgets next to each other--- in the specified order (leftmost first). Defers growth policies to--- the growth policies of the contained widgets (if any are greedy, so--- is the box).-hBox :: [Widget n] -> Widget n-hBox [] = emptyWidget-hBox pairs = renderBox hBoxRenderer pairs---- | The process of rendering widgets in a box layout is exactly the--- same except for the dimension under consideration (width vs. height),--- in which case all of the same operations that consider one dimension--- in the layout algorithm need to be switched to consider the other.--- Because of this we fill a BoxRenderer with all of the functions--- needed to consider the "primary" dimension (e.g. vertical if the--- box layout is vertical) as well as the "secondary" dimension (e.g.--- horizontal if the box layout is vertical). Doing this permits us to--- have one implementation for box layout and parameterizing on the--- orientation of all of the operations.-data BoxRenderer n =-    BoxRenderer { contextPrimary :: Lens' Context Int-                , contextSecondary :: Lens' Context Int-                , imagePrimary :: V.Image -> Int-                , imageSecondary :: V.Image -> Int-                , limitPrimary :: Int -> Widget n -> Widget n-                , limitSecondary :: Int -> Widget n -> Widget n-                , primaryWidgetSize :: Widget n -> Size-                , concatenatePrimary :: [V.Image] -> V.Image-                , locationFromOffset :: Int -> Location-                , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image-                }--vBoxRenderer :: BoxRenderer n-vBoxRenderer =-    BoxRenderer { contextPrimary = availHeightL-                , contextSecondary = availWidthL-                , imagePrimary = V.imageHeight-                , imageSecondary = V.imageWidth-                , limitPrimary = vLimit-                , limitSecondary = hLimit-                , primaryWidgetSize = vSize-                , concatenatePrimary = V.vertCat-                , locationFromOffset = Location . (0 ,)-                , padImageSecondary = \amt img a ->-                    let p = V.charFill a ' ' amt (V.imageHeight img)-                    in V.horizCat [img, p]-                }--hBoxRenderer :: BoxRenderer n-hBoxRenderer =-    BoxRenderer { contextPrimary = availWidthL-                , contextSecondary = availHeightL-                , imagePrimary = V.imageWidth-                , imageSecondary = V.imageHeight-                , limitPrimary = hLimit-                , limitSecondary = vLimit-                , primaryWidgetSize = hSize-                , concatenatePrimary = V.horizCat-                , locationFromOffset = Location . (, 0)-                , padImageSecondary = \amt img a ->-                    let p = V.charFill a ' ' (V.imageWidth img) amt-                    in V.vertCat [img, p]-                }---- | Render a series of widgets in a box layout in the order given.------ The growth policy of a box layout is the most unrestricted of the--- growth policies of the widgets it contains, so to determine the hSize--- and vSize of the box we just take the maximum (using the Ord instance--- for Size) of all of the widgets to be rendered in the box.------ Then the box layout algorithm proceeds as follows. We'll use--- the vertical case to concretely describe the algorithm, but the--- horizontal case can be envisioned just by exchanging all--- "vertical"/"horizontal" and "rows"/"columns", etc., in the--- description.------ The growth policies of the child widgets determine the order in which--- they are rendered, i.e., the order in which space in the box is--- allocated to widgets as the algorithm proceeds. This is because order--- matters: if we render greedy widgets first, there will be no space--- left for non-greedy ones.------ So we render all widgets with size 'Fixed' in the vertical dimension--- first. Each is rendered with as much room as the overall box has, but--- we assume that they will not be greedy and use it all. If they do,--- maybe it's because the terminal is small and there just isn't enough--- room to render everything.------ Then the remaining height is distributed evenly amongst all remaining--- (greedy) widgets and they are rendered in sub-boxes that are as high--- as this even slice of rows and as wide as the box is permitted to be.--- We only do this step at all if rendering the non-greedy widgets left--- us any space, i.e., if there were any rows left.------ After rendering the non-greedy and then greedy widgets, their images--- are sorted so that they are stored in the order the original widgets--- were given. All cursor locations and visibility requests in each--- sub-widget are translated according to the position of the sub-widget--- in the box.------ All images are padded to be as wide as the widest sub-widget to--- prevent attribute over-runs. Without this step the attribute used by--- a sub-widget may continue on in an undesirable fashion until it hits--- something with a different attribute. To prevent this and to behave--- in the least surprising way, we pad the image on the right with--- whitespace using the context's current attribute.------ Finally, the padded images are concatenated together vertically and--- returned along with the translated cursor positions and visibility--- requests.-renderBox :: BoxRenderer n -> [Widget n] -> Widget n-renderBox br ws =-    Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do-      c <- getContext--      let pairsIndexed = zip [(0::Int)..] ws-          (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed)-                        pairsIndexed--      let availPrimary = c^.(contextPrimary br)-          availSecondary = c^.(contextSecondary br)--          renderHis _ prev [] = return $ DL.toList prev-          renderHis remainingPrimary prev ((i, prim):rest) = do-              result <- render $ limitPrimary br remainingPrimary-                               $ limitSecondary br availSecondary-                               $ cropToContext prim-              renderHis (remainingPrimary - (result^.imageL.(to $ imagePrimary br)))-                        (DL.snoc prev (i, result)) rest--      renderedHis <- renderHis availPrimary DL.empty his--      renderedLows <- case lows of-          [] -> return []-          ls -> do-              let remainingPrimary = c^.(contextPrimary br) --                                     (sum $ (^._2.imageL.(to $ imagePrimary br)) <$> renderedHis)-                  primaryPerLow = remainingPrimary `div` length ls-                  padFirst = remainingPrimary - (primaryPerLow * length ls)-                  secondaryPerLow = c^.(contextSecondary br)-                  primaries = replicate (length ls) primaryPerLow & ix 0 %~ (+ padFirst)--              let renderLow ((i, prim), pri) =-                      (i,) <$> (render $ limitPrimary br pri-                                       $ limitSecondary br secondaryPerLow-                                       $ cropToContext prim)--              if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return []--      let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows-          allResults = snd <$> rendered-          allImages = (^.imageL) <$> allResults-          allPrimaries = imagePrimary br <$> allImages-          allTranslatedResults = (flip map) (zip [0..] allResults) $ \(i, result) ->-              let off = locationFromOffset br offPrimary-                  offPrimary = sum $ take i allPrimaries-              in addResultOffset off result-          -- Determine the secondary dimension value to pad to. In a-          -- vertical box we want all images to be the same width to-          -- avoid attribute over-runs or blank spaces with the wrong-          -- attribute. In a horizontal box we want all images to have-          -- the same height for the same reason.-          maxSecondary = maximum $ imageSecondary br <$> allImages-          padImage img = padImageSecondary br (maxSecondary - imageSecondary br img)-                         img (c^.attrL)-          paddedImages = padImage <$> allImages--      cropResultToContext $ Result (concatenatePrimary br paddedImages)-                            (concat $ cursors <$> allTranslatedResults)-                            (concat $ visibilityRequests <$> allTranslatedResults)-                            (concat $ extents <$> allTranslatedResults)---- | Limit the space available to the specified widget to the specified--- number of columns. This is important for constraining the horizontal--- growth of otherwise-greedy widgets. This is non-greedy horizontally--- and defers to the limited widget vertically.-hLimit :: Int -> Widget n -> Widget n-hLimit w p =-    Widget Fixed (vSize p) $-      withReaderT (& availWidthL .~ w) $ render $ cropToContext p---- | Limit the space available to the specified widget to the specified--- number of rows. This is important for constraining the vertical--- growth of otherwise-greedy widgets. This is non-greedy vertically and--- defers to the limited widget horizontally.-vLimit :: Int -> Widget n -> Widget n-vLimit h p =-    Widget (hSize p) Fixed $-      withReaderT (& availHeightL .~ h) $ render $ cropToContext p---- | When drawing the specified widget, set the current attribute used--- for drawing to the one with the specified name. Note that the widget--- may use further calls to 'withAttr' to override this; if you really--- 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'.-withAttr :: AttrName -> Widget n -> Widget n-withAttr an p =-    Widget (hSize p) (vSize p) $-      withReaderT (& ctxAttrNameL .~ an) (render p)---- | Update the attribute map while rendering the specified widget: set--- its new default attribute to the one that we get by looking up the--- specified attribute name in the map.-withDefAttr :: AttrName -> Widget n -> Widget n-withDefAttr an p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL %~ (setDefault (attrMapLookup an (c^.ctxAttrMapL)))) (render p)---- | When rendering the specified widget, update the attribute map with--- the specified transformation.-updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n-updateAttrMap f p =-    Widget (hSize p) (vSize p) $-        withReaderT (& ctxAttrMapL %~ f) (render p)---- | When rendering the specified widget, force all attribute lookups--- in the attribute map to use the value currently assigned to the--- specified attribute name.-forceAttr :: AttrName -> Widget n -> Widget n-forceAttr an p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)---- | Override the lookup of 'targetName' to return the attribute value--- associated with 'fromName' when rendering the specified widget.--- See also 'mapAttrName'.-overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n-overrideAttr targetName fromName =-    updateAttrMap (mapAttrName fromName targetName)---- | Build a widget directly from a raw Vty image.-raw :: V.Image -> Widget n-raw img = Widget Fixed Fixed $ return $ emptyResult & imageL .~ img---- | Translate the specified widget by the specified offset amount.--- Defers to the translated widget for growth policy.-translateBy :: Location -> Widget n -> Widget n-translateBy off p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ addResultOffset off-             $ result & imageL %~ (V.translate (off^.locationColumnL) (off^.locationRowL))---- | Crop the specified widget on the left by the specified number of--- columns. Defers to the cropped widget for growth policy.-cropLeftBy :: Int -> Widget n -> Widget n-cropLeftBy cols p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageWidth (result^.imageL) - cols-          cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img-      return $ addResultOffset (Location (-1 * cols, 0))-             $ result & imageL %~ cropped---- | Crop the specified widget on the right by the specified number of--- columns. Defers to the cropped widget for growth policy.-cropRightBy :: Int -> Widget n -> Widget n-cropRightBy cols p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageWidth (result^.imageL) - cols-          cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img-      return $ result & imageL %~ cropped---- | Crop the specified widget on the top by the specified number of--- rows. Defers to the cropped widget for growth policy.-cropTopBy :: Int -> Widget n -> Widget n-cropTopBy rows p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageHeight (result^.imageL) - rows-          cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img-      return $ addResultOffset (Location (0, -1 * rows))-             $ result & imageL %~ cropped---- | Crop the specified widget on the bottom by the specified number of--- rows. Defers to the cropped widget for growth policy.-cropBottomBy :: Int -> Widget n -> Widget n-cropBottomBy rows p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageHeight (result^.imageL) - rows-          cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img-      return $ result & imageL %~ cropped---- | When rendering the specified widget, also register a cursor--- positioning request using the specified name and location.-showCursor :: n -> Location -> Widget n -> Widget n-showCursor n cloc p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ result & cursorsL %~ (CursorLocation cloc (Just n):)--hRelease :: Widget n -> Maybe (Widget n)-hRelease p =-    case hSize p of-        Fixed -> Just $ Widget Greedy (vSize p) $-                        withReaderT (& availWidthL .~ unrestricted) (render p)-        Greedy -> Nothing--vRelease :: Widget n -> Maybe (Widget n)-vRelease p =-    case vSize p of-        Fixed -> Just $ Widget (hSize p) Greedy $-                        withReaderT (& availHeightL .~ unrestricted) (render p)-        Greedy -> Nothing---- | Render the specified widget. If the widget has an entry in the--- rendering cache using the specified name as the cache key, use the--- rendered version from the cache instead. If not, render the widget--- and update the cache.------ See also 'invalidateCacheEntry'.-cached :: (Ord n) => n -> Widget n -> Widget n-cached n w =-    Widget (hSize w) (vSize w) $ do-        result <- cacheLookup n-        case result of-            Just prevResult -> return prevResult-            Nothing  -> do-                wResult <- render w-                cacheUpdate n wResult-                return wResult--cacheLookup :: (Ord n) => n -> RenderM n (Maybe (Result n))-cacheLookup n = do-    cache <- lift $ gets (^.renderCacheL)-    return $ M.lookup n cache--cacheUpdate :: (Ord n) => n -> Result n -> RenderM n ()-cacheUpdate n r = lift $ modify (& renderCacheL %~ M.insert n r)---- | Render the specified widget in a named viewport with the--- specified type. This permits widgets to be scrolled without being--- scrolling-aware. To make the most use of viewports, the specified--- widget should use the 'visible' combinator to make a "visibility--- request". This viewport combinator will then translate the resulting--- rendering to make the requested region visible. In addition, the--- 'Brick.Main.EventM' monad provides primitives to scroll viewports--- created by this function if 'visible' is not what you want.------ If a viewport receives more than one visibility request, then the--- visibility requests are merged with the inner visibility request--- taking preference. If a viewport receives more than one scrolling--- request from 'Brick.Main.EventM', all are honored in the order in--- which they are received.-viewport :: (Ord n, Show n)-         => n-         -- ^ The name of the viewport (must be unique and stable for-         -- reliable behavior)-         -> ViewportType-         -- ^ The type of viewport (indicates the permitted scrolling-         -- direction)-         -> Widget n-         -- ^ The widget to be rendered in the scrollable viewport-         -> Widget n-viewport vpname typ p =-    Widget Greedy Greedy $ do-      -- First, update the viewport size.-      c <- getContext-      let newVp = VP 0 0 newSize-          newSize = (c^.availWidthL, c^.availHeightL)-          doInsert (Just vp) = Just $ vp & vpSize .~ newSize-          doInsert Nothing = Just newVp--      let observeName :: (Ord n, Show n) => n -> RenderM n ()-          observeName n = do-              observed <- use observedNamesL-              case S.member n observed of-                  False -> observedNamesL %= S.insert n-                  True ->-                      error $ "Error: while rendering the interface, the name " <> show n <>-                              " was seen more than once. You should ensure that all of the widgets " <>-                              "in each interface have unique name values. This means either " <>-                              "using a different name type or adding constructors to your " <>-                              "existing one and using those to name your widgets.  For more " <>-                              "information, see the \"Resource Names\" section of the Brick User Guide."--      observeName vpname--      lift $ modify (& viewportMapL %~ (M.alter doInsert vpname))--      -- Then render the sub-rendering with the rendering layout-      -- constraint released (but raise an exception if we are asked to-      -- render an infinitely-sized widget in the viewport's scrolling-      -- dimension)-      let release = case typ of-            Vertical -> vRelease-            Horizontal -> hRelease-            Both -> vRelease >=> hRelease-          released = case release p of-            Just w -> w-            Nothing -> case typ of-                Vertical -> error $ "tried to embed an infinite-height " <>-                                    "widget in vertical viewport " <> (show vpname)-                Horizontal -> error $ "tried to embed an infinite-width " <>-                                      "widget in horizontal viewport " <> (show vpname)-                Both -> error $ "tried to embed an infinite-width or " <>-                                "infinite-height widget in 'Both' type " <>-                                "viewport " <> (show vpname)--      initialResult <- render released--      -- If the rendering state includes any scrolling requests for this-      -- viewport, apply those-      reqs <- lift $ gets $ (^.rsScrollRequestsL)-      let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs-      when (not $ null relevantRequests) $ do-          Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))-          let updatedVp = applyRequests relevantRequests vp-              applyRequests [] v = v-              applyRequests (rq:rqs) v =-                  case typ of-                      Horizontal -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v-                      Vertical -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v-                      Both -> scrollTo Horizontal rq (initialResult^.imageL) $-                              scrollTo Vertical rq (initialResult^.imageL) $-                              applyRequests rqs v-          lift $ modify (& viewportMapL %~ (M.insert vpname updatedVp))-          return ()--      -- If the sub-rendering requested visibility, update the scroll-      -- state accordingly-      when (not $ null $ initialResult^.visibilityRequestsL) $ do-          Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))-          let rqs = initialResult^.visibilityRequestsL-              updateVp vp' rq = case typ of-                  Both -> scrollToView Horizontal rq $ scrollToView Vertical rq vp'-                  Horizontal -> scrollToView typ rq vp'-                  Vertical -> scrollToView typ rq vp'-          lift $ modify (& viewportMapL %~ (M.insert vpname $ foldl updateVp vp rqs))--      -- If the size of the rendering changes enough to make the-      -- viewport offsets invalid, reset them-      Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))-      let img = initialResult^.imageL-          fixTop v = if V.imageHeight img < v^.vpSize._2-                   then v & vpTop .~ 0-                   else v-          fixLeft v = if V.imageWidth img < v^.vpSize._1-                   then v & vpLeft .~ 0-                   else v-          updateVp = case typ of-              Both -> fixLeft . fixTop-              Horizontal -> fixLeft-              Vertical -> fixTop-      lift $ modify (& viewportMapL %~ (M.insert vpname (updateVp vp)))--      -- Get the viewport state now that it has been updated.-      Just vpFinal <- lift $ gets (M.lookup vpname . (^.viewportMapL))--      -- Then perform a translation of the sub-rendering to fit into the-      -- viewport-      translated <- render $ translateBy (Location (-1 * vpFinal^.vpLeft, -1 * vpFinal^.vpTop))-                           $ Widget Fixed Fixed $ return initialResult--      -- Return the translated result with the visibility requests-      -- discarded-      let translatedSize = ( translated^.imageL.to V.imageWidth-                           , translated^.imageL.to V.imageHeight-                           )-      case translatedSize of-          (0, 0) -> do-              let spaceFill = V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL)-              return $ translated & imageL .~ spaceFill-                                  & visibilityRequestsL .~ mempty-                                  & extentsL .~ mempty-          _ -> render $ cropToContext-                      $ padBottom Max-                      $ padRight Max-                      $ Widget Fixed Fixed-                      $ return $ translated & visibilityRequestsL .~ mempty---- | Given a name, obtain the viewport for that name by consulting the--- viewport map in the rendering monad. NOTE! Some care must be taken--- when calling this function, since it only returns useful values--- after the viewport in question has been rendered. If you call this--- function during rendering before a viewport has been rendered, you--- may get nothing or you may get a stale version of the viewport. This--- is because viewports are updated during rendering and the one you are--- interested in may not have been rendered yet. So if you want to use--- this, be sure you know what you are doing.-unsafeLookupViewport :: (Ord n) => n -> RenderM n (Maybe Viewport)-unsafeLookupViewport name = lift $ gets (M.lookup name . (^.viewportMapL))--scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport-scrollTo Both _ _ _ = error "BUG: called scrollTo on viewport type 'Both'"-scrollTo Vertical req img vp = vp & vpTop .~ newVStart-    where-        newVStart = clamp 0 (V.imageHeight img - vp^.vpSize._2) adjustedAmt-        adjustedAmt = case req of-            VScrollBy amt -> vp^.vpTop + amt-            VScrollPage Up -> vp^.vpTop - vp^.vpSize._2-            VScrollPage Down -> vp^.vpTop + vp^.vpSize._2-            VScrollToBeginning -> 0-            VScrollToEnd -> V.imageHeight img - vp^.vpSize._2-            SetTop i -> i-            _ -> vp^.vpTop-scrollTo Horizontal req img vp = vp & vpLeft .~ newHStart-    where-        newHStart = clamp 0 (V.imageWidth img - vp^.vpSize._1) adjustedAmt-        adjustedAmt = case req of-            HScrollBy amt -> vp^.vpLeft + amt-            HScrollPage Up -> vp^.vpLeft - vp^.vpSize._1-            HScrollPage Down -> vp^.vpLeft + vp^.vpSize._1-            HScrollToBeginning -> 0-            HScrollToEnd -> V.imageWidth img - vp^.vpSize._1-            SetLeft i -> i-            _ -> vp^.vpLeft--scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport-scrollToView Both _ _ = error "BUG: called scrollToView on 'Both' type viewport"-scrollToView Vertical rq vp = vp & vpTop .~ newVStart-    where-        curStart = vp^.vpTop-        curEnd = curStart + vp^.vpSize._2-        reqStart = rq^.vrPositionL.locationRowL--        reqEnd = rq^.vrPositionL.locationRowL + rq^.vrSizeL._2-        newVStart :: Int-        newVStart = if reqStart < vStartEndVisible-                   then reqStart-                   else vStartEndVisible-        vStartEndVisible = if reqEnd < curEnd-                           then curStart-                           else curStart + (reqEnd - curEnd)-scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart-    where-        curStart = vp^.vpLeft-        curEnd = curStart + vp^.vpSize._1-        reqStart = rq^.vrPositionL.locationColumnL--        reqEnd = rq^.vrPositionL.locationColumnL + rq^.vrSizeL._1-        newHStart :: Int-        newHStart = if reqStart < hStartEndVisible-                   then reqStart-                   else hStartEndVisible-        hStartEndVisible = if reqEnd < curEnd-                           then curStart-                           else curStart + (reqEnd - curEnd)---- | Request that the specified widget be made visible when it is--- rendered inside a viewport. This permits widgets (whose sizes and--- positions cannot be known due to being embedded in arbitrary layouts)--- to make a request for a parent viewport to locate them and scroll--- enough to put them in view. This, together with 'viewport', is what--- makes the text editor and list widgets possible without making them--- deal with the details of scrolling state management.------ This does nothing if not rendered in a viewport.-visible :: Widget n -> Widget n-visible p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let imageSize = ( result^.imageL.to V.imageWidth-                      , result^.imageL.to V.imageHeight-                      )-      -- The size of the image to be made visible in a viewport must have-      -- non-zero size in both dimensions.-      return $ if imageSize^._1 > 0 && imageSize^._2 > 0-               then result & visibilityRequestsL %~ (VR (Location (0, 0)) imageSize :)-               else result---- | Similar to 'visible', request that a region (with the specified--- 'Location' as its origin and 'V.DisplayRegion' as its size) be made--- visible when it is rendered inside a viewport. The 'Location' is--- relative to the specified widget's upper-left corner of (0, 0).------ This does nothing if not rendered in a viewport.-visibleRegion :: Location -> V.DisplayRegion -> Widget n -> Widget n-visibleRegion vrloc sz p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      -- The size of the image to be made visible in a viewport must have-      -- non-zero size in both dimensions.-      return $ if sz^._1 > 0 && sz^._2 > 0-               then result & visibilityRequestsL %~ (VR vrloc sz :)-               else result---- | Horizontal box layout: put the specified widgets next to each other--- in the specified order. Defers growth policies to the growth policies--- of both widgets.  This operator is a binary version of 'hBox'.-(<+>) :: Widget n-      -- ^ Left-      -> Widget n-      -- ^ Right-      -> Widget n-(<+>) a b = hBox [a, b]---- | Vertical box layout: put the specified widgets one above the other--- in the specified order. Defers growth policies to the growth policies--- of both widgets.  This operator is a binary version of 'vBox'.-(<=>) :: Widget n-      -- ^ Top-      -> Widget n-      -- ^ Bottom-      -> Widget n-(<=>) a b = vBox [a, b]+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- | This module provides the core widget combinators and rendering+-- routines. Everything this library does is in terms of these basic+-- primitives.+module Brick.Widgets.Core+  ( -- * Basic rendering primitives+    TextWidth(..)+  , emptyWidget+  , raw+  , txt+  , txtWrap+  , txtWrapWith+  , str+  , strWrap+  , strWrapWith+  , fill+  , hyperlink++  -- * Padding+  , Padding(..)+  , padLeft+  , padRight+  , padTop+  , padBottom+  , padLeftRight+  , padTopBottom+  , padAll++  -- * Box layout+  , (<=>)+  , (<+>)+  , hBox+  , vBox++  -- * Limits+  , hLimit+  , hLimitPercent+  , vLimit+  , vLimitPercent+  , setAvailableSize++  -- * Attribute management+  , withDefAttr+  , modifyDefAttr+  , withAttr+  , forceAttr+  , forceAttrAllowStyle+  , overrideAttr+  , updateAttrMap++  -- * Border style management+  , withBorderStyle+  , joinBorders+  , separateBorders+  , freezeBorders++  -- * Cursor placement+  , showCursor+  , putCursor++  -- * Naming+  , Named(..)++  -- * Translation and positioning+  , translateBy+  , relativeTo++  -- * Cropping+  , cropLeftBy+  , cropRightBy+  , cropTopBy+  , cropBottomBy+  , cropLeftTo+  , cropRightTo+  , cropTopTo+  , cropBottomTo++  -- * Extent reporting+  , reportExtent+  , clickable++  -- * Scrollable viewports+  , viewport+  , visible+  , visibleRegion+  , unsafeLookupViewport+  , cached++  -- ** Viewport scroll bars+  , withVScrollBars+  , withHScrollBars+  , withClickableHScrollBars+  , withClickableVScrollBars+  , withVScrollBarHandles+  , withHScrollBarHandles+  , withVScrollBarRenderer+  , withHScrollBarRenderer+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , verticalScrollbarRenderer+  , horizontalScrollbarRenderer+  , scrollbarAttr+  , scrollbarTroughAttr+  , scrollbarHandleAttr+  , verticalScrollbar+  , horizontalScrollbar++  -- ** Adding offsets to cursor positions and visibility requests+  , addResultOffset++  -- ** Cropping results+  , cropToContext+  )+where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif++import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens')+import Lens.Micro.Mtl (use, (%=))+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader+import qualified Data.Foldable as F+import Data.Traversable (for)+import qualified Data.Text as T+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.IMap as I+import qualified Data.Function as DF+import Data.List (sortBy, partition)+import Data.Maybe (fromMaybe)+import qualified Graphics.Vty as V+import Control.DeepSeq++import Text.Wrap (wrapTextToLines, WrapSettings, defaultWrapSettings)++import Brick.Types+import Brick.Types.Internal+import Brick.Widgets.Border.Style+import Brick.Util (clOffset, clamp)+import Brick.AttrMap+import Brick.Widgets.Internal+import qualified Brick.BorderMap as BM++-- | The class of text types that have widths measured in terminal+-- columns. NEVER use 'length' etc. to measure the length of a string if+-- you need to compute how much screen space it will occupy; always use+-- 'textWidth'.+class TextWidth a where+    textWidth :: a -> Int++instance TextWidth T.Text where+    textWidth = V.wcswidth . T.unpack++instance (F.Foldable f) => TextWidth (f Char) where+    textWidth = V.wcswidth . F.toList++-- | The class of types that store interface element names.+class Named a n where+    -- | Get the name of the specified value.+    getName :: a -> n++-- | When rendering the specified widget, use the specified border style+-- for any border rendering.+withBorderStyle :: BorderStyle -> Widget n -> Widget n+withBorderStyle bs p = Widget (hSize p) (vSize p) $+    withReaderT (ctxBorderStyleL .~ bs) (render p)++-- | When rendering the specified widget, create borders that respond+-- dynamically to their neighbors to form seamless connections.+joinBorders :: Widget n -> Widget n+joinBorders p = Widget (hSize p) (vSize p) $+    withReaderT (ctxDynBordersL .~ True) (render p)++-- | When rendering the specified widget, use static borders. This+-- may be marginally faster, but will introduce a small gap between+-- neighboring orthogonal borders.+--+-- This is the default for backwards compatibility.+separateBorders :: Widget n -> Widget n+separateBorders p = Widget (hSize p) (vSize p) $+    withReaderT (ctxDynBordersL .~ False) (render p)++-- | After the specified widget has been rendered, freeze its borders. A+-- frozen border will not be affected by neighbors, nor will it affect+-- neighbors. Compared to 'separateBorders', 'freezeBorders' will not+-- affect whether borders connect internally to a widget (whereas+-- 'separateBorders' prevents them from connecting).+--+-- Frozen borders cannot be thawed.+freezeBorders :: Widget n -> Widget n+freezeBorders p = Widget (hSize p) (vSize p) $ (bordersL %~ BM.clear) <$> render p++-- | The empty widget.+emptyWidget :: Widget n+emptyWidget = raw V.emptyImage++-- | Add an offset to all cursor locations, visibility requests, and+-- extents in the specified rendering result. This function is critical+-- for maintaining correctness in the rendering results as they are+-- processed successively by box layouts and other wrapping combinators,+-- since calls to this function result in converting from widget-local+-- coordinates to (ultimately) terminal-global ones so they can be+-- used by other combinators. You should call this any time you render+-- something and then translate it or otherwise offset it from its+-- original origin.+addResultOffset :: Location -> Result n -> Result n+addResultOffset off = addCursorOffset off .+                      addVisibilityOffset off .+                      addExtentOffset off .+                      addDynBorderOffset off++addVisibilityOffset :: Location -> Result n -> Result n+addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)++addExtentOffset :: Location -> Result n -> Result n+addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz) -> Extent n (off <> l) sz)++addDynBorderOffset :: Location -> Result n -> Result n+addDynBorderOffset off r = r & bordersL %~ BM.translate off++-- | Render the specified widget and record its rendering extent using+-- the specified name (see also 'lookupExtent').+--+-- This function is the counterpart to 'makeVisible'; any visibility+-- requests made with 'makeVisible' must have a corresponding+-- 'reportExtent' in order to work. The 'clickable' function will also+-- work for this purpose to tell the renderer about the clickable+-- region.+reportExtent :: (Ord n) => n -> Widget n -> Widget n+reportExtent n p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let ext = Extent n (Location (0, 0)) sz+            sz = ( result^.imageL.to V.imageWidth+                 , result^.imageL.to V.imageHeight+                 )+        -- If the reported extent also has a visibility request+        -- from EventM via makeVisible, add a visibility request to+        -- the render state so this gets scrolled into view by any+        -- containing viewport.+        vReqs <- use requestedVisibleNames_L+        let addVisReq = if sz^._1 > 0 && sz^._2 > 0 && n `S.member` vReqs+                        then visibilityRequestsL %~ (VR (Location (0, 0)) sz :)+                        else id+        return $ addVisReq $ result & extentsL %~ (ext:)++-- | Request mouse click events on the specified widget.+--+-- Regions used with 'clickable' can be scrolled into view with+-- 'makeVisible'.+clickable :: (Ord n) => n -> Widget n -> Widget n+clickable n p =+    Widget (hSize p) (vSize p) $ do+        clickableNamesL %= (n:)+        render $ reportExtent n p++addCursorOffset :: Location -> Result n -> Result n+addCursorOffset off r =+    let onlyVisible = filter isVisible+        isVisible l = l^.locationColumnL >= 0 && l^.locationRowL >= 0+    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)++unrestricted :: Int+unrestricted = 100000++-- | Make a widget from a string, but wrap the words in the input's+-- lines at the available width using the default wrapping settings. The+-- input string should not contain escape sequences or carriage returns.+--+-- Unlike 'str', this is greedy horizontally.+strWrap :: String -> Widget n+strWrap = strWrapWith defaultWrapSettings++-- | Make a widget from a string, but wrap the words in the input's+-- lines at the available width using the specified wrapping settings.+-- The input string should not contain escape sequences or carriage+-- returns.+--+-- Unlike 'str', this is greedy horizontally.+strWrapWith :: WrapSettings -> String -> Widget n+strWrapWith settings t = txtWrapWith settings $ T.pack t++-- | Make a widget from text, but wrap the words in the input's lines at+-- the available width using the default wrapping settings. The input+-- text should not contain escape sequences or carriage returns.+--+-- Unlike 'txt', this is greedy horizontally.+txtWrap :: T.Text -> Widget n+txtWrap = txtWrapWith defaultWrapSettings++-- | Make a widget from text, but wrap the words in the input's lines at+-- the available width using the specified wrapping settings. The input+-- text should not contain escape sequences or carriage returns.+--+-- Unlike 'txt', this is greedy horizontally.+txtWrapWith :: WrapSettings -> T.Text -> Widget n+txtWrapWith settings s =+    Widget Greedy Fixed $ do+      c <- getContext+      let theLines = fixEmpty <$> wrapTextToLines settings (c^.availWidthL) s+          fixEmpty l | T.null l = " "+                     | otherwise = l+      case force theLines of+          [] -> return emptyResult+          multiple ->+              let maxLength = maximum $ textWidth <$> multiple+                  padding = V.charFill (c^.attrL) ' ' (c^.availWidthL - maxLength) (length lineImgs)+                  lineImgs = lineImg <$> multiple+                  lineImg lStr = V.text' (c^.attrL)+                                   (lStr <> T.replicate (maxLength - textWidth lStr) " ")+              in return $ emptyResult & imageL .~ (V.horizCat [V.vertCat lineImgs, padding])++-- | Build a widget from a 'String'. Behaves the same as 'txt' when the+-- input contains multiple lines.+--+-- The input string must not contain tab characters. If it does,+-- interface corruption will result since the terminal will likely+-- render it as taking up more than a single column. The caller should+-- replace tabs with the appropriate number of spaces as desired. The+-- input string should not contain escape sequences or carriage returns.+str :: String -> Widget n+str = txt . T.pack++-- | Build a widget from a 'T.Text' value. Breaks newlines up and+-- space-pads short lines out to the length of the longest line.+--+-- The input string must not contain tab characters. If it does,+-- interface corruption will result since the terminal will likely+-- render it as taking up more than a single column. The caller should+-- replace tabs with the appropriate number of spaces as desired. The+-- input text should not contain escape sequences or carriage returns.+txt :: T.Text -> Widget n+txt s =+    -- Although vty Image uses lazy Text internally, using lazy text at this+    -- level may not be an improvement.  Indeed it can be much worse, due+    -- the overhead of lazy Text being significant compared to the typically+    -- short string content used to compose UIs.+    Widget Fixed Fixed $ do+        c <- getContext+        let theLines = fixEmpty <$> (dropUnused . T.lines) s+            fixEmpty l = if T.null l then T.singleton ' ' else l+            dropUnused l = takeColumnsT (availWidth c) <$> take (availHeight c) l+        pure $ case theLines of+            [] -> emptyResult+            [one] -> emptyResult & imageL .~ (V.text' (c^.attrL) one)+            multiple ->+                let maxLength = maximum $ V.safeWctwidth <$> multiple+                    lineImgs = lineImg <$> multiple+                    lineImg lStr = V.text' (c^.attrL)+                        (lStr <> T.replicate (maxLength - V.safeWctwidth lStr) (T.singleton ' '))+                in emptyResult & imageL .~ (V.vertCat lineImgs)++-- | Take up to the given width, having regard to character width.+takeColumnsT :: Int -> T.Text -> T.Text+takeColumnsT w s = T.take (fst $ T.foldl' f (0,0) s) s+    where+    -- The accumulator value is (index in Text value, width of Text so far)+    f (i,z) c+        -- Width was previously exceeded; continue with same values.+        | z < 0                   = (i, z)+        -- Width exceeded.  Signal this with z = -1.  Index will no longer be+        -- incremented.+        --+        -- Why not short circuit (e.g. using foldlM construction)?+        -- Because in the typical case, the Either allocation costs exceed+        -- any benefits.  The pathological case, string length >> width, is+        -- probably rare.+        | z + V.safeWcwidth c > w = (i, -1)+        -- Width not yet exceeded.  Increment index and add character width.+        | otherwise               = (i + 1, z + V.safeWcwidth c)++-- | Hyperlink the given widget to the specified URL. Not all terminal+-- emulators support this. In those that don't, this should have no+-- discernible effect.+hyperlink :: T.Text -> Widget n -> Widget n+hyperlink url p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        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.+padLeft :: Padding -> Widget n -> Widget n+padLeft padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (hLimit i, hSize p)+    in Widget sz (vSize p) $ do+        c <- getContext+        let lim = case padding of+              Max -> c^.availWidthL+              Pad i -> c^.availWidthL - i+        result <- render $ hLimit lim p+        render $ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') <+>+                 (Widget Fixed Fixed $ return result)++-- | Pad the specified widget on the right. If max padding is used,+-- this grows greedily horizontally; otherwise it defers to the padded+-- widget.+padRight :: Padding -> Widget n -> Widget n+padRight padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (hLimit i, hSize p)+    in Widget sz (vSize p) $ do+        c <- getContext+        let lim = case padding of+              Max -> c^.availWidthL+              Pad i -> c^.availWidthL - i+        result <- render $ hLimit lim p+        render $ (Widget Fixed Fixed $ return result) <+>+                 (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ')++-- | Pad the specified widget on the top. If max padding is used, this+-- grows greedily vertically; otherwise it defers to the padded widget.+padTop :: Padding -> Widget n -> Widget n+padTop padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (vLimit i, vSize p)+    in Widget (hSize p) sz $ do+        c <- getContext+        let lim = case padding of+              Max -> c^.availHeightL+              Pad i -> c^.availHeightL - i+        result <- render $ vLimit lim p+        render $ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') <=>+                 (Widget Fixed Fixed $ return result)++-- | Pad the specified widget on the bottom. If max padding is used,+-- this grows greedily vertically; otherwise it defers to the padded+-- widget.+padBottom :: Padding -> Widget n -> Widget n+padBottom padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (vLimit i, vSize p)+    in Widget (hSize p) sz $ do+        c <- getContext+        let lim = case padding of+              Max -> c^.availHeightL+              Pad i -> c^.availHeightL - i+        result <- render $ vLimit lim p+        render $ (Widget Fixed Fixed $ return result) <=>+                 (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ')++-- | Pad a widget on the left and right. Defers to the padded widget for+-- growth policy.+padLeftRight :: Int -> Widget n -> Widget n+padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w++-- | Pad a widget on the top and bottom. Defers to the padded widget for+-- growth policy.+padTopBottom :: Int -> Widget n -> Widget n+padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w++-- | Pad a widget on all sides. Defers to the padded widget for growth+-- policy.+padAll :: Int -> Widget n -> Widget n+padAll v w = padLeftRight v $ padTopBottom v w++-- | Fill all available space with the specified character. Grows both+-- horizontally and vertically.+fill :: Char -> Widget n+fill ch =+    Widget Greedy Greedy $ do+      c <- getContext+      return $ emptyResult & imageL .~ (V.charFill (c^.attrL) ch (c^.availWidthL) (c^.availHeightL))++-- | Vertical box layout: put the specified widgets one above the other+-- in the specified order (uppermost first). Defers growth policies to+-- the growth policies of the contained widgets (if any are greedy, so+-- is the box).+--+-- Allocates space to 'Fixed' elements first and 'Greedy' elements+-- second. For example, if a 'vBox' contains three elements @A@, @B@,+-- and @C@, and if @A@ and @B@ are 'Fixed', then 'vBox' first renders+-- @A@ and @B@. Suppose those two take up 10 rows total, and the 'vBox'+-- was given 50 rows. This means 'vBox' then allocates the remaining+-- 40 rows to @C@. If, on the other hand, @A@ and @B@ take up 50 rows+-- together, @C@ will not be rendered at all.+--+-- If all elements are 'Greedy', 'vBox' allocates the available height+-- evenly among the elements. So, for example, if a 'vBox' is rendered+-- in 90 rows and has three 'Greedy' elements, each element will be+-- allocated 30 rows.+{-# NOINLINE vBox #-}+vBox :: [Widget n] -> Widget n+vBox [] = emptyWidget+vBox [a] = a+vBox pairs = renderBox vBoxRenderer pairs++-- | Horizontal box layout: put the specified widgets next to each other+-- in the specified order (leftmost first). Defers growth policies to+-- the growth policies of the contained widgets (if any are greedy, so+-- is the box).+--+-- Allocates space to 'Fixed' elements first and 'Greedy' elements+-- second. For example, if an 'hBox' contains three elements @A@, @B@,+-- and @C@, and if @A@ and @B@ are 'Fixed', then 'hBox' first renders+-- @A@ and @B@. Suppose those two take up 10 columns total, and the+-- 'hBox' was given 50 columns. This means 'hBox' then allocates the+-- remaining 40 columns to @C@. If, on the other hand, @A@ and @B@ take+-- up 50 columns together, @C@ will not be rendered at all.+--+-- If all elements are 'Greedy', 'hBox' allocates the available width+-- evenly among the elements. So, for example, if an 'hBox' is rendered+-- in 90 columns and has three 'Greedy' elements, each element will be+-- allocated 30 columns.+{-# NOINLINE hBox #-}+hBox :: [Widget n] -> Widget n+hBox [] = emptyWidget+hBox [a] = a+hBox pairs = renderBox hBoxRenderer pairs++-- | The process of rendering widgets in a box layout is exactly the+-- same except for the dimension under consideration (width vs. height),+-- in which case all of the same operations that consider one dimension+-- in the layout algorithm need to be switched to consider the other.+-- Because of this we fill a BoxRenderer with all of the functions+-- needed to consider the "primary" dimension (e.g. vertical if the+-- box layout is vertical) as well as the "secondary" dimension (e.g.+-- horizontal if the box layout is vertical). Doing this permits us to+-- have one implementation for box layout and parameterizing on the+-- orientation of all of the operations.+data BoxRenderer n =+    BoxRenderer { contextPrimary :: Lens' (Context n) Int+                , contextSecondary :: Lens' (Context n) Int+                , imagePrimary :: V.Image -> Int+                , imageSecondary :: V.Image -> Int+                , limitPrimary :: Int -> Widget n -> Widget n+                , primaryWidgetSize :: Widget n -> Size+                , concatenatePrimary :: [V.Image] -> V.Image+                , concatenateSecondary :: [V.Image] -> V.Image+                , locationFromOffset :: Int -> Location+                , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image+                , loPrimary :: forall a. Lens' (Edges a) a -- lo: towards smaller coordinates in that dimension+                , hiPrimary :: forall a. Lens' (Edges a) a -- hi: towards larger  coordinates in that dimension+                , loSecondary :: forall a. Lens' (Edges a) a+                , hiSecondary :: forall a. Lens' (Edges a) a+                , locationFromPrimarySecondary :: Int -> Int -> Location+                , splitLoPrimary :: Int -> V.Image -> V.Image+                , splitHiPrimary :: Int -> V.Image -> V.Image+                , splitLoSecondary :: Int -> V.Image -> V.Image+                , splitHiSecondary :: Int -> V.Image -> V.Image+                , lookupPrimary :: Int -> BM.BorderMap DynBorder -> I.IMap DynBorder+                , insertSecondary :: Location -> I.Run DynBorder -> BM.BorderMap DynBorder -> BM.BorderMap DynBorder+                }++vBoxRenderer :: BoxRenderer n+vBoxRenderer =+    BoxRenderer { contextPrimary = availHeightL+                , contextSecondary = availWidthL+                , imagePrimary = V.imageHeight+                , imageSecondary = V.imageWidth+                , limitPrimary = vLimit+                , primaryWidgetSize = vSize+                , concatenatePrimary = V.vertCat+                , concatenateSecondary = V.horizCat+                , locationFromOffset = Location . (0 ,)+                , padImageSecondary = \amt img a ->+                    let p = V.charFill a ' ' amt (V.imageHeight img)+                    in V.horizCat [img, p]+                , loPrimary = eTopL+                , hiPrimary = eBottomL+                , loSecondary = eLeftL+                , hiSecondary = eRightL+                , locationFromPrimarySecondary = \r c -> Location (c, r)+                , splitLoPrimary = V.cropBottom+                , splitHiPrimary = \n img -> V.cropTop (V.imageHeight img-n) img+                , splitLoSecondary = V.cropRight+                , splitHiSecondary = \n img -> V.cropLeft (V.imageWidth img-n) img+                , lookupPrimary = BM.lookupRow+                , insertSecondary = BM.insertH+                }++hBoxRenderer :: BoxRenderer n+hBoxRenderer =+    BoxRenderer { contextPrimary = availWidthL+                , contextSecondary = availHeightL+                , imagePrimary = V.imageWidth+                , imageSecondary = V.imageHeight+                , limitPrimary = hLimit+                , primaryWidgetSize = hSize+                , concatenatePrimary = V.horizCat+                , concatenateSecondary = V.vertCat+                , locationFromOffset = Location . (, 0)+                , padImageSecondary = \amt img a ->+                    let p = V.charFill a ' ' (V.imageWidth img) amt+                    in V.vertCat [img, p]+                , loPrimary = eLeftL+                , hiPrimary = eRightL+                , loSecondary = eTopL+                , hiSecondary = eBottomL+                , locationFromPrimarySecondary = \c r -> Location (c, r)+                , splitLoPrimary = V.cropRight+                , splitHiPrimary = \n img -> V.cropLeft (V.imageWidth img-n) img+                , splitLoSecondary = V.cropBottom+                , splitHiSecondary = \n img -> V.cropTop (V.imageHeight img-n) img+                , lookupPrimary = BM.lookupCol+                , insertSecondary = BM.insertV+                }++-- | Render a series of widgets in a box layout in the order given.+--+-- The growth policy of a box layout is the most unrestricted of the+-- growth policies of the widgets it contains, so to determine the hSize+-- and vSize of the box we just take the maximum (using the Ord instance+-- for Size) of all of the widgets to be rendered in the box.+--+-- Then the box layout algorithm proceeds as follows. We'll use+-- the vertical case to concretely describe the algorithm, but the+-- horizontal case can be envisioned just by exchanging all+-- "vertical"/"horizontal" and "rows"/"columns", etc., in the+-- description.+--+-- The growth policies of the child widgets determine the order in which+-- they are rendered, i.e., the order in which space in the box is+-- allocated to widgets as the algorithm proceeds. This is because order+-- matters: if we render greedy widgets first, there will be no space+-- left for non-greedy ones.+--+-- So we render all widgets with size 'Fixed' in the vertical dimension+-- first. Each is rendered with as much room as the overall box has, but+-- we assume that they will not be greedy and use it all. If they do,+-- maybe it's because the terminal is small and there just isn't enough+-- room to render everything.+--+-- Then the remaining height is distributed evenly amongst all remaining+-- (greedy) widgets and they are rendered in sub-boxes that are as high+-- as this even slice of rows and as wide as the box is permitted to be.+-- We only do this step at all if rendering the non-greedy widgets left+-- us any space, i.e., if there were any rows left.+--+-- After rendering the non-greedy and then greedy widgets, their images+-- are sorted so that they are stored in the order the original widgets+-- were given. All cursor locations and visibility requests in each+-- sub-widget are translated according to the position of the sub-widget+-- in the box.+--+-- All images are padded to be as wide as the widest sub-widget to+-- prevent attribute over-runs. Without this step the attribute used by+-- a sub-widget may continue on in an undesirable fashion until it hits+-- something with a different attribute. To prevent this and to behave+-- in the least surprising way, we pad the image on the right with+-- whitespace using the context's current attribute.+--+-- Finally, the padded images are concatenated together vertically and+-- returned along with the translated cursor positions and visibility+-- requests.+renderBox :: BoxRenderer n -> [Widget n] -> Widget n+renderBox br ws =+    Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do+      c <- getContext++      let pairsIndexed = zip [(0::Int)..] ws+          (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed)+                        pairsIndexed++          renderHi prim = do+            remainingPrimary <- get+            result <- lift $ render $ limitPrimary br remainingPrimary prim+            result <$ (put $! remainingPrimary - (result^.imageL.(to $ imagePrimary br)))++      (renderedHis, remainingPrimary) <-+        runStateT (traverse (traverse renderHi) his) (c ^. contextPrimary br)++      renderedLows <- case lows of+          [] -> return []+          ls -> do+              let primaryPerLow = remainingPrimary `div` length ls+                  rest = remainingPrimary - (primaryPerLow * length ls)+                  primaries = replicate rest (primaryPerLow + 1) <>+                              replicate (length ls - rest) primaryPerLow++              let renderLow ((i, prim), pri) = (i,) <$> render (limitPrimary br pri prim)++              if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return []++      let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows+          allResults = snd <$> rendered+          allImages = (^.imageL) <$> allResults+          allTranslatedResults = flip evalState 0 $ for allResults $ \result -> do+              offPrimary <- get+              put $ offPrimary + (result ^. imageL . to (imagePrimary br))+              pure $ addResultOffset (locationFromOffset br offPrimary) result+          -- Determine the secondary dimension value to pad to. In a+          -- vertical box we want all images to be the same width to+          -- avoid attribute over-runs or blank spaces with the wrong+          -- attribute. In a horizontal box we want all images to have+          -- the same height for the same reason.+          maxSecondary = maximum $ imageSecondary br <$> allImages+          padImage img = padImageSecondary br (maxSecondary - imageSecondary br img)+                         img (c^.attrL)+          (imageRewrites, newBorders) = catAllBorders br (borders <$> allTranslatedResults)+          rewrittenImages = zipWith (rewriteImage br) imageRewrites allImages+          paddedImages = padImage <$> rewrittenImages++      cropResultToContext $ Result (concatenatePrimary br paddedImages)+                            (concatMap cursors allTranslatedResults)+                            (concatMap visibilityRequests allTranslatedResults)+                            (concatMap extents allTranslatedResults)+                            newBorders++catDynBorder :: Lens' (Edges BorderSegment) BorderSegment+             -> Lens' (Edges BorderSegment) BorderSegment+             -> DynBorder+             -> DynBorder+             -> Maybe DynBorder+catDynBorder towardsA towardsB a b+    -- Currently, we check if the 'BorderStyle's are exactly the same. In the+    -- future, it might be nice to relax this restriction. For example, if a+    -- horizontal border is being rewritten to accommodate a neighboring+    -- vertical border, all we care about is that the two 'bsVertical's line up+    -- sanely. After all, if the horizontal border's 'bsVertical' is the same+    -- as the vertical one's, and the horizontal border's 'BorderStyle' is+    -- self-consistent, then it will look "right" to rewrite according to the+    -- horizontal border's 'BorderStyle'.+    |  dbStyle a == dbStyle b+    && dbAttr  a == dbAttr  b+    && a ^. dbSegmentsL.towardsB.bsAcceptL+    && b ^. dbSegmentsL.towardsA.bsOfferL+    && not (a ^. dbSegmentsL.towardsB.bsDrawL) -- don't bother doing an update if we don't need to+    = Just (a & dbSegmentsL.towardsB.bsDrawL .~ True)+    | otherwise = Nothing++catDynBorders :: Lens' (Edges BorderSegment) BorderSegment+              -> Lens' (Edges BorderSegment) BorderSegment+              -> I.IMap DynBorder+              -> I.IMap DynBorder+              -> I.IMap DynBorder+catDynBorders towardsA towardsB am bm = I.mapMaybe id+    $ I.intersectionWith (catDynBorder towardsA towardsB) am bm++-- | Given borders that should be placed next to each other (the first argument+-- on the right or bottom, and the second argument on the left or top), compute+-- new borders and the rewrites that should be done along the edges of the two+-- images to keep the image in sync with the border information.+--+-- The input borders are assumed to be disjoint. This property is not checked.+catBorders :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)+           => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)+catBorders br r l = if lCoord + 1 == rCoord+    then ((lRe, rRe), lr')+    else ((I.empty, I.empty), lr)+    where+    lr     = BM.expand (BM.coordinates r) l `BM.unsafeUnion`+             BM.expand (BM.coordinates l) r+    lr'    = id+           . mergeIMap lCoord lIMap'+           . mergeIMap rCoord rIMap'+           $ lr+    lCoord = BM.coordinates l ^. hiPrimary br+    rCoord = BM.coordinates r ^. loPrimary br+    lIMap  = lookupPrimary br lCoord l+    rIMap  = lookupPrimary br rCoord r+    lIMap' = catDynBorders (loPrimary br) (hiPrimary br) lIMap rIMap+    rIMap' = catDynBorders (hiPrimary br) (loPrimary br) rIMap lIMap+    lRe    = renderDynBorder <$> lIMap'+    rRe    = renderDynBorder <$> rIMap'+    mergeIMap p imap bm = F.foldl'+        (\bm' (s,v) -> insertSecondary br (locationFromPrimarySecondary br p s) v bm')+        bm+        (I.unsafeToAscList imap)++-- | Given a direction to concatenate borders in, and the border information+-- itself (which list is assumed to be already shifted so that borders do not+-- overlap and are strictly increasing in the primary direction), produce: a+-- list of rewrites for the lo and hi directions of each border, respectively,+-- and the borders describing the fully concatenated object.+catAllBorders :: BoxRenderer n+              -> [BM.BorderMap DynBorder]+              -> ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder)+catAllBorders _ [] = ([], BM.empty)+catAllBorders br (bm:bms) = (zip ([I.empty]++los) (his++[I.empty]), bm') where+    (rewrites, bm') = runState (traverse (state . catBorders br) bms) bm+    (his, los) = unzip rewrites++rewriteEdge :: (Int -> V.Image -> V.Image)+            -> (Int -> V.Image -> V.Image)+            -> ([V.Image] -> V.Image)+            -> I.IMap V.Image+            -> V.Image+            -> V.Image+rewriteEdge splitLo splitHi combine = (combine .) . go . offsets 0 . I.unsafeToAscList where++    -- convert absolute positions into relative ones+    offsets _ [] = []+    offsets n ((n', r):nrs) = (n'-n, r) : offsets (n'+I.len r) nrs++    go [] old = [old]+    -- TODO: might be nice to construct this image with fill rather than+    -- replicate+char+    go ((lo, I.Run len new):nrs) old+        =  [splitLo lo old]+        ++ replicate len new+        ++ go nrs (splitHi (lo+len) old)++rewriteImage :: BoxRenderer n -> (I.IMap V.Image, I.IMap V.Image) -> V.Image -> V.Image+rewriteImage br (loRewrite, hiRewrite) old = rewriteHi . rewriteLo $ old where+    size = imagePrimary br old+    go = rewriteEdge (splitLoSecondary br) (splitHiSecondary br) (concatenateSecondary br)+    rewriteLo img+        | I.null loRewrite || size == 0 = img+        | otherwise = concatenatePrimary br+            [ go loRewrite (splitLoPrimary br 1 img)+            , splitHiPrimary br 1 img+            ]+    rewriteHi img+        | I.null hiRewrite || size == 0 = img+        | otherwise = concatenatePrimary br+            [ splitLoPrimary br (size-1) img+            , go hiRewrite (splitHiPrimary br (size-1) img)+            ]++-- | Limit the space available to the specified widget to the specified+-- number of columns. This is important for constraining the horizontal+-- growth of otherwise-greedy widgets. This is non-greedy horizontally+-- and defers to the limited widget vertically.+hLimit :: Int -> Widget n -> Widget n+hLimit w p+    | w <= 0 = emptyWidget+    | otherwise =+        Widget Fixed (vSize p) $+          withReaderT (availWidthL %~ (min w)) $ render $ cropToContext p++-- | Limit the space available to the specified widget to the specified+-- percentage of available width, as a value between 0 and 100+-- inclusive. Values outside the valid range will be clamped to the+-- range endpoints. This is important for constraining the horizontal+-- growth of otherwise-greedy widgets. This is non-greedy horizontally+-- and defers to the limited widget vertically.+hLimitPercent :: Int -> Widget n -> Widget n+hLimitPercent w' p+    | w' <= 0 = emptyWidget+    | otherwise =+        Widget Fixed (vSize p) $ do+          let w = clamp 0 100 w'+          ctx <- getContext+          let usableWidth = ctx^.availWidthL+              widgetWidth = round (toRational usableWidth * (toRational w / 100))+          withReaderT (availWidthL %~ (min widgetWidth)) $ render $ cropToContext p++-- | Limit the space available to the specified widget to the specified+-- number of rows. This is important for constraining the vertical+-- growth of otherwise-greedy widgets. This is non-greedy vertically and+-- defers to the limited widget horizontally.+vLimit :: Int -> Widget n -> Widget n+vLimit h p+    | h <= 0 = emptyWidget+    | otherwise =+        Widget (hSize p) Fixed $+          withReaderT (availHeightL %~ (min h)) $ render $ cropToContext p++-- | Limit the space available to the specified widget to the specified+-- percentage of available height, as a value between 0 and 100+-- inclusive. Values outside the valid range will be clamped to the+-- range endpoints. This is important for constraining the vertical+-- growth of otherwise-greedy widgets. This is non-greedy vertically and+-- defers to the limited widget horizontally.+vLimitPercent :: Int -> Widget n -> Widget n+vLimitPercent h' p+    | h' <= 0 = emptyWidget+    | otherwise =+        Widget (hSize p) Fixed $ do+          let h = clamp 0 100 h'+          ctx <- getContext+          let usableHeight = ctx^.availHeightL+              widgetHeight = round (toRational usableHeight * (toRational h / 100))+          withReaderT (availHeightL %~ (min widgetHeight)) $ render $ cropToContext p++-- | Set the rendering context height and width for this widget. This+-- is useful for relaxing the rendering size constraints on e.g. layer+-- widgets where cropping to the screen size is undesirable.+setAvailableSize :: (Int, Int) -> Widget n -> Widget n+setAvailableSize (w, h) p+    | w <= 0 || h <= 0 = emptyWidget+    | otherwise =+        Widget Fixed Fixed $+          withReaderT (\c -> c & availHeightL .~ h & availWidthL .~ w) $+            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+-- 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:+--+-- @+--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)+--                                           , ("warning", bg magenta)+--                                           ]+--+--    renderA :: (String, String) -> [Widget n]+--    renderA (a,b) = hBox [ str a+--                         , str " is "+--                         , withAttr "highlight" (str b)+--                         ]+--+--    render1 = renderA (\"Brick\", "fun")+--    render2 = withAttr "warning" render1+-- @+--+-- In the example above, @render1@ will show @Brick is fun@ where the+-- first two words are white on a blue background and the last word+-- is yellow on a blue background. However, @render2@ will show the+-- first two words in white on magenta although the last word is still+-- rendered in yellow on blue.+withAttr :: AttrName -> Widget n -> Widget n+withAttr an p =+    Widget (hSize p) (vSize p) $+      withReaderT (ctxAttrNameL .~ an) (render p)++-- | Update the attribute map while rendering the specified widget: set+-- the map's default attribute to the one that we get by applying the+-- specified function to the current map's default attribute. This is a+-- variant of 'withDefAttr'; see the latter for more information.+modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n+modifyDefAttr f p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        withReaderT (ctxAttrMapL %~ (setDefaultAttr (f $ getDefaultAttr (c^.ctxAttrMapL)))) (render p)++-- | Update the attribute map used while rendering the specified+-- widget (and any sub-widgets): set its new *default* attribute+-- (i.e. the attribute components that will be applied if not+-- overridden by any more specific attributes) to the one that we get+-- by looking up the specified attribute name in the map.+--+-- For example:+--+-- @+--    ...+--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)+--                                           , ("warning", bg magenta)+--                                           , ("good", white `on` green) ]+--    ...+--+--    renderA :: (String, String) -> [Widget n]+--    renderA (a,b) = hBox [ withAttr "good" (str a)+--                         , str " is "+--                         , withAttr "highlight" (str b) ]+--+--    render1 = renderA (\"Brick\", "fun")+--    render2 = withDefAttr "warning" render1+-- @+--+-- In the above, render1 will show "Brick is fun" where the first word+-- is white on a green background, the middle word is white on a blue+-- background, and the last word is yellow on a blue background.+-- However, render2 will show the first word in the same colors but+-- the middle word will be shown in whatever the terminal's normal+-- foreground is on a magenta background, and the third word will be+-- yellow on a magenta background.+withDefAttr :: AttrName -> Widget n -> Widget n+withDefAttr an p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        withReaderT (ctxAttrMapL %~ (setDefaultAttr (attrMapLookup an (c^.ctxAttrMapL)))) (render p)++-- | While rendering the specified widget, use a transformed version+-- of the current attribute map. This is a very general function with+-- broad capabilities: you probably want a more specific function such+-- as 'withDefAttr' or 'withAttr'.+updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n+updateAttrMap f p =+    Widget (hSize p) (vSize p) $+        withReaderT (ctxAttrMapL %~ f) (render p)++-- | When rendering the specified widget, force all attribute lookups+-- in the attribute map to use the value currently assigned to the+-- specified attribute name. This means that the attribute lookups will+-- behave as if they all used the name specified here. That further+-- means that the resolved attribute will still inherit from its parent+-- entry in the attribute map as would normally be the case. If you+-- want to have more control over the resulting attribute, consider+-- 'modifyDefAttr'.+--+-- For example:+--+-- @+--    ...+--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)+--                                           , ("notice", fg red) ]+--    ...+--+--    renderA :: (String, String) -> [Widget n]+--    renderA (a,b) = hBox [ withAttr "highlight" (str a)+--                         , str " is "+--                         , withAttr "highlight" (str b)+--                         ]+--+--    render1 = renderA ("Brick", "fun")+--    render2 = forceAttr "notice" render1+-- @+--+-- In the above, render1 will show "Brick is fun" where the first and+-- last words are yellow on a blue background and the middle word is+-- white on a blue background.  However, render2 will show all words+-- in red on a blue background.  In both versions, the middle word+-- will be in white on a blue background.+forceAttr :: AttrName -> Widget n -> Widget n+forceAttr an p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        withReaderT (ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)++-- | Like 'forceAttr', except that the style of attribute lookups in the+-- attribute map is preserved and merged with the forced attribute. This+-- allows for situations where 'forceAttr' would otherwise ignore style+-- information that is important to preserve.+forceAttrAllowStyle :: AttrName -> Widget n -> Widget n+forceAttrAllowStyle an p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        let m = c^.ctxAttrMapL+        withReaderT (ctxAttrMapL .~ (forceAttrMapAllowStyle (attrMapLookup an m) m)) (render p)++-- | Override the lookup of the attribute name 'targetName' to return+-- the attribute value associated with 'fromName' when rendering the+-- specified widget.+--+-- For example:+--+-- @+--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)+--                                           , ("notice", fg red)+--                                           ]+--+--    renderA :: (String, String) -> [Widget n]+--    renderA (a, b) = str a <+> str " is " <+> withAttr "highlight" (str b)+--+--    render1 = withAttr "notice" $ renderA ("Brick", "fun")+--    render2 = overrideAttr "highlight" "notice" render1+-- @+--+-- In the example above, @render1@ will show @Brick is fun@ where the+-- first two words are red on a blue background, but @fun@ is yellow on+-- a blue background. However, @render2@ will show all three words in+-- red on a blue background.+overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n+overrideAttr targetName fromName =+    updateAttrMap (mapAttrName fromName targetName)++-- | Build a widget directly from a raw Vty image.+raw :: V.Image -> Widget n+raw img = Widget Fixed Fixed $ return $ emptyResult & imageL .~ img++-- | Translate the specified widget by the specified offset amount.+-- Defers to the translated widget for growth policy.+translateBy :: Location -> Widget n -> Widget n+translateBy off p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      return $ addResultOffset off+             $ result & imageL %~ (V.translate (off^.locationColumnL) (off^.locationRowL))++-- | Given a widget, translate it to position it relative to the+-- upper-left coordinates of a reported extent with the specified+-- positioning offset. If the specified name has no reported extent,+-- this draws nothing on the basis that it only makes sense to draw what+-- was requested when the relative position can be known.+--+-- This is only useful for positioning something in a higher layer+-- relative to a reported extent in a lower layer. Any other use is+-- likely to result in the specified widget not being rendered. This+-- is because this function relies on information about lower layer+-- renderings in order to work; using it with a resource name that+-- wasn't rendered in a lower layer will result in this being equivalent+-- to @emptyWidget@.+--+-- For example, if you have two layers @topLayer@ and @bottomLayer@,+-- then a widget drawn in @bottomLayer@ with @reportExtent Foo@ can be+-- used to relatively position a widget in @topLayer@ with @topLayer =+-- relativeTo Foo ...@.+relativeTo :: (Ord n) => n -> Location -> Widget n -> Widget n+relativeTo n off w =+    Widget (hSize w) (vSize w) $ do+        mExt <- lookupReportedExtent n+        case mExt of+            Nothing -> render emptyWidget+            Just ext -> render $ translateBy (extentUpperLeft ext <> off) w++-- | Crop the specified widget on the left by the specified number of+-- columns. Defers to the cropped widget for growth policy.+cropLeftBy :: Int -> Widget n -> Widget n+cropLeftBy cols p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageWidth (result^.imageL) - cols+          cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img+      render $ Widget (hSize p) (vSize p) $+               withReaderT (availWidthL .~ amt) $+                   cropResultToContext $+                       addResultOffset (Location (-1 * cols, 0)) $+                           result & imageL %~ cropped++-- | Crop the specified widget to the specified size from the left.+-- Defers to the cropped widget for growth policy.+cropLeftTo :: Int -> Widget n -> Widget n+cropLeftTo cols p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let w = V.imageWidth $ result^.imageL+            amt = w - cols+        if w <= cols+           then return result+           else render $ cropLeftBy amt $ Widget Fixed Fixed $ return result++-- | Crop the specified widget on the right by the specified number of+-- columns. Defers to the cropped widget for growth policy.+cropRightBy :: Int -> Widget n -> Widget n+cropRightBy cols p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageWidth (result^.imageL) - cols+          cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img+      withReaderT (availWidthL .~ amt) $+          cropResultToContext $ result & imageL %~ cropped++-- | Crop the specified widget to the specified size from the right.+-- Defers to the cropped widget for growth policy.+cropRightTo :: Int -> Widget n -> Widget n+cropRightTo cols p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let w = V.imageWidth $ result^.imageL+            amt = w - cols+        if w <= cols+           then return result+           else render $ cropRightBy amt $ Widget Fixed Fixed $ return result++-- | Crop the specified widget on the top by the specified number of+-- rows. Defers to the cropped widget for growth policy.+cropTopBy :: Int -> Widget n -> Widget n+cropTopBy rows p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageHeight (result^.imageL) - rows+          cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img+      render $ Widget (hSize p) (vSize p) $+               withReaderT (availHeightL .~ amt) $+                   cropResultToContext $+                       addResultOffset (Location (0, -1 * rows)) $+                           result & imageL %~ cropped++-- | Crop the specified widget to the specified size from the top.+-- Defers to the cropped widget for growth policy.+cropTopTo :: Int -> Widget n -> Widget n+cropTopTo rows p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let h = V.imageHeight $ result^.imageL+            amt = h - rows+        if h <= rows+           then return result+           else render $ cropTopBy amt $ Widget Fixed Fixed $ return result++-- | Crop the specified widget on the bottom by the specified number of+-- rows. Defers to the cropped widget for growth policy.+cropBottomBy :: Int -> Widget n -> Widget n+cropBottomBy rows p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageHeight (result^.imageL) - rows+          cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img+      withReaderT (availHeightL .~ amt) $+          cropResultToContext $ result & imageL %~ cropped++-- | Crop the specified widget to the specified size from the bottom.+-- Defers to the cropped widget for growth policy.+cropBottomTo :: Int -> Widget n -> Widget n+cropBottomTo rows p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let h = V.imageHeight $ result^.imageL+            amt = h - rows+        if h <= rows+           then return result+           else render $ cropBottomBy amt $ Widget Fixed Fixed $ return result++-- | When rendering the specified widget, also register a cursor+-- positioning request using the specified name and location.+showCursor :: n -> Location -> Widget n -> Widget n+showCursor n cloc p = Widget (hSize p) (vSize p) $+    (cursorsL %~ (CursorLocation cloc (Just n) True:)) <$> (render p)++-- | When rendering the specified widget, also register a cursor+-- positioning request using the specified name and location.+-- The cursor will only be positioned but not made visible.+putCursor :: n -> Location -> Widget n -> Widget n+putCursor n cloc p = Widget (hSize p) (vSize p) $+    (cursorsL %~ (CursorLocation cloc (Just n) False:)) <$> (render p)++hRelease :: Widget n -> Maybe (Widget n)+hRelease p =+    case hSize p of+        Fixed -> Just $ Widget Greedy (vSize p) $+                        withReaderT (availWidthL .~ unrestricted) (render p)+        Greedy -> Nothing++vRelease :: Widget n -> Maybe (Widget n)+vRelease p =+    case vSize p of+        Fixed -> Just $ Widget (hSize p) Greedy $+                        withReaderT (availHeightL .~ unrestricted) (render p)+        Greedy -> Nothing++-- | If the specified resource name has an entry in the rendering cache,+-- use the rendered version from the cache. If not, render the specified+-- widget and update the cache with the result.+--+-- To ensure that mouse events are emitted correctly for cached widgets,+-- in addition to the rendered widget, we also cache (the names of) any+-- clickable extents that were rendered and restore that when utilizing+-- the cache.+--+-- See also 'invalidateCacheEntry'.+cached :: (Ord n) => n -> Widget n -> Widget n+cached n w =+    Widget (hSize w) (vSize w) $ do+        result <- cacheLookup n+        case result of+            Just (clickables, prevResult) -> do+                clickableNamesL %= (clickables ++)+                return prevResult+            Nothing  -> do+                wResult <- render w+                clickables <- renderedClickables wResult+                cacheUpdate n (clickables, wResult & visibilityRequestsL .~ mempty)+                return wResult+    where+        -- Given the rendered result of a Widget, collect the list of "clickable" names+        -- from the extents that were in the result.+        renderedClickables :: (Ord n) => Result n -> RenderM n [n]+        renderedClickables renderResult = do+            allClickables <- use clickableNamesL+            return [extentName e | e <- renderResult^.extentsL, extentName e `elem` allClickables]++cacheLookup :: (Ord n) => n -> RenderM n (Maybe ([n], Result n))+cacheLookup n = do+    cache <- lift $ gets (^.renderCacheL)+    return $ M.lookup n cache++cacheUpdate :: Ord n => n -> ([n], Result n) -> RenderM n ()+cacheUpdate n r = lift $ modify (renderCacheL %~ M.insert n r)++-- | Enable vertical scroll bars on all viewports in the specified+-- widget and draw them with the specified orientation.+withVScrollBars :: VScrollBarOrientation -> Widget n -> Widget n+withVScrollBars orientation w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxVScrollBarOrientationL .~ Just orientation) (render w)++-- | Enable scroll bar handles on all vertical scroll bars in the+-- specified widget. Handles appear at the ends of the scroll bar,+-- representing the "handles" that are typically clickable in+-- graphical UIs to move the scroll bar incrementally. Vertical+-- scroll bars are also clickable if mouse mode is enabled and if+-- 'withClickableVScrollBars' is used.+--+-- This will only have an effect if 'withVScrollBars' is also called.+withVScrollBarHandles :: Widget n -> Widget n+withVScrollBarHandles w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxVScrollBarShowHandlesL .~ True) (render w)++-- | Render vertical viewport scroll bars in the specified widget with+-- the specified renderer. This is only needed if you want to override+-- the use of the default renderer, 'verticalScrollbarRenderer'.+withVScrollBarRenderer :: VScrollbarRenderer n -> Widget n -> Widget n+withVScrollBarRenderer r w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxVScrollBarRendererL .~ Just r) (render w)++-- | The default renderer for vertical viewport scroll bars. Override+-- with 'withVScrollBarRenderer'.+verticalScrollbarRenderer :: VScrollbarRenderer n+verticalScrollbarRenderer =+    VScrollbarRenderer { renderVScrollbar = fill '█'+                       , renderVScrollbarTrough = fill ' '+                       , renderVScrollbarHandleBefore = str "^"+                       , renderVScrollbarHandleAfter = str "v"+                       , scrollbarWidthAllocation = 1+                       }++-- | Enable horizontal scroll bars on all viewports in the specified+-- widget and draw them with the specified orientation.+withHScrollBars :: HScrollBarOrientation -> Widget n -> Widget n+withHScrollBars orientation w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxHScrollBarOrientationL .~ Just orientation) (render w)++-- | Enable mouse click reporting on horizontal scroll bars in the+-- specified widget. This must be used with 'withHScrollBars'. The+-- provided function is used to build a resource name containing the+-- scroll bar element clicked and the viewport name associated with the+-- scroll bar. It is usually a data constructor of the @n@ type.+withClickableHScrollBars :: (ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n+withClickableHScrollBars f w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxHScrollBarClickableConstrL .~ Just f) (render w)++-- | Enable mouse click reporting on vertical scroll bars in the+-- specified widget. This must be used with 'withVScrollBars'. The+-- provided function is used to build a resource name containing the+-- scroll bar element clicked and the viewport name associated with the+-- scroll bar. It is usually a data constructor of the @n@ type.+withClickableVScrollBars :: (ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n+withClickableVScrollBars f w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxVScrollBarClickableConstrL .~ Just f) (render w)++-- | Enable scroll bar handles on all horizontal scroll bars in+-- the specified widget. Handles appear at the ends of the scroll+-- bar, representing the "handles" that are typically clickable in+-- graphical UIs to move the scroll bar incrementally. Horizontal+-- scroll bars are also clickable if mouse mode is enabled and if+-- 'withClickableHScrollBars' is used.+--+-- This will only have an effect if 'withHScrollBars' is also called.+withHScrollBarHandles :: Widget n -> Widget n+withHScrollBarHandles w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxHScrollBarShowHandlesL .~ True) (render w)++-- | Render horizontal viewport scroll bars in the specified widget with+-- the specified renderer. This is only needed if you want to override+-- the use of the default renderer, 'horizontalScrollbarRenderer'.+withHScrollBarRenderer :: HScrollbarRenderer n -> Widget n -> Widget n+withHScrollBarRenderer r w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxHScrollBarRendererL .~ Just r) (render w)++-- | The default renderer for horizontal viewport scroll bars. Override+-- with 'withHScrollBarRenderer'.+horizontalScrollbarRenderer :: HScrollbarRenderer n+horizontalScrollbarRenderer =+    HScrollbarRenderer { renderHScrollbar = fill '█'+                       , renderHScrollbarTrough = fill ' '+                       , renderHScrollbarHandleBefore = str "<"+                       , renderHScrollbarHandleAfter = str ">"+                       , scrollbarHeightAllocation = 1+                       }++-- | Render the specified widget in a named viewport with the+-- specified type. This permits widgets to be scrolled without being+-- scrolling-aware. To make the most use of viewports, the specified+-- widget should use the 'visible' combinator to make a "visibility+-- request". This viewport combinator will then translate the resulting+-- rendering to make the requested region visible. In addition, the+-- 'Brick.Main.EventM' monad provides primitives to scroll viewports+-- created by this function if 'visible' is not what you want.+--+-- This function can automatically render vertical and horizontal scroll+-- bars if desired. To enable scroll bars, wrap your call to 'viewport'+-- with a call to 'withVScrollBars' and/or 'withHScrollBars'. If you+-- don't like the appearance of the resulting scroll bars (defaults:+-- 'verticalScrollbarRenderer' and 'horizontalScrollbarRenderer'),+-- you can customize how they are drawn by making your own+-- 'VScrollbarRenderer' or 'HScrollbarRenderer' and using+-- 'withVScrollBarRenderer' and/or 'withHScrollBarRenderer'. Note that+-- when you enable scrollbars, the content of your viewport will lose+-- one column of available space if vertical scroll bars are enabled and+-- one row of available space if horizontal scroll bars are enabled.+--+-- If a viewport receives more than one visibility request, then the+-- visibility requests are merged with the inner visibility request+-- taking preference. If a viewport receives more than one scrolling+-- request from 'Brick.Main.EventM', all are honored in the order in+-- which they are received.+--+-- Some caution should be advised when using this function. The viewport+-- renders its contents anew each time the viewport is drawn; in many+-- cases this is prohibitively expensive, and viewports should not be+-- used to display large contents for scrolling. This function is best+-- used when the contents are not too large OR when the contents are+-- large and render-cacheable.+--+-- Also, be aware that there is a rich API for accessing viewport+-- information from within the 'EventM' monad; check the docs for+-- @Brick.Main@ to learn more about ways to get information about+-- viewports after they're drawn.+viewport :: (Ord n, Show n)+         => n+         -- ^ The name of the viewport (must be unique and stable for+         -- reliable behavior)+         -> ViewportType+         -- ^ The type of viewport (indicates the permitted scrolling+         -- direction)+         -> Widget n+         -- ^ The widget to be rendered in the scrollable viewport+         -> Widget n+viewport vpname typ p =+    clickable vpname $ Widget Greedy Greedy $ do+      -- Obtain the scroll bar configuration.+      c <- getContext+      let vsOrientation = ctxVScrollBarOrientation c+          hsOrientation = ctxHScrollBarOrientation c+          vsRenderer = fromMaybe verticalScrollbarRenderer (ctxVScrollBarRenderer c)+          hsRenderer = fromMaybe horizontalScrollbarRenderer (ctxHScrollBarRenderer c)+          showVHandles = ctxVScrollBarShowHandles c+          showHHandles = ctxHScrollBarShowHandles c+          vsbClickableConstr = ctxVScrollBarClickableConstr c+          hsbClickableConstr = ctxHScrollBarClickableConstr c++      -- Observe the viewport name so we can detect multiple uses of the+      -- name.+      let observeName :: (Ord n, Show n) => n -> RenderM n ()+          observeName n = do+              observed <- use observedNamesL+              case S.member n observed of+                  False -> observedNamesL %= S.insert n+                  True ->+                      error $ "Error: while rendering the interface, the name " <> show n <>+                              " was seen more than once. You should ensure that all of the widgets " <>+                              "in each interface have unique name values. This means either " <>+                              "using a different name type or adding constructors to your " <>+                              "existing one and using those to name your widgets.  For more " <>+                              "information, see the \"Resource Names\" section of the Brick User Guide."++      observeName vpname++      -- Update the viewport size.+      let newVp = VP 0 0 newSize (0, 0)+          newSize = (newWidth, newHeight)+          newWidth = c^.availWidthL - vSBWidth+          newHeight = c^.availHeightL - hSBHeight+          vSBWidth = maybe 0 (const $ scrollbarWidthAllocation vsRenderer) vsOrientation+          hSBHeight = maybe 0 (const $ scrollbarHeightAllocation hsRenderer) hsOrientation+          doInsert (Just vp) = Just $ vp & vpSize .~ newSize+          doInsert Nothing = Just newVp++      lift $ modify (viewportMapL %~ (M.alter doInsert vpname))++      -- Then render the viewport content widget with the rendering+      -- layout constraint released (but raise an exception if we are+      -- asked to render an infinitely-sized widget in the viewport's+      -- scrolling dimension). Also note that for viewports that+      -- only scroll in one direction, we apply a constraint in the+      -- non-scrolling direction in case a scroll bar is present.+      let release = case typ of+            Vertical -> vRelease . hLimit newWidth+            Horizontal -> hRelease . vLimit newHeight+            Both -> vRelease >=> hRelease+          released = case release p of+            Just w -> w+            Nothing -> case typ of+                Vertical -> error $ "tried to embed an infinite-height " <>+                                    "widget in vertical viewport " <> (show vpname)+                Horizontal -> error $ "tried to embed an infinite-width " <>+                                      "widget in horizontal viewport " <> (show vpname)+                Both -> error $ "tried to embed an infinite-width or " <>+                                "infinite-height widget in 'Both' type " <>+                                "viewport " <> (show vpname)++      initialResult <- render released++      -- If the rendering state includes any scrolling requests for this+      -- viewport, apply those+      reqs <- lift $ gets (^.rsScrollRequestsL)+      let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs+      when (not $ null relevantRequests) $ do+          mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname))+          case mVp of+              Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+              Just vp -> do+                  let updatedVp = applyRequests relevantRequests vp+                      applyRequests [] v = v+                      applyRequests (rq:rqs) v =+                          case typ of+                              Horizontal -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v+                              Vertical -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v+                              Both -> scrollTo Horizontal rq (initialResult^.imageL) $+                                      scrollTo Vertical rq (initialResult^.imageL) $+                                      applyRequests rqs v+                  lift $ modify (viewportMapL %~ (M.insert vpname updatedVp))++      -- If the sub-rendering requested visibility, update the scroll+      -- state accordingly+      when (not $ null $ initialResult^.visibilityRequestsL) $ do+          mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname))+          case mVp of+              Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+              Just vp -> do+                  let rqs = initialResult^.visibilityRequestsL+                      updateVp vp' rq = case typ of+                          Both -> scrollToView Horizontal rq $ scrollToView Vertical rq vp'+                          Horizontal -> scrollToView typ rq vp'+                          Vertical -> scrollToView typ rq vp'+                  lift $ modify (viewportMapL %~ (M.insert vpname $ foldl updateVp vp rqs))++      -- If the size of the rendering changes enough to make the+      -- viewport offsets invalid, reset them+      mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname))+      vp <- case mVp of+          Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+          Just v -> return v++      let img = initialResult^.imageL+          fixTop v = if V.imageHeight img < v^.vpSize._2+                   then v & vpTop .~ 0+                   else v+          fixLeft v = if V.imageWidth img < v^.vpSize._1+                   then v & vpLeft .~ 0+                   else v+          updateContentSize v = v & vpContentSize .~ (V.imageWidth img, V.imageHeight img)+          updateVp = updateContentSize . case typ of+              Both -> fixLeft . fixTop+              Horizontal -> fixLeft+              Vertical -> fixTop+      lift $ modify (viewportMapL %~ (M.insert vpname (updateVp vp)))++      -- Get the viewport state now that it has been updated.+      mVpFinal <- lift $ gets (M.lookup vpname . (^.viewportMapL))+      vpFinal <- case mVpFinal of+          Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+          Just v -> return v++      -- Then perform a translation of the sub-rendering to fit into the+      -- viewport+      translated <- render $ translateBy (Location (-1 * vpFinal^.vpLeft, -1 * vpFinal^.vpTop))+                           $ Widget Fixed Fixed $ return initialResult++      -- If the vertical scroll bar is enabled, render the scroll bar+      -- area.+      let addVScrollbar = case vsOrientation of+              Nothing -> id+              Just orientation ->+                  let sb = verticalScrollbar vsRenderer orientation+                                                        vpname+                                                        vsbClickableConstr+                                                        showVHandles+                                                        (vpFinal^.vpSize._2)+                                                        (vpFinal^.vpTop)+                                                        (vpFinal^.vpContentSize._2)+                      combine = case orientation of+                          OnLeft -> (<+>)+                          OnRight -> flip (<+>)+                  in combine sb+          addHScrollbar = case hsOrientation of+              Nothing -> id+              Just orientation ->+                  let sb = horizontalScrollbar hsRenderer orientation+                                                          vpname+                                                          hsbClickableConstr+                                                          showHHandles+                                                          (vpFinal^.vpSize._1)+                                                          (vpFinal^.vpLeft)+                                                          (vpFinal^.vpContentSize._1)+                      combine = case orientation of+                          OnTop -> (<=>)+                          OnBottom -> flip (<=>)+                  in combine sb++      -- Return the translated result with the visibility requests+      -- discarded+      let translatedSize = ( translated^.imageL.to V.imageWidth+                           , translated^.imageL.to V.imageHeight+                           )+      case translatedSize of+          (0, 0) -> do+              let spaceFill = V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL)+              return $ translated & imageL .~ spaceFill+                                  & visibilityRequestsL .~ mempty+                                  & extentsL .~ mempty+          _ -> render $ addVScrollbar+                      $ addHScrollbar+                      $ vLimit (vpFinal^.vpSize._2)+                      $ hLimit (vpFinal^.vpSize._1)+                      $ padBottom Max+                      $ padRight Max+                      $ Widget Fixed Fixed+                      $ return $ translated & visibilityRequestsL .~ mempty++-- | The base attribute for scroll bars.+scrollbarAttr :: AttrName+scrollbarAttr = attrName "scrollbar"++-- | The attribute for scroll bar troughs. This attribute is a+-- specialization of @scrollbarAttr@.+scrollbarTroughAttr :: AttrName+scrollbarTroughAttr = scrollbarAttr <> attrName "trough"++-- | The attribute for scroll bar handles. This attribute is a+-- specialization of @scrollbarAttr@.+scrollbarHandleAttr :: AttrName+scrollbarHandleAttr = scrollbarAttr <> attrName "handle"++maybeClick :: (Ord n)+           => n+           -> Maybe (ClickableScrollbarElement -> n -> n)+           -> ClickableScrollbarElement+           -> Widget n+           -> Widget n+maybeClick _ Nothing _ w = w+maybeClick n (Just f) el w = clickable (f el n) w++-- | Build a vertical scroll bar using the specified renderer and+-- settings.+--+-- You probably don't want to use this directly; instead,+-- use @viewport@, @withVScrollBars@, and, if needed,+-- @withVScrollBarRenderer@. This is exposed so that if you want to+-- render a scroll bar of your own, you can do so outside the @viewport@+-- context.+verticalScrollbar :: (Ord n)+                  => VScrollbarRenderer n+                  -- ^ The renderer to use.+                  -> VScrollBarOrientation+                  -- ^ The scroll bar orientation. The orientation+                  -- governs how additional padding is added to+                  -- the scroll bar if it is smaller than it space+                  -- allocation according to 'scrollbarWidthAllocation'.+                  -> n+                  -- ^ The viewport name associated with this scroll+                  -- bar.+                  -> Maybe (ClickableScrollbarElement -> n -> n)+                  -- ^ Constructor for clickable scroll bar element names.+                  -> Bool+                  -- ^ Whether to display handles.+                  -> Int+                  -- ^ The total viewport height in effect.+                  -> Int+                  -- ^ The viewport vertical scrolling offset in effect.+                  -> Int+                  -- ^ The total viewport content height.+                  -> Widget n+verticalScrollbar vsRenderer o n constr showHandles vpHeight vOffset contentHeight =+    hLimit (scrollbarWidthAllocation vsRenderer) $+    applyPadding $+    if showHandles+       then vBox [ vLimit 1 $+                   maybeClick n constr SBHandleBefore $+                   withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleBefore vsRenderer+                 , sbBody+                 , vLimit 1 $+                   maybeClick n constr SBHandleAfter $+                   withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleAfter vsRenderer+                 ]+       else sbBody+    where+        sbBody = verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight+        applyPadding = case o of+            OnLeft -> padRight Max+            OnRight -> padLeft Max++verticalScrollbar' :: (Ord n)+                   => VScrollbarRenderer n+                   -- ^ The renderer to use.+                   -> n+                   -- ^ The viewport name associated with this scroll+                   -- bar.+                   -> Maybe (ClickableScrollbarElement -> n -> n)+                   -- ^ Constructor for clickable scroll bar element+                   -- names. Will be given the element name and the+                   -- viewport name.+                   -> Int+                   -- ^ The total viewport height in effect.+                   -> Int+                   -- ^ The viewport vertical scrolling offset in effect.+                   -> Int+                   -- ^ The total viewport content height.+                   -> Widget n+verticalScrollbar' vsRenderer _ _ vpHeight _ 0 =+    vLimit vpHeight $ renderVScrollbarTrough vsRenderer+verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight =+    Widget Fixed Greedy $ do+        c <- getContext++        -- Get the proportion of the total content that is visible+        let visibleContentPercent :: Double+            visibleContentPercent = fromIntegral vpHeight /+                                    fromIntegral contentHeight++            ctxHeight = c^.availHeightL++            -- Then get the proportion of the scroll bar that+            -- should be filled in+            sbSize = min ctxHeight $+                     max 1 $+                     round $ visibleContentPercent * (fromIntegral ctxHeight)++            -- Then get the vertical offset of the scroll bar+            -- itself+            sbOffset = if vOffset == 0+                       then 0+                       else if vOffset == contentHeight - vpHeight+                            then ctxHeight - sbSize+                            else min (ctxHeight - sbSize - 1) $+                                 max 1 $+                                 round $ fromIntegral ctxHeight *+                                         (fromIntegral vOffset /+                                          fromIntegral contentHeight::Double)++            sbAbove = maybeClick n constr SBTroughBefore $+                      withDefAttr scrollbarTroughAttr $ vLimit sbOffset $+                      renderVScrollbarTrough vsRenderer+            sbBelow = maybeClick n constr SBTroughAfter $+                      withDefAttr scrollbarTroughAttr $ vLimit (ctxHeight - (sbOffset + sbSize)) $+                      renderVScrollbarTrough vsRenderer+            sbMiddle = maybeClick n constr SBBar $+                       withDefAttr scrollbarAttr $ vLimit sbSize $ renderVScrollbar vsRenderer++            sb = if sbSize == ctxHeight+                 then vLimit sbSize $+                      renderVScrollbarTrough vsRenderer+                 else vBox [sbAbove, sbMiddle, sbBelow]++        render sb++-- | Build a horizontal scroll bar using the specified renderer and+-- settings.+--+-- You probably don't want to use this directly; instead, use+-- @viewport@, @withHScrollBars@, and, if needed,+-- @withHScrollBarRenderer@. This is exposed so that if you want to+-- render a scroll bar of your own, you can do so outside the @viewport@+-- context.+horizontalScrollbar :: (Ord n)+                    => HScrollbarRenderer n+                    -- ^ The renderer to use.+                    -> HScrollBarOrientation+                    -- ^ The scroll bar orientation. The orientation+                    -- governs how additional padding is added+                    -- to the scroll bar if it is smaller+                    -- than it space allocation according to+                    -- 'scrollbarHeightAllocation'.+                    -> n+                    -- ^ The viewport name associated with this scroll+                    -- bar.+                    -> Maybe (ClickableScrollbarElement -> n -> n)+                    -- ^ Constructor for clickable scroll bar element+                    -- names. Will be given the element name and the+                    -- viewport name.+                    -> Bool+                    -- ^ Whether to show handles.+                    -> Int+                    -- ^ The total viewport width in effect.+                    -> Int+                    -- ^ The viewport horizontal scrolling offset in effect.+                    -> Int+                    -- ^ The total viewport content width.+                    -> Widget n+horizontalScrollbar hsRenderer o n constr showHandles vpWidth hOffset contentWidth =+    vLimit (scrollbarHeightAllocation hsRenderer) $+    applyPadding $+    if showHandles+       then hBox [ hLimit 1 $+                   maybeClick n constr SBHandleBefore $+                   withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleBefore hsRenderer+                 , sbBody+                 , hLimit 1 $+                   maybeClick n constr SBHandleAfter $+                   withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleAfter hsRenderer+                 ]+       else sbBody+    where+        sbBody = horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth+        applyPadding = case o of+            OnTop -> padBottom Max+            OnBottom -> padTop Max++horizontalScrollbar' :: (Ord n)+                     => HScrollbarRenderer n+                     -- ^ The renderer to use.+                     -> n+                     -- ^ The viewport name associated with this scroll+                     -- bar.+                     -> Maybe (ClickableScrollbarElement -> n -> n)+                     -- ^ Constructor for clickable scroll bar element+                     -- names.+                     -> Int+                     -- ^ The total viewport width in effect.+                     -> Int+                     -- ^ The viewport horizontal scrolling offset in effect.+                     -> Int+                     -- ^ The total viewport content width.+                     -> Widget n+horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 =+    hLimit vpWidth $ renderHScrollbarTrough hsRenderer+horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth =+    Widget Greedy Fixed $ do+        c <- getContext++        -- Get the proportion of the total content that is visible+        let visibleContentPercent :: Double+            visibleContentPercent = fromIntegral vpWidth /+                                    fromIntegral contentWidth++            ctxWidth = c^.availWidthL++            -- Then get the proportion of the scroll bar that+            -- should be filled in+            sbSize = min ctxWidth $+                     max 1 $+                     round $ visibleContentPercent * (fromIntegral ctxWidth)++            -- Then get the horizontal offset of the scroll bar itself+            sbOffset = if hOffset == 0+                       then 0+                       else if hOffset == contentWidth - vpWidth+                            then ctxWidth - sbSize+                            else min (ctxWidth - sbSize - 1) $+                                 max 1 $+                                 round $ fromIntegral ctxWidth *+                                         (fromIntegral hOffset /+                                          fromIntegral contentWidth::Double)++            sbLeft = maybeClick n constr SBTroughBefore $+                     withDefAttr scrollbarTroughAttr $ hLimit sbOffset $+                     renderHScrollbarTrough hsRenderer+            sbRight = maybeClick n constr SBTroughAfter $+                      withDefAttr scrollbarTroughAttr $ hLimit (ctxWidth - (sbOffset + sbSize)) $+                      renderHScrollbarTrough hsRenderer+            sbMiddle = maybeClick n constr SBBar $+                       withDefAttr scrollbarAttr $ hLimit sbSize $ renderHScrollbar hsRenderer++            sb = if sbSize == ctxWidth+                 then hLimit sbSize $+                      renderHScrollbarTrough hsRenderer+                 else hBox [sbLeft, sbMiddle, sbRight]++        render sb++-- | Given a name, obtain the viewport for that name by consulting the+-- viewport map in the rendering monad. NOTE! Some care must be taken+-- when calling this function, since it only returns useful values+-- after the viewport in question has been rendered. If you call this+-- function during rendering before a viewport has been rendered, you+-- may get nothing or you may get a stale version of the viewport. This+-- is because viewports are updated during rendering and the one you are+-- interested in may not have been rendered yet. So if you want to use+-- this, be sure you know what you are doing.+unsafeLookupViewport :: (Ord n) => n -> RenderM n (Maybe Viewport)+unsafeLookupViewport name = lift $ gets (M.lookup name . (^.viewportMapL))++scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport+scrollTo Both _ _ _ = error "BUG: called scrollTo on viewport type 'Both'"+scrollTo Vertical req img vp = vp & vpTop .~ newVStart+    where+        newVStart = clamp 0 (V.imageHeight img - vp^.vpSize._2) adjustedAmt+        adjustedAmt = case req of+            VScrollBy amt -> vp^.vpTop + amt+            VScrollPage Up -> vp^.vpTop - vp^.vpSize._2+            VScrollPage Down -> vp^.vpTop + vp^.vpSize._2+            VScrollToBeginning -> 0+            VScrollToEnd -> V.imageHeight img - vp^.vpSize._2+            SetTop i -> i+            _ -> vp^.vpTop+scrollTo Horizontal req img vp = vp & vpLeft .~ newHStart+    where+        newHStart = clamp 0 (V.imageWidth img - vp^.vpSize._1) adjustedAmt+        adjustedAmt = case req of+            HScrollBy amt -> vp^.vpLeft + amt+            HScrollPage Up -> vp^.vpLeft - vp^.vpSize._1+            HScrollPage Down -> vp^.vpLeft + vp^.vpSize._1+            HScrollToBeginning -> 0+            HScrollToEnd -> V.imageWidth img - vp^.vpSize._1+            SetLeft i -> i+            _ -> vp^.vpLeft++scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport+scrollToView Both _ _ = error "BUG: called scrollToView on 'Both' type viewport"+scrollToView Vertical rq vp = vp & vpTop .~ newVStart+    where+        curStart = vp^.vpTop+        curEnd = curStart + vp^.vpSize._2+        reqStart = rq^.vrPositionL.locationRowL++        reqEnd = rq^.vrPositionL.locationRowL + rq^.vrSizeL._2+        newVStart :: Int+        newVStart = if reqStart < vStartEndVisible+                   then reqStart+                   else vStartEndVisible+        vStartEndVisible = if reqEnd < curEnd+                           then curStart+                           else curStart + (reqEnd - curEnd)+scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart+    where+        curStart = vp^.vpLeft+        curEnd = curStart + vp^.vpSize._1+        reqStart = rq^.vrPositionL.locationColumnL++        reqEnd = rq^.vrPositionL.locationColumnL + rq^.vrSizeL._1+        newHStart :: Int+        newHStart = if reqStart < hStartEndVisible+                   then reqStart+                   else hStartEndVisible+        hStartEndVisible = if reqEnd < curEnd+                           then curStart+                           else curStart + (reqEnd - curEnd)++-- | Request that the specified widget be made visible when it is+-- rendered inside a viewport. This permits widgets (whose sizes and+-- positions cannot be known due to being embedded in arbitrary layouts)+-- to make a request for a parent viewport to locate them and scroll+-- enough to put them in view. This, together with 'viewport', is what+-- makes the text editor and list widgets possible without making them+-- deal with the details of scrolling state management.+--+-- This does nothing if not rendered in a viewport.+visible :: Widget n -> Widget n+visible p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let imageSize = ( result^.imageL.to V.imageWidth+                      , result^.imageL.to V.imageHeight+                      )+      -- The size of the image to be made visible in a viewport must have+      -- non-zero size in both dimensions.+      return $ if imageSize^._1 > 0 && imageSize^._2 > 0+               then result & visibilityRequestsL %~ (VR (Location (0, 0)) imageSize :)+               else result++-- | Similar to 'visible', request that a region (with the specified+-- 'Location' as its origin and 'V.DisplayRegion' as its size) be made+-- visible when it is rendered inside a viewport. The 'Location' is+-- relative to the specified widget's upper-left corner of (0, 0).+--+-- This does nothing if not rendered in a viewport.+visibleRegion :: Location -> V.DisplayRegion -> Widget n -> Widget n+visibleRegion vrloc sz p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      -- The size of the image to be made visible in a viewport must have+      -- non-zero size in both dimensions.+      return $ if sz^._1 > 0 && sz^._2 > 0+               then result & visibilityRequestsL %~ (VR vrloc sz :)+               else result++-- | Horizontal box layout: put the specified widgets next to each other+-- in the specified order. Defers growth policies to the growth policies+-- of both widgets.  This operator is a binary version of 'hBox'.+{-# NOINLINE (<+>) #-}+(<+>) :: Widget n+      -- ^ Left+      -> Widget n+      -- ^ Right+      -> Widget n+(<+>) a b = hBox [a, b]++-- | Vertical box layout: put the specified widgets one above the other+-- in the specified order. Defers growth policies to the growth policies+-- of both widgets.  This operator is a binary version of 'vBox'.+{-# NOINLINE (<=>) #-}+(<=>) :: Widget n+      -- ^ Top+      -> Widget n+      -- ^ Bottom+      -> Widget n+(<=>) a b = vBox [a, b]++{-# RULES+"baseHbox" forall a b   . a <+> b                 = hBox [a, b]+"hBox2"    forall as bs . hBox [hBox as, hBox bs] = hBox (as ++ bs)+"hboxL"    forall as b  . hBox [hBox as, b]       = hBox (as ++ [b])+"hboxR"    forall a bs  . hBox [a, hBox bs]       = hBox (a : bs)+"baseVbox" forall a b   . a <=> b                 = vBox [a, b]+"vBox2"    forall as bs . vBox [vBox as, vBox bs] = vBox (as ++ bs)+"vboxL"    forall as b  . vBox [vBox as, b]       = vBox (as ++ [b])+"vboxR"    forall a bs  . vBox [a, vBox bs]       = vBox (a : bs)+  #-}
src/Brick/Widgets/Dialog.hs view
@@ -1,16 +1,29 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- | This module provides a simple dialog widget. You get to pick the -- dialog title, if any, as well as its body and buttons.+--+-- Note that this dialog is really for simple use cases where you want+-- to get the user's answer to a question, such as "Would you like to+-- save changes before quitting?" As is typical in such cases, we assume+-- that this dialog box is used modally, meaning that while it is open+-- it is has exclusive input focus until it is closed.+--+-- If you require something more sophisticated, you'll need to build it+-- yourself. You might also consider seeing the 'Brick.Forms' module for+-- help with input management and see the implementation of this module+-- to see how to reproduce a dialog-style UI. module Brick.Widgets.Dialog   ( Dialog   , dialogTitle   , dialogButtons-  , dialogSelectedIndex   , dialogWidth   -- * Construction and rendering   , dialog   , renderDialog+  , getDialogFocus+  , setDialogFocus   -- * Handling events   , handleDialogEvent   -- * Getting a dialog's current value@@ -21,22 +34,20 @@   , buttonSelectedAttr   -- * Lenses   , dialogButtonsL-  , dialogSelectedIndexL   , dialogWidthL   , dialogTitleL   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- import Lens.Micro+import Lens.Micro.Mtl ((%=))+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid-import Data.List (intersperse)+#endif+import Data.List (intersperse, find) import Graphics.Vty.Input (Event(..), Key(..)) -import Brick.Util (clamp)+import Brick.Focus import Brick.Types import Brick.Widgets.Core import Brick.Widgets.Center@@ -44,81 +55,99 @@ import Brick.AttrMap  -- | Dialogs present a window with a title (optional), a body, and--- buttons (optional). They provide a 'HandleEvent' instance that knows--- about Tab and Shift-Tab as well as ArrowLeft and ArrowRight--- for changing which button is active. Dialog--- buttons are labeled with strings and map to values of type 'a', which--- you choose.+-- buttons (optional). Dialog buttons are labeled with strings and map+-- to values of type 'a', which you choose. ----- Dialogs handle the following events by default:+-- Dialogs handle the following events by default with+-- handleDialogEvent: ----- * Tab: selecte the next button--- * Shift-tab: select the previous button-data Dialog a =-    Dialog { dialogTitle :: Maybe String+-- * Tab or Right Arrow: select the next button+-- * Shift-tab or Left Arrow: select the previous button+data Dialog a n =+    Dialog { dialogTitle :: Maybe (Widget n)            -- ^ The dialog title-           , dialogButtons :: [(String, a)]-           -- ^ The dialog button labels and values-           , dialogSelectedIndex :: Maybe Int-           -- ^ The currently selected dialog button index (if any)+           , dialogButtons :: [(String, n, a)]+           -- ^ The dialog buttons' labels, resource names, and values            , dialogWidth :: Int            -- ^ The maximum width of the dialog+           , dialogFocus :: FocusRing n+           -- ^ The focus ring for the dialog's buttons            }  suffixLenses ''Dialog -handleDialogEvent :: Event -> Dialog a -> EventM n (Dialog a)-handleDialogEvent ev d =-    return $ case ev of-        EvKey (KChar '\t') [] -> nextButtonBy 1 d-        EvKey KBackTab [] -> nextButtonBy (-1) d-        EvKey KRight [] -> nextButtonBy 1 d-        EvKey KLeft [] -> nextButtonBy (-1) d-        _ -> d+handleDialogEvent :: Event -> EventM n (Dialog a n) ()+handleDialogEvent ev = do+    case ev of+        EvKey (KChar '\t') [] -> dialogFocusL %= focusNext+        EvKey KRight []       -> dialogFocusL %= focusNext+        EvKey KBackTab []     -> dialogFocusL %= focusPrev+        EvKey KLeft []        -> dialogFocusL %= focusPrev+        _ -> return () +-- | Set the focused button of a dialog.+setDialogFocus :: (Eq n) => n -> Dialog a n -> Dialog a n+setDialogFocus n d = d { dialogFocus = focusSetCurrent n $ dialogFocus d }++-- | Get the focused button of a dialog.+getDialogFocus :: Dialog a n -> Maybe n+getDialogFocus = focusGetCurrent . dialogFocus+ -- | Create a dialog.-dialog :: Maybe String+dialog :: (Eq n)+       => Maybe (Widget n)        -- ^ The dialog title-       -> Maybe (Int, [(String, a)])-       -- ^ The currently-selected button index (starting at zero) and-       -- the button labels and values to use+       -> Maybe (n, [(String, n, a)])+       -- ^ The currently-selected button resource name and the button+       -- labels, resource names, and values to use for each button,+       -- respectively        -> Int        -- ^ The maximum width of the dialog-       -> Dialog a+       -> Dialog a n dialog title buttonData w =-    let (buttons, idx) = case buttonData of-          Nothing -> ([], Nothing)-          Just (_, []) -> ([], Nothing)-          Just (i, bs) -> (bs, Just $ clamp 0 (length bs - 1) i)-    in Dialog title buttons idx w+    let (r, buttons) = case buttonData of+            Nothing ->+                (focusRing [], [])+            Just (focName, entries) ->+                let ns = (\(_, n, _) -> n) <$> entries+                in (focusSetCurrent focName $ focusRing ns, entries)+    in Dialog title buttons w r  -- | 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 -- your rendering function to be rendered on top of the rest of your -- interface.-renderDialog :: Dialog a -> Widget n -> Widget n+renderDialog :: (Ord n) => Dialog a n -> Widget n -> Widget n renderDialog d body =     let buttonPadding = str "   "-        mkButton (i, (s, _)) = let att = if Just i == d^.dialogSelectedIndexL-                                         then buttonSelectedAttr-                                         else buttonAttr-                               in withAttr att $ str $ "  " <> s <> "  "+        foc = focusGetCurrent $ dialogFocus d+        mkButton (s, n, _) =+            let att = if Just n == foc+                      then buttonSelectedAttr+                      else buttonAttr+                csr = if Just n == foc+                      then putCursor n (Location (1,0))+                      else id+            in csr $+               clickable n $+               withAttr att $+               str $ "  " <> s <> "  "         buttons = hBox $ intersperse buttonPadding $-                         mkButton <$> (zip [0..] (d^.dialogButtonsL))+                         mkButton <$> (d^.dialogButtonsL) -        doBorder = maybe border borderWithLabel (str <$> d^.dialogTitleL)+        doBorder = maybe border borderWithLabel (d^.dialogTitleL)     in centerLayer $        withDefAttr dialogAttr $        hLimit (d^.dialogWidthL) $@@ -127,19 +156,12 @@             , hCenter buttons             ] -nextButtonBy :: Int -> Dialog a -> Dialog a-nextButtonBy amt d =-    let numButtons = length $ d^.dialogButtonsL-    in if numButtons == 0 then d-       else case d^.dialogSelectedIndexL of-           Nothing -> d & dialogSelectedIndexL .~ (Just 0)-           Just i -> d & dialogSelectedIndexL .~ (Just $ (i + amt) `mod` numButtons)---- | Obtain the value associated with the dialog's currently-selected--- button, if any. This function is probably what you want when someone--- presses 'Enter' in a dialog.-dialogSelection :: Dialog a -> Maybe a-dialogSelection d =-    case d^.dialogSelectedIndexL of-        Nothing -> Nothing-        Just i -> Just $ ((d^.dialogButtonsL) !! i)^._2+-- | Obtain the resource name and value associated with the dialog's+-- currently-selected button, if any. The result of this function is+-- probably what you want when someone presses 'Enter' in a dialog.+dialogSelection :: (Eq n) => Dialog a n -> Maybe (n, a)+dialogSelection d = do+    n' <- focusGetCurrent $ dialogFocus d+    let matches (_, n, _) = n == n'+    (_, n, a) <- find matches (d^.dialogButtonsL)+    return (n, a)
src/Brick/Widgets/Edit.hs view
@@ -2,15 +2,16 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE CPP #-} -- | This module provides a basic text editor widget. You'll need to -- embed an 'Editor' in your application state and transform it with--- 'handleEvent' when relevant events arrive. To get the contents+-- 'handleEditorEvent' when relevant events arrive. To get the contents -- of the editor, just use 'getEditContents'. To modify it, use the -- 'Z.TextZipper' interface with 'applyEdit'. ----- The editor's 'HandleEvent' instance handles a set of basic input--- events that should suffice for most purposes; see the source for a--- complete list.+-- The editor's 'handleEditorEvent' function handles a set of basic+-- input events that should suffice for most purposes; see the source+-- for a complete list. -- -- Bear in mind that the editor provided by this module is intended to -- provide basic input support for brick applications but it is not@@ -18,34 +19,42 @@ -- Emacs. It is also not suitable for building sophisticated editors. If -- you want to build your own editor, I suggest starting from scratch. module Brick.Widgets.Edit-  ( Editor(editContents, editorName, editDrawContents)+  ( Editor(editContents, editorName)   -- * Constructing an editor   , editor   , editorText   -- * Reading editor contents   , getEditContents+  , getCursorPosition   -- * Handling events   , handleEditorEvent   -- * Editing text   , applyEdit   -- * Lenses for working with editors   , editContentsL-  , editDrawContentsL   -- * Rendering editors   , renderEditor   -- * Attributes   , editAttr   , editFocusedAttr+  -- * UTF-8 decoding of editor pastes+  , DecodeUtf8(..)   ) where +#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import Lens.Micro import Graphics.Vty (Event(..), Key(..), Modifier(..)) +import qualified Data.ByteString as BS import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Data.Text.Zipper as Z hiding ( textZipper ) import qualified Data.Text.Zipper.Generic as Z+import qualified Data.Text.Zipper.Generic.Words as Z+import Data.Tuple (swap)  import Brick.Types import Brick.Widgets.Core@@ -53,19 +62,28 @@  -- | Editor state.  Editors support the following events by default: ----- * Ctrl-a: go to beginning of line--- * Ctrl-e: go to end of line+-- * 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+-- * Ctrl-e, End: go to end of line -- * Ctrl-d, Del: delete character at cursor position+-- * Meta-d: delete word at cursor position -- * Backspace: delete character prior to cursor position -- * Ctrl-k: delete all from cursor to end of line -- * Ctrl-u: delete all from cursor to beginning of line+-- * Ctrl-t: transpose character before cursor with the one at cursor position+-- * Meta-b: move one word to the left+-- * Ctrl-b: move one character to the left+-- * Meta-f: move one word to the right+-- * Ctrl-f: move one character to the right -- * Arrow keys: move cursor -- * Enter: break the current line at the cursor position+-- * Paste: Bracketed Pastes from the terminal will be pasted, provided+--   the incoming data is UTF-8-encoded. data Editor t n =     Editor { editContents :: Z.TextZipper t            -- ^ The contents of the editor-           , editDrawContents :: [t] -> Widget n-           -- ^ The function the editor uses to draw its contents            , editorName :: n            -- ^ The name of the editor            }@@ -83,86 +101,128 @@ instance Named (Editor t n) n where     getName = editorName -handleEditorEvent :: (Eq t, Monoid t) => Event -> Editor t n -> EventM n (Editor t n)-handleEditorEvent e ed =-        let f = case e of-                  EvKey (KChar 'a') [MCtrl] -> Z.gotoBOL-                  EvKey (KChar 'e') [MCtrl] -> Z.gotoEOL-                  EvKey (KChar 'd') [MCtrl] -> Z.deleteChar-                  EvKey (KChar 'k') [MCtrl] -> Z.killToEOL-                  EvKey (KChar 'u') [MCtrl] -> Z.killToBOL-                  EvKey KEnter [] -> Z.breakLine-                  EvKey KDel [] -> Z.deleteChar-                  EvKey (KChar c) [] | c /= '\t' -> Z.insertChar c-                  EvKey KUp [] -> Z.moveUp-                  EvKey KDown [] -> Z.moveDown-                  EvKey KLeft [] -> Z.moveLeft-                  EvKey KRight [] -> Z.moveRight-                  EvKey KBS [] -> Z.deletePrevChar-                  _ -> id-        in return $ applyEdit f ed+-- | Values that can be constructed by decoding bytestrings in UTF-8+-- encoding.+class DecodeUtf8 t where+    -- | Decode a bytestring assumed to be text in UTF-8 encoding. If+    -- the decoding fails, return 'Left'. This must not raise+    -- exceptions.+    decodeUtf8 :: BS.ByteString -> Either String t +instance DecodeUtf8 T.Text where+    decodeUtf8 bs = case T.decodeUtf8' bs of+        Left e -> Left $ show e+        Right t -> Right t++instance DecodeUtf8 String where+    decodeUtf8 bs = T.unpack <$> decodeUtf8 bs++handleEditorEvent :: (Eq n, DecodeUtf8 t, Eq t, Z.GenericTextZipper t)+                  => BrickEvent n e+                  -> 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 ->+                  Z.moveCursorClosest (swap pos)+              _ -> id+        handleVtyEvent ev = case ev of+            EvPaste bs -> case decodeUtf8 bs of+                Left _ -> id+                Right t -> Z.insertMany t+            EvKey (KChar 'a') [MCtrl] -> Z.gotoBOL+            EvKey (KChar 'e') [MCtrl] -> Z.gotoEOL+            EvKey (KChar 'd') [MCtrl] -> Z.deleteChar+            EvKey (KChar 'd') [MMeta] -> Z.deleteWord+            EvKey (KChar 'k') [MCtrl] -> Z.killToEOL+            EvKey (KChar 'u') [MCtrl] -> Z.killToBOL+            EvKey KEnter [] -> Z.breakLine+            EvKey KDel [] -> Z.deleteChar+            EvKey (KChar c) [] | c /= '\t' -> Z.insertChar c+            EvKey KUp [] -> Z.moveUp+            EvKey KDown [] -> Z.moveDown+            EvKey KLeft [] -> Z.moveLeft+            EvKey KRight [] -> Z.moveRight+            EvKey (KChar 'b') [MCtrl] -> Z.moveLeft+            EvKey (KChar 'f') [MCtrl] -> Z.moveRight+            EvKey (KChar 'b') [MMeta] -> Z.moveWordLeft+            EvKey (KChar 'f') [MMeta] -> Z.moveWordRight+            EvKey KBS [] -> Z.deletePrevChar+            EvKey (KChar 't') [MCtrl] -> Z.transposeChars+            EvKey KHome [] -> Z.gotoBOL+            EvKey KEnd [] -> Z.gotoEOL+            EvKey (KChar '<') [MMeta] -> Z.gotoBOF+            EvKey (KChar '>') [MMeta] -> Z.gotoEOF+            _ -> id+    put $ applyEdit f ed+ -- | Construct an editor over 'Text' values editorText :: n-       -- ^ The editor's name (must be unique)-       -> ([T.Text] -> Widget n)-       -- ^ The content rendering function-       -> Maybe Int-       -- ^ The limit on the number of lines in the editor ('Nothing'-       -- means no limit)-       -> T.Text-       -- ^ The initial content-       -> Editor T.Text n+           -- ^ The editor's name (must be unique)+           -> Maybe Int+           -- ^ The limit on the number of lines in the editor ('Nothing'+           -- means no limit)+           -> T.Text+           -- ^ The initial content+           -> Editor T.Text n editorText = editor --- | Construct an editor over 'String' values+-- | Construct an editor over generic text values editor :: Z.GenericTextZipper a        => n        -- ^ The editor's name (must be unique)-       -> ([a] -> Widget n)-       -- ^ The content rendering function        -> Maybe Int        -- ^ The limit on the number of lines in the editor ('Nothing'        -- means no limit)        -> a        -- ^ The initial content        -> Editor a n-editor name draw limit s = Editor (Z.textZipper (Z.lines s) limit) draw name+editor name limit s = Editor (Z.textZipper (Z.lines s) limit) name --- | Apply an editing operation to the editor's contents. Bear in mind--- that you should only apply zipper operations that operate on the--- current line; the editor will only ever render the first line of--- text.+-- | Apply an editing operation to the editor's contents.+--+-- This is subject to the restrictions of the underlying text zipper;+-- for example, if the underlying zipper has a line limit configured,+-- any edits applied here will be ignored if they edit text outside+-- the line limit. applyEdit :: (Z.TextZipper t -> Z.TextZipper t)-          -- ^ The 'Data.Text.Zipper' editing transformation to apply+          -- ^ The 'Z.TextZipper' editing transformation to apply           -> Editor t n           -> Editor t n applyEdit f e = e & editContentsL %~ f  -- | 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] getEditContents e = Z.getText $ e^.editContentsL +-- | Get the cursor position of the editor (row, column).+getCursorPosition :: Editor t n -> (Int, Int)+getCursorPosition e = Z.cursorPosition $ e^.editContentsL+ -- | Turn an editor state value into a widget. This uses the editor's -- name for its scrollable viewport handle and the name is also used to -- report mouse events. renderEditor :: (Ord n, Show n, Monoid t, TextWidth t, Z.GenericTextZipper t)-             => Bool+             => ([t] -> Widget n)+             -- ^ The content drawing function+             -> Bool              -- ^ Whether the editor has focus. It will report a cursor              -- position if and only if it has focus.              -> Editor t n              -- ^ The editor.              -> Widget n-renderEditor foc e =+renderEditor draw foc e =     let cp = Z.cursorPosition z         z = e^.editContentsL         toLeft = Z.take (cp^._2) (Z.currentLine z)@@ -175,10 +235,9 @@     in withAttr (if foc then editFocusedAttr else editAttr) $        limit $        viewport (e^.editorNameL) Both $-       clickable (e^.editorNameL) $        (if foc then showCursor (e^.editorNameL) cursorLoc else id) $        visibleRegion cursorLoc (atCharWidth, 1) $-       e^.editDrawContentsL $+       draw $        getEditContents e  charAtCursor :: (Z.GenericTextZipper t) => Z.TextZipper t -> Maybe t
+ src/Brick/Widgets/FileBrowser.hs view
@@ -0,0 +1,948 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- | This module provides a file browser widget that allows users to+-- navigate directory trees, search for files and directories, and+-- select entries of interest. For a complete working demonstration of+-- this module, see @programs/FileBrowserDemo.hs@.+--+-- To use this module:+--+-- * Embed a 'FileBrowser' in your application state.+-- * Dispatch events to it in your event handler with+--   'handleFileBrowserEvent'.+-- * Get the entry under the browser's cursor with 'fileBrowserCursor'+--   and get the entries selected by the user with 'Enter' or 'Space'+--   using 'fileBrowserSelection'.+-- * Inspect 'fileBrowserException' to determine whether the+--   file browser encountered an error when reading a directory in+--   'setWorkingDirectory' or when changing directories in the event+--   handler.+--+-- File browsers have a built-in user-configurable function to limit the+-- entries displayed that defaults to showing all files. For example,+-- an application might want to limit the browser to just directories+-- and XML files. That is accomplished by setting the filter with+-- 'setFileBrowserEntryFilter' and some examples are provided in this+-- module: 'fileTypeMatch' and 'fileExtensionMatch'.+--+-- File browsers are styled using the provided collection of attribute+-- names, so add those to your attribute map to get the appearance you+-- want. File browsers also make use of a 'List' internally, so the+-- 'List' attributes will affect how the list appears.+--+-- File browsers catch 'IOException's when changing directories. If a+-- call to 'setWorkingDirectory' triggers an 'IOException' while reading+-- the working directory, the resulting 'IOException' is stored in the+-- file browser and is accessible with 'fileBrowserException'. The+-- 'setWorkingDirectory' function clears the exception field if the+-- working directory is read successfully. The caller is responsible for+-- deciding when and whether to display the exception to the user. In+-- the event that an 'IOException' is raised as described here, the file+-- browser will always present @..@ as a navigation option to allow the+-- user to continue navigating up the directory tree. It does this even+-- if the current or parent directory does not exist or cannot be read,+-- so it is always safe to present a file browser for any working+-- directory. Bear in mind that the @..@ entry is always subjected to+-- filtering and searching.+module Brick.Widgets.FileBrowser+  ( -- * Types+    FileBrowser+  , FileInfo(..)+  , FileStatus(..)+  , FileType(..)++  -- * Making a new file browser+  , newFileBrowser+  , selectNonDirectories+  , selectDirectories++  -- * Manipulating a file browser's state+  , setWorkingDirectory+  , getWorkingDirectory+  , updateFileBrowserSearch+  , setFileBrowserEntryFilter++  -- * Actions+  , actionFileBrowserBeginSearch+  , actionFileBrowserSelectEnter+  , actionFileBrowserSelectCurrent+  , actionFileBrowserToggleCurrent+  , actionFileBrowserListPageUp+  , actionFileBrowserListPageDown+  , actionFileBrowserListHalfPageUp+  , actionFileBrowserListHalfPageDown+  , actionFileBrowserListTop+  , actionFileBrowserListBottom+  , actionFileBrowserListNext+  , actionFileBrowserListPrev++  -- * Handling events+  , handleFileBrowserEvent+  , maybeSelectCurrentEntry++  -- * Rendering+  , renderFileBrowser++  -- * Getting information+  , fileBrowserCursor+  , fileBrowserIsSearching+  , fileBrowserSelection+  , fileBrowserException+  , fileBrowserSelectable+  , fileInfoFileType++  -- * Attributes+  , fileBrowserAttr+  , fileBrowserCurrentDirectoryAttr+  , fileBrowserSelectionInfoAttr+  , fileBrowserSelectedAttr+  , fileBrowserDirectoryAttr+  , fileBrowserBlockDeviceAttr+  , fileBrowserRegularFileAttr+  , fileBrowserCharacterDeviceAttr+  , fileBrowserNamedPipeAttr+  , fileBrowserSymbolicLinkAttr+  , fileBrowserUnixSocketAttr++  -- * Example browser entry filters+  , fileTypeMatch+  , fileExtensionMatch++  -- * Lenses+  , fileBrowserSelectableL+  , fileInfoFilenameL+  , fileInfoSanitizedFilenameL+  , fileInfoFilePathL+  , fileInfoFileStatusL+  , fileInfoLinkTargetTypeL+  , fileStatusSizeL+  , fileStatusFileTypeL++  -- * Getters+  , fileBrowserEntryFilterG+  , fileBrowserWorkingDirectoryG+  , fileBrowserEntriesG+  , fileBrowserLatestResultsG+  , fileBrowserSelectedFilesG+  , fileBrowserNameG+  , fileBrowserSearchStringG+  , fileBrowserExceptionG+  , fileBrowserSelectableG++  -- * Miscellaneous+  , prettyFileSize++  -- * Utilities+  , entriesForDirectory+  , getFileInfo+  )+where++import qualified Control.Exception as E+import Control.Monad (forM, when)+import Control.Monad.IO.Class (liftIO)+import Data.Char (toLower, isPrint)+import Data.Foldable (for_)+import Data.Maybe (fromMaybe, isJust, fromJust)+import qualified Data.Foldable as F+import qualified Data.Text as T+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import Data.Int (Int64)+import Data.List (sortBy, isSuffixOf, dropWhileEnd)+import qualified Data.Set as Set+import qualified Data.Vector as V+import Lens.Micro+import Lens.Micro.Mtl ((%=), use)+import Lens.Micro.TH (lensRules, generateUpdateableOptics)+import qualified Graphics.Vty as Vty+import qualified System.Directory as D+import qualified System.PosixCompat.Files as U+import qualified System.PosixCompat.Types as U+import qualified System.FilePath as FP+import Text.Printf (printf)++import Brick.Types+import Brick.AttrMap (AttrName, attrName)+import Brick.Widgets.Core+import Brick.Widgets.List++-- | A file browser's state. Embed this in your application state and+-- transform it with 'handleFileBrowserEvent' and the functions included+-- in this module.+data FileBrowser n =+    FileBrowser { fileBrowserWorkingDirectory :: FilePath+                , fileBrowserEntries :: List n FileInfo+                , fileBrowserLatestResults :: [FileInfo]+                , fileBrowserSelectedFiles :: Set.Set String+                , fileBrowserName :: n+                , fileBrowserEntryFilter :: Maybe (FileInfo -> Bool)+                , fileBrowserSearchString :: Maybe T.Text+                , fileBrowserException :: Maybe E.IOException+                -- ^ The exception status of the latest directory+                -- change. If 'Nothing', the latest directory change+                -- was successful and all entries were read. Otherwise,+                -- this contains the exception raised by the latest+                -- directory change in case the calling application+                -- needs to inspect or present the error to the user.+                , fileBrowserSelectable :: FileInfo -> Bool+                -- ^ The function that determines what kinds of entries+                -- are selectable with in the event handler. Note that+                -- if this returns 'True' for an entry, an @Enter@ or+                -- @Space@ keypress selects that entry rather than doing+                -- anything else; directory changes can only occur if+                -- this returns 'False' for directories.+                --+                -- Note that this is a record field so it can be used to+                -- change the selection function.+                }++instance Named (FileBrowser n) n where+    getName = getName . fileBrowserEntries++-- | File status information.+data FileStatus =+    FileStatus { fileStatusSize :: Int64+               -- ^ The size, in bytes, of this entry's file.+               , fileStatusFileType :: Maybe FileType+               -- ^ The type of this entry's file, if it could be+               -- determined.+               }+               deriving (Show, Eq)++-- | Information about a file entry in the browser.+data FileInfo =+    FileInfo { fileInfoFilename :: String+             -- ^ The filename of this entry, without its path.+             -- This is not for display purposes; for that, use+             -- 'fileInfoSanitizedFilename'.+             , fileInfoSanitizedFilename :: String+             -- ^ The filename of this entry with out its path,+             -- sanitized of non-printable characters (replaced with+             -- '?'). This is for display purposes only.+             , fileInfoFilePath :: FilePath+             -- ^ The full path to this entry's file.+             , fileInfoFileStatus :: Either E.IOException FileStatus+             -- ^ The file status if it could be obtained, or the+             -- exception that was caught when attempting to read the+             -- file's status.+             , fileInfoLinkTargetType :: Maybe FileType+             -- ^ If this entry is a symlink, this indicates the type of+             -- file the symlink points to, if it could be obtained.+             }+             deriving (Show, Eq)++-- | The type of file entries in the browser.+data FileType =+    RegularFile+    -- ^ A regular disk file.+    | BlockDevice+    -- ^ A block device.+    | CharacterDevice+    -- ^ A character device.+    | NamedPipe+    -- ^ A named pipe.+    | Directory+    -- ^ A directory.+    | SymbolicLink+    -- ^ A symbolic link.+    | UnixSocket+    -- ^ A Unix socket.+    deriving (Read, Show, Eq)++suffixLenses ''FileBrowser+suffixLensesWith "G" (lensRules & generateUpdateableOptics .~ False) ''FileBrowser+suffixLenses ''FileInfo+suffixLenses ''FileStatus++-- | Make a new file browser state. The provided resource name will be+-- used to render the 'List' viewport of the browser.+--+-- By default, the browser will show all files and directories+-- in its working directory. To change that behavior, see+-- 'setFileBrowserEntryFilter'.+newFileBrowser :: (FileInfo -> Bool)+               -- ^ The function used to determine what kinds of entries+               -- can be selected (see 'handleFileBrowserEvent'). A+               -- good default is 'selectNonDirectories'. This can be+               -- changed at 'any time with 'fileBrowserSelectable' or+               -- its 'corresponding lens.+               -> n+               -- ^ The resource name associated with the browser's+               -- entry listing.+               -> Maybe FilePath+               -- ^ The initial working directory that the browser+               -- displays. If not provided, this defaults to the+               -- executable's current working directory.+               -> IO (FileBrowser n)+newFileBrowser selPredicate name mCwd = do+    initialCwd <- FP.normalise <$> case mCwd of+        Just path -> return $ removeTrailingSlash path+        Nothing -> D.getCurrentDirectory++    let b = FileBrowser { fileBrowserWorkingDirectory = initialCwd+                        , fileBrowserEntries = list name mempty 1+                        , fileBrowserLatestResults = mempty+                        , fileBrowserSelectedFiles = mempty+                        , fileBrowserName = name+                        , fileBrowserEntryFilter = Nothing+                        , fileBrowserSearchString = Nothing+                        , fileBrowserException = Nothing+                        , fileBrowserSelectable = selPredicate+                        }++    setWorkingDirectory initialCwd b++-- | Removes any trailing slash(es) from the supplied FilePath (which should+-- indicate a directory).  This does not remove a sole slash indicating the root+-- directory.+--+-- This is done because if the FileBrowser is initialized with an initial working+-- directory that ends in a slash, then selecting the "../" entry to move to the+-- parent directory will cause the removal of the trailing slash, but it will not+-- otherwise cause any change, misleading the user into thinking no action was+-- taken (the disappearance of the trailing slash is unlikely to be noticed).+-- All subsequent parent directory selection operations are processed normally,+-- and the 'fileBrowserWorkingDirectory' never ends in a trailing slash+-- thereafter (except at the root directory).+removeTrailingSlash :: FilePath -> FilePath+removeTrailingSlash "/" = "/"+removeTrailingSlash d = dropWhileEnd (== '/') d++-- | A file entry selector that permits selection of all file entries+-- except directories. Use this if you want users to be able to navigate+-- directories in the browser. If you want users to be able to select+-- only directories, use 'selectDirectories'.+selectNonDirectories :: FileInfo -> Bool+selectNonDirectories i =+    case fileInfoFileType i of+        Just Directory -> False+        Just SymbolicLink ->+            case fileInfoLinkTargetType i of+                Just Directory -> False+                _ -> True+        _ -> True++-- | A file entry selector that permits selection of directories+-- only. This prevents directory navigation and only supports directory+-- selection.+selectDirectories :: FileInfo -> Bool+selectDirectories i =+    case fileInfoFileType i of+        Just Directory -> True+        Just SymbolicLink -> fileInfoLinkTargetType i == Just Directory+        _ -> False++-- | Set the filtering function used to determine which entries in+-- the browser's current directory appear in the browser. 'Nothing'+-- indicates no filtering, meaning all entries will be shown. 'Just'+-- indicates a function that should return 'True' for entries that+-- should be permitted to appear.+--+-- Note that this applies the filter after setting it by updating the+-- listed entries to reflect the result of the filter. That is unlike+-- setting the filter with the 'fileBrowserEntryFilterL' lens directly,+-- which just sets the filter but does not (and cannot) update the+-- listed entries.+setFileBrowserEntryFilter :: Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n+setFileBrowserEntryFilter f b =+    applyFilterAndSearch $ b & fileBrowserEntryFilterL .~ f++-- | Set the working directory of the file browser. This scans the new+-- directory and repopulates the browser while maintaining any active+-- search string and/or entry filtering.+--+-- If the directory scan raises an 'IOException', the exception is+-- stored in the browser and is accessible with 'fileBrowserException'. If+-- no exception is raised, the exception field is cleared. Regardless of+-- whether an exception is raised, @..@ is always presented as a valid+-- option in the browser.+setWorkingDirectory :: FilePath -> FileBrowser n -> IO (FileBrowser n)+setWorkingDirectory path b = do+    entriesResult <- E.try $ entriesForDirectory path++    let (entries, exc) = case entriesResult of+            Left (e::E.IOException) -> ([], Just e)+            Right es -> (es, Nothing)++    allEntries <- if path == "/" then return entries else do+        parentResult <- E.try $ parentOf path+        return $ case parentResult of+            Left (_::E.IOException) -> entries+            Right parent -> parent : entries++    return $ setEntries allEntries b+                 & fileBrowserWorkingDirectoryL .~ path+                 & fileBrowserExceptionL .~ exc+                 & fileBrowserSelectedFilesL .~ mempty++parentOf :: FilePath -> IO FileInfo+parentOf path = getFileInfo ".." $ FP.takeDirectory path++-- | Build a 'FileInfo' for the specified file and path. If an+-- 'IOException' is raised while attempting to get the file information,+-- the 'fileInfoFileStatus' field is populated with the exception.+-- Otherwise it is populated with the 'FileStatus' for the file.+getFileInfo :: String+            -- ^ The name of the file to inspect. This filename is only+            -- used to set the 'fileInfoFilename' and sanitized filename+            -- fields; the actual file to be inspected is referred+            -- to by the second argument. This is decomposed so that+            -- 'FileInfo's can be used to represent information about+            -- entries like @..@, whose display names differ from their+            -- physical paths.+            -> FilePath+            -- ^ The actual full path to the file or directory to+            -- inspect.+            -> IO FileInfo+getFileInfo name = go []+    where+        go history fullPath = do+            filePath <- D.makeAbsolute fullPath+            statusResult <- E.try $ U.getSymbolicLinkStatus filePath++            let stat = do+                  status <- statusResult+                  let U.COff sz = U.fileSize status+                  return FileStatus { fileStatusFileType = fileTypeFromStatus status+                                    , fileStatusSize = sz+                                    }++            targetTy <- case fileStatusFileType <$> stat of+                Right (Just SymbolicLink) -> do+                    targetPathResult <- E.try $ U.readSymbolicLink filePath+                    case targetPathResult of+                        Left (_::E.SomeException) -> return Nothing+                        Right targetPath ->+                            -- Watch out for recursive symlink chains:+                            -- if history starts repeating, abort the+                            -- symlink following process.+                            --+                            -- Examples:+                            --   $ ln -s foo foo+                            --+                            --   $ ln -s foo bar+                            --   $ ln -s bar foo+                            if targetPath `elem` history+                            then return Nothing+                            else do+                                targetInfo <- liftIO $ go (fullPath : history) targetPath+                                case fileInfoFileStatus targetInfo of+                                    Right (FileStatus _ targetTy) -> return targetTy+                                    _ -> return Nothing+                _ -> return Nothing++            return FileInfo { fileInfoFilename = name+                            , fileInfoFilePath = filePath+                            , fileInfoSanitizedFilename = sanitizeFilename name+                            , fileInfoFileStatus = stat+                            , fileInfoLinkTargetType = targetTy+                            }++-- | Get the file type for this file info entry. If the file type could+-- not be obtained due to an 'IOException', return 'Nothing'.+fileInfoFileType :: FileInfo -> Maybe FileType+fileInfoFileType i =+    case fileInfoFileStatus i of+        Left _ -> Nothing+        Right stat -> fileStatusFileType stat++-- | Get the working directory of the file browser.+getWorkingDirectory :: FileBrowser n -> FilePath+getWorkingDirectory = fileBrowserWorkingDirectory++setEntries :: [FileInfo] -> FileBrowser n -> FileBrowser n+setEntries es b =+    applyFilterAndSearch $ b & fileBrowserLatestResultsL .~ es++-- | Returns whether the file browser is in search mode, i.e., the mode+-- in which user input affects the browser's active search string and+-- displayed entries. This is used to aid in event dispatching in the+-- calling program.+fileBrowserIsSearching :: FileBrowser n -> Bool+fileBrowserIsSearching b = isJust $ b^.fileBrowserSearchStringL++-- | Get the entries chosen by the user, if any. Entries are chosen by+-- an 'Enter' or 'Space' keypress; if you want the entry under the+-- cursor, use 'fileBrowserCursor'.+fileBrowserSelection :: FileBrowser n -> [FileInfo]+fileBrowserSelection b =+    let getEntry filename = fromJust $ F.find ((== filename) . fileInfoFilename) $ b^.fileBrowserLatestResultsL+    in fmap getEntry $ F.toList $ b^.fileBrowserSelectedFilesL++-- | Modify the file browser's active search string. This causes the+-- browser's displayed entries to change to those in its current+-- directory that match the search string, if any. If a search string+-- is provided, it is matched case-insensitively anywhere in file or+-- directory names.+updateFileBrowserSearch :: (Maybe T.Text -> Maybe T.Text)+                        -- ^ The search transformation. 'Nothing'+                        -- indicates that search mode should be off;+                        -- 'Just' indicates that it should be on and+                        -- that the provided search string should be+                        -- used.+                        -> FileBrowser n+                        -- ^ The browser to modify.+                        -> FileBrowser n+updateFileBrowserSearch f b =+    let old = b^.fileBrowserSearchStringL+        new = f $ b^.fileBrowserSearchStringL+        oldLen = maybe 0 T.length old+        newLen = maybe 0 T.length new+    in if old == new+       then b+       else if oldLen == newLen+            -- This case avoids a list rebuild and cursor position reset+            -- when the search state isn't *really* changing.+            then b & fileBrowserSearchStringL .~ new+            else applyFilterAndSearch $ b & fileBrowserSearchStringL .~ new++applyFilterAndSearch :: FileBrowser n -> FileBrowser n+applyFilterAndSearch b =+    let filterMatch = fromMaybe (const True) (b^.fileBrowserEntryFilterL)+        searchMatch = maybe (const True)+                            (\search i -> T.toLower search `T.isInfixOf` T.pack (toLower <$> fileInfoSanitizedFilename i))+                            (b^.fileBrowserSearchStringL)+        match i = filterMatch i && searchMatch i+        matching = filter match $ b^.fileBrowserLatestResultsL+    in b { fileBrowserEntries = list (b^.fileBrowserNameL) (V.fromList matching) 1 }++-- | Generate a textual abbreviation of a file size, e.g. "10.2M" or "12+-- bytes".+prettyFileSize :: Int64+               -- ^ A file size in bytes.+               -> T.Text+prettyFileSize i+    | i >= 2 ^ (40::Int64) = T.pack $ format (i `divBy` (2 ** 40)) <> "T"+    | i >= 2 ^ (30::Int64) = T.pack $ format (i `divBy` (2 ** 30)) <> "G"+    | i >= 2 ^ (20::Int64) = T.pack $ format (i `divBy` (2 ** 20)) <> "M"+    | i >= 2 ^ (10::Int64) = T.pack $ format (i `divBy` (2 ** 10)) <> "K"+    | otherwise    = T.pack $ show i <> " bytes"+    where+        format = printf "%0.1f"+        divBy :: Int64 -> Double -> Double+        divBy a b = ((fromIntegral a) :: Double) / b++-- | Build a list of file info entries for the specified directory. This+-- function does not catch any exceptions raised by calling+-- 'makeAbsolute' or 'listDirectory', but it does catch exceptions on+-- a per-file basis. Any exceptions caught when inspecting individual+-- files are stored in the 'fileInfoFileStatus' field of each+-- 'FileInfo'.+--+-- The entries returned are all entries in the specified directory+-- except for @.@ and @..@. Directories are always given first. Entries+-- are sorted in case-insensitive lexicographic order.+--+-- This function is exported for those who want to implement their own+-- file browser using the types in this module.+entriesForDirectory :: FilePath -> IO [FileInfo]+entriesForDirectory rawPath = do+    path <- D.makeAbsolute rawPath++    -- Get all entries except "." and "..", then sort them+    dirContents <- D.listDirectory path++    infos <- forM dirContents $ \f -> do+        getFileInfo f (path FP.</> f)++    let dirsFirst a b = if fileInfoFileType a == Just Directory &&+                           fileInfoFileType b == Just Directory+                        then compare (toLower <$> fileInfoFilename a)+                                     (toLower <$> fileInfoFilename b)+                        else if fileInfoFileType a == Just Directory &&+                                fileInfoFileType b /= Just Directory+                             then LT+                             else if fileInfoFileType b == Just Directory &&+                                     fileInfoFileType a /= Just Directory+                                  then GT+                                  else compare (toLower <$> fileInfoFilename a)+                                               (toLower <$> fileInfoFilename b)++        allEntries = sortBy dirsFirst infos++    return allEntries++fileTypeFromStatus :: U.FileStatus -> Maybe FileType+fileTypeFromStatus s =+    if | U.isBlockDevice s     -> Just BlockDevice+       | U.isCharacterDevice s -> Just CharacterDevice+       | U.isNamedPipe s       -> Just NamedPipe+       | U.isRegularFile s     -> Just RegularFile+       | U.isDirectory s       -> Just Directory+       | U.isSocket s          -> Just UnixSocket+       | U.isSymbolicLink s    -> Just SymbolicLink+       | otherwise             -> Nothing++-- | Get the file information for the file under the cursor, if any.+fileBrowserCursor :: FileBrowser n -> Maybe FileInfo+fileBrowserCursor b = snd <$> listSelectedElement (b^.fileBrowserEntriesL)++-- | Handle a Vty input event. Note that event handling can+-- cause a directory change so the caller should be aware that+-- 'fileBrowserException' may need to be checked after handling an+-- event in case an exception was triggered while scanning the working+-- directory.+--+-- Events handled regardless of mode:+--+-- * @Ctrl-b@: 'actionFileBrowserListPageUp'+-- * @Ctrl-f@: 'actionFileBrowserListPageDown'+-- * @Ctrl-d@: 'actionFileBrowserListHalfPageDown'+-- * @Ctrl-u@: 'actionFileBrowserListHalfPageUp'+-- * @Ctrl-n@: 'actionFileBrowserListNext'+-- * @Ctrl-p@: 'actionFileBrowserListPrev'+--+-- Events handled only in normal mode:+--+-- * @/@: 'actionFileBrowserBeginSearch'+-- * @Enter@: 'actionFileBrowserSelectEnter'+-- * @Space@: 'actionFileBrowserToggleCurrent'+-- * @g@: 'actionFileBrowserListTop'+-- * @G@: 'actionFileBrowserListBottom'+-- * @j@: 'actionFileBrowserListNext'+-- * @k@: 'actionFileBrowserListPrev'+--+-- Events handled only in search mode:+--+-- * @Esc@, @Ctrl-C@: cancel search mode+-- * Text input: update search string++actionFileBrowserBeginSearch :: EventM n (FileBrowser n) ()+actionFileBrowserBeginSearch =+    modify $ updateFileBrowserSearch (const $ Just "")++actionFileBrowserSelectEnter :: EventM n (FileBrowser n) ()+actionFileBrowserSelectEnter =+    maybeSelectCurrentEntry++actionFileBrowserSelectCurrent :: EventM n (FileBrowser n) ()+actionFileBrowserSelectCurrent =+    selectCurrentEntry++actionFileBrowserToggleCurrent :: EventM n (FileBrowser n) ()+actionFileBrowserToggleCurrent =+    toggleCurrentEntrySelected++actionFileBrowserListPageUp :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPageUp =+    zoom fileBrowserEntriesL listMovePageUp++actionFileBrowserListPageDown :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPageDown =+    zoom fileBrowserEntriesL listMovePageDown++actionFileBrowserListHalfPageUp :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListHalfPageUp =+    zoom fileBrowserEntriesL (listMoveByPages (-0.5::Double))++actionFileBrowserListHalfPageDown :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListHalfPageDown =+    zoom fileBrowserEntriesL (listMoveByPages (0.5::Double))++actionFileBrowserListTop :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListTop =+    fileBrowserEntriesL %= listMoveTo 0++actionFileBrowserListBottom :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListBottom = do+    b <- get+    let sz = length (listElements $ b^.fileBrowserEntriesL)+    fileBrowserEntriesL %= listMoveTo (sz - 1)++actionFileBrowserListNext :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListNext =+    fileBrowserEntriesL %= listMoveBy 1++actionFileBrowserListPrev :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPrev =+    fileBrowserEntriesL %= listMoveBy (-1)++handleFileBrowserEvent :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEvent e = do+    b <- get+    if fileBrowserIsSearching 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 -> EventM n (FileBrowser n) ()+handleFileBrowserEventSearching e =+    case e of+        Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl] ->+            modify $ updateFileBrowserSearch (const Nothing)+        Vty.EvKey Vty.KEsc [] ->+            modify $ updateFileBrowserSearch (const Nothing)+        Vty.EvKey Vty.KBS [] ->+            modify $ updateFileBrowserSearch (fmap safeInit)+        Vty.EvKey Vty.KEnter [] -> do+            maybeSelectCurrentEntry+            modify $ updateFileBrowserSearch (const Nothing)+        Vty.EvKey (Vty.KChar c) [] ->+            modify $ updateFileBrowserSearch (fmap (flip T.snoc c))+        _ ->+            handleFileBrowserEventCommon e++handleFileBrowserEventNormal :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventNormal e =+    case e of+        Vty.EvKey (Vty.KChar '/') [] ->+            -- Begin file search+            actionFileBrowserBeginSearch+        Vty.EvKey Vty.KEnter [] ->+            -- Select file or enter directory+            actionFileBrowserSelectEnter+        Vty.EvKey (Vty.KChar ' ') [] ->+            -- Toggle selected status of current entry+            actionFileBrowserToggleCurrent+        _ ->+            handleFileBrowserEventCommon e++handleFileBrowserEventCommon :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventCommon e =+    case e of+        Vty.EvKey (Vty.KChar 'b') [Vty.MCtrl] ->+            actionFileBrowserListPageUp+        Vty.EvKey (Vty.KChar 'f') [Vty.MCtrl] ->+            actionFileBrowserListPageDown+        Vty.EvKey (Vty.KChar 'd') [Vty.MCtrl] ->+            actionFileBrowserListHalfPageDown+        Vty.EvKey (Vty.KChar 'u') [Vty.MCtrl] ->+            actionFileBrowserListHalfPageUp+        Vty.EvKey (Vty.KChar 'g') [] ->+            actionFileBrowserListTop+        Vty.EvKey (Vty.KChar 'G') [] ->+            actionFileBrowserListBottom+        Vty.EvKey (Vty.KChar 'j') [] ->+            actionFileBrowserListNext+        Vty.EvKey (Vty.KChar 'k') [] ->+            actionFileBrowserListPrev+        Vty.EvKey (Vty.KChar 'n') [Vty.MCtrl] ->+            actionFileBrowserListNext+        Vty.EvKey (Vty.KChar 'p') [Vty.MCtrl] ->+            actionFileBrowserListPrev+        _ ->+            zoom fileBrowserEntriesL $ handleListEvent e++toggleSelected :: FileInfo -> EventM n (FileBrowser n) ()+toggleSelected e = do+    sel <- fileBrowserIsSelected e+    if sel+       then fileBrowserRemoveSelected e+       else fileBrowserAddSelected e++fileBrowserIsSelected :: FileInfo -> EventM n (FileBrowser n) Bool+fileBrowserIsSelected e = do+    fs <- use fileBrowserSelectedFilesL+    let fName = fileInfoFilename e+    return $ Set.member fName fs++fileBrowserAddSelected :: FileInfo -> EventM n (FileBrowser n) ()+fileBrowserAddSelected e = do+    let fName = fileInfoFilename e+    fileBrowserSelectedFilesL %= Set.insert fName++fileBrowserRemoveSelected :: FileInfo -> EventM n (FileBrowser n) ()+fileBrowserRemoveSelected e = do+    let fName = fileInfoFilename e+    fileBrowserSelectedFilesL %= Set.delete fName++-- | If the browser's current entry is selectable according to+-- @fileBrowserSelectable@, add it to the selection set and return.+-- If not, and if the entry is a directory or a symlink targeting a+-- directory, set the browser's current path to the selected directory.+--+-- Otherwise, return the browser state unchanged.+maybeSelectCurrentEntry :: EventM n (FileBrowser n) ()+maybeSelectCurrentEntry = do+    b <- get+    for_ (fileBrowserCursor b) $ \entry ->+        if fileBrowserSelectable b entry+        then fileBrowserAddSelected entry+        else when (selectDirectories entry) $+            put =<< liftIO (setWorkingDirectory (fileInfoFilePath entry) b)++selectCurrentEntry :: EventM n (FileBrowser n) ()+selectCurrentEntry = do+    b <- get+    for_ (fileBrowserCursor b) $ \entry ->+        when (fileBrowserSelectable b entry) $+            fileBrowserAddSelected entry++toggleCurrentEntrySelected :: EventM n (FileBrowser n) ()+toggleCurrentEntrySelected = do+    b <- get+    for_ (fileBrowserCursor b) $ \entry ->+        when (fileBrowserSelectable b entry) $+            toggleSelected entry++-- | Render a file browser. This renders a list of entries in the+-- working directory, a cursor to select from among the entries, a+-- header displaying the working directory, and a footer displaying+-- information about the selected entry.+--+-- Note that if the most recent file browser operation produced an+-- exception in 'fileBrowserException', that exception is not rendered+-- by this function. That exception needs to be rendered (if at all) by+-- the calling application.+--+-- The file browser is greedy in both dimensions.+renderFileBrowser :: (Show n, Ord n)+                  => Bool+                  -- ^ Whether the file browser has input focus.+                  -> FileBrowser n+                  -- ^ The browser to render.+                  -> Widget n+renderFileBrowser foc b =+    let maxFilenameLength = maximum $ length . fileInfoFilename <$> (b^.fileBrowserEntriesL)+        cwdHeader = padRight Max $+                    str $ sanitizeFilename $ fileBrowserWorkingDirectory b+        selInfo = case listSelectedElement (b^.fileBrowserEntriesL) of+            Nothing -> vLimit 1 $ fill ' '+            Just (_, i) -> padRight Max $ selInfoFor i+        fileTypeLabel Nothing = "unknown"+        fileTypeLabel (Just t) =+            case t of+                RegularFile -> "file"+                BlockDevice -> "block device"+                CharacterDevice -> "character device"+                NamedPipe -> "pipe"+                Directory -> "directory"+                SymbolicLink -> "symbolic link"+                UnixSocket -> "socket"+        selInfoFor i =+            let label = case fileInfoFileStatus i of+                    Left _ -> "unknown"+                    Right stat ->+                        let maybeSize = if fileStatusFileType stat == Just RegularFile+                                        then ", " <> prettyFileSize (fileStatusSize stat)+                                        else ""+                        in fileTypeLabel (fileStatusFileType stat) <> maybeSize+            in txt $ T.pack (fileInfoSanitizedFilename i) <> ": " <> label++        maybeSearchInfo = case b^.fileBrowserSearchStringL of+            Nothing -> emptyWidget+            Just s -> padRight Max $+                      txt "Search: " <+>+                      showCursor (b^.fileBrowserNameL) (Location (T.length s, 0)) (txt s)++    in withDefAttr fileBrowserAttr $+       vBox [ withDefAttr fileBrowserCurrentDirectoryAttr cwdHeader+            , renderList (renderFileInfo foc maxFilenameLength (b^.fileBrowserSelectedFilesL) (b^.fileBrowserNameL))+                         foc (b^.fileBrowserEntriesL)+            , maybeSearchInfo+            , withDefAttr fileBrowserSelectionInfoAttr selInfo+            ]++renderFileInfo :: Bool -> Int -> Set.Set String -> n -> Bool -> FileInfo -> Widget n+renderFileInfo foc maxLen selFiles n listSel info =+    (if foc+     then (if listSel then forceAttr listSelectedFocusedAttr+               else if sel then forceAttr fileBrowserSelectedAttr else id)+     else (if listSel then forceAttr listSelectedAttr+               else if sel then forceAttr fileBrowserSelectedAttr else id)) $+    padRight Max body+    where+        sel = fileInfoFilename info `Set.member` selFiles+        addAttr = maybe id (withDefAttr . attrForFileType) (fileInfoFileType info)+        body = addAttr (hLimit (maxLen + 1) $+               padRight Max $+               (if foc && listSel then putCursor n (Location (0,0)) else id) $+               str $ fileInfoSanitizedFilename info <> suffix)+        suffix = (if fileInfoFileType info == Just Directory then "/" else "") <>+                 (if sel then "*" else "")++-- | Sanitize a filename for terminal display, replacing non-printable+-- characters with '?'.+sanitizeFilename :: String -> String+sanitizeFilename = fmap toPrint+    where+        toPrint c | isPrint c = c+                  | otherwise = '?'++attrForFileType :: FileType -> AttrName+attrForFileType RegularFile = fileBrowserRegularFileAttr+attrForFileType BlockDevice = fileBrowserBlockDeviceAttr+attrForFileType CharacterDevice = fileBrowserCharacterDeviceAttr+attrForFileType NamedPipe = fileBrowserNamedPipeAttr+attrForFileType Directory = fileBrowserDirectoryAttr+attrForFileType SymbolicLink = fileBrowserSymbolicLinkAttr+attrForFileType UnixSocket = fileBrowserUnixSocketAttr++-- | The base attribute for all file browser attributes.+fileBrowserAttr :: AttrName+fileBrowserAttr = attrName "fileBrowser"++-- | The attribute used for the current directory displayed at the top+-- of the browser.+fileBrowserCurrentDirectoryAttr :: AttrName+fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> attrName "currentDirectory"++-- | The attribute used for the entry information displayed at the+-- bottom of the browser.+fileBrowserSelectionInfoAttr :: AttrName+fileBrowserSelectionInfoAttr = fileBrowserAttr <> attrName "selectionInfo"++-- | The attribute used to render directory entries.+fileBrowserDirectoryAttr :: AttrName+fileBrowserDirectoryAttr = fileBrowserAttr <> attrName "directory"++-- | The attribute used to render block device entries.+fileBrowserBlockDeviceAttr :: AttrName+fileBrowserBlockDeviceAttr = fileBrowserAttr <> attrName "block"++-- | The attribute used to render regular file entries.+fileBrowserRegularFileAttr :: AttrName+fileBrowserRegularFileAttr = fileBrowserAttr <> attrName "regular"++-- | The attribute used to render character device entries.+fileBrowserCharacterDeviceAttr :: AttrName+fileBrowserCharacterDeviceAttr = fileBrowserAttr <> attrName "char"++-- | The attribute used to render named pipe entries.+fileBrowserNamedPipeAttr :: AttrName+fileBrowserNamedPipeAttr = fileBrowserAttr <> attrName "pipe"++-- | The attribute used to render symbolic link entries.+fileBrowserSymbolicLinkAttr :: AttrName+fileBrowserSymbolicLinkAttr = fileBrowserAttr <> attrName "symlink"++-- | The attribute used to render Unix socket entries.+fileBrowserUnixSocketAttr :: AttrName+fileBrowserUnixSocketAttr = fileBrowserAttr <> attrName "unixSocket"++-- | The attribute used for selected entries in the file browser.+fileBrowserSelectedAttr :: AttrName+fileBrowserSelectedAttr = fileBrowserAttr <> attrName "selected"++-- | A file type filter for use with 'setFileBrowserEntryFilter'. This+-- filter permits entries whose file types are in the specified list.+fileTypeMatch :: [FileType] -> FileInfo -> Bool+fileTypeMatch tys i = maybe False (`elem` tys) $ fileInfoFileType i++-- | A filter that matches any directory regardless of name, or any+-- regular file with the specified extension. For example, an extension+-- argument of @"xml"@ would match regular files @test.xml@ and+-- @TEST.XML@ and it will match directories regardless of name.+--+-- This matcher also matches symlinks if and only if their targets are+-- directories. This is intended to make it possible to use this matcher+-- to find files with certain extensions, but also support directory+-- traversal via symlinks.+fileExtensionMatch :: String -> FileInfo -> Bool+fileExtensionMatch ext i = case fileInfoFileType i of+    Just Directory -> True+    Just RegularFile -> ('.' : (toLower <$> ext)) `isSuffixOf` (toLower <$> fileInfoFilename i)+    Just SymbolicLink -> case fileInfoLinkTargetType i of+        Just Directory -> True+        _ -> False+    _ -> False
src/Brick/Widgets/Internal.hs view
@@ -3,42 +3,80 @@   ( renderFinal   , cropToContext   , cropResultToContext+  , renderDynBorder+  , renderWidget   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif--import Lens.Micro ((^.), (&), (%~))-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader-import Data.Maybe (catMaybes)+import Lens.Micro ((^.), (&), (%~), (.~))+import Lens.Micro.Mtl ((%=))+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader+import Data.Maybe (fromMaybe, mapMaybe)+import qualified Data.Map as M+import qualified Data.Set as S import qualified Graphics.Vty as V  import Brick.Types import Brick.Types.Internal import Brick.AttrMap import Brick.Widgets.Border.Style+import Brick.BorderMap (BorderMap)+import qualified Brick.BorderMap as BM -renderFinal :: AttrMap+renderFinal :: (Ord n)+            => AttrMap             -> [Widget n]             -> V.DisplayRegion             -> ([CursorLocation n] -> Maybe (CursorLocation n))             -> RenderState n             -> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n])-renderFinal aMap layerRenders sz chooseCursor rs = (newRS, picWithBg, theCursor, concat layerExtents)+renderFinal aMap layerRenders (w, h) chooseCursor rs =+    (newRS, picWithBg, theCursor, concat layerExtents)     where-        (layerResults, !newRS) = flip runState rs $ sequence $+        -- Reset various fields from the last rendering state so they+        -- don't accumulate or affect this rendering.+        resetRs = rs & reportedExtentsL .~ mempty+                     & observedNamesL .~ mempty+                     & clickableNamesL .~ mempty++        (layerResults, !newRS) = flip runState resetRs $ sequence $             (\p -> runReaderT p ctx) <$>-            (render <$> cropToContext <$> layerRenders)-        ctx = Context mempty (fst sz) (snd sz) defaultBorderStyle aMap-        pic = V.picForLayers $ uncurry V.resize sz <$> (^.imageL) <$> layerResults+            (\layerWidget -> do+                result <- render $ cropToContext layerWidget+                forM_ (result^.extentsL) $ \e ->+                    reportedExtentsL %= M.insert (extentName e) e+                return result+                ) <$> reverse layerRenders++        ctx = Context { ctxAttrName = mempty+                      , availWidth = w+                      , availHeight = h+                      , windowWidth = w+                      , windowHeight = h+                      , ctxBorderStyle = defaultBorderStyle+                      , ctxAttrMap = aMap+                      , ctxDynBorders = False+                      , ctxVScrollBarOrientation = Nothing+                      , ctxVScrollBarRenderer = Nothing+                      , ctxHScrollBarOrientation = Nothing+                      , ctxHScrollBarRenderer = Nothing+                      , ctxHScrollBarShowHandles = False+                      , ctxVScrollBarShowHandles = False+                      , ctxHScrollBarClickableConstr = Nothing+                      , ctxVScrollBarClickableConstr = Nothing+                      }++        layersTopmostFirst = reverse layerResults+        pic = V.picForLayers $ V.resize w h <$> (^.imageL) <$> layersTopmostFirst+         -- picWithBg is a workaround for runaway attributes.         -- See https://github.com/coreyoconnor/vty/issues/95         picWithBg = pic { V.picBackground = V.Background ' ' V.defAttr }-        layerCursors = (^.cursorsL) <$> layerResults-        layerExtents = reverse $ (^.extentsL) <$> layerResults++        layerCursors = (^.cursorsL) <$> layersTopmostFirst+        layerExtents = reverse $ (^.extentsL) <$> layersTopmostFirst         theCursor = chooseCursor $ concat layerCursors  -- | After rendering the specified widget, crop its result image to the@@ -53,12 +91,13 @@     return $ result & imageL   %~ cropImage   c                     & cursorsL %~ cropCursors c                     & extentsL %~ cropExtents c+                    & bordersL %~ cropBorders c -cropImage :: Context -> V.Image -> V.Image+cropImage :: Context n -> V.Image -> V.Image cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL) -cropCursors :: Context -> [CursorLocation n] -> [CursorLocation n]-cropCursors ctx cs = catMaybes $ cropCursor <$> cs+cropCursors :: Context n -> [CursorLocation n] -> [CursorLocation n]+cropCursors ctx cs = mapMaybe cropCursor cs     where         -- A cursor location is removed if it is not within the region         -- described by the context.@@ -71,37 +110,90 @@                , c^.cursorLocationL.locationColumnL >= ctx^.availWidthL                ] -cropExtents :: Context -> [Extent n] -> [Extent n]-cropExtents ctx es = catMaybes $ cropExtent <$> es+cropExtents :: Context n -> [Extent n] -> [Extent n]+cropExtents ctx es = mapMaybe cropExtent es     where-        -- An extent is cropped in places where it is not within the-        -- region described by the context.-        ---        -- If its entirety is outside the context region, it is dropped.-        ---        -- Otherwise its size and upper left corner are adjusted so that-        -- they are contained within the context region.-        cropExtent (Extent n (Location (c, r)) (w, h) (Location (oC, oR))) =-            -- First, clamp the upper-left corner to at least (0, 0).-            let c' = max c 0-                r' = max r 0-                -- Compute deltas for the offset since if the upper-left-                -- corner moved, so should the offset.-                dc = c' - c-                dr = r' - r-                -- Then, determine the new lower-right corner based on-                -- the clamped corner.-                endCol = c' + w-                endRow = r' + h-                -- Then clamp the lower-right corner based on the-                -- context-                endCol' = min (ctx^.availWidthL) endCol-                endRow' = min (ctx^.availHeightL) endRow-                -- Then compute the new width and height from the-                -- clamped lower-right corner.-                w' = endCol' - c'-                h' = endRow' - r'-                e = Extent n (Location (c', r')) (w', h') (Location (oC + dc, oR + dr))-            in if w' < 0 || h' < 0-               then Nothing-               else Just e+        cropExtent (Extent n (Location (c, r)) (w, h)) =+            -- Clamp the original extent's UL corner to the context.+            --+            -- Clamp the original extent's LR corner to the context.+            --+            -- Keep the modified extent (i.e. with clamped corners)+            -- only if the resulting extent has non-zero size in both+            -- dimensions.+            let nonEmpty = nonEmptyH && nonEmptyV+                nonEmptyH = newWidth > 0+                nonEmptyV = newHeight > 0+                newWidth = newEndCol - newStartCol+                newHeight = newEndRow - newStartRow+                (newStartCol, newStartRow) = clampCorner (c, r)+                (newEndCol, newEndRow) = clampCorner (c + w, r + h)+                clampCorner (cols, rows) =+                    ( clampRange (ctx^.availWidthL) cols+                    , clampRange (ctx^.availHeightL) rows+                    )+                clampRange bound val =+                    min bound $ max 0 val+                newExtent = Extent n (Location (newStartCol, newStartRow)) (newWidth, newHeight)+            in if nonEmpty+               then Just newExtent+               else Nothing++cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder+cropBorders ctx = BM.crop Edges+    { eTop = 0+    , eBottom = availHeight ctx - 1+    , eLeft = 0+    , eRight = availWidth ctx - 1+    }++renderDynBorder :: DynBorder -> V.Image+renderDynBorder db = V.char (dbAttr db) $ getBorderChar $ dbStyle db+    where+        getBorderChar = case bsDraw <$> dbSegments db of+            --    top   bot   left  right+            Edges False False False False -> const ' '+            Edges False False _     _     -> bsHorizontal+            Edges _     _     False False -> bsVertical+            Edges False True  False True  -> bsCornerTL+            Edges False True  True  False -> bsCornerTR+            Edges True  False False True  -> bsCornerBL+            Edges True  False True  False -> bsCornerBR+            Edges False True  True  True  -> bsIntersectT+            Edges True  False True  True  -> bsIntersectB+            Edges True  True  False True  -> bsIntersectL+            Edges True  True  True  False -> bsIntersectR+            Edges True  True  True  True  -> bsIntersectFull++-- | This function provides a simplified interface to rendering a list+-- of 'Widget's as a 'V.Picture' outside of the context of an 'App'.+-- This can be useful in a testing setting but isn't intended to be used+-- for normal application rendering. The API is deliberately narrower+-- than the main interactive API and is not yet stable. Use at your own+-- risk.+--+-- Consult the [Vty library documentation](https://hackage.haskell.org/package/vty)+-- for details on how to output the resulting 'V.Picture'.+renderWidget :: (Ord n)+             => Maybe AttrMap+             -- ^ Optional attribute map used to render. If omitted,+             -- an empty attribute map with the terminal's default+             -- attribute will be used.+             -> [Widget n]+             -- ^ The widget layers to render, topmost first.+             -> V.DisplayRegion+             -- ^ The size of the display region in which to render the+             -- layers.+             -> V.Picture+renderWidget mAttrMap layerRenders region = pic+    where+        initialRS = RS { viewportMap = M.empty+                       , rsScrollRequests = []+                       , observedNames = S.empty+                       , renderCache = mempty+                       , clickableNames = []+                       , requestedVisibleNames_ = S.empty+                       , reportedExtents = mempty+                       }+        am = fromMaybe (attrMap V.defAttr []) mAttrMap+        (_, pic, _, _) = renderFinal am layerRenders region (const Nothing) initialRS
src/Brick/Widgets/List.hs view
@@ -1,62 +1,100 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable#-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-} -- | This module provides a scrollable list type and functions for -- manipulating and rendering it.+--+-- Note that lenses are provided for direct manipulation purposes, but+-- lenses are *not* safe and should be used with care. (For example,+-- 'listElementsL' permits direct manipulation of the list container+-- without performing bounds checking on the selected index.) If you+-- need a safe API, consider one of the various functions for list+-- manipulation. For example, instead of 'listElementsL', consider+-- 'listReplace'. module Brick.Widgets.List-  ( List(listElements, listSelected, listName, listItemHeight)+  ( GenericList+  , List    -- * Constructing a list   , list    -- * Rendering a list   , renderList+  , renderListWithIndex    -- * Handling events   , handleListEvent+  , handleListEventVi    -- * Lenses   , listElementsL   , listSelectedL   , listNameL   , listItemHeightL+  , listSelectedElementL +  -- * Accessors+  , listElements+  , listName+  , listSelectedElement+  , listSelected+  , listItemHeight+   -- * Manipulating a list   , listMoveBy   , listMoveTo+  , listMoveToElement+  , listFindBy   , listMoveUp   , listMoveDown+  , listMoveByPages+  , listMovePageUp+  , listMovePageDown+  , listMoveToBeginning+  , listMoveToEnd   , listInsert   , listRemove   , listReplace-  , listSelectedElement   , listClear   , listReverse   , listModify +  -- * Querying a list+  , listFindFirst+   -- * Attributes   , listAttr   , listSelectedAttr   , listSelectedFocusedAttr++  -- * Classes+  , Splittable(..)+  , Reversible(..)   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>),(<*>),pure)-import Data.Foldable (Foldable)-import Data.Traversable (Traversable)-#endif+import Prelude hiding (reverse, splitAt) -import Lens.Micro ((^.), (&), (.~), (%~), _2)+import Control.Applicative ((<|>))+import Data.Foldable (find, toList)+import Control.Monad.State (evalState)++import Lens.Micro (Traversal', (^.), (^?), (&), (.~), (%~), _2, set)+import Data.Functor (($>))+import Data.List.NonEmpty (NonEmpty((:|))) import Data.Maybe (fromMaybe)-import Data.Monoid ((<>))-import Graphics.Vty (Event(..), Key(..))+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup, (<>))+#endif+import Data.Semigroup (sconcat)+import qualified Data.Sequence as Seq+import Graphics.Vty (Event(..), Key(..), Modifier(..)) import qualified Data.Vector as V+import GHC.Generics (Generic)  import Brick.Types import Brick.Main (lookupViewport)@@ -64,101 +102,257 @@ import Brick.Util (clamp) import Brick.AttrMap --- | List state. Lists have an element type 'e' that is the data stored--- by the list.  Lists handle the following events by default:+-- | List state. Lists have a container @t@ of element type @e@ that is+-- the data stored by the list. Internally, Lists handle the following+-- events by default: -- -- * Up/down arrow keys: move cursor of selected item -- * Page up / page down keys: move cursor of selected item by one page --   at a time (based on the number of items shown) -- * Home/end keys: move cursor of selected item to beginning or end of --   list-data List n e =-    List { listElements :: !(V.Vector e)+--+-- The 'List' type synonym fixes @t@ to 'V.Vector' for compatibility+-- with previous versions of this library.+--+-- For a container type to be usable with 'GenericList', it must have+-- instances of 'Traversable' and 'Splittable'. The following functions+-- impose further constraints:+--+-- * 'listInsert': 'Applicative' and 'Semigroup'+-- * 'listRemove': 'Semigroup'+-- * 'listClear': 'Monoid'+-- * 'listReverse': 'Reversible'+--+data GenericList n t e =+    List { listElements :: !(t e)+         -- ^ The list's sequence of elements.          , listSelected :: !(Maybe Int)+         -- ^ The list's selected element index, if any.          , listName :: n+         -- ^ The list's name.          , listItemHeight :: Int-         } deriving (Functor, Foldable, Traversable, Show)+         -- ^ The height of an individual item in the list.+         } deriving (Functor, Foldable, Traversable, Show, Generic) -suffixLenses ''List+suffixLenses ''GenericList -instance Named (List n e) n where+-- | An alias for 'GenericList' specialized to use a 'Vector' as its+-- container type.+type List n e = GenericList n V.Vector e++instance Named (GenericList n t e) n where     getName = listName -handleListEvent :: (Ord n) => Event -> List n e -> EventM n (List n e)-handleListEvent e theList =+-- | Ordered container types that can be split at a given index. An+-- instance of this class is required for a container type to be usable+-- with 'GenericList'.+class Splittable t where+    {-# MINIMAL splitAt #-}++    -- | Split at the given index. Equivalent to @(take n xs, drop n xs)@+    -- and therefore total.+    splitAt :: Int -> t a -> (t a, t a)++    -- | Slice the structure. Equivalent to @(take n . drop i) xs@ and+    -- therefore total.+    --+    -- The default implementation applies 'splitAt' two times: first to+    -- drop elements leading up to the slice, and again to drop elements+    -- after the slice.+    slice :: Int {- ^ start index -} -> Int {- ^ length -} -> t a -> t a+    slice i n = fst . splitAt n . snd . splitAt i++-- | /O(1)/ 'splitAt'.+instance Splittable V.Vector where+    splitAt = V.splitAt++-- | /O(log(min(i,n-i)))/ 'splitAt'.+instance Splittable Seq.Seq where+    splitAt = Seq.splitAt++-- | Ordered container types where the order of elements can be+-- reversed. Only required if you want to use 'listReverse'.+class Reversible t where+    {-# MINIMAL reverse #-}+    reverse :: t a -> t a++-- | /O(n)/ 'reverse'+instance Reversible V.Vector where+  reverse = V.reverse++-- | /O(n)/ 'reverse'+instance Reversible Seq.Seq where+  reverse = Seq.reverse++-- | Handle events for list cursor movement.  Events handled are:+--+-- * Up (up arrow key)+-- * Down (down arrow key)+-- * Page Up (PgUp)+-- * Page Down (PgDown)+-- * Go to first element (Home)+-- * Go to last element (End)+handleListEvent :: (Foldable t, Splittable t, Ord n)+                => Event+                -> EventM n (GenericList n t e) ()+handleListEvent e =     case e of-        EvKey KUp [] -> return $ listMoveUp theList-        EvKey KDown [] -> return $ listMoveDown theList-        EvKey KHome [] -> return $ listMoveTo 0 theList-        EvKey KEnd [] -> return $ listMoveTo (V.length $ listElements theList) theList-        EvKey KPageDown [] -> do-            v <- lookupViewport (theList^.listNameL)-            case v of-                Nothing -> return theList-                Just vp -> return $ listMoveBy (vp^.vpSize._2 `div` theList^.listItemHeightL) theList-        EvKey KPageUp [] -> do-            v <- lookupViewport (theList^.listNameL)-            case v of-                Nothing -> return theList-                Just vp -> return $ listMoveBy (negate $ vp^.vpSize._2 `div` theList^.listItemHeightL) 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' in place of 'handleListEvent'+-- to add the vi keys bindings to the standard ones. Movements handled+-- include:+--+-- * Up (k)+-- * Down (j)+-- * Page Up (Ctrl-b)+-- * Page Down (Ctrl-f)+-- * Half Page Up (Ctrl-u)+-- * Half Page Down (Ctrl-d)+-- * Go to first element (g)+-- * Go to last element (G)+handleListEventVi :: (Foldable t, Splittable t, Ord n)+                  => (Event -> EventM n (GenericList n t e) ())+                  -- ^ Fallback event handler to use if none of the vi keys+                  -- match.+                  -> Event+                  -> EventM n (GenericList n t e) ()+handleListEventVi fallback e =+    case e of+        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)+                    => GenericList n t e+                    -> GenericList n t e+listMoveToBeginning = listMoveTo 0++-- | Move the list selection to the last element in the list.+listMoveToEnd :: (Foldable t, Splittable t)+              => GenericList n t e+              -> GenericList n t e+listMoveToEnd l = listMoveTo (max 0 $ length (listElements l) - 1) l+ -- | 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 an element type 'e'.-list :: n+-- | Construct a list in terms of container 't' with element type 'e'.+list :: (Foldable t)+     => n      -- ^ The list name (must be unique)-     -> V.Vector e+     -> t e      -- ^ The initial list contents      -> Int      -- ^ The list item height in rows (all list item widgets must be-     -- this high)-     -> List n e+     -- this high).+     -> GenericList n t e list name es h =-    let selIndex = if V.null es then Nothing else Just 0+    let selIndex = if null es then Nothing else Just 0         safeHeight = max 1 h     in List es selIndex name safeHeight --- | Turn a list state value into a widget given an item drawing--- function.-renderList :: (Ord n, Show n)+-- | Render a list using the specified item drawing function.+--+-- Evaluates the underlying container up to, and a bit beyond, the+-- selected element. The exact amount depends on available height+-- for drawing and 'listItemHeight'. At most, it will evaluate up to+-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the+-- available height.+--+-- Note that this function renders the list with the 'listAttr' as+-- the default attribute and then uses 'listSelectedAttr' as the+-- default attribute for the selected item if the list is not focused+-- or 'listSelectedFocusedAttr' otherwise. This is provided as a+-- convenience so that the item rendering function doesn't have to be+-- concerned with attributes, but if those attributes are undesirable+-- for your purposes, 'forceAttr' can always be used by the item+-- rendering function to ensure that another attribute is used instead.+renderList :: (Traversable t, Splittable t, Ord n, Show n)            => (Bool -> e -> Widget n)            -- ^ Rendering function, True for the selected element            -> Bool            -- ^ Whether the list has focus-           -> List n e+           -> GenericList n t e            -- ^ The List to be rendered            -> Widget n            -- ^ rendered widget-renderList drawElem foc l =+renderList drawElem = renderListWithIndex $ const drawElem++-- | Like 'renderList', except the render function is also provided with+-- the index of each element.+--+-- Has the same evaluation characteristics as 'renderList'.+renderListWithIndex :: (Traversable t, Splittable t, Ord n, Show n)+                    => (Int -> Bool -> e -> Widget n)+                    -- ^ Rendering function, taking index, and True for+                    -- the selected element+                    -> Bool+                    -- ^ Whether the list has focus+                    -> GenericList n t e+                    -- ^ The List to be rendered+                    -> Widget n+                    -- ^ rendered widget+renderListWithIndex drawElem foc l =     withDefAttr listAttr $     drawListElements foc l drawElem -drawListElements :: (Ord n, Show n) => Bool -> List n e -> (Bool -> e -> Widget n) -> Widget n+imap :: (Traversable t) => (Int -> a -> b) -> t a -> t b+imap f xs =+    let act = traverse (\a -> get >>= \i -> put (i + 1) $> f i a) xs+    in evalState act 0++-- | Draws the list elements.+--+-- Evaluates the underlying container up to, and a bit beyond, the+-- selected element. The exact amount depends on available height+-- for drawing and 'listItemHeight'. At most, it will evaluate up to+-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the+-- available height.+drawListElements :: (Traversable t, Splittable t, Ord n, Show n)+                 => Bool+                 -> GenericList n t e+                 -> (Int -> Bool -> e -> Widget n)+                 -> Widget n drawListElements foc l drawElem =     Widget Greedy Greedy $ do         c <- getContext -        let es = V.slice start num (l^.listElementsL)+        -- Take (numPerHeight * 2) elements, or whatever is left+        let es = slice start (numPerHeight * 2) (l^.listElementsL)+             idx = fromMaybe 0 (l^.listSelectedL)              start = max 0 $ idx - numPerHeight + 1-            num = min (numPerHeight * 2) (V.length (l^.listElementsL) - start) -            -- The number of items to show is the available height divided by-            -- the item height...+            -- The number of items to show is the available height+            -- divided by the item height...             initialNumPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL)             -- ... but if the available height leaves a remainder of             -- an item height then we need to ensure that we render an@@ -175,9 +369,10 @@              off = start * (l^.listItemHeightL) -            drawnElements = flip V.imap es $ \i e ->-                let isSelected = Just (i + start) == l^.listSelectedL-                    elemWidget = drawElem isSelected e+            drawnElements = flip imap es $ \i e ->+                let j = i + start+                    isSelected = Just j == l^.listSelectedL+                    elemWidget = drawElem j isSelected e                     selItemAttr = if foc                                   then withDefAttr listSelectedFocusedAttr                                   else withDefAttr listSelectedAttr@@ -188,105 +383,312 @@          render $ viewport (l^.listNameL) Vertical $                  translateBy (Location (0, off)) $-                 vBox $ V.toList drawnElements+                 vBox $ toList drawnElements  -- | Insert an item into a list at the specified position.-listInsert :: Int+--+-- Complexity: the worse of 'splitAt' and `<>` for the container type.+--+-- @+-- listInsert for 'List': O(n)+-- listInsert for 'Seq.Seq': O(log(min(i, length n - i)))+-- @+listInsert :: (Splittable t, Applicative t, Semigroup (t e))+           => Int            -- ^ The position at which to insert (0 <= i <= size)            -> e            -- ^ The element to insert-           -> List n e-           -> List n e+           -> GenericList n t e+           -> GenericList n t e listInsert pos e l =-    let safePos = clamp 0 (V.length es) pos-        es = l^.listElementsL+    let es = l^.listElementsL         newSel = case l^.listSelectedL of-          Nothing -> 0-          Just s -> if safePos <= s-                    then s + 1-                    else s-        (front, back) = V.splitAt safePos es+            Nothing -> 0+            Just s -> if pos <= s+                      then s + 1+                      else s+        (front, back) = splitAt pos es     in l & listSelectedL .~ Just newSel-         & listElementsL .~ (front V.++ (e `V.cons` back))+         & listElementsL .~ sconcat (front :| [pure e, back])  -- | Remove an element from a list at the specified position.-listRemove :: Int-           -- ^ The position at which to remove an element (0 <= i < size)-           -> List n e-           -> List n e-listRemove pos l | V.null (l^.listElementsL) = l-                 | pos /= clamp 0 (V.length (l^.listElementsL) - 1) pos = l+--+-- Applies 'splitAt' two times: first to split the structure at the+-- given position, and again to remove the first element from the tail.+-- Consider the asymptotics of `splitAt` for the container type when+-- using this function.+--+-- Complexity: the worse of 'splitAt' and `<>` for the container type.+--+-- @+-- listRemove for 'List': O(n)+-- listRemove for 'Seq.Seq': O(log(min(i, n - i)))+-- @+listRemove :: (Splittable t, Foldable t, Semigroup (t e))+           => Int+           -- ^ The position at which to remove an element (0 <= i <+           -- size)+           -> GenericList n t e+           -> GenericList n t e+listRemove pos l | null l = l+                 | pos /= splitClamp l pos = l                  | otherwise =     let newSel = case l^.listSelectedL of-          Nothing -> 0-          Just s | pos == 0 -> 0-                 | pos == s -> pos - 1-                 | pos  < s -> s - 1-                 | otherwise -> s-        (front, back) = V.splitAt pos es-        es' = front V.++ V.tail back+            Nothing -> 0+            Just s | pos == 0 -> 0+                   | pos == s -> pos - 1+                   | pos  < s -> s - 1+                   | otherwise -> s+        (front, rest) = splitAt pos es+        (_, back) = splitAt 1 rest+        es' = front <> back         es = l^.listElementsL-    in l & listSelectedL .~ (if V.null es' then Nothing else Just newSel)+    in l & listSelectedL .~ (if null es' then Nothing else Just newSel)          & listElementsL .~ es'  -- | Replace the contents of a list with a new set of elements and--- update the new selected index. If the list is empty, empty selection is used--- instead. Otherwise, if the specified selected index (via 'Just') is not in--- the list bounds, zero is used instead.-listReplace :: V.Vector e -> Maybe Int -> List n e -> List n e+-- update the new selected index. If the list is empty, empty selection+-- is used instead. Otherwise, if the specified selected index (via+-- 'Just') is not in the list bounds, zero is used instead.+--+-- Complexity: same as 'splitAt' for the container type.+listReplace :: (Foldable t, Splittable t)+            => t e+            -> Maybe Int+            -> GenericList n t e+            -> GenericList n t e listReplace es idx l =-    let newSel = if V.null es then Nothing else clamp 0 (V.length es - 1) <$> idx-    in l & listSelectedL .~ newSel-         & listElementsL .~ es+    let l' = l & listElementsL .~ es+        newSel = if null es then Nothing else inBoundsOrZero <$> idx+        inBoundsOrZero i+            | i == splitClamp l' i = i+            | otherwise = 0+    in l' & listSelectedL .~ newSel  -- | Move the list selected index up by one. (Moves the cursor up, -- subtracts one from the index.)-listMoveUp :: List n e -> List n e+listMoveUp :: (Foldable t, Splittable t)+           => GenericList n t e+           -> GenericList n t e listMoveUp = listMoveBy (-1) +-- | Move the list selected index up by one page.+listMovePageUp :: (Foldable t, Splittable t, Ord n)+               => EventM n (GenericList n t e) ()+listMovePageUp = listMoveByPages (-1::Double)+ -- | Move the list selected index down by one. (Moves the cursor down, -- adds one to the index.)-listMoveDown :: List n e -> List n e+listMoveDown :: (Foldable t, Splittable t)+             => GenericList n t e+             -> GenericList n t e listMoveDown = listMoveBy 1 --- | Move the list selected index by the specified amount, subject to--- validation.-listMoveBy :: Int -> List n e -> List n e+-- | Move the list selected index down by one page.+listMovePageDown :: (Foldable t, Splittable t, Ord n)+                 => 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+                -> EventM n (GenericList n t e) ()+listMoveByPages pages = do+    theList <- get+    v <- lookupViewport (theList^.listNameL)+    case v of+        Nothing -> return ()+        Just vp -> do+            let nElems = round $ pages * fromIntegral (vp^.vpSize._2) /+                                 fromIntegral (theList^.listItemHeightL)+            modify $ listMoveBy nElems++-- | Move the list selected index.+--+-- If the current selection is @Just x@, the selection is adjusted by+-- the specified amount. The value is clamped to the extents of the list+-- (i.e. the selection does not "wrap").+--+-- If the current selection is @Nothing@ (i.e. there is no selection)+-- and the direction is positive, set to @Just 0@ (first element),+-- otherwise set to @Just (length - 1)@ (last element).+--+-- Complexity: same as 'splitAt' for the container type.+--+-- @+-- listMoveBy for 'List': O(1)+-- listMoveBy for 'Seq.Seq': O(log(min(i,n-i)))+-- @+listMoveBy :: (Foldable t, Splittable t)+           => Int+           -> GenericList n t e+           -> GenericList n t e listMoveBy amt l =-    let newSel = clamp 0 (V.length (l^.listElementsL) - 1) <$> (amt +) <$> (l^.listSelectedL)-    in l & listSelectedL .~ newSel+    let target = case l ^. listSelectedL of+            Nothing+                | amt > 0 -> 0+                | otherwise -> length l - 1+            Just i -> max 0 (amt + i)  -- don't be negative+    in listMoveTo target l  -- | Set the selected index for a list to the specified index, subject -- to validation.-listMoveTo :: Int -> List n e -> List n e+--+-- If @pos >= 0@, indexes from the start of the list (which gets+-- evaluated up to the target index)+--+-- If @pos < 0@, indexes from the end of the list (which evaluates+-- 'length' of the list).+--+-- Complexity: same as 'splitAt' for the container type.+--+-- @+-- listMoveTo for 'List': O(1)+-- listMoveTo for 'Seq.Seq': O(log(min(i,n-i)))+-- @+listMoveTo :: (Foldable t, Splittable t)+           => Int+           -> GenericList n t e+           -> GenericList n t e listMoveTo pos l =-    let len = V.length (l^.listElementsL)-        newSel = clamp 0 (len - 1) $ if pos < 0 then len - pos else pos-    in l & listSelectedL .~ if len > 0-                            then Just newSel-                            else Nothing+    let len = length l+        i = if pos < 0 then len - pos else pos+        newSel = splitClamp l i+    in l & listSelectedL .~ if null l then Nothing else Just newSel +-- | Split-based clamp that avoids evaluating 'length' of the structure+-- (unless the structure is already fully evaluated).+splitClamp :: (Foldable t, Splittable t) => GenericList n t e -> Int -> Int+splitClamp l i =+    let (_, t) = splitAt i (l ^. listElementsL)  -- split at i+    in+        -- If the tail is empty, then the requested index is not in the+        -- list. And because we have already seen the end of the list,+        -- using 'length' will not force unwanted computation.+        --+        -- Otherwise if tail is not empty, then we already know that i+        -- is in the list, so we don't need to know the length+        clamp 0 (if null t then length l - 1 else i) i++-- | Set the selected index for a list to the index of the first+-- occurrence of the specified element if it is in the list, or leave+-- the list unmodified otherwise.+--+-- /O(n)/.  Only evaluates as much of the container as needed.+listMoveToElement :: (Eq e, Foldable t, Splittable t)+                  => e+                  -> GenericList n t e+                  -> GenericList n t e+listMoveToElement e = listFindBy (== e) . set listSelectedL Nothing++-- | Find the first element in the list that satisfies the specified+-- predicate. If such an element is found, return the resulting index+-- and element.+--+-- /O(n)/.+listFindFirst :: (Semigroup (t e), Splittable t, Traversable t)+              => (e -> Bool)+              -> GenericList n t e+              -> Maybe (Int, e)+listFindFirst f l =+    listSelectedElement $+    listFindBy f $+    set listSelectedL Nothing l++-- | Starting from the currently-selected position, attempt to find+-- and select the next element matching the predicate. If there are no+-- matches for the remainder of the list or if the list has no selection+-- at all, the search starts at the beginning. If no matching element is+-- found anywhere in the list, leave the list unmodified.+--+-- /O(n)/.  Only evaluates as much of the container as needed.+listFindBy :: (Foldable t, Splittable t)+           => (e -> Bool)+           -> GenericList n t e+           -> GenericList n t e+listFindBy test l =+    let start = maybe 0 (+1) (l ^. listSelectedL)+        (h, t) = splitAt start (l ^. listElementsL)+        tailResult = find (test . snd) . zip [start..] . toList $ t+        headResult = find (test . snd) . zip [0..] . toList $ h+        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.-listSelectedElement :: List n e -> Maybe (Int, e)-listSelectedElement l = do-  sel <- l^.listSelectedL-  return (sel, (l^.listElementsL) V.! sel)+--+-- Only evaluates as much of the container as needed.+--+-- Complexity: same as 'splitAt' for the container type.+--+-- @+-- listSelectedElement for 'List': O(1)+-- listSelectedElement for 'Seq.Seq': O(log(min(i, n - i)))+-- @+listSelectedElement :: (Splittable t, Traversable t, Semigroup (t e))+                    => GenericList n t e+                    -> Maybe (Int, e)+listSelectedElement l =+    (,) <$> l^.listSelectedL <*> l^?listSelectedElementL  -- | Remove all elements from the list and clear the selection.-listClear :: List n e -> List n e-listClear l = l & listElementsL .~ V.empty & listSelectedL .~ Nothing+--+-- /O(1)/+listClear :: (Monoid (t e)) => GenericList n t e -> GenericList n t e+listClear l = l & listElementsL .~ mempty & listSelectedL .~ Nothing --- | Reverse the list.  The element selected before the reversal will+-- | Reverse the list. The element selected before the reversal will -- again be the selected one.-listReverse :: List n e -> List n e-listReverse theList = theList & listElementsL %~ V.reverse & listSelectedL .~ newSel-  where n = V.length (listElements theList)-        newSel = (-) <$> pure (n-1) <*> listSelected theList+--+-- Complexity: same as 'reverse' for the container type.+--+-- @+-- listReverse for 'List': O(n)+-- listReverse for 'Seq.Seq': O(n)+-- @+listReverse :: (Reversible t, Foldable t)+            => GenericList n t e+            -> GenericList n t e+listReverse l =+    l & listElementsL %~ reverse+      & listSelectedL %~ fmap (length l - 1 -)  -- | Apply a function to the selected element. If no element is selected -- the list is not modified.-listModify :: (e -> e) -> List n e -> List n e-listModify f l = case listSelectedElement l of-  Nothing -> l-  Just (n,e) -> let es = V.update (l^.listElementsL) (return (n, f e))-                in listReplace es (Just n) l+--+-- Complexity: same as 'traverse' for the container type (typically+-- /O(n)/).+--+-- 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 = listSelectedElementL %~ f
src/Brick/Widgets/ProgressBar.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- | This module provides a progress bar widget. module Brick.Widgets.ProgressBar   ( progressBar+  , customProgressBar   -- * Attributes   , progressCompleteAttr   , progressIncompleteAttr@@ -10,7 +12,9 @@  import Lens.Micro ((^.)) import Data.Maybe (fromMaybe)+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import Graphics.Vty (safeWcswidth)  import Brick.Types@@ -19,11 +23,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@@ -34,18 +38,47 @@             -> Float             -- ^ The progress value. Should be between 0 and 1 inclusive.             -> Widget n-progressBar mLabel progress =+progressBar = customProgressBar ' ' ' '++-- | Draw a progress bar with the specified (optional) label,+-- progress value and custom characters to fill the progress.+-- This fills available horizontal space and is one row high.+-- Please be aware of using wide characters in Brick,+-- see [Wide Character Support and the TextWidth class](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst#wide-character-support-and-the-textwidth-class)+customProgressBar :: Char+                  -- ^ Character to fill the completed part.+                  -> Char+                  -- ^ Character to fill the incomplete part.+                  -> Maybe String+                  -- ^ The label. If specified, this is shown in the center of+                  -- the progress bar.+                  -> Float+                  -- ^ The progress value. Should be between 0 and 1 inclusive.+                  -> Widget n+customProgressBar completeChar incompleteChar mLabel progress =     Widget Greedy Fixed $ do         c <- getContext         let barWidth = c^.availWidthL             label = fromMaybe "" mLabel             labelWidth = safeWcswidth label             spacesWidth = barWidth - labelWidth-            leftPart = replicate (spacesWidth `div` 2) ' '-            rightPart = replicate (barWidth - (labelWidth + length leftPart)) ' '+            leftWidth = spacesWidth `div` 2+            rightWidth = barWidth - labelWidth - leftWidth+            completeWidth = round $ progress * toEnum barWidth++            leftCompleteWidth = min leftWidth completeWidth+            leftIncompleteWidth = leftWidth - leftCompleteWidth+            leftPart = replicate leftCompleteWidth completeChar ++ replicate leftIncompleteWidth incompleteChar+            rightCompleteWidth = max 0 (completeWidth - labelWidth - leftWidth)+            rightIncompleteWidth = rightWidth - rightCompleteWidth+            rightPart = replicate rightCompleteWidth completeChar ++ replicate rightIncompleteWidth incompleteChar+             fullBar = leftPart <> label <> rightPart-            completeWidth = round $ progress * toEnum (length fullBar)-            completePart = take completeWidth fullBar-            incompletePart = drop completeWidth fullBar+            adjustedCompleteWidth = if completeWidth == length fullBar && progress < 1.0+                                    then completeWidth - 1+                                    else if completeWidth == 0 && progress > 0.0+                                         then 1+                                         else completeWidth+            (completePart, incompletePart) = splitAt adjustedCompleteWidth fullBar         render $ (withAttr progressCompleteAttr $ str completePart) <+>                  (withAttr progressIncompleteAttr $ str incompletePart)
+ src/Brick/Widgets/Table.hs view
@@ -0,0 +1,389 @@+{-# LANGUAGE MultiWayIf #-}+-- | This module provides a table widget that can draw other widgets+-- in a table layout, draw borders between rows and columns, and allow+-- configuration of row and column alignment. To get started, see+-- 'table'.+module Brick.Widgets.Table+  (+  -- * Types+    Table+  , ColumnAlignment(..)+  , RowAlignment(..)+  , TableException(..)++  -- * Construction+  , table++  -- * Configuration+  , alignLeft+  , alignRight+  , alignCenter+  , alignTop+  , alignMiddle+  , alignBottom+  , setColAlignment+  , setRowAlignment+  , setDefaultColAlignment+  , setDefaultRowAlignment+  , surroundingBorder+  , rowBorders+  , columnBorders++  -- * Rendering+  , renderTable++  -- * Low-level API+  , RenderedTableCells(..)+  , BorderConfiguration(..)+  , tableCellLayout+  , addBorders+  , alignColumns+  )+where++import Control.Monad (forM)+import qualified Control.Exception as E+import Data.List (transpose, intersperse, nub)+import qualified Data.Map as M+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Graphics.Vty (imageHeight, imageWidth, charFill)+import Lens.Micro ((^.))++import Brick.Types+import Brick.Widgets.Core+import Brick.Widgets.Center+import Brick.Widgets.Border++-- | Column alignment modes. Use these modes with the alignment+-- functions in this module to configure column alignment behavior.+data ColumnAlignment =+    AlignLeft+    -- ^ Align all cells to the left.+    | AlignCenter+    -- ^ Center the content horizontally in all cells in the column.+    | AlignRight+    -- ^ Align all cells to the right.+    deriving (Eq, Show, Read)++-- | Row alignment modes. Use these modes with the alignment functions+-- in this module to configure row alignment behavior.+data RowAlignment =+    AlignTop+    -- ^ Align all cells to the top.+    | AlignMiddle+    -- ^ Center the content vertically in all cells in the row.+    | AlignBottom+    -- ^ Align all cells to the bottom.+    deriving (Eq, Show, Read)++-- | A table creation exception.+data TableException =+    TEUnequalRowSizes+    -- ^ Rows did not all have the same number of cells.+    | TEInvalidCellSizePolicy+    -- ^ Some cells in the table did not use the 'Fixed' size policy for+    -- both horizontal and vertical sizing.+    deriving (Eq, Show, Read)++instance E.Exception TableException where++-- | A table data structure for widgets of type 'Widget' @n@. Create a+-- table with 'table'.+data Table n =+    Table { columnAlignments :: M.Map Int ColumnAlignment+          , rowAlignments :: M.Map Int RowAlignment+          , tableRows :: [[Widget n]]+          , defaultColumnAlignment :: ColumnAlignment+          , defaultRowAlignment :: RowAlignment+          , tableBorderConfiguration :: BorderConfiguration+          }++-- | A border configuration for a table.+data BorderConfiguration =+    BorderConfiguration { drawSurroundingBorder :: Bool+                        , drawRowBorders :: Bool+                        , drawColumnBorders :: Bool+                        }++-- | Construct a new table.+--+-- The argument is the list of rows with the topmost row first, with+-- each element of the argument list being the contents of the cells in+-- in each column of the respective row, with the leftmost cell first.+--+-- Each row's height is determined by the height of the tallest cell+-- in that row, and each column's width is determined by the width of+-- the widest cell in that column. This means that control over row+-- and column dimensions is a matter of controlling the size of the+-- individual cells, such as by wrapping cell contents in padding,+-- 'fill' and 'hLimit' or 'vLimit', etc. This also means that it is not+-- necessary to explicitly set the width of most table cells because+-- the table will determine the per-row and per-column dimensions by+-- looking at the largest cell contents. In particular, this means+-- that the table's alignment logic only has an effect when a given+-- cell's contents are smaller than the maximum for its row and column,+-- thus giving the table some way to pad the contents to result in the+-- desired alignment.+--+-- By default:+--+-- * All columns are left-aligned. Use the alignment functions in this+-- module to change that behavior.+-- * All rows are top-aligned. Use the alignment functions in this+-- module to change that behavior.+-- * The table will draw borders between columns, between rows, and+-- around the outside of the table. Border-drawing behavior can be+-- configured with the API in this module. Note that tables always draw+-- with 'joinBorders' enabled. If a cell's contents has smart borders+-- but you don't want those borders to connect to the surrounding table+-- borders, wrap the cell's contents with 'freezeBorders'.+--+-- All cells of all rows MUST use the 'Fixed' growth policy for both+-- horizontal and vertical growth. If the argument list contains any+-- cells that use the 'Greedy' policy, this function will raise a+-- 'TableException'.+--+-- All rows MUST have the same number of cells. If not, this function+-- will raise a 'TableException'.+table :: [[Widget n]] -> Table n+table rows =+    if | not allFixed      -> E.throw TEInvalidCellSizePolicy+       | not allSameLength -> E.throw TEUnequalRowSizes+       | otherwise         -> t+    where+        allSameLength = length (nub (length <$> rows)) <= 1+        allFixed = all fixedRow rows+        fixedRow = all fixedCell+        fixedCell w = hSize w == Fixed && vSize w == Fixed+        t = Table { columnAlignments = mempty+                  , rowAlignments = mempty+                  , tableRows = rows+                  , defaultColumnAlignment = AlignLeft+                  , defaultRowAlignment = AlignTop+                  , tableBorderConfiguration =+                      BorderConfiguration { drawSurroundingBorder = True+                                          , drawRowBorders = True+                                          , drawColumnBorders = True+                                          }+                  }++-- | Configure whether the table draws a border on its exterior.+surroundingBorder :: Bool -> Table n -> Table n+surroundingBorder b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawSurroundingBorder = b } }++-- | Configure whether the table draws borders between its rows.+rowBorders :: Bool -> Table n -> Table n+rowBorders b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawRowBorders = b } }++-- | Configure whether the table draws borders between its columns.+columnBorders :: Bool -> Table n -> Table n+columnBorders b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawColumnBorders = b } }++-- | Align the specified column to the right. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignRight :: Int -> Table n -> Table n+alignRight = setColAlignment AlignRight++-- | Align the specified column to the left. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignLeft :: Int -> Table n -> Table n+alignLeft = setColAlignment AlignLeft++-- | Align the specified column to center. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignCenter :: Int -> Table n -> Table n+alignCenter = setColAlignment AlignCenter++-- | Align the specified row to the top. The argument is the row index,+-- starting with zero. Silently does nothing if the index is out of+-- range.+alignTop :: Int -> Table n -> Table n+alignTop = setRowAlignment AlignTop++-- | Align the specified row to the middle. The argument is the row+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignMiddle :: Int -> Table n -> Table n+alignMiddle = setRowAlignment AlignMiddle++-- | Align the specified row to bottom. The argument is the row index,+-- starting with zero. Silently does nothing if the index is out of+-- range.+alignBottom :: Int -> Table n -> Table n+alignBottom = setRowAlignment AlignBottom++-- | Set the alignment for the specified column index (starting at+-- zero). Silently does nothing if the index is out of range.+setColAlignment :: ColumnAlignment -> Int -> Table n -> Table n+setColAlignment a col t =+    t { columnAlignments = M.insert col a (columnAlignments t) }++-- | Set the alignment for the specified row index (starting at+-- zero). Silently does nothing if the index is out of range.+setRowAlignment :: RowAlignment -> Int -> Table n -> Table n+setRowAlignment a row t =+    t { rowAlignments = M.insert row a (rowAlignments t) }++-- | Set the default column alignment for columns with no explicitly+-- configured alignment.+setDefaultColAlignment :: ColumnAlignment -> Table n -> Table n+setDefaultColAlignment a t =+    t { defaultColumnAlignment = a }++-- | Set the default row alignment for rows with no explicitly+-- configured alignment.+setDefaultRowAlignment :: RowAlignment -> Table n -> Table n+setDefaultRowAlignment a t =+    t { defaultRowAlignment = a }++-- | Render the table.+renderTable :: Table n -> Widget n+renderTable t =+    joinBorders $+    Widget Fixed Fixed $ do+        tableCellLayout t >>= addBorders >>= render++-- | The result of performing table cell intermediate rendering and+-- layout.+data RenderedTableCells n =+    RenderedTableCells { renderedTableRows :: [[Widget n]]+                       -- ^ The table's cells in row-major order.+                       , renderedTableColumnWidths :: [Int]+                       -- ^ The widths of the table's columns.+                       , renderedTableRowHeights :: [Int]+                       -- ^ The heights of the table's rows.+                       , borderConfiguration :: BorderConfiguration+                       -- ^ The border configuration to use.+                       }++-- | Augment rendered table cells with borders according to the+-- border configuration accompanying the cells.+addBorders :: RenderedTableCells n -> RenderM n (Widget n)+addBorders r = do+    let cfg = borderConfiguration r+        rows = renderedTableRows r+        rowHeights = renderedTableRowHeights r+        colWidths = renderedTableColumnWidths r++        contentWidth = sum colWidths+        contentHeight = sum rowHeights++        hBorderLength = contentWidth + if drawColumnBorders cfg+                                       then max (length colWidths - 1) 0+                                       else 0+        vBorderHeight = contentHeight + if drawRowBorders cfg+                                        then max (length rowHeights - 1) 0+                                        else 0+        horizBorder = hLimit hBorderLength hBorder+        vertBorder = vLimit vBorderHeight vBorder++        leftBorder =+            vBox [topLeftCorner, vertBorder, bottomLeftCorner]+        rightBorder =+            vBox [topRightCorner, vertBorder, bottomRightCorner]++        maybeWrap check f =+            if check cfg then f else id+        addSurroundingBorder b =+            leftBorder <+> (horizBorder <=> b <=> horizBorder) <+> rightBorder+        addRowBorders =+            intersperse horizBorder++        rowsWithColumnBorders = (\(h, row) -> hBox $ maybeColumnBorders h row) <$> zip rowHeights rows+        maybeColumnBorders height = maybeIntersperse cfg drawColumnBorders (vLimit height vBorder)+        body = vBox $+               maybeWrap drawRowBorders addRowBorders rowsWithColumnBorders++    return $ maybeWrap drawSurroundingBorder addSurroundingBorder body++tableCellLayout :: Table n -> RenderM n (RenderedTableCells n)+tableCellLayout t = do+    ctx <- getContext+    cellResults <- forM (tableRows t) $ mapM render++    let rowHeights = rowHeight <$> cellResults+        colWidths = colWidth <$> transpose cellResults+        numRows = length rowHeights+        numCols = if length cellResults >= 1+                     then length (cellResults !! 0)+                     else 0+        allRowAligns = (\i -> M.findWithDefault (defaultRowAlignment t) i (rowAlignments t)) <$>+                       [0..numRows - 1]+        allColAligns = (\i -> M.findWithDefault (defaultColumnAlignment t) i (columnAlignments t)) <$>+                       [0..numCols - 1]+        rowHeight = maximum . fmap (imageHeight . image)+        colWidth = maximum . fmap (imageWidth . image)++        toW = Widget Fixed Fixed . return+        fillEmptyCell w h result =+            if imageWidth (image result) == 0 && imageHeight (image result) == 0+            then result { image = charFill (ctx^.attrL) ' ' w h }+            else result+        mkRow (vAlign, height, rowCells) =+            let paddedCells = flip map (zip3 allColAligns colWidths rowCells) $ \(hAlign, width, cell) ->+                    applyColAlignment width hAlign $+                    applyRowAlignment height vAlign $+                    toW $+                    fillEmptyCell width height cell+            in paddedCells++    let rows = mkRow <$> zip3 allRowAligns rowHeights cellResults++    return $ RenderedTableCells { renderedTableRows = rows+                                , renderedTableColumnWidths = colWidths+                                , renderedTableRowHeights = rowHeights+                                , borderConfiguration = tableBorderConfiguration t+                                }++maybeIntersperse :: BorderConfiguration -> (BorderConfiguration -> Bool) -> Widget n -> [Widget n] -> [Widget n]+maybeIntersperse cfg f v | f cfg = intersperse v+                         | otherwise = id++topLeftCorner :: Widget n+topLeftCorner = joinableBorder $ Edges False True False True++topRightCorner :: Widget n+topRightCorner = joinableBorder $ Edges False True True False++bottomLeftCorner :: Widget n+bottomLeftCorner = joinableBorder $ Edges True False False True++bottomRightCorner :: Widget n+bottomRightCorner = joinableBorder $ Edges True False True False++-- | Given a "table row" of widgets, align each one according to the+-- list of specified column alignments in columns of the specified+-- widths.+alignColumns :: [ColumnAlignment]+             -- ^ The column alignments to use for each widget,+             -- respectively.+             -> [Int]+             -- ^ The width of each column in terminal columns,+             -- respectively.+             -> [Widget n]+             -- ^ The column cells to align.+             -> [Widget n]+alignColumns as widths cells =+    (\(w, a, c) -> applyColAlignment w a c) <$> zip3 widths as cells++applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n+applyColAlignment width align w =+    hLimit width $ case align of+        AlignLeft   -> padRight Max w+        AlignCenter -> hCenter w+        AlignRight  -> padLeft Max w++applyRowAlignment :: Int -> RowAlignment -> Widget n -> Widget n+applyRowAlignment rHeight align w =+    vLimit rHeight $ case align of+        AlignTop    -> padBottom Max w+        AlignMiddle -> vCenter w+        AlignBottom -> padTop Max w
+ src/Data/IMap.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+module Data.IMap+    ( IMap+    , Run(..)+    , empty+    , Data.IMap.null+    , singleton+    , insert+    , delete+    , restrict+    , lookup+    , splitLE+    , intersectionWith+    , mapMaybe+    , addToKeys+    , unsafeUnion+    , fromList+    , unsafeRuns+    , unsafeToAscList+    ) where++import Data.List (foldl')+import Data.Monoid+import Data.IntMap.Strict (IntMap)+import GHC.Generics+import Control.DeepSeq+import Prelude hiding (lookup)+import qualified Data.IntMap.Strict as IM++-- | Semantically, 'IMap' and 'IntMap' are identical; but 'IMap' is more+-- efficient when large sequences of contiguous keys are mapped to the same+-- value.+newtype IMap a = IMap { _runs :: IntMap (Run a) } deriving (Show, Functor, Read, Generic, NFData)++{-# INLINE unsafeRuns #-}+-- | This function is unsafe because 'IMap's that compare equal may split their+-- runs into different chunks; consumers must promise that they do not treat+-- run boundaries specially.+unsafeRuns :: IMap a -> IntMap (Run a)+unsafeRuns = _runs++instance Eq a => Eq (IMap a) where+    IMap m == IMap m' = go (IM.toAscList m) (IM.toAscList m') where+        go ((k, Run n a):kvs) ((k', Run n' a'):kvs')+            = k == k' && a == a' && case compare n n' of+                LT -> go kvs ((k'+n, Run (n'-n) a'):kvs')+                EQ -> go kvs kvs'+                GT -> go ((k+n', Run (n-n') a):kvs) kvs'+        go [] [] = True+        go _ _ = False++instance Ord a => Ord (IMap a) where+    compare (IMap m) (IMap m') = go (IM.toAscList m) (IM.toAscList m') where+        go [] [] = EQ+        go [] _  = LT+        go _  [] = GT+        go ((k, Run n a):kvs) ((k', Run n' a'):kvs')+            = compare k k' <> compare a a' <> case compare n n' of+                LT -> go kvs ((k'+n, Run (n'-n) a'):kvs')+                EQ -> go kvs kvs'+                GT -> go ((k+n', Run (n-n') a):kvs) kvs'++-- | Zippy: '(<*>)' combines values at equal keys, discarding any values whose+-- key is in only one of its two arguments.+instance Applicative IMap where+    pure a = IMap . IM.fromDistinctAscList $+        [ (minBound, Run maxBound a)+        , (-1, Run maxBound a)+        , (maxBound-1, Run 2 a)+        ]+    (<*>) = intersectionWith ($)++-- | @Run n a@ represents @n@ copies of the value @a@.+data Run a = Run+    { len :: !Int+    , val :: !a+    } deriving (Eq, Ord, Read, Show, Functor, Generic, NFData)++instance Foldable    Run where foldMap f r = f (val r)+instance Traversable Run where sequenceA (Run n v) = Run n <$> v++empty :: IMap a+empty = IMap IM.empty++null :: IMap a -> Bool+null = IM.null . _runs++singleton :: Int -> Run a -> IMap a+singleton k r+    | len r >= 1 = IMap (IM.singleton k r)+    | otherwise = empty++insert :: Int -> Run a -> IMap a -> IMap a+insert k r m+    | len r < 1 = m+    | otherwise = m { _runs = IM.insert k r (_runs (delete k r m)) }++{-# INLINE delete #-}+delete :: Int -> Run ignored -> IMap a -> IMap a+delete k r m+    | len r < 1 = m+    | otherwise = m { _runs = IM.union (_runs lt) (_runs gt) }+    where+    (lt, ge) = splitLE (k-1) m+    (_ , gt) = splitLE (k+len r-1) ge++-- | Given a range of keys (as specified by a starting key and a length for+-- consistency with other functions in this module), restrict the map to keys+-- in that range. @restrict k r m@ is equivalent to @intersectionWith const m+-- (insert k r empty)@ but potentially more efficient.+restrict :: Int -> Run ignored -> IMap a -> IMap a+restrict k r = id+    . snd+    . splitLE (k-1)+    . fst+    . splitLE (k+len r-1)++lookup :: Int -> IMap a -> Maybe a+lookup k m = case IM.lookupLE k (_runs m) of+    Just (k', Run n a) | k < k'+n -> Just a+    _ -> Nothing++-- | @splitLE n m@ produces a tuple @(le, gt)@ where @le@ has all the+-- associations of @m@ where the keys are @<= n@ and @gt@ has all the+-- associations of @m@ where the keys are @> n@.+splitLE :: Int -> IMap a -> (IMap a, IMap a)+splitLE k m = case IM.lookupLE k (_runs m) of+    Nothing -> (empty, m)+    Just (k', r@(Run n _)) -> case (k' + n - 1 <= k, k' == k) of+        (True , False) -> (m { _runs = lt }, m { _runs = gt })+        (True , True ) -> (m { _runs = IM.insert k r lt }, m { _runs = gt })+        (False, _    ) -> ( m { _runs = IM.insert k'    r { len =     1 + k - k' } lt' }+                          , m { _runs = IM.insert (k+1) r { len = n - 1 - k + k' } gt' }+                          )+        where+        (lt', gt') = IM.split k' (_runs m)+    where+    (lt, gt) = IM.split k (_runs m)++-- | Increment all keys by the given amount. This is like+-- 'IM.mapKeysMonotonic', but restricted to partially-applied addition.+addToKeys :: Int -> IMap a -> IMap a+addToKeys n m = m { _runs = IM.mapKeysMonotonic (n+) (_runs m) }++-- TODO: This is pretty inefficient. IntMap offers some splitting functions+-- that should make it possible to be more efficient here (though the+-- implementation would be significantly messier).+intersectionWith :: (a -> b -> c) -> IMap a -> IMap b -> IMap c+intersectionWith f (IMap runsa) (IMap runsb)+    = IMap . IM.fromDistinctAscList $ merge (IM.toAscList runsa) (IM.toAscList runsb)+    where+    merge as@((ka, ra):at) bs@((kb, rb):bt)+        | ka' < kb = merge at bs+        | kb' < ka = merge as bt+        | otherwise = (kc, Run (kc' - kc + 1) vc) : case compare ka' kb' of+            LT -> merge at bs+            EQ -> merge at bt+            GT -> merge as bt+        where+        ka' = ka + len ra - 1+        kb' = kb + len rb - 1+        kc  = max ka  kb+        kc' = min ka' kb'+        vc  = f (val ra) (val rb)+    merge _ _ = []++mapMaybe :: (a -> Maybe b) -> IMap a -> IMap b+mapMaybe f (IMap runs) = IMap (IM.mapMaybe (traverse f) runs)++fromList :: [(Int, Run a)] -> IMap a+fromList = foldl' (\m (k, r) -> insert k r m) empty++-- | This function is unsafe because 'IMap's that compare equal may split their+-- runs into different chunks; consumers must promise that they do not treat+-- run boundaries specially.+unsafeToAscList :: IMap a -> [(Int, Run a)]+unsafeToAscList = IM.toAscList . _runs++-- | This function is unsafe because it assumes there is no overlap between its+-- arguments. That is, in the call @unsafeUnion a b@, the caller must guarantee+-- that if @lookup k a = Just v@ then @lookup k b = Nothing@ and vice versa.+unsafeUnion :: IMap a -> IMap a -> IMap a+unsafeUnion a b = IMap { _runs = _runs a `IM.union` _runs b }
− src/Data/Text/Markup.hs 
@@ -1,82 +0,0 @@--- | This module provides an API for "marking up" text with arbitrary--- values. A piece of markup can then be converted to a list of pairs--- representing the sequences of characters assigned the same markup--- value.------ This interface is experimental. Don't use this for your full-file--- syntax highlighter just yet!-module Data.Text.Markup-  ( Markup-  , markupToList-  , markupSet-  , fromList-  , fromText-  , toText-  , (@@)-  )-where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-import Data.Monoid-#endif--import Data.String (IsString(..))-import qualified Data.Text as T---- | Markup with metadata type 'a' assigned to each character.-data Markup a = Markup [(Char, a)]-              deriving Show--instance Monoid (Markup a) where-    mempty = Markup mempty-    mappend (Markup t1) (Markup t2) =-        Markup (t1 `mappend` t2)--instance (Monoid a) => IsString (Markup a) where-    fromString = fromText . T.pack---- | Build a piece of markup; assign the specified metadata to every--- character in the specified text.-(@@) :: T.Text -> a -> Markup a-t @@ val = Markup [(c, val) | c <- T.unpack t]---- | Build markup from text with the default metadata.-fromText :: (Monoid a) => T.Text -> Markup a-fromText = (@@ mempty)---- | Extract the text from markup, discarding the markup metadata.-toText :: (Eq a) => Markup a -> T.Text-toText = T.concat . (fst <$>) . concat . markupToList---- | Set the metadata for a range of character positions in a piece of--- markup. This is useful for, e.g., syntax highlighting.-markupSet :: (Eq a) => (Int, Int) -> a -> Markup a -> Markup a-markupSet (start, len) val m@(Markup l) = if start < 0 || start + len > length l-                                          then m-                                          else newM-    where-        newM = Markup $ theHead ++ theNewEntries ++ theTail-        (theHead, theLongTail) = splitAt start l-        (theOldEntries, theTail) = splitAt len theLongTail-        theNewEntries = zip (fst <$> theOldEntries) (repeat val)---- | Convert markup to a list of lines. Each line is represented by a--- list of pairs in which each pair contains the longest subsequence of--- characters having the same metadata.-markupToList :: (Eq a) => Markup a -> [[(T.Text, a)]]-markupToList (Markup thePairs) = toList <$> toLines [] [] thePairs-    where-        toLines ls cur [] = ls ++ [cur]-        toLines ls cur ((ch, val):rest)-            | ch == '\n' = toLines (ls ++ [cur]) [] rest-            | otherwise = toLines ls (cur ++ [(ch, val)]) rest--        toList [] = []-        toList ((ch, val):rest) = (T.pack $ ch : (fst <$> matching), val) : toList remaining-            where-                (matching, remaining) = break (\(_, v) -> v /= val) rest---- | Convert a list of text and metadata pairs into markup.-fromList :: [(T.Text, a)] -> Markup a-fromList pairs = Markup $ concatMap (\(t, val) -> [(c, val) | c <- T.unpack t]) pairs
+ tests/List.hs view
@@ -0,0 +1,375 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+module List+  ( main+  )+where++import Prelude hiding (reverse, splitAt)++import Data.Foldable (find)+import Data.Function (on)+import qualified Data.List+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+import Lens.Micro+import Test.QuickCheck++import Brick.Util (clamp)+import Brick.Widgets.List++instance (Arbitrary n, Arbitrary a) => Arbitrary (List n a) where+    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)++instance Arbitrary a => Arbitrary (ListMoveOp a) where+    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)++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)+                  ]++-- 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)+op Clear = listClear+op Reverse = listReverse+op (ListMoveOp mo) = moveOp mo++-- Turn a ListMoveOp into a List endomorphism+moveOp :: (Eq a) => ListMoveOp a -> List n a -> List n a+moveOp MoveUp = listMoveUp+moveOp MoveDown = listMoveDown+moveOp (MoveBy n) = listMoveBy n+moveOp (MoveTo n) = listMoveTo n+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 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 operations keep the selected index in bounds+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'++-- reversing a list keeps the selected element the same+prop_reverseMaintainsSelectedElement :: (Eq a)+                                     => [ListOp a]+                                     -> List n a+                                     -> Bool+prop_reverseMaintainsSelectedElement ops l =+    -- apply some random list ops to (probably) set a selected element+    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)++-- 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)++-- 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++-- inserting an element and moving to it always succeeds and+-- the selected element is the one we inserted.+--+-- The index is not necessarily the index we inserted at, because+-- the element could be present in the original list.  So we don't+-- check that.+--+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++-- inserting an element and repeatedly seeking it always+-- reaches the element we inserted, at the index where we+-- inserted it.+--+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)++-- 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++-- 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))++-- 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++-- Apply @f@ until @test a (f a) == True@, then return @a@.+converge :: (a -> a -> Bool) -> (a -> a) -> a -> a+converge test f = last . converging test f++-- Apply @f@ until @test a (f a) == True@, returning the start,+-- 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)++-- 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)++-- 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)++-- 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++-- 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 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++-- 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)++-- | 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+-- direction is positive, set to `Just 0` (first element), otherwise set to+-- `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++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++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+prop_splitAtLength_Vector = splitAtLength . V.fromList++prop_splitAtAppend_Vector :: (Eq a) => [a] -> Int -> Bool+prop_splitAtAppend_Vector = splitAtAppend . V.fromList++prop_splitAtLength_Seq :: [a] -> Int -> Bool+prop_splitAtLength_Seq = splitAtLength . Seq.fromList++prop_splitAtAppend_Seq :: (Eq a) => [a] -> Int -> Bool+prop_splitAtAppend_Seq = splitAtAppend . Seq.fromList+++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++reverseAppend :: (Reversible t, Semigroup (t a), Eq (t a))+              => t a -> t a -> Bool+reverseAppend l1 l2 =+  reverse (l1 <> l2) == reverse l2 <> reverse l1++prop_reverseSingleton_Vector :: (Eq a) => a -> Bool+prop_reverseSingleton_Vector = reverseSingleton (Proxy :: Proxy V.Vector)++prop_reverseAppend_Vector :: (Eq a) => [a] -> [a] -> Bool+prop_reverseAppend_Vector l1 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)++-- 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, Semigroup)++instance Splittable L where+    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++-- 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++prop_listFindFirst :: Bool+prop_listFindFirst =+    let v = L [1..5] :: L Int+        l = list () v 1+        result1 = listFindFirst even l+        result2 = listFindFirst (> 10) l+    in result1 == Just (1, 2) &&+       result2 == Nothing++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 []++main :: IO Bool+main = $quickCheckAll
+ tests/Main.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++import Control.Applicative+import Data.Bool (bool)+import Data.Traversable (sequenceA)+import System.Exit (exitFailure, exitSuccess)++import Data.IMap (IMap, Run(Run))+import Data.IntMap (IntMap)+import Test.QuickCheck+import qualified Data.IMap as IMap+import qualified Data.IntMap as IntMap++import qualified List+import qualified Render++instance Arbitrary v => Arbitrary (Run v) where+    arbitrary = liftA2 (\(Positive n) -> Run n) arbitrary arbitrary++instance Arbitrary v => Arbitrary (IMap v) where+    arbitrary = IMap.fromList <$> arbitrary++instance (a ~ Ordering, Show b) => Show (a -> b) where+    show f = show [f x | x <- [minBound .. maxBound]]++lower :: IMap v -> IntMap v+lower m = IntMap.fromDistinctAscList+    [ (base+offset, v)+    | (base, Run n v) <- IMap.unsafeToAscList m+    , offset <- [0..n-1]+    ]++raise :: Eq v => IntMap v -> IMap v+raise = IMap.fromList . rle . map singletonRun . IntMap.toAscList where+    singletonRun (k, v) = (k, Run 1 v)++    rle ((k, Run n v):(k', Run n' v'):kvs)+        | k+n == k' && v == v' = rle ((k, Run (n+n') v):kvs)+    rle (kv:kvs) = kv:rle kvs+    rle [] = []++lowerRun :: Int -> Run v -> IntMap v+lowerRun k r = IntMap.fromAscList [(k+offset, IMap.val r) | offset <- [0..IMap.len r-1]]++type O = Ordering+type I = IMap Ordering++-- These next two probably have overflow bugs that QuickCheck can't reasonably+-- notice. Hopefully they don't come up in real use cases...+prop_raiseLowerFaithful :: IntMap O -> Bool+prop_raiseLowerFaithful m = m == lower (raise m)++prop_equalityReflexive :: I -> Bool+prop_equalityReflexive m = m == raise (lower m)++prop_equality :: I -> I -> Bool+prop_equality l r = (l == r) == (lower l == lower r)++prop_compare :: I -> I -> Bool+prop_compare l r = compare l r == compare (lower l) (lower r)++prop_applicativeIdentity :: I -> Bool+prop_applicativeIdentity v = (id <$> v) == v++prop_applicativeComposition :: IMap (O -> O) -> IMap (O -> O) -> IMap O -> Bool+prop_applicativeComposition u v w = ((.) <$> u <*> v <*> w) == (u <*> (v <*> w))++prop_applicativeHomomorphism :: (O -> O) -> O -> Bool+prop_applicativeHomomorphism f x = (f <$> pure x :: I) == pure (f x)++prop_applicativeInterchange :: IMap (O -> O) -> O -> Bool+prop_applicativeInterchange u y = (u <*> pure y) == (($ y) <$> u)++prop_empty :: Bool+prop_empty = lower (IMap.empty :: I) == IntMap.empty++prop_singleton :: Int -> Run O -> Bool+prop_singleton k r = lower (IMap.singleton k r) == lowerRun k r++prop_insert :: Int -> Run O -> I -> Bool+prop_insert k r m = lower (IMap.insert k r m) == IntMap.union (lowerRun k r) (lower m)++prop_delete :: Int -> Run () -> I -> Bool+prop_delete k r m = lower (IMap.delete k r m) == lower m IntMap.\\ lowerRun k r++prop_splitLE :: Int -> I -> Bool+prop_splitLE k m = (lower le, lower gt) == (le', gt') where+    (le, gt) = IMap.splitLE k m+    (lt, eq, gt') = IntMap.splitLookup k (lower m)+    le' = maybe id (IntMap.insert k) eq lt++prop_intersectionWith :: (O -> O -> O) -> I -> I -> Bool+prop_intersectionWith f l r = lower (IMap.intersectionWith f l r) == IntMap.intersectionWith f (lower l) (lower r)++prop_addToKeys :: Int -> I -> Bool+prop_addToKeys n m = lower (IMap.addToKeys n m) == IntMap.mapKeysMonotonic (n+) (lower m)++prop_lookup :: Int -> I -> Bool+prop_lookup k m = IMap.lookup k m == IntMap.lookup k (lower m)++prop_restrict :: Int -> Run () -> I -> Bool+prop_restrict k r m = lower (IMap.restrict k r m) == IntMap.intersection (lower m) (lowerRun k r)++prop_mapMaybe :: (O -> Maybe O) -> I -> Bool+prop_mapMaybe f m = lower (IMap.mapMaybe f m) == IntMap.mapMaybe f (lower m)++prop_null :: I -> Bool+prop_null m = IMap.null m == IntMap.null (lower m)++return []++main :: IO ()+main =+  (and <$> sequenceA [$quickCheckAll, List.main, Render.main])+  >>= bool exitFailure exitSuccess
+ tests/Render.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}+module Render+  ( main+  )+where++import Brick+import Control.Monad (when)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V+import qualified Graphics.Vty.CrossPlatform.Testing as V+import Brick.Widgets.Border (hBorder)+import Control.Exception (SomeException, try)++region :: V.DisplayRegion+region = (30, 10)++renderDisplay :: Ord n => [Widget n] -> IO ()+renderDisplay ws = do+    outp <- V.mkDefaultOutput+    ctx <- V.displayContext outp region+    V.outputPicture ctx (renderWidget Nothing ws region)+    V.releaseDisplay outp++myWidget :: Widget ()+myWidget = str "Why" <=> hBorder <=> str "not?"++-- Since you can't Read a Picture, we have to compare the result with+-- the Shown one+expectedResult :: String+expectedResult = "Picture {picCursor = NoCursor, picLayers = [VertJoin {partTop = VertJoin {partTop = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"Why                           \", outputWidth = 30, charWidth = 30}, partBottom = VertJoin {partTop = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\", outputWidth = 30, charWidth = 30}, partBottom = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"not?                          \", outputWidth = 30, charWidth = 30}, outputWidth = 30, outputHeight = 2}, outputWidth = 30, outputHeight = 3}, partBottom = BGFill {outputWidth = 30, outputHeight = 7}, outputWidth = 30, outputHeight = 10}], picBackground = Background {backgroundChar = ' ', backgroundAttr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}}}"++main :: IO Bool+main = do+    result <- try (renderDisplay [myWidget]) :: IO (Either SomeException ())+    case result of+        Left _ -> do+            putStrLn "Terminal is not available, skipping test"+            -- Even though we could not actually run the test, we return+            -- True here to prevent the absence of a terminal from+            -- causing a test suite failure in an automated context.+            -- This means that this test effectively doesn't get+            -- considered at all in the automated context.+            return True+        Right () -> do+            let matched = actualResult == expectedResult+                actualResult = show (renderWidget Nothing [myWidget] region)+                msg = if matched then "rendering match" else "rendering mismatch"++            putStrLn ""+            putStrLn $ "renderWidget test outcome: " <> msg++            when (not matched) $ do+                putStrLn "Expected result:"+                putStrLn expectedResult++                putStrLn "Actual result:"+                putStrLn actualResult++            return matched