packages feed

brick 0.39 → 2.12

raw patch · 77 files changed

Files

CHANGELOG.md view
@@ -2,780 +2,1877 @@ Brick changelog --------------- -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-   concatentation settings default to their former hard-coded values,-   `vBox` (#172).--0.36.1---------Package changes:- * Raiseed 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 demonstraton. 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 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-2018, 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,30 +1,21 @@ ![](logo/brick-final-clearbg-with-text.svg) -[![Build Status](https://travis-ci.org/jtdaugherty/brick.svg?branch=master)](https://travis-ci.org/jtdaugherty/brick)--`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.--Release Announcements / News-------------------------------Find out about `brick` releases and other news on Twitter:--https://twitter.com/brick_haskell/+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 -------@@ -32,6 +23,7 @@ Here's an example interface (see `programs/ReadmeDemo.hs`):  ```+joinBorders $ withBorderStyle unicode $ borderWithLabel (str "Hello!") $ (center (str "Left") <+> vBorder <+> center (str "Right"))@@ -46,29 +38,82 @@ │   Left    │   Right    │ │           │            │ │           │            │-└────────────────────────┘+└───────────┴────────────┘ ```  Featured Projects ----------------- -To get an idea of what some people have done with `brick`, take a look-at these 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! - * `tetris`, an implementation of the Tetris game: https://github.com/SamTay/tetris- * `gotta-go-fast`, a typing tutor: https://github.com/hot-leaf-juice/gotta-go-fast- * `haskell-player`, an `afplay` frontend: https://github.com/potomak/haskell-player- * `mushu`, an `MPD` client: https://github.com/elaye/mushu- * `matterhorn`, a client for [Mattermost](https://about.mattermost.com/): https://github.com/matterhorn-chat/matterhorn- * `viewprof`, a GHC profile viewer: https://github.com/maoe/viewprof- * `tart`, a mouse-driven ASCII art drawing program: https://github.com/jtdaugherty/tart- * `silly-joy`, an interpreter for Joy: https://github.com/rootmos/silly-joy- * `herms`, a command-line tool for managing kitchen recipes: https://github.com/jackkiefer/herms- * `purebred`, a mail user agent: https://github.com/purebred-mua/purebred- * `2048Haskell`, an implementation of the 2048 game: https://github.com/8Gitbrix/2048Haskell- * `bhoogle`, a [Hoogle](https://www.haskell.org/hoogle/) client: https://github.com/andrevdm/bhoogle- * `clifm`, a file manager: https://github.com/pasqu4le/clifm+| 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 --------------- @@ -88,8 +133,7 @@ Documentation for `brick` comes in a variety of forms:  * [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-* [Samuel Tay's brick tutorial](https://github.com/jtdaugherty/brick/blob/master/docs/samtay-tutorial.md)-* Haddock (all modules)+* [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) @@ -100,26 +144,27 @@   * 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- * (And many more general-purpose layout control combinators)--Other killer features:+ * Animation support+ * Generic scrollable viewports and viewport scroll bars+ * General-purpose layout control combinators  * Extensible widget-building API  * 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! -Brick-Users Discussion-----------------------+Brick 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:+There are two forums for discussing brick-related things: -[https://groups.google.com/group/brick-users](https://groups.google.com/group/brick-users)+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 ------@@ -139,14 +184,24 @@ 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 ... @@ -159,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.@@ -166,7 +223,12 @@    codebase.  - Please adjust or provide Haddock and/or user guide documentation    relevant to any changes you make.- - New commits should be `-Wall` clean.+ - 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
brick.cabal view
@@ -1,9 +1,10 @@ name:                brick-version:             0.39+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,23 +32,34 @@ license-file:        LICENSE author:              Jonathan Daugherty <cygnus@foobox.com> maintainer:          Jonathan Daugherty <cygnus@foobox.com>-copyright:           (c) Jonathan Daugherty 2015-2018+copyright:           (c) Jonathan Daugherty 2015-2025 category:            Graphics build-type:          Simple cabal-version:       1.18 Homepage:            https://github.com/jtdaugherty/brick/ Bug-reports:         https://github.com/jtdaugherty/brick/issues-tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1+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,-                     docs/samtay-tutorial.md,                      docs/snake-demo.gif,-                     CHANGELOG.md+                     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@@ -55,18 +67,25 @@  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@@ -76,54 +95,120 @@     Brick.Widgets.Core     Brick.Widgets.Dialog     Brick.Widgets.Edit+    Brick.Widgets.FileBrowser     Brick.Widgets.List     Brick.Widgets.ProgressBar+    Brick.Widgets.Table     Data.IMap-    Data.Text.Markup   other-modules:+    Brick.Animation.Clock     Brick.Types.Common     Brick.Types.TH+    Brick.Types.EventM     Brick.Types.Internal     Brick.Widgets.Internal -  build-depends:       base <= 4.11.1.0,-                       vty >= 5.23.1,-                       transformers,+  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,-                       dlist,-                       containers,-                       microlens >= 0.3.0.0,+                       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,-                       word-wrap >= 0.2-  if impl(ghc < 8.0)-    build-depends:     semigroups+                       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 -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   default-extensions:  CPP   main-is:             FormDemo.hs@@ -132,306 +217,344 @@                        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 -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   default-extensions:  CPP   main-is:             TextWrapDemo.hs   build-depends:       base,                        brick,-                       text,                        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,-                       text,-                       microlens >= 0.3.0.0,-                       microlens-th+                       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,-                       text,                        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,-                       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,                        brick,-                       vty,-                       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,                        brick,                        vty,-                       text,                        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,                        brick,                        vty,-                       text,                        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,                        brick,                        vty,-                       text,                        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,                        brick,-                       vty,-                       text,-                       microlens+                       vty  executable brick-theme-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:             ThemeDemo.hs   build-depends:       base,                        brick,                        vty,-                       text,-                       microlens+                       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,                        brick,-                       vty,-                       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+  main-is:             TabularListDemo.hs   build-depends:       base,                        brick,                        vty,-                       text,-                       microlens+                       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,                        brick,                        vty,-                       text,                        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 -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             ListViDemo.hs   build-depends:       base,                        brick,                        vty,-                       text,                        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,                        brick,                        vty,-                       text,                        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 -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             FillDemo.hs   build-depends:       base,-                       brick,-                       vty,-                       text,-                       microlens+                       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,-                       brick,-                       vty,-                       text,-                       microlens+                       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,                        brick,                        vty,-                       text,-                       vector,                        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,                        brick,                        vty,-                       text,-                       microlens+                       text  executable brick-dynamic-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:             DynamicBorderDemo.hs   build-depends:       base <= 5,-                       brick,-                       vty,-                       text,-                       microlens+                       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,                        brick,                        vty,-                       text,-                       microlens+                       microlens-mtl,+                       microlens-th  test-suite brick-tests   type:                exitcode-stdio-1.0   hs-source-dirs:      tests-  ghc-options:         -Wall -O2-  if impl(ghc >= 8)-    ghc-options:       -Wno-orphans+  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,7 +11,8 @@ 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.+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@@ -21,7 +22,7 @@ two important functions:  - A *drawing function* that turns your application state into a-  specification of how your interface should look, and+  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. @@ -30,9 +31,9 @@ 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`_.+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 ------------@@ -52,6 +53,13 @@    $ 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 ----------------------------------- @@ -68,16 +76,17 @@ documentation and as you explore the library source and write your own programs. -- Use of `microlens`_ packages: ``brick`` uses ``microlens`` family of-  packages internally and also exposes lenses for many types in the+- Use of `microlens`_ packages: ``brick`` uses the ``microlens`` family+  of packages internally and also exposes lenses for many types in the   library. However, if you prefer not to use the lens interface in your   program, all lens interfaces have non-lens equivalents exported by   the same module. In general, the "``L``" suffix on something tells   you it is a lens; the name without the "``L``" suffix is the non-lens-  version. You can get by without using ``brick``'s lens interface but-  your life will probably be much more pleasant once your application-  state becomes sufficiently complex if you use lenses to modify it (see-  `appHandleEvent: Handling Events`_).+  version. You can get by without using ``brick``'s lens interface+  but your life will probably be much more pleasant if you use lenses+  to modify your application state once it becomes sufficiently+  complex (see `appHandleEvent: Handling Events`_ and `Event Handlers+  for Component State`_). - Attribute names: some modules export attribute names (see `How   Attributes Work`_) associated with user interface elements. These tend   to end in an "``Attr``" suffix (e.g. ``borderAttr``). In addition,@@ -96,8 +105,8 @@ Brick applications must be compiled with the threaded RTS using the GHC ``-threaded`` option. -The App Type-============+The ``App`` Type+================  To use the library we must provide it with a value of type ``Brick.Main.App``. This type is a record type whose fields perform@@ -108,8 +117,8 @@    data App s e n =        App { appDraw         :: s -> [Widget n]            , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)-           , appHandleEvent  :: s -> BrickEvent n e -> EventM n (Next s)-           , appStartEvent   :: s -> EventM n s+           , appHandleEvent  :: BrickEvent n e -> EventM n s ()+           , appStartEvent   :: EventM n s ()            , appAttrMap      :: s -> AttrMap            } @@ -150,16 +159,16 @@     main :: IO ()    main = do-     let app = App { ... }-         initialState = ...-     finalState <- defaultMain app initialState-     -- Use finalState and exit+       let app = App { ... }+           initialState = ...+       finalState <- defaultMain app initialState+       -- Use finalState and exit  The ``customMain`` function is for more advanced uses; for details see `Using Your Own Event Type`_. -appDraw: Drawing an Interface------------------------------+``appDraw``: Drawing an Interface+---------------------------------  The value of ``appDraw`` is a function that turns the current application state into a list of *layers* of type ``Widget``, listed@@ -201,109 +210,162 @@ ``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets`` namespace provides specific kinds of functionality. -appHandleEvent: Handling Events--------------------------------+``appHandleEvent``: Handling Events+-----------------------------------  The value of ``appHandleEvent`` is a function that decides how to modify the application state as a result of an event:  .. code:: haskell -   appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)+   appHandleEvent :: BrickEvent n e -> EventM n s () -The first parameter of type ``s`` is your application's state at the-time the event arrives. ``appHandleEvent`` is responsible for deciding-how to change the state based on the event and then return it.+``appHandleEvent`` is responsible for deciding how to change the state+based on 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 second parameter of type ``BrickEvent n e`` is the event itself.-The type variables ``n`` and ``e`` correspond to the *resource name-type* and *event type* of your application, respectively, and must match-the corresponding types in ``App`` and ``EventM``.+The ``EventM`` monad is parameterized on the *resource name type*+``n`` and your application's state type ``s``. The ``EventM`` monad+is a state monad over ``s``, so one way to access and modify your+application's state in an event handler is to use the ``MonadState``+type class and associated operations from the ``mtl`` package. The+recommended approach, however, is to use the lens operations from the+``microlens-mtl`` package with lenses to perform concise state updates.+We'll cover this topic in more detail in `Event Handlers for Component+State`_. -The return value type ``Next s`` value describes what should happen-after the event handler is finished. We have three choices:+Once the event handler has performed any relevant state updates, it can+also indicate what should happen once the event handler has finished+executing. By default, after an event handler has completed, Brick will+redraw the screen with the application state (by calling ``appDraw``)+and wait for the next input event. However, there are two other options: -* ``Brick.Main.continue s``: continue executing the event loop with the-  specified application state ``s`` as the next value. Commonly this is-  where you'd modify the state based on the event and return it.-* ``Brick.Main.halt s``: halt the event loop and return the final-  application state value ``s``. This state value is returned to the-  caller of ``defaultMain`` or ``customMain`` where it can be used prior-  to finally exiting ``main``.-* ``Brick.Main.suspendAndResume act``: suspend the ``brick`` event loop-  and execute the specified ``IO`` action ``act``. The action ``act``-  must be of type ``IO s``, so when it executes it must return the next-  application state. When ``suspendAndResume`` is used, the ``brick``-  event loop is shut down and the terminal state is restored to its-  state when the ``brick`` event loop began execution. When it finishes-  executing, the event loop will be resumed using the returned state-  value. This is useful for situations where your program needs to-  suspend your interface and execute some other program that needs to-  gain control of the terminal (such as an external editor).+* ``Brick.Main.halt``: halt the event loop. The application state as it+  exists after the event handler completes is returned to the caller+  of ``defaultMain`` or ``customMain``.+* ``Brick.Main.continueWithoutRedraw``: continue executing the event+  loop, but do not redraw the screen using the new state before waiting+  for another input event. This is faster than the default continue+  behavior since it doesn't redraw the screen; it just leaves up the+  previous screen contents. This function is only useful when you know+  that your event handler's state change(s) won't cause anything on+  the screen to change. Use this only when you are certain that no+  redraw of the screen is needed *and* when you are trying to address a+  performance problem. (See also `The Rendering Cache`_ for details on+  how to deal with rendering performance issues.) -The ``EventM`` monad is the event-handling monad. This monad is a-transformer around ``IO`` so you are free to do I/O in this monad by-using ``liftIO``. Beyond I/O, this monad is used to make scrolling-requests to the renderer (see `Viewports`_) and obtain named extents-(see `Extents`_). Keep in mind that time spent blocking in your event-handler is time during which your UI is unresponsive, so consider this-when deciding whether to have background threads do work instead of-inlining the work in the event handler.+The ``EventM`` monad is a transformer around ``IO`` so I/O is possible+in this monad by using ``liftIO``. Keep in mind, however, that event+handlers should execute as quickly as possible to avoid introducing+screen redraw latency. Consider using background threads to work+asynchronously when handling an event would otherwise cause redraw+latency. -Widget Event Handlers-*********************+``EventM`` is also used to make scrolling requests to the renderer (see+`Viewports`_), obtain named extents (see `Extents`_), and other duties. -Event handlers are responsible for transforming the application state.-While you can use ordinary methods to do this such as pattern matching-and pure function calls, some widget state types such as the ones-provided by the ``Brick.Widgets.List`` and ``Brick.Widgets.Edit``-modules provide their own widget-specific event-handling functions.-For example, ``Brick.Widgets.Edit`` provides ``handleEditorEvent`` and-``Brick.Widgets.List`` provides ``handleListEvent``.+Event Handlers for Component State+********************************** -Since these event handlers run in ``EventM``, they have access to-rendering viewport states via ``Brick.Main.lookupViewport`` and the-``IO`` monad via ``liftIO``.+The top-level ``appHandleEvent`` handler is responsible for managing+the application state, but it also needs to be able to update the state+associated with UI components such as those that come with Brick. -To use these handlers in your program, invoke them on the relevant piece-of state in your application state. In the following example we use an-``Edit`` state from ``Brick.Widgets.Edit``:+For example, consider an application that uses Brick's built-in text+editor from ``Brick.Widgets.Edit``. The built-in editor is similar to+the main application in that it has three important elements: -.. code:: haskell+* The editor state of type ``Editor t n``: this stores the editor's+  contents, cursor position, etc.+* The editor's drawing function, ``renderEditor``: this is responsible+  for drawing the editor in the UI.+* The editor's event handler, ``handleEditorEvent``: this is responsible+  for updating the editor's contents and cursor position in response to+  key events. -   data Name = Edit1-   type MyState = Editor String Name+To use the built-in editor, the application must: -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = continue =<< handleEditorEvent e s+* Embed an ``Editor t n`` somewhere in the application state ``s``,+* Render the editor's state at the appropriate place in ``appDraw`` with+  ``renderEditor``, and+* Dispatch events to the editor in the ``appHandleEvent`` with+  ``handleEditorEvent``. -This pattern works well enough when your application state has an-event handler as shown in the ``Edit`` example above, but it can-become unpleasant if the value on which you want to invoke a handler-is embedded deeply within your application state. If you have chosen-to generate lenses for your application state fields, you can use the-convenience function ``handleEventLensed`` by specifying your state, a-lens, and the event:+An example application state using an editor might look like this:  .. code:: haskell -   data Name = Edit1-   data MyState = MyState { _theEdit :: Editor String Name-                          }+   data MyState n = MyState { _editor :: Editor Text n }    makeLenses ''MyState -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = continue =<< handleEventLensed s theEdit handleEditorEvent e+This declares the ``MyState`` type with an ``Editor`` contained within+it and uses Template Haskell to generate a lens, ``editor``, to allow us+to easily update the editor state in our event handler. -You might consider that preferable to the desugared version:+To dispatch events to the ``editor`` we'd start by writing the+application event handler:  .. code:: haskell -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = do-     newVal <- handleEditorEvent e (s^.theEdit)-     continue $ s & theEdit .~ newVal+   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       ... +But there's a problem: ``handleEditorEvent``'s type indicates that it+can only run over a state of type ``Editor t n``, but our handler runs+on ``MyState``. Specifically, ``handleEditorEvent`` has this type:++.. code:: haskell++   handleEditorEvent :: BrickEvent n e -> EventM n (Editor t n) ()++This means that to use ``handleEditorEvent``, it must be composed+into the application's event handler, but since the state types ``s``+and ``Editor t n`` do not match, we need a way to compose these event+handlers. There are two ways to do this:++* Use ``Lens.Micro.Mtl.zoom`` from the ``microlens-mtl`` package+  (re-exported by ``Brick.Types`` for convenience). This function is+  required when you want to change the state type to a field embedded in+  your application state using a lens. For example:++.. code:: haskell++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       zoom editor $ handleEditorEvent e++* Use ``Brick.Types.nestEventM``: this function lets you provide a state+  value and run ``EventM`` using that state. The following+  ``nestEventM`` example is equivalent to the ``zoom`` example above:++.. code:: haskell++   import Lens.Micro (_1)+   import Lens.Micro.Mtl (use, (.=))++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       editorState <- use editor+       (newEditorState, ()) <- nestEventM editorState $ do+           handleEditorEvent e+       editor .= newEditorState++The ``zoom`` function, together with lenses for your application state's+fields, is by far the best way to manage your state in ``EventM``. As+you can see from the examples above, the ``zoom`` approach avoids a lot+of boilerplate. The ``nestEventM`` approach is provided in cases where+the state that you need to mutate is not easily accessed by ``zoom``.++Finally, if you prefer to avoid the use of lenses, you can always use+the ``MonadState`` API to get, put, and modify your state. Keep in+mind that the ``MonadState`` approach will still require the use of+``nestEventM`` when events scoped to widget states such as ``Editor``+need to be handled.+ Using Your Own Event Type ************************* @@ -327,13 +389,13 @@  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+events we'll just need to check for ``AppEvent`` values in the event handler:  .. code:: haskell -   myEvent :: s -> BrickEvent n CounterEvent -> EventM n (Next s)-   myEvent s (AppEvent (CounterEvent i)) = ...+   myEvent :: BrickEvent n CounterEvent -> EventM n s ()+   myEvent (AppEvent (Counter i)) = ...  The next step is to actually *generate* our custom events and inject them into the ``brick`` event stream so they make it to the@@ -348,15 +410,20 @@    main :: IO ()    main = do        eventChan <- Brick.BChan.newBChan 10-       finalState <- customMain-                       (Graphics.Vty.mkVty Data.Default.defaultConfig)+       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.+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:@@ -383,8 +450,8 @@ 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-**************************+``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@@ -395,16 +462,17 @@  .. code:: haskell -   appStartEvent :: s -> EventM n s+   appStartEvent :: EventM n s () -This function takes the initial application state and returns it in-``EventM``, possibly changing it and possibly making viewport requests.-This function is invoked once and only once, at application startup.-For more details, see `Viewports`_. You will probably just want to use-``return`` as the implementation of this function for most applications.+This function is a handler action to run on the initial application+state. This function is invoked once and only once, at application+startup. This might be a place to make initial viewport scroll requests+or make changes to the Vty environment. You will probably just want+to use ``return ()`` as the implementation of this function for most+applications. -appChooseCursor: Placing the Cursor------------------------------------+``appChooseCursor``: Placing the Cursor+---------------------------------------  The rendering process for a ``Widget`` may return information about where that widget would like to place the cursor. For example, a text@@ -461,9 +529,10 @@  .. code:: haskell -   myApp = App { ...-               , appChooseCursor = \_ -> showCursorNamed CustomName-               }+   myApp =+       App { ...+           , appChooseCursor = \_ -> showCursorNamed CustomName+           }  See the next section for more information on using names. @@ -514,9 +583,8 @@  .. code:: haskell -   do-     let vp = viewportScroll Viewport1-     vScrollBy vp 1+   let vp = viewportScroll Viewport1+   vScrollBy vp 1  The solution is to ensure that for a given resource type (in this case viewport), a unique name is assigned in each use.@@ -529,10 +597,10 @@    ui = (viewport Viewport1 Vertical $ str "Foo") <+>         (viewport Viewport2 Vertical $ str "Bar") <+> -appAttrMap: Managing Attributes--------------------------------+``appAttrMap``: Managing Attributes+----------------------------------- -In ``brick`` we use an *attribute map* to assign attibutes to elements+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.@@ -619,7 +687,7 @@ 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+``Brick.Widgets.Center.hCenter`` function centers a widget and is ``Greedy`` horizontally and defers to the widget it centers for vertical growth behavior. @@ -755,27 +823,71 @@                                , (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.+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. -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:+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.Widgets.Core.updateAttrMap``-* ``Brick.Widgets.Core.forceAttr``-* ``Brick.Widgets.Core.withDefAttr``-* ``Brick.Widgets.Core.overrideAttr``+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 ================ @@ -783,7 +895,7 @@ follows:  * The application provides a default theme built in to the program.-* The application customizes the them by loading theme customizations+* 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.@@ -866,16 +978,20 @@ If the theme is further customized at runtime, any changes can be saved with ``Brick.Themes.saveCustomizations``. -Wide Character Support and the TextWidth class-==============================================+Wide Character Support and the ``TextWidth`` class+================================================== -Brick supports rendering wide characters in all widgets, and the brick-editor supports entering and editing wide characters. Wide characters-are those such as many Asian characters and emoji that need more than-a single terminal column to be displayed. Brick relies on Vty's use of-the `utf8proc`_ library to determine the column width of each character-rendered.+Brick attempts to support rendering wide characters in all widgets,+and the brick editor supports entering and editing wide characters.+Wide characters are those such as many Asian characters and emoji+that need more than a single terminal column to be displayed. +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@@ -885,26 +1001,28 @@     let width = Data.Text.length t -because if the string contains any wide characters, their widths-will not be counted properly. In order to get this right, use the-``TextWidth`` type class to compute the width:+If the string contains any wide characters, their widths will not be+counted properly. In order to get this right, use the ``TextWidth`` type+class to compute the width:  .. code:: haskell     let width = Brick.Widgets.Core.textWidth t -The ``TextWidth`` type class uses Vty's character width routine (and-thus ``utf8proc``) to compute the correct width. If you need to compute-the width of a single character, use ``Graphics.Text.wcwidth``.+The ``TextWidth`` type class uses Vty's character width routine to+compute the width by looking up the string's 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 it-in an event handler. In the following example, the application needs to-know where the bordered box containing "Foo" is rendered:+When an application needs to know where a particular widget was drawn+by the renderer, the application can request that the renderer record+the *extent* of the widget--its upper-left corner and size--and provide+access to it in an event handler. Extents are represented using Brick's+``Brick.Types.Extent`` type. In the following example, the application+needs to know where the bordered box containing "Foo" is rendered:  .. code:: haskell @@ -923,22 +1041,21 @@         reportExtent FooBox $         border $ str "Foo" -Now, whenever the ``ui`` is rendered, the location and size of the-bordered box containing "Foo" will be recorded. We can then look it up-in event handlers in ``EventM``:+Now, whenever the ``ui`` is rendered, the extent of the bordered box+containing "Foo" will be recorded. We can then look it up in event+handlers in ``EventM``:  .. code:: haskell -   do-     mExtent <- Brick.Main.lookupExtent FooBox-     case mExtent of+   mExtent <- Brick.Main.lookupExtent FooBox+   case mExtent of        Nothing -> ...-       Just (Extent _ upperLeft (width, height) offset) -> ...+       Just (Extent _ upperLeft (width, height)) -> ...  Paste Support ============= -Some terminal emulators support "bracketed paste" support. This feature+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@@ -956,10 +1073,10 @@    import qualified Graphics.Vty as V     do-     vty <- Brick.Main.getVtyHandle-     let output = V.outputIface vty-     when (V.supportsMode output V.BracketedPaste) $-         liftIO $ V.setMode output V.BracketedPaste True+       vty <- Brick.Main.getVtyHandle+       let output = V.outputIface vty+       when (V.supportsMode output V.BracketedPaste) $+           liftIO $ V.setMode output V.BracketedPaste True  Once enabled, paste mode will generate Vty ``EvPaste`` events. These events will give you the entire pasted content as a ``ByteString`` which@@ -977,10 +1094,10 @@ .. code:: haskell     do-     vty <- Brick.Main.getVtyHandle-     let output = outputIface vty-     when (supportsMode output Mouse) $-       liftIO $ setMode output Mouse True+       vty <- Brick.Main.getVtyHandle+       let output = outputIface vty+       when (supportsMode output Mouse) $+           liftIO $ setMode output Mouse True  Bear in mind that some terminals do not support mouse interaction, so use Vty's ``getModeStatus`` to find out whether your terminal will@@ -1001,7 +1118,7 @@  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row button mods) = ...+   handleEvent (VtyEvent (EvMouseDown col row button mods) = ...  Brick Mouse Events ------------------@@ -1011,27 +1128,60 @@ language. The disadvantage to the low-level interface described above is that you still need to determine *what* was clicked, i.e., the part of the interface that was under the mouse cursor. There are two ways to do-this with ``brick``: with *extent checking* and *click reporting*.+this with ``brick``: with *click reporting* and *extent checking*. +Click reporting+***************++The *click reporting* approach is the most high-level approach offered+by ``brick`` and the one that we recommend you use. In this approach,+we use ``Brick.Widgets.Core.clickable`` when drawing the interface to+request that a given widget generate ``MouseDown`` and ``MouseUp``+events when it is clicked.++.. code:: haskell++   data Name = MyButton++   ui :: Widget Name+   ui = center $+        clickable MyButton $+        border $+        str "Click me"++   handleEvent (MouseDown MyButton button modifiers coords) = ...+   handleEvent (MouseUp MyButton button coords) = ...++This approach enables event handlers to use pattern matching to check+for mouse clicks on specific regions; this uses `Extent checking`_+under the hood but makes it possible to denote which widgets are+clickable in the interface description. The event's click coordinates+are local to the widget being clicked. In the above example, a click+on the upper-left corner of the border would result in coordinates of+``(0,0)``.+ Extent checking ***************  The *extent checking* approach entails requesting extents (see `Extents`_) for parts of your interface, then checking the Vty mouse-click event's coordinates against one or more extents.+click event's coordinates against one or more extents. This approach+is slightly lower-level than the direct mouse click reporting approach+above but is provided in case you need more control over how mouse+clicks are dealt with.  The most direct way to do this is to check a specific extent:  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do-     mExtent <- lookupExtent SomeExtent-     case mExtent of-       Nothing -> continue s-       Just e -> do-         if Brick.Main.clickedExtent (col, row) e-           then ...-           else ...+   handleEvent (VtyEvent (EvMouseDown col row _ _)) = do+       mExtent <- lookupExtent SomeExtent+       case mExtent of+           Nothing -> return ()+           Just e -> do+               if Brick.Main.clickedExtent (col, row) e+                   then ...+                   else ...  This approach works well enough if you know which extent you're interested in checking, but what if there are many extents and you@@ -1040,10 +1190,10 @@  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do-     extents <- Brick.Main.findClickedExtents (col, row)-     -- Then check to see if a specific extent is in the list, or just-     -- take the first one in the list.+   handleEvent (VtyEvent (EvMouseDown col row _ _)) = do+       extents <- Brick.Main.findClickedExtents (col, row)+       -- Then check to see if a specific extent is in the list, or just+       -- take the first one in the list.  This approach finds all clicked extents and returns them in a list with the following properties:@@ -1057,35 +1207,6 @@ As a result, the extents are ordered in a natural way, starting with the most specific extents and proceeding to the most general. -Click reporting-***************--The *click reporting* approach is the most high-level approach-offered by ``brick``. When rendering the interface we use-``Brick.Widgets.Core.clickable`` to request that a given widget generate-``MouseDown`` and ``MouseUp`` events when it is clicked.--.. code:: haskell--   data Name = MyButton--   ui :: Widget Name-   ui = center $-        clickable MyButton $-        border $-        str "Click me"--   handleEvent s (MouseDown MyButton button modifiers coords) = ...-   handleEvent s (MouseUp MyButton button coords) = ...--This approach enables event handlers to use pattern matching to check-for mouse clicks on specific regions; this uses extent reporting-under the hood but makes it possible to denote which widgets are-clickable in the interface description. The event's click coordinates-are local to the widget being clicked. In the above example, a click-on the upper-left corner of the border would result in coordinates of-``(0,0)``.- Viewports ========= @@ -1158,14 +1279,14 @@  .. code:: haskell -   hScrollPage        :: Direction -> EventM n ()-   hScrollBy          :: Int       -> EventM n ()-   hScrollToBeginning ::              EventM n ()-   hScrollToEnd       ::              EventM n ()-   vScrollPage        :: Direction -> EventM n ()-   vScrollBy          :: Int       -> EventM n ()-   vScrollToBeginning ::              EventM n ()-   vScrollToEnd       ::              EventM n ()+   hScrollPage        :: Direction -> EventM n s ()+   hScrollBy          :: Int       -> EventM n s ()+   hScrollToBeginning ::              EventM n s ()+   hScrollToEnd       ::              EventM n s ()+   vScrollPage        :: Direction -> EventM n s ()+   vScrollBy          :: Int       -> EventM n s ()+   vScrollToBeginning ::              EventM n s ()+   vScrollToEnd       ::              EventM n s ()  In each case the scrolling function scrolls the viewport by the specified amount in the specified direction; functions prefixed with@@ -1181,11 +1302,10 @@  .. code:: haskell -   myHandler :: s -> e -> EventM n (Next s)-   myHandler s e = do+   myHandler :: e -> EventM n s ()+   myHandler e = do        let vp = viewportScroll Viewport1        hScrollBy vp 1-       continue s  Scrolling Viewports With Visibility Requests --------------------------------------------@@ -1204,7 +1324,7 @@    -- Assuming that App uses 'Name' for its resource names:    data Name = Viewport1    let w = viewport Viewport1 Horizontal $-           (visible $ str "Hello," <+> (str " world!")+           (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@@ -1224,6 +1344,29 @@   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 --------------------- @@ -1264,7 +1407,7 @@ A Form Example -------------- -Let's look at an example data type that we'd want to use as the+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. @@ -1351,9 +1494,14 @@ 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 approprate type+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@@ -1389,7 +1537,7 @@ .. code:: haskell      (str "Name: " <+>) @@=-      editTextField name NameField (Just 1)+        editTextField name NameField (Just 1)  Now when we invoke ``renderForm`` on a form using the above example, we'll see a ``"Name:"`` label to the left of the editor field for@@ -1413,7 +1561,7 @@ * ``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 valid validation.+  field that has user input that has invalid validation.  Your application should set both of these. Some good mappings in the attribute map are:@@ -1424,14 +1572,14 @@ Handling Form Events -------------------- -Handling form events is easy: we just call-``Brick.Forms.handleFormEvent`` with the ``BrickEvent`` and the-``Form``. This automatically dispatches input events to the-currently-focused input field, and it also manages focus changes with-``Tab`` and ``Shift-Tab`` keybindings. (For details on all of its-behaviors, see the Haddock documentation for ``handleFormEvent``.) It's-still up to the application to decide when events should go to the form-in the first place.+Handling form events is easy: we just use ``zoom`` to call+``Brick.Forms.handleFormEvent`` with the ``BrickEvent`` and a lens+to access the ``Form`` in the application state. This automatically+dispatches input events to the currently-focused input field, and it+also manages focus changes with ``Tab`` and ``Shift-Tab`` keybindings.+(For details on all of its behaviors, see the Haddock documentation for+``handleFormEvent``.) It's still up to the application to decide when+events should go to the form in the first place.  Since the form field handlers take ``BrickEvent`` values, that means that custom fields could even handle application-specific events (of the@@ -1477,6 +1625,161 @@ 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 =============== @@ -1499,7 +1802,7 @@ 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 to so that it connects+the Brick will re-draw one of the characters so that it connects seamlessly with the adjacent border.  How Joining Works@@ -1663,6 +1966,14 @@ 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 =================== @@ -1682,8 +1993,8 @@         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 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@@ -1698,12 +2009,12 @@  .. code:: haskell -   handleEvent s ... = do-     -- Invalidate just a single cache entry:-     Brick.Main.invalidateCacheEntry ExpensiveThing+   handleEvent ... = do+       -- Invalidate just a single cache entry:+       Brick.Main.invalidateCacheEntry ExpensiveThing -     -- Invalidate the entire cache (useful on a resize):-     Brick.Main.invalidateCache+       -- Invalidate the entire cache (useful on a resize):+       Brick.Main.invalidateCache  Implementing Custom Widgets ===========================@@ -1803,7 +2114,7 @@            ctx <- getContext            let a = ctx^.attrL            return $ Result (Graphics.Vty.charFill a ch (ctx^.availWidthL) (ctx^.availHeightL))-                           [] []+                           [] [] [] Brick.BorderMap.empty  Rendering Sub-Widgets ---------------------@@ -1844,4 +2155,3 @@ .. _Hackage: http://hackage.haskell.org/ .. _microlens: http://hackage.haskell.org/package/microlens .. _bracketed paste mode: https://cirw.in/blog/bracketed-paste-.. _utf8proc: http://julialang.org/utf8proc/
− docs/samtay-tutorial.md 
@@ -1,542 +0,0 @@--# Brick Tutorial by Samuel Tay--This tutorial was written by Samuel Tay, Copyright 2017-(https://github.com/samtay, https://samtay.github.io/). It is provided-as part of the brick distribution with permission.--## Introduction--I'm going to give a short introduction to-[brick](https://hackage.haskell.org/package/brick), a Haskell library-for building terminal user interfaces. So far I've used `brick` to-implement [Conway's Game of Life](https://github.com/samtay/conway) and-a [Tetris clone](https://github.com/samtay/tetris). I'll explain the-basics, walk through an example [snake](https://github.com/samtay/snake)-application, and then explain some more complicated scenarios.--The first thing I'll say is that this package has some of the most-impressive documentation and resources, which makes it easy to figure-out pretty much anything you need to do. I'll try to make this useful,-but I imagine if you're reading this then it is mostly being used as a-reference in addition to the existing resources:--1. [Demo programs](https://github.com/jtdaugherty/brick/tree/master/programs)-(clone down to explore the code and run them locally)-2. [User guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-3. [Haddock docs](https://hackage.haskell.org/package/brick-0.18)-4. [Google group](https://groups.google.com/forum/#!forum/brick-users)--### The basic idea--`brick` is very declarative. Once your base application logic is in-place, the interface is generally built by two functions: drawing and-handling events. The drawing function--```haskell-appDraw :: s -> [Widget n]-```--takes your app state `s` and produces the visuals `[Widget n]`. The-handler--```haskell-appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)-```--takes your app state, an event (e.g. user presses the `'m'` key), and-produces the resulting app state. *That's pretty much it.*--## `snake`--We're going to build the [classic-snake](https://en.wikipedia.org/wiki/Snake_(video_game)) game that you-might recall from arcades or the first cell phones. The full source code-is [here](https://github.com/samtay/snake). This is the end product:--![](snake-demo.gif)--### Structure of the app--The library makes it easy to separate the concerns of your application-and the interface; I like to have a module with all of the core business-logic that exports the core state of the app and functions for modifying-it, and then have an interface module that just handles the setup,-drawing, and handling events. So let's just use the `simple` stack-template and add two modules--```-├── LICENSE-├── README.md-├── Setup.hs-├── snake.cabal-├── src-│   ├── Main.hs-│   ├── Snake.hs-│   └── UI.hs-└── stack.yaml-```--and our dependencies to `test.cabal`--```yaml-executable snake-  hs-source-dirs:      src-  main-is:             Main.hs-  ghc-options:         -threaded-  exposed-modules:     Snake-                     , UI-  default-language:    Haskell2010-  build-depends:       base >= 4.7 && < 5-                     , brick-                     , containers-                     , linear-                     , microlens-                     , microlens-th-                     , random-```--### `Snake`--Since this tutorial is about `brick`, I'll elide most of the-implementation details of the actual game, but here are some of the key-types and scaffolding:--```haskell-{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}-module Snake where--import Control.Applicative ((<|>))-import Control.Monad (guard)-import Data.Maybe (fromMaybe)--import Data.Sequence (Seq, ViewL(..), ViewR(..), (<|))-import qualified Data.Sequence as S-import Lens.Micro.TH (makeLenses)-import Lens.Micro ((&), (.~), (%~), (^.))-import Linear.V2 (V2(..), _x, _y)-import System.Random (Random(..), newStdGen)---- Types--data Game = Game-  { _snake  :: Snake        -- ^ snake as a sequence of points in R2-  , _dir    :: Direction    -- ^ direction-  , _food   :: Coord        -- ^ location of the food-  , _foods  :: Stream Coord -- ^ infinite list of random food locations-  , _dead   :: Bool         -- ^ game over flag-  , _paused :: Bool         -- ^ paused flag-  , _score  :: Int          -- ^ score-  , _frozen :: Bool         -- ^ freeze to disallow duplicate turns-  } deriving (Show)--type Coord = V2 Int-type Snake = Seq Coord--data Stream a = a :| Stream a-  deriving (Show)--data Direction-  = North-  | South-  | East-  | West-  deriving (Eq, Show)-```--All of this is pretty self-explanatory, with the possible exception-of lenses if you haven't seen them. At first glance they may seem-complicated (and the underlying theory arguably is), but using them as-getters and setters is very straightforward. So, if you are following-along because you are writing a terminal app like this, I'd recommend-using them, but they are not required to use `brick`.--Here are the core functions for playing the game:--```haskell--- | Step forward in time-step :: Game -> Game-step g = fromMaybe g $ do-  guard (not $ g ^. paused || g ^. dead)-  let g' = g & frozen .~ False-  return . fromMaybe (move g') $ die g' <|> eatFood g'---- | Possibly die if next head position is disallowed-die :: Game -> Maybe Game---- | Possibly eat food if next head position is food-eatFood :: Game -> Maybe Game---- | Move snake along in a marquee fashion-move :: Game -> Game---- | Turn game direction (only turns orthogonally)------ Implicitly unpauses yet freezes game-turn :: Direction -> Game -> Game---- | Initialize a paused game with random food location-initGame :: IO Game-```--### `UI`--To start, we need to determine what our `App s e n` type parameters are.-This will completely describe the interface application and be passed-to one of the library's `main` style functions for execution. Note that-`s` is the app state, `e` is an event type, and `n` is a resource name.-The `e` is abstracted so that we can provide custom events. The `n`-is usually a custom sum type called `Name` which allows us to *name*-particular viewports. This is important so that we can keep track of-where the user currently has *focus*, such as typing in one of two-textboxes; however, for this simple snake game we don't need to worry-about that.--In simpler cases, the state `s` can directly coincide with a core-datatype such as our `Snake.Game`. In many cases however, it will be-necessary to wrap the core state within the ui state `s` to keep track-of things that are interface specific (more on this later).--Let's write out our app definition and leave some undefined functions:--```haskell-{-# LANGUAGE OverloadedStrings #-}-module UI where--import Control.Monad (forever, void)-import Control.Monad.IO.Class (liftIO)-import Control.Concurrent (threadDelay, forkIO)-import Data.Maybe (fromMaybe)--import Snake--import Brick-  ( App(..), AttrMap, BrickEvent(..), EventM, Next, Widget-  , customMain, neverShowCursor-  , continue, halt-  , hLimit, vLimit, vBox, hBox-  , padRight, padLeft, padTop, padAll, Padding(..)-  , withBorderStyle-  , str-  , attrMap, withAttr, emptyWidget, AttrName, on, fg-  , (<+>)-  )-import Brick.BChan (newBChan, writeBChan)-import qualified Brick.Widgets.Border as B-import qualified Brick.Widgets.Border.Style as BS-import qualified Brick.Widgets.Center as C-import qualified Graphics.Vty as V-import Data.Sequence (Seq)-import qualified Data.Sequence as S-import Linear.V2 (V2(..))-import Lens.Micro ((^.))---- Types---- | Ticks mark passing of time------ This is our custom event that will be constantly fed into the app.-data Tick = Tick---- | Named resources------ Not currently used, but will be easier to refactor--- if we call this "Name" now.-type Name = ()--data Cell = Snake | Food | Empty---- App definition--app :: App Game Tick Name-app = App { appDraw = drawUI-          , appChooseCursor = neverShowCursor-          , appHandleEvent = handleEvent-          , appStartEvent = return-          , appAttrMap = const theMap-          }--main :: IO ()-main = undefined---- Handling events--handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent = undefined---- Drawing--drawUI :: Game -> [Widget Name]-drawUI = undefined--theMap :: AttrMap-theMap = undefined-```--#### Custom Events--So far I've only used `brick` to make games which need to be redrawn-as time passes, with or without user input. This requires using-`Brick.customMain` with that `Tick` event type, and opening a forked-process to `forever` feed that event type into the channel. Since this-is a common scenario, there is a `Brick.BChan` module that makes this-pretty quick:--```haskell-main :: IO ()-main = do-  chan <- newBChan 10-  forkIO $ forever $ do-    writeBChan chan Tick-    threadDelay 100000 -- decides how fast your game moves-  g <- initGame-  void $ customMain (V.mkVty V.defaultConfig) (Just chan) app g-```--We do need to import `Vty.Graphics` since `customMain` allows us-to specify a custom `IO Vty.Graphics.Vty` handle, but we're only-customizing the existence of the event channel `BChan Tick`. The app-is now bootstrapped, and all we need to do is implement `handleEvent`,-`drawUI`, and `theMap` (handles styling).--#### Handling events--Handling events is largely straightforward, and can be very clean when-your underlying application logic is taken care of in a core module. All-we do is essentially map events to the proper state modifiers.--```haskell-handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent g (AppEvent Tick)                       = continue $ step g-handleEvent g (VtyEvent (V.EvKey V.KUp []))         = continue $ turn North g-handleEvent g (VtyEvent (V.EvKey V.KDown []))       = continue $ turn South g-handleEvent g (VtyEvent (V.EvKey V.KRight []))      = continue $ turn East g-handleEvent g (VtyEvent (V.EvKey V.KLeft []))       = continue $ turn West g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'k') [])) = continue $ turn North g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'j') [])) = continue $ turn South g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'l') [])) = continue $ turn East g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'h') [])) = continue $ turn West g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'r') [])) = liftIO (initGame) >>= continue-handleEvent g (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt g-handleEvent g (VtyEvent (V.EvKey V.KEsc []))        = halt g-handleEvent g _                                     = continue g-```--It's probably obvious, but `continue` will continue execution with-the supplied state value, which is then drawn. We can also `halt` to-stop execution, which will essentially finish the evaluation of our-`customMain` and result in `IO Game`, where the resulting game is the-last value that we supplied to `halt`.--#### Drawing--Drawing is fairly simple as well but can require a good amount of code-to position things how you want them. I like to break up the visual-space into regions with drawing functions for each one.--```haskell-drawUI :: Game -> [Widget Name]-drawUI g =-  [ C.center $ padRight (Pad 2) (drawStats g) <+> drawGrid g ]--drawStats :: Game -> Widget Name-drawStats = undefined--drawGrid :: Game -> Widget Name-drawGrid = undefined-```--This will center the overall interface (`C.center`), put the stats and-grid widgets horizontally side by side (`<+>`), and separate them by a-2-character width (`padRight (Pad 2)`).--Let's move forward with the stats column:--```haskell-drawStats :: Game -> Widget Name-drawStats g = hLimit 11-  $ vBox [ drawScore (g ^. score)-         , padTop (Pad 2) $ drawGameOver (g ^. dead)-         ]--drawScore :: Int -> Widget Name-drawScore n = withBorderStyle BS.unicodeBold-  $ B.borderWithLabel (str "Score")-  $ C.hCenter-  $ padAll 1-  $ str $ show n--drawGameOver :: Bool -> Widget Name-drawGameOver dead =-  if dead-     then withAttr gameOverAttr $ C.hCenter $ str "GAME OVER"-     else emptyWidget--gameOverAttr :: AttrName-gameOverAttr = "gameOver"-```--I'm throwing in that `hLimit 11` to prevent the widget greediness caused-by the outer `C.center`. I'm also using `vBox` to show some other-options of aligning widgets; `vBox` and `hBox` align a list of widgets-vertically and horizontally, respectfully. They can be thought of as-folds over the binary `<=>` and `<+>` operations.--The score is straightforward, but it is the first border in-this tutorial. Borders are well documented in the [border-demo](https://github.com/jtdaugherty/brick/blob/master/programs/BorderDe-mo.hs) and the Haddocks for that matter.--We also only show the "game over" widget if the game is actually over.-In that case, we are rendering the string widget with the `gameOverAttr`-attribute name. Attribute names are basically type safe *names* that-we can assign to widgets to apply predetermined styles, similar to-assigning a class name to a div in HTML and defining the CSS styles for-that class elsewhere.--Attribute names implement `IsString`, so they are easy to construct with-the `OverloadedStrings` pragma.--Now for the main event:--```haskell-drawGrid :: Game -> Widget Name-drawGrid g = withBorderStyle BS.unicodeBold-  $ B.borderWithLabel (str "Snake")-  $ vBox rows-  where-    rows         = [hBox $ cellsInRow r | r <- [height-1,height-2..0]]-    cellsInRow y = [drawCoord (V2 x y) | x <- [0..width-1]]-    drawCoord    = drawCell . cellAt-    cellAt c-      | c `elem` g ^. snake = Snake-      | c == g ^. food      = Food-      | otherwise           = Empty--drawCell :: Cell -> Widget Name-drawCell Snake = withAttr snakeAttr cw-drawCell Food  = withAttr foodAttr cw-drawCell Empty = withAttr emptyAttr cw--cw :: Widget Name-cw = str "  "--snakeAttr, foodAttr, emptyAttr :: AttrName-snakeAttr = "snakeAttr"-foodAttr = "foodAttr"-emptyAttr = "emptyAttr"--```--There's actually nothing new here! We've already covered all the-`brick` functions necessary to draw the grid. My approach to grids is-to render a square cell widget `cw` with different colors depending-on the cell state. The easiest way to draw a colored square is to-stick two characters side by side. If we assign an attribute with a-matching foreground and background, then it doesn't matter what the two-characters are (provided that they aren't some crazy Unicode characters-that might render to an unexpected size). However, if we want empty-cells to render with the same color as the user's default background-color, then spaces are a good choice.--Finally, we'll define the attribute map:--```haskell-theMap :: AttrMap-theMap = attrMap V.defAttr-  [ (snakeAttr, V.blue `on` V.blue)-  , (foodAttr, V.red `on` V.red)-  , (gameOverAttr, fg V.red `V.withStyle` V.bold)-  ]-```--Again, styles aren't terribly complicated, but it-will be one area where you might have to look in the-[vty](http://hackage.haskell.org/package/vty) package (specifically-[Graphics.Vty.Attributes](http://hackage.haskell.org/package/vty-5.15.1/docs/Graphics-Vty-Attributes.html)) to find what you need.--Another thing to mention is that the attributes form a hierarchy and-can be combined in a parent-child relationship via `mappend`. I haven't-actually used this feature, but it does sound quite handy. For a more-detailed discussion see the-[Brick.AttrMap](https://hackage.haskell.org/package/brick-0.18/docs/Brick-AttrMap.html) haddocks.--## Variable speed--One difficult problem I encountered was implementing a variable speed in-the GoL. I could have just used the same approach above with the minimum-thread delay (corresponding to the maximum speed) and counted `Tick`-events, only issuing an actual `step` in the game when the modular count-of `Tick`s reached an amount corresponding to the current game speed,-but that's kind of an ugly approach.--Instead, I reached out to the author and he advised me to use a `TVar`-within the app state.  I had never used `TVar`, but it's pretty easy!--```haskell-main :: IO ()-main = do-  chan <- newBChan 10-  tv   <- atomically $ newTVar (spToInt initialSpeed)-  forkIO $ forever $ do-    writeBChan chan Tick-    int <- atomically $ readTVar tv-    threadDelay int-  customMain (V.mkVty V.defaultConfig) (Just chan) app (initialGame tv)-    >>= printResult-```--The `tv <- atomically $ newTVar (value :: a)` creates a new mutable-reference to a value of type `a`, i.e. `TVar a`, and returns it in `IO`.-In this case `value` is an `Int` which represents the delay between game-steps. Then in the forked process, we read the delay from the `TVar`-reference and use that to space out the calls to `writeBChan chan Tick`.--I store that same `tv :: TVar Int` in the brick app state, so that the-user can change the speed:--```haskell-handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent g (VtyEvent (V.EvKey V.KRight [V.MCtrl])) = handleSpeed g (+)-handleEvent g (VtyEvent (V.EvKey V.KLeft [V.MCtrl]))  = handleSpeed g (-)--handleSpeed :: Game -> (Float -> Float -> Float) -> EventM n (Next Game)-handleSpeed g (+/-) = do-  let newSp = validS $ (g ^. speed) +/- speedInc-  liftIO $ atomically $ writeTVar (g ^. interval) (spToInt newSp)-  continue $ g & speed .~ newSp---- where---- | Speed increments = 0.01 gives 100 discrete speed settings-speedInc :: Float-speedInc = 0.01---- | Game state-data Game = Game-  { _board    :: Board -- ^ Board state-  , _time     :: Int   -- ^ Time elapsed-  , _paused   :: Bool  -- ^ Playing vs. paused-  , _speed    :: Float -- ^ Speed in [0..1]-  , _interval :: TVar Int -- ^ Interval kept in TVar-  , _focus    :: F.FocusRing Name -- ^ Keeps track of grid focus-  , _selected :: Cell -- ^ Keeps track of cell focus-  }-```--## Conclusion--`brick` let's you build TUIs very quickly. I was able to write `snake`-along with this tutorial within a few hours. More complicated interfaces-can be tougher, but if you can successfully separate the interface and-core functionality, you'll have an easier time tacking on the frontend.--Lastly, let me remind you to look in the-[demo programs](https://github.com/jtdaugherty/brick/tree/master/programs)-to figure stuff out, as *many* scenarios are covered throughout them.--## Links-* [brick](https://hackage.haskell.org/package/brick)-* [snake](https://github.com/samtay/snake)-* [tetris](https://github.com/samtay/tetris)-* [conway](https://github.com/samtay/conway)
+ 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
@@ -23,28 +23,28 @@   , modifyDefAttr   ) import Brick.Util (on, fg)-import Brick.AttrMap (attrMap, AttrMap)+import Brick.AttrMap (attrMap, AttrMap, attrName)  ui :: Widget n ui =     vBox [ str "This text uses the global default attribute."-         , withAttr "foundFull" $+         , withAttr (attrName "foundFull") $            str "Specifying an attribute name means we look it up in the attribute tree."-         , (withAttr "foundFgOnly" $-           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" $+         , 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 "linked" $+         , withAttr (attrName "linked") $            str "This text is hyperlinked in terminals that support hyperlinking."          , str " "          , hyperlink "http://www.google.com/" $@@ -59,18 +59,19 @@  theMap :: AttrMap theMap = attrMap globalDefault-    [ ("foundFull",               white `on` green)-    , ("foundFgOnly",             fg red)-    , ("general",                 yellow `on` black)-    , ("general" <> "specific",   fg cyan)-    , ("linked",                  fg yellow `withURL` "http://www.google.com/")+    [ (attrName "foundFull",               white `on` green)+    , (attrName "foundFgOnly",             fg red)+    , (attrName "general",                 yellow `on` black)+    , (attrName "general" <> attrName "specific",+                                           fg cyan)+    , (attrName "linked",                  fg yellow `withURL` "http://www.google.com/")     ]  app :: App () e () app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const theMap         , appChooseCursor = neverShowCursor         }
programs/BorderDemo.hs view
@@ -1,11 +1,11 @@+{-# 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 @@ -16,16 +16,17 @@   ( 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@@ -65,20 +66,23 @@     B.borderWithLabel (str "label") $     vLimit 5 $     C.vCenter $-    txt $ "  " <> styleName <> " style  "+    padLeftRight 2 $+    txt $ styleName <> " style"  titleAttr :: A.AttrName-titleAttr = "title"+titleAttr = A.attrName "title" -borderMappings :: [(A.AttrName, V.Attr)]-borderMappings =+attrs :: [(A.AttrName, V.Attr)]+attrs =     [ (B.borderAttr,         V.yellow `on` V.black)+    , (B.vBorderAttr,        fg V.cyan)+    , (B.hBorderAttr,        fg V.magenta)     , (titleAttr,            fg V.cyan)     ]  colorDemo :: Widget () colorDemo =-    updateAttrMap (A.applyAttrMappings borderMappings) $+    updateAttrMap (A.applyAttrMappings attrs) $     B.borderWithLabel (withAttr titleAttr $ str "title") $     hLimit 20 $     vLimit 5 $@@ -87,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
@@ -3,8 +3,9 @@ {-# LANGUAGE CPP #-} module Main where -import Lens.Micro ((^.), (&), (.~), (%~))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void, forever) import Control.Concurrent (threadDelay, forkIO) #if !(MIN_VERSION_base(4,11,0))@@ -16,8 +17,7 @@ import Brick.Main   ( App(..)   , showFirstCursor-  , customMain-  , continue+  , customMainWithDefaultVty   , halt   ) import Brick.AttrMap@@ -25,7 +25,6 @@   ) import Brick.Types   ( Widget-  , Next   , EventM   , BrickEvent(..)   )@@ -50,14 +49,15 @@             <=>             (str $ "Counter value is: " <> (show $ st^.stCounter)) -appEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St)-appEvent st e =+appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e =     case e of-        VtyEvent (V.EvKey V.KEsc []) -> halt st-        VtyEvent _ -> continue $ st & stLastBrickEvent .~ (Just e)-        AppEvent Counter -> continue $ st & stCounter %~ (+1)-                                          & stLastBrickEvent .~ (Just e)-        _ -> continue st+        VtyEvent (V.EvKey V.KEsc []) -> halt+        VtyEvent _ -> stLastBrickEvent .= (Just e)+        AppEvent Counter -> do+            stCounter %= (+1)+            stLastBrickEvent .= (Just e)+        _ -> return ()  initialState :: St initialState =@@ -70,7 +70,7 @@     App { appDraw = drawUI         , appChooseCursor = showFirstCursor         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         } @@ -78,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
@@ -25,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@@ -53,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/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@@ -47,18 +48,19 @@             str " " <=>             str "Press Tab to switch between editors, Esc to quit." -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.VtyEvent 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 =@@ -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
@@ -1,11 +1,15 @@ module Main where  import Brick+import Brick.Widgets.Border  ui :: Widget ()-ui = vBox [ str "This text is at the top."-          , fill ' '-          , str "This text is at the bottom."+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 ()
programs/FormDemo.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} module Main where@@ -5,9 +6,13 @@ 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@@ -109,29 +114,31 @@ app :: App (Form UserInfo e Name) e Name app =     App { appDraw = draw-        , appHandleEvent = \s ev ->+        , appHandleEvent = \ev -> do+            f <- gets formFocus             case ev of-                VtyEvent (V.EvResize {})     -> continue s-                VtyEvent (V.EvKey V.KEsc [])   -> halt s+                VtyEvent (V.EvResize {}) -> return ()+                VtyEvent (V.EvKey V.KEsc []) -> halt                 -- Enter quits only when we aren't in the multi-line editor.                 VtyEvent (V.EvKey V.KEnter [])-                    | focusGetCurrent (formFocus s) /= Just AddressField -> halt s+                    | focusGetCurrent f /= Just AddressField -> halt                 _ -> do-                    s' <- handleFormEvent ev s+                    handleFormEvent ev                      -- Example of external validation:                     -- Require age field to contain a value that is at least 18.-                    continue $ setFieldValid ((formState s')^.age >= 18) AgeField s'+                    st <- gets formState+                    modify $ setFieldValid (st^.age >= 18) AgeField          , appChooseCursor = focusRingCursor formFocus-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const theMap         }  main :: IO () main = do     let buildVty = do-          v <- V.mkVty =<< V.standardIOConfig+          v <- mkVty V.defaultConfig           V.setMode (V.outputIface v) V.Mouse True           return v @@ -145,7 +152,8 @@         f = setFieldValid False AgeField $             mkForm initialUserInfo -    f' <- customMain buildVty Nothing app f+    initialVty <- buildVty+    f' <- customMain initialVty buildVty Nothing app f      putStrLn "The starting form state was:"     print initialUserInfo
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,10 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where  import Lens.Micro ((^.))+import Lens.Micro.Mtl import Control.Monad (void)+import Control.Monad.State (modify) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif@@ -48,26 +49,28 @@                               , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List () Char -> T.BrickEvent () e -> T.EventM () (T.Next (L.List () Char))-appEvent l (T.VtyEvent e) =+appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent (T.VtyEvent e) =     case e of-        V.EvKey (V.KChar '+') [] ->-            let el = nextElement (L.listElements l)-                pos = Vec.length $ l^.(L.listElementsL)-            in M.continue $ L.listInsert pos el l+        V.EvKey (V.KChar '+') [] -> do+            els <- use L.listElementsL+            let el = nextElement els+                pos = Vec.length els+            modify $ L.listInsert pos el -        V.EvKey (V.KChar '-') [] ->-            case l^.(L.listSelectedL) of-                Nothing -> M.continue l-                Just i -> M.continue $ L.listRemove i l+        V.EvKey (V.KChar '-') [] -> do+            sel <- use L.listSelectedL+            case sel of+                Nothing -> return ()+                Just i -> modify $ L.listRemove i -        V.EvKey V.KEsc [] -> M.halt l+        V.EvKey V.KEsc [] -> M.halt -        ev -> M.continue =<< L.handleListEvent ev l+        ev -> L.handleListEvent ev     where       nextElement :: Vec.Vector Char -> Char       nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])-appEvent l _ = M.continue l+appEvent _ = return ()  listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a =@@ -80,7 +83,7 @@ initialState = L.list () (Vec.fromList ['a','b','c']) 1  customAttr :: A.AttrName-customAttr = L.listSelectedAttr <> "custom"+customAttr = L.listSelectedAttr <> A.attrName "custom"  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -94,7 +97,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
programs/ListViDemo.hs view
@@ -1,14 +1,15 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where  import Control.Monad (void)+import Control.Monad.State (modify) import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import qualified Graphics.Vty as V import Lens.Micro ((^.))+import Lens.Micro.Mtl  import qualified Brick.AttrMap as A import qualified Brick.Main as M@@ -39,26 +40,28 @@                               , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List () Char -> T.BrickEvent () e -> T.EventM () (T.Next (L.List () Char))-appEvent l (T.VtyEvent e) =+appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent (T.VtyEvent e) =     case e of-        V.EvKey (V.KChar '+') [] ->-            let el = nextElement (L.listElements l)-                pos = Vec.length $ l^.(L.listElementsL)-            in M.continue $ L.listInsert pos el l+        V.EvKey (V.KChar '+') [] -> do+            els <- use L.listElementsL+            let el = nextElement els+                pos = Vec.length els+            modify $ L.listInsert pos el -        V.EvKey (V.KChar '-') [] ->-            case l^.(L.listSelectedL) of-                Nothing -> M.continue l-                Just i  -> M.continue $ L.listRemove i l+        V.EvKey (V.KChar '-') [] -> do+            sel <- use L.listSelectedL+            case sel of+                Nothing -> return ()+                Just i  -> modify $ L.listRemove i -        V.EvKey V.KEsc [] -> M.halt l+        V.EvKey V.KEsc [] -> M.halt -        ev -> M.continue =<< (L.handleListEventVi L.handleListEvent) ev l+        ev -> L.handleListEventVi L.handleListEvent ev     where       nextElement :: Vec.Vector Char -> Char       nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])-appEvent l _ = M.continue l+appEvent _ = return ()  listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a =@@ -71,7 +74,7 @@ initialState = L.list () (Vec.fromList ['a','b','c']) 1  customAttr :: A.AttrName-customAttr = L.listSelectedAttr <> "custom"+customAttr = L.listSelectedAttr <> A.attrName "custom"  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -85,7 +88,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
− 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 (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 that 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"+    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,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} module Main where  import Control.Monad (void)@@ -7,6 +8,8 @@ import Data.Monoid #endif import qualified Graphics.Vty as V+import Lens.Micro.Mtl+import Lens.Micro.TH  import qualified Brick.AttrMap as A import qualified Brick.Main as M@@ -18,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@@ -33,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"@@ -80,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)@@ -88,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)          ] @@ -96,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
@@ -3,7 +3,7 @@ {-# LANGUAGE CPP #-} module Main where -import Lens.Micro ((.~), (^.), (&))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) import Control.Monad (void) #if !(MIN_VERSION_base(4,11,0))@@ -13,7 +13,7 @@  import Brick.Main   ( App(..), neverShowCursor, defaultMain-  , suspendAndResume, halt, continue+  , suspendAndResume, halt   ) import Brick.AttrMap   ( attrMap@@ -21,7 +21,6 @@ import Brick.Types   ( Widget   , EventM-  , Next   , BrickEvent(..)   ) import Brick.Widgets.Core@@ -42,16 +41,16 @@                   , str "(Press Esc to quit or Space to ask for input)"                   ] -appEvent :: St -> BrickEvent () e -> EventM () (Next St)-appEvent st (VtyEvent e) =+appEvent :: BrickEvent () e -> EventM () St ()+appEvent (VtyEvent e) =     case e of-        V.EvKey V.KEsc [] -> halt st+        V.EvKey V.KEsc [] -> halt         V.EvKey (V.KChar ' ') [] -> suspendAndResume $ do             putStrLn "Suspended. Please enter something and press enter to resume:"             s <- getLine-            return $ st & stExternalInput .~ s-        _ -> continue st-appEvent st _ = continue st+            return $ St { _stExternalInput = s }+        _ -> return ()+appEvent _ = return ()  initialState :: St initialState =@@ -63,7 +62,7 @@     App { appDraw = drawUI         , appChooseCursor = neverShowCursor         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         }
+ 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
@@ -1,6 +1,9 @@+{-# LANGUAGE CPP #-} module Main where +#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))+#endif import Brick import Text.Wrap (defaultWrapSettings, preserveIndentation)
programs/ThemeDemo.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Monad (void)+import Control.Monad.State (put) import Graphics.Vty   ( white, blue, green, yellow, black, magenta   , Event(EvKey)@@ -18,7 +18,6 @@   ( Widget   , BrickEvent(VtyEvent)   , EventM-  , Next   ) import Brick.Widgets.Center   ( hCenter@@ -32,7 +31,7 @@   , withDefAttr   ) import Brick.Util (on, fg)-import Brick.AttrMap (AttrName)+import Brick.AttrMap (AttrName, attrName)  ui :: Widget n ui =@@ -44,7 +43,7 @@          ]  keybindingAttr :: AttrName-keybindingAttr = "keybinding"+keybindingAttr = attrName "keybinding"  theme1 :: Theme theme1 =@@ -58,28 +57,28 @@              [ (keybindingAttr, fg yellow)              ] -appEvent :: Int -> BrickEvent () e -> EventM () (Next Int)-appEvent _ (VtyEvent (EvKey (KChar '1') [])) = continue 1-appEvent _ (VtyEvent (EvKey (KChar '2') [])) = continue 2-appEvent s (VtyEvent (EvKey (KChar 'q') [])) = halt s-appEvent s (VtyEvent (EvKey KEsc [])) = halt s-appEvent s _ = continue s+appEvent :: BrickEvent () e -> EventM () Int ()+appEvent (VtyEvent (EvKey (KChar '1') [])) = put 1+appEvent (VtyEvent (EvKey (KChar '2') [])) = put 2+appEvent (VtyEvent (EvKey (KChar 'q') [])) = halt+appEvent (VtyEvent (EvKey KEsc [])) = halt+appEvent _ = return ()  app :: App Int e () app =     App { appDraw = const [ui]         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = \s ->             -- Note that in practice this is not ideal: we don't want-            -- to build an attribute from a theme every time this is+            -- 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.-            if s == 1-            then themeToAttrMap theme1-            else themeToAttrMap theme2+            themeToAttrMap $ if s == 1+                             then theme1+                             else theme2         , appChooseCursor = neverShowCursor         }
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,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} module Main where@@ -6,6 +5,7 @@ import Control.Monad (void) import Lens.Micro import Lens.Micro.TH+import Lens.Micro.Mtl #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif@@ -15,7 +15,7 @@ import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B-import Brick.AttrMap (AttrMap, AttrName, attrMap)+import Brick.AttrMap (AttrMap, AttrName, attrMap, attrName) import Brick.Util (on) import Brick.Types   ( Widget@@ -55,7 +55,7 @@ vp3Size = (25, 25)  selectedAttr :: AttrName-selectedAttr = "selected"+selectedAttr = attrName "selected"  drawUi :: St -> [Widget Name] drawUi st = [ui]@@ -102,17 +102,17 @@ vp3Scroll :: M.ViewportScroll Name vp3Scroll = M.viewportScroll VP3 -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = M.continue $ st & vp3Index._2 %~ max 1 .  subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KDown []))         = M.continue $ st & vp1Index %~ min vp1Size . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp []))           = M.continue $ st & vp1Index %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KRight []))        = M.continue $ st & vp2Index %~ min vp2Size . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft []))         = M.continue $ st & vp2Index %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st-appEvent st _ = M.continue st+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = vp3Index._1 %= min (vp3Size^._1) . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = vp3Index._1 %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = vp3Index._2 %= min (vp3Size^._1) . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = vp3Index._2 %= max 1 .  subtract 1+appEvent (T.VtyEvent (V.EvKey V.KDown []))         = vp1Index %= min vp1Size . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp []))           = vp1Index %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KRight []))        = vp2Index %= min vp2Size . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft []))         = vp2Index %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return ()  theMap :: AttrMap theMap = attrMap V.defAttr@@ -122,7 +122,7 @@ app :: M.App St e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const theMap           , M.appChooseCursor = M.neverShowCursor
+ programs/custom_keys.ini view
@@ -0,0 +1,4 @@+[keybindings]+quit = x+increment = i+decrement = d
src/Brick.hs view
@@ -1,8 +1,11 @@ -- | This module is provided as a convenience to import the most--- important parts of the API all at once. Note that the Haddock--- documentation for this library is for /reference/ usage; if you--- are looking for an introduction or tutorial, see the README for links--- to plenty of material!+-- 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,6 +27,7 @@   -- * Construction   , attrMap   , forceAttrMap+  , forceAttrMapAllowStyle   , attrName   -- * Inspection   , attrNameComponents@@ -43,19 +43,16 @@   ) 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. Hierarchy in an attribute name is used to@@ -65,12 +62,12 @@ -- example: -- -- @--- "window" <> "border"--- "window" <> "title"--- "header" <> "clock" <> "seconds"+-- attrName "window" <> attrName "border"+-- attrName "window" <> attrName "title"+-- attrName "header" <> attrName "clock" <> attrName "seconds" -- @ data AttrName = AttrName [String]-              deriving (Show, Read, Eq, Ord)+              deriving (Show, Read, Eq, Ord, Generic, NFData)  instance Sem.Semigroup AttrName where     (AttrName as) <> (AttrName bs) = AttrName $ as `mappend` bs@@ -79,13 +76,11 @@     mempty = AttrName []     mappend = (Sem.<>) -instance IsString AttrName where-    fromString = AttrName . (:[])- -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr)              | ForceAttr Attr-             deriving Show+             | ForceAttrAllowStyle Attr AttrMap+             deriving (Show, Generic, NFData)  -- | Create an attribute name from a string. attrName :: String -> AttrName@@ -106,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@@ -129,46 +129,60 @@ -- @ 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. 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 u1) (Attr s2 f2 b2 u2) =-    Attr (s1 `combineMDs` s2)+    Attr (s1 `combineStyles` s2)          (f1 `combineMDs` f2)          (b1 `combineMDs` b2)          (u1 `combineMDs` u2)@@ -178,10 +192,17 @@ 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
@@ -1,11 +1,12 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Brick.BorderMap     ( BorderMap     , Edges(..)     , eTopL, eBottomL, eRightL, eLeftL-    , empty, emptyCoordinates, singleton+    , empty, clear, emptyCoordinates, singleton     , insertH, insertV, insert     , unsafeUnion     , coordinates, bounds@@ -16,8 +17,12 @@     ) 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 @@ -43,21 +48,30 @@ data BorderMap a = BorderMap     { _coordinates :: Edges Int     , _values :: Edges (IMap a)-    } deriving (Eq, Ord, Show, Functor)+    } 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 only tracks the point (0,0).+-- | 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 (pure 0)+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 $ empty+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@@ -161,8 +175,8 @@     }     where     bounds' = neighbors coordinates'-    values' = pure gc-        <*> _coordinates m+    values' = gc+        <$> _coordinates m         <*> coordinates'         <*> bounds'         <*> _values m
src/Brick/Focus.hs view
@@ -1,7 +1,5 @@ -- | This module provides a type and functions for handling focus rings -- of values.------ This interface is experimental. module Brick.Focus   ( FocusRing   , focusRing@@ -9,6 +7,8 @@   , focusPrev   , focusGetCurrent   , focusSetCurrent+  , focusRingLength+  , focusRingToList   , focusRingCursor   , withFocusRing   , focusRingModify@@ -16,7 +16,7 @@ where  import Lens.Micro ((^.))-import Data.Maybe (listToMaybe)+import Data.List (find) import qualified Data.CircularList as C  import Brick.Types@@ -25,6 +25,7 @@ -- | A focus ring containing a sequence of resource names to focus and a -- currently-focused name. newtype FocusRing n = FocusRing (C.CList n)+                    deriving (Show)  -- | Construct a focus ring from the list of resource names. focusRing :: [n] -> FocusRing n@@ -58,13 +59,13 @@               -> (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 (FocusRing l) = C.focus l @@ -76,6 +77,18 @@         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.@@ -95,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
@@ -2,9 +2,13 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}--- | NOTE: This API is experimental and will probably change. Please try--- it out! Feedback is very much appreciated, and your patience in the--- face of breaking API changes is also appreciated!+{-# 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@@ -18,10 +22,6 @@ -- user when a form field's value is invalid, and stores valid inputs in -- your data type when possible. ----- This module provides the API to create forms, populate them with some--- basic input field types, render forms, handle form events, and create--- custom input field types.--- -- 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@@ -31,6 +31,11 @@ -- '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@@ -44,6 +49,7 @@     Form   , FormFieldState(..)   , FormField(..)+  , FormFieldVisibilityMode(..)    -- * Creating and using forms   , newForm@@ -58,16 +64,23 @@   , 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@@ -76,22 +89,25 @@   ) where -import Graphics.Vty+import Graphics.Vty hiding (showCursor) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif-import Data.Maybe (isJust, isNothing)+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@@ -105,34 +121,47 @@ --  * @e@ - your application's event type --  * @n@ - your application's resource name type data FormField a b e n =-    FormField { formFieldName        :: n+    FormField { formFieldName :: n               -- ^ The name identifying this form field.-              , formFieldValidate    :: b -> Maybe a+              , 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 s-              -- aan integer and return 'Maybe' 'Int'. This is for pure-              -- avalue validation; if additional validation is required-              -- a(e.g. via 'IO'), use this field's state value in an-              -- aexternal validation routine and use 'setFieldValid' to-              -- afeed the result back into the form.+              -- 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+              , 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 -> b -> EventM n b-              -- ^ An event handler for this field. This receives the-              -- event and the field state and returns a new field-              -- state.+              , formFieldHandleEvent :: BrickEvent n e -> EventM n b ()+              -- ^ An event handler for this field.               } +-- | 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@@ -158,11 +187,14 @@                       -- the field collection. Note that this type is                       -- existential. All form fields in the collection                       -- must validate to this type.-                      , formFieldLens  :: Lens' s a+                      , formFieldLens :: Lens' s a                       -- ^ A lens to extract and store a                       -- successfully-validated form input back into                       -- your form state.-                      , formFields     :: [FormField a b e n]+                      , 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@@ -174,10 +206,14 @@                       , 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.+-- underlying state that you choose. This value must be stored in the+-- Brick application's state. -- -- Type variables are as follows: --@@ -187,10 +223,10 @@ --  * @n@ - your application's resource name type data Form s e n =     Form { formFieldStates  :: [FormFieldState s e n]-         , formFocus        :: FocusRing n+         , formFocus :: FocusRing n          -- ^ The focus ring for the form, indicating which form field          -- has input focus.-         , formState        :: s+         , 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@@ -201,6 +237,8 @@          -- ^ Concatenation function for this form's field renderings.          } +suffixLenses ''Form+ -- | Compose a new rendering augmentation function with the one in the -- form field collection. For example, we might put a label on the left -- side of a form field:@@ -219,6 +257,29 @@     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 }@@ -240,13 +301,13 @@ newForm mkEs s =     let es = mkEs <*> pure s     in Form { formFieldStates = es-            , formFocus       = focusRing $ concat $ formFieldNames <$> es+            , formFocus       = focusRing $ concatMap formFieldNames es             , formState       = s             , formConcatAll   = vBox             }  formFieldNames :: FormFieldState s e n -> [n]-formFieldNames (FormFieldState _ _ fields _ _) = formFieldName <$> fields+formFieldNames (FormFieldState _ _ _ fields _ _ _) = formFieldName <$> fields  -- | A form field for manipulating a boolean value. This represents -- 'True' as @[X] label@ and 'False' as @[ ] label@.@@ -263,31 +324,113 @@               -> s               -- ^ The initial form state.               -> FormFieldState s e n-checkboxField stLens name label initialState =+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 _ _ _) s | n == name = return $ not s-        handleEvent (VtyEvent (EvKey (KChar ' ') [])) s = return $ not s-        handleEvent _ s = return s+        handleEvent (MouseDown n _ _ _) | n == name = modify not+        handleEvent (VtyEvent (EvKey (KChar ' ') [])) = modify not+        handleEvent _ = return () -    in FormFieldState { formFieldState        = initVal-                      , formFields            = [ FormField name Just True-                                                            (renderCheckbox label name)-                                                            handleEvent-                                                ]-                      , formFieldLens         = stLens+    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+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly                       } -renderCheckbox :: T.Text -> n -> Bool -> Bool -> Widget n-renderCheckbox label n foc val =+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 $-       (str $ "[" <> (if val then "X" else " ") <> "] ") <+> txt label+       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@@ -301,7 +444,30 @@            -> s            -- ^ The initial form state.            -> FormFieldState s e n-radioField stLens options initialState =+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 =@@ -310,45 +476,52 @@                 [(val, _, _)] -> Just val                 _ -> Nothing -        handleEvent _ (MouseDown n _ _ _) s =+        handleEvent _ (MouseDown n _ _ _) =             case lookupOptionValue n of-                Nothing -> return s-                Just v -> return v-        handleEvent new (VtyEvent (EvKey (KChar ' ') [])) _ = return new-        handleEvent _ _ s = return s+                Nothing -> return ()+                Just v -> put v+        handleEvent new (VtyEvent (EvKey (KChar ' ') [])) = put new+        handleEvent _ _ = return ()          optionFields = mkOptionField <$> options         mkOptionField (val, name, label) =             FormField name                       Just                       True-                      (renderRadio val name label)+                      (renderRadio lb check rb val name label)                       (handleEvent val) -    in FormFieldState { formFieldState        = initVal-                      , formFields            = optionFields-                      , formFieldLens         = stLens+    in FormFieldState { formFieldState = initVal+                      , formFields = optionFields+                      , formFieldLens = stLens+                      , formFieldUpdate = \val _ -> val                       , formFieldRenderHelper = id-                      , formFieldConcat       = vBox+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly                       } -renderRadio :: (Eq a) => a -> n -> T.Text -> Bool -> a -> Widget n-renderRadio val name label foc cur =+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 $-       hBox [ str "["-            , str $ if isSet then "*" else " "-            , txt $ "] " <> label-            ]+       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)@@ -363,7 +536,7 @@           -- the editor's initial contents. The resulting text may           -- contain newlines.           -> ([T.Text] -> Maybe a)-          -- ^ The validation function that converts the editors+          -- ^ 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@@ -383,19 +556,23 @@                      then id                      else Z.moveCursor pos         initialText = ini $ initialState ^. stLens-        handleEvent (VtyEvent e) ed = handleEditorEvent e ed-        handleEvent _ ed = return ed      in FormFieldState { formFieldState = initVal-                      , formFields     = [ FormField n-                                                     (val . getEditContents)-                                                     True-                                                     (\b e -> wrapEditor $ renderEditor renderText b e)-                                                     handleEvent-                                         ]-                      , formFieldLens  = stLens+                      , 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'@@ -404,6 +581,9 @@ -- 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)@@ -415,8 +595,39 @@                   -- ^ 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 = readMaybe . T.unpack . T.intercalate "\n"+        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@@ -424,6 +635,9 @@ -- | 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)@@ -446,6 +660,9 @@ -- 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)@@ -468,15 +685,22 @@  -- | The namespace for the other form attributes. formAttr :: AttrName-formAttr = "brickForm"+formAttr = attrName "brickForm" --- | The attribute for form input fields with invalid values.+-- | 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 <> "invalidInput"+invalidFormInputAttr = formAttr <> attrName "invalidInput" --- | The attribute for form input fields that have the focus.+-- | 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 <> "focusedInput"+focusedFormInputAttr = formAttr <> attrName "focusedInput"  -- | Returns whether all form fields in the form currently have valid -- values according to the fields' validation functions. This is useful@@ -490,8 +714,53 @@ -- force the user to repair invalid inputs before moving on from a form -- editing session. invalidFields :: Form s e n -> [n]-invalidFields f = concat $ getInvalidFields <$> formFieldStates f+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@@ -508,21 +777,21 @@     let go1 [] = []         go1 (s:ss) =             let s' = case s of-                       FormFieldState st l fs rh concatAll ->+                       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 (go2 fs) rh concatAll+                           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 _ _) =+getInvalidFields (FormFieldState st _ _ fs _ _ _) =     let gather (FormField n validate extValid _ _) =-            if (not extValid || (isNothing $ validate st)) then [n] else []-    in concat $ gather <$> fs+            if not extValid || isNothing (validate st) then [n] else []+    in concatMap gather fs  -- | Render a form. --@@ -536,7 +805,9 @@ -- 'invalidFormInputAttr' attribute. -- -- Finally, all of the resulting field renderings are concatenated with--- the form's concatenation function (see 'setFormConcat').+-- 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@@ -549,18 +820,27 @@                      => FocusRing n                      -> FormFieldState s e n                      -> Widget n-renderFormFieldState fr (FormFieldState st _ fields helper concatFields) =-    let renderFields [] = []+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-                foc = Just n == focusGetCurrent fr-            in maybeInvalid (renderField foc st) : renderFields fs-    in helper $ concatFields $ renderFields fields+                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 appropriate form field and return a new--- form. This handles the following events in this order:+-- | Dispatch an event to the currently focused form field. This handles+-- the following events in this order: -- -- * On @Tab@ keypresses, this changes the focus to the next field in --   the form.@@ -585,44 +865,31 @@ -- lens. The external validation flag is ignored during this step to -- ensure that external validators have a chance to get the intermediate -- validated value.-handleFormEvent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n)-handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) f =-    return $ f { formFocus = focusNext $ formFocus f }-handleFormEvent (VtyEvent (EvKey KBackTab [])) f =-    return $ f { formFocus = focusPrev $ formFocus f }-handleFormEvent e@(MouseDown n _ _ _) f =-    handleFormFieldEvent n e $ f { formFocus = focusSetCurrent n (formFocus f) }-handleFormEvent e@(MouseUp n _ _) f =-    handleFormFieldEvent n e $ f { formFocus = focusSetCurrent n (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KUp [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryBefore grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KDown [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryAfter grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KLeft [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryBefore grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KRight [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryAfter grp n) (formFocus f) }-handleFormEvent e f = forwardToCurrent e f+handleFormEvent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()+handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) =+    formFocusL %= focusNext+handleFormEvent (VtyEvent (EvKey KBackTab [])) =+    formFocusL %= focusPrev+handleFormEvent e@(MouseDown n _ _ _) = do+    formFocusL %= focusSetCurrent n+    handleFormFieldEvent e n+handleFormEvent e@(MouseUp n _ _) = do+    formFocusL %= focusSetCurrent n+    handleFormFieldEvent e n+handleFormEvent e@(VtyEvent (EvKey KUp [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryBefore grp n)+handleFormEvent e@(VtyEvent (EvKey KDown [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryAfter grp n)+handleFormEvent e@(VtyEvent (EvKey KLeft [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryBefore grp n)+handleFormEvent e@(VtyEvent (EvKey KRight [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryAfter grp n)+handleFormEvent e =+    forwardToCurrent e  getFocusGrouping :: (Eq n) => Form s e n -> n -> Maybe [n] getFocusGrouping f n = findGroup (formFieldStates f)@@ -636,34 +903,52 @@  entryAfter :: (Eq a) => [a] -> a -> a entryAfter as a =-    let Just i = elemIndex a as+    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 Just i = elemIndex a as+    let i = fromJust $ elemIndex a as         i' = if i == 0 then length as - 1 else i - 1     in as !! i' -forwardToCurrent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n)-forwardToCurrent e f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  -> handleFormFieldEvent n e f+withFocusAndGrouping :: (Eq n)+                     => BrickEvent n e+                     -> (n -> [n] -> EventM n (Form s e n) ())+                     -> EventM n (Form s e n) ()+withFocusAndGrouping e act = do+    foc <- gets formFocus+    case focusGetCurrent foc of+        Nothing -> return ()+        Just n -> do+            f <- get+            case getFocusGrouping f n of+                Nothing -> forwardToCurrent e+                Just grp -> act n grp -handleFormFieldEvent :: (Eq n) => n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)-handleFormFieldEvent n ev f = findFieldState [] (formFieldStates f)-    where-        findFieldState _ [] = return f+withFocus :: (n -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()+withFocus act = do+    foc <- gets formFocus+    case focusGetCurrent foc of+        Nothing -> return ()+        Just n -> act n++forwardToCurrent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()+forwardToCurrent =+    withFocus . handleFormFieldEvent++handleFormFieldEvent :: (Eq n) => BrickEvent n e -> n -> EventM n (Form s e n) ()+handleFormFieldEvent ev n = do+    let findFieldState _ [] = return ()         findFieldState prev (e:es) =             case e of-                FormFieldState st stLens fields helper concatAll -> do+                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 <- handleFunc ev st+                                    (nextSt, ()) <- nestEventM st (handleFunc ev)                                     -- If the new state validates, go ahead and update                                     -- the form state with it.                                     case validate nextSt of@@ -674,10 +959,12 @@                     result <- findField fields                     case result of                         Nothing -> findFieldState (prev <> [e]) es-                        Just (newSt, maybeSt) ->-                            let newFieldState = FormFieldState newSt stLens fields helper concatAll-                            in return $ f { formFieldStates = prev <> [newFieldState] <> es-                                          , formState = case maybeSt of-                                              Nothing -> formState f-                                              Just s  -> formState f & stLens .~ s-                                          }+                        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,15 +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@@ -38,21 +44,23 @@   -- * Rendering cache management   , invalidateCacheEntry   , invalidateCache++  -- * Renderer internals (for benchmarking)+  , renderFinal+  , getRenderState+  , resetRenderState+  , renderWidget   ) where -import Control.Exception (finally)+import qualified Control.Exception as E import Lens.Micro ((^.), (&), (.~), (%~), _1, _2)-import Control.Monad (forever)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State-import Control.Monad.Trans.Reader+import Control.Monad+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@@ -66,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@@ -99,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.@@ -113,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.@@ -122,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@@ -145,7 +157,7 @@ simpleApp w =     App { appDraw = const [w]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap defAttr []         , appChooseCursor = neverShowCursor         }@@ -155,50 +167,55 @@ -- 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)-              => 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@@ -209,39 +226,136 @@            -> s            -- ^ The initial application state.            -> IO s-customMain buildVty mUserChan app initialAppState = do-    initialVty <- buildVty-    let run vty rs st brickChan = do-            result <- runWithNewVty vty brickChan mUserChan app rs st-            case result of-                InternalHalt s -> return s-                InternalSuspendAndResume newRS action -> do-                    newAppState <- action-                    newVty <- buildVty-                    run newVty newRS newAppState brickChan+customMain initialVty buildVty mUserChan app initialAppState = do+    let restoreInitialState = restoreInputState $ inputIface initialVty -        emptyES = ES [] mempty-        eventRO = EventRO M.empty initialVty 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 initialVty 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@@ -250,67 +364,73 @@         -- 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+                    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))+                            -- 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)-                        False -> return (e, firstRS, exts)+                        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-                                -- 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)-                        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 [] mempty-        eventRO = EventRO (viewportMap nextRS) 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) => S.Set (CacheInvalidateRequest n) -> M.Map n v -> M.Map n v applyInvalidations ns cache =@@ -325,57 +445,73 @@ -- 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 Vty-getVtyHandle = EventM $ asks eventVtyHandle+getVtyHandle :: EventM n s Vty+getVtyHandle = vtyContextHandle <$> getVtyContext +setVtyContext :: VtyContext -> EventM n s ()+setVtyContext ctx =+    EventM $ lift $ lift $ modify $ \s -> s { vtyContext = ctx }+ -- | Invalidate the rendering cache entry with the specified resource -- name.-invalidateCacheEntry :: (Ord n) => n -> EventM n ()+invalidateCacheEntry :: (Ord n) => n -> EventM n s () invalidateCacheEntry n = EventM $ do-    lift $ modify (\s -> s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })  -- | Invalidate the entire rendering cache.-invalidateCache :: (Ord n) => EventM n ()+invalidateCache :: (Ord n) => EventM n s () invalidateCache = EventM $ do-    lift $ modify (\s -> s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s })+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s }) -withVty :: Vty -> (Vty -> IO a) -> IO a-withVty vty useVty = do-    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@@ -383,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) @@ -410,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.@@ -418,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@@ -468,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
@@ -1,12 +1,11 @@ {-# 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. ----- The file format is as follows:--- -- Customization files are INI-style files with two sections, both -- optional: @"default"@ and @"other"@. --@@ -29,13 +28,14 @@ -- (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@, and @bold@.+-- @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 (@"foo" <> "bar"@), then+-- 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@@ -48,7 +48,7 @@ -- -- 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 @"list" <> "selected"@ can be+-- a dot. For example, the attribute name @attrName "list" <> attrName "selected"@ can be -- referenced by using the string "list.selected". module Brick.Themes   ( CustomAttr(..)@@ -76,6 +76,7 @@  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@@ -87,7 +88,9 @@ 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@@ -107,7 +110,7 @@                , customStyle :: Maybe Style                -- ^ The customized style, if any.                }-               deriving (Eq, Read, Show, Generic)+               deriving (Eq, Read, Show, Generic, NFData)  instance Sem.Semigroup CustomAttr where     a <> b =@@ -127,7 +130,7 @@                        -- so e.g. documentation for theme customization                        -- can be generated mechanically.                        }-                       deriving (Eq, Read, Show, Generic)+                       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@@ -151,7 +154,7 @@           -- default mapping; any attributes named here that are not           -- present in the default mapping will not be considered.           }-          deriving (Eq, Read, Show, Generic)+          deriving (Eq, Read, Show, Generic, NFData)  suffixLenses ''CustomAttr suffixLenses ''Theme@@ -247,6 +250,7 @@ allStyles =     [ ("standout", standout)     , ("underline", underline)+    , ("strikethrough", strikethrough)     , ("reversevideo", reverseVideo)     , ("blink", blink)     , ("dim", dim)@@ -399,7 +403,7 @@ attrToCustom :: Attr -> CustomAttr attrToCustom a =     CustomAttr { customFg    = Just $ attrForeColor a-               , customBg    = 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,22 +19,34 @@   , 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, ctxDynBorders)+  , Context(ctxAttrName, availWidth, availHeight, windowWidth, windowHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)   , attrL   , availWidthL   , availHeightL+  , windowWidthL+  , windowHeightL+  , ctxVScrollBarOrientationL+  , ctxVScrollBarRendererL+  , ctxHScrollBarOrientationL+  , ctxHScrollBarRendererL   , ctxAttrMapL   , ctxAttrNameL   , ctxBorderStyleL@@ -61,6 +71,7 @@    -- * Making lenses   , suffixLenses+  , suffixLensesWith    -- * Dynamic borders   , bordersL@@ -73,95 +84,75 @@    -- * 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
@@ -1,7 +1,9 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}-+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE CPP #-} module Brick.Types.Common   ( Location(..)   , locL@@ -12,14 +14,20 @@  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)+data Location = Location { loc :: !(Int, Int)                          -- ^ (Column, Row)                          }-                deriving (Show, Eq, Ord)+                deriving (Show, Eq, Ord, Read, Generic, NFData)  suffixLenses ''Location @@ -40,8 +48,8 @@     mempty = origin     mappend = (Sem.<>) -data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }-    deriving (Eq, Ord, Read, Show, Functor)+data Edges a = Edges { eTop, eBottom, eLeft, eRight :: !a }+    deriving (Eq, Ord, Read, Show, Functor, Generic, NFData)  suffixLenses ''Edges
+ 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,10 +19,36 @@   , 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(..)@@ -31,15 +59,22 @@   , dbStyleL, dbAttrL, dbSegmentsL   , CacheInvalidateRequest(..)   , BrickEvent(..)+  , RenderM+  , getContext+  , lookupReportedExtent+  , Widget(..)    , rsScrollRequestsL   , viewportMapL   , clickableNamesL+  , reportedExtentsL   , renderCacheL   , observedNamesL+  , requestedVisibleNames_L   , vpSize   , vpLeft   , vpTop+  , vpContentSize   , imageL   , cursorsL   , extentsL@@ -49,15 +84,17 @@   ) 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 qualified Data.Set as S import qualified Data.Map as M 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@@ -66,79 +103,202 @@ 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     deriving (Ord, Eq) -data EventState n = ES { esScrollRequests :: [(n, ScrollRequest)]-                       , cacheInvalidateRequests :: S.Set (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 :: 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)+               deriving (Show, Eq, Read, Generic, NFData)  -- | The class of types that behave like terminal locations. class TerminalLocation a where@@ -162,52 +322,50 @@                    -- ^ 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+    { bsAccept :: !Bool     -- ^ Would this segment be willing to be drawn if a neighbor wanted to     -- connect to it?-    , bsOffer :: Bool+    , bsOffer :: !Bool     -- ^ Does this segment want to connect to its neighbor?-    , bsDraw :: Bool+    , bsDraw :: !Bool     -- ^ Should this segment be represented visually?-    } deriving (Eq, Ord, Read, Show)--suffixLenses ''BorderSegment+    } 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+    { 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+    , 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)--suffixLenses ''DynBorder+    , 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@@ -220,55 +378,88 @@            -- If you're writing a widget, this should make it easier for you to            -- do so; but beware this lack of invariant if you are consuming            -- widgets.-           , borders :: BorderMap DynBorder+           , borders :: !(BorderMap DynBorder)            -- ^ Places where we may rewrite the edge of the image when            -- placing this widget next to another one.            }-           deriving Show--suffixLenses ''Result+           deriving (Show, Read, Generic, NFData)  emptyResult :: Result n-emptyResult = Result emptyImage [] [] [] BM.empty+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+                    | MouseDown !n !Button ![Modifier] !Location                     -- ^ A mouse-down event on the specified region was                     -- received. The 'n' value is the resource name of                     -- the clicked widget (see 'clickable').-                    | MouseUp n (Maybe Button) Location+                    | 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-            , ctxDynBorders :: Bool+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
@@ -20,16 +20,17 @@    -- * Attribute names   , borderAttr+  , hBorderAttr+  , vBorderAttr    -- * Utility   , joinableBorder   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>)) #endif- import Lens.Micro ((^.), (&), (.~), to) import Graphics.Vty (imageHeight, imageWidth) @@ -43,8 +44,16 @@  -- | The top-level border attribute name. borderAttr :: AttrName-borderAttr = "border"+borderAttr = attrName "border" +-- | The horizontal border attribute name. Inherits from 'borderAttr'.+hBorderAttr :: AttrName+hBorderAttr = borderAttr <> attrName "horizontal"++-- | 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'. --@@ -99,7 +108,8 @@              $ 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 =     withAttr borderAttr $ Widget Greedy Fixed $ do@@ -109,7 +119,8 @@       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 $ vLimit 1 $ fill (bsHorizontal bs)+      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.@@ -121,7 +132,8 @@       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 =     withAttr borderAttr $ Widget Fixed Greedy $ do@@ -131,7 +143,8 @@       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 $ hLimit 1 $ fill (bsVertical bs)+      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
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
@@ -4,1198 +4,1983 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}--- | 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-  , padLeft-  , padRight-  , padTop-  , padBottom-  , padLeftRight-  , padTopBottom-  , padAll--  -- * Box layout-  , (<=>)-  , (<+>)-  , hBox-  , vBox--  -- * Limits-  , hLimit-  , vLimit-  , setAvailableSize--  -- * Attribute management-  , withDefAttr-  , modifyDefAttr-  , withAttr-  , forceAttr-  , overrideAttr-  , updateAttrMap--  -- * Border style management-  , withBorderStyle-  , joinBorders-  , separateBorders-  , freezeBorders--  -- * 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, 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.IMap as I-import qualified Data.Function as DF-import Data.List (sortBy, partition)-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.empty) <$> 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 .-                      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 o) -> Extent n (off <> l) sz o)--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').-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 ""---- | 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 escapes.-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 escapes.-strWrapWith :: WrapSettings -> String -> Widget n-strWrapWith settings t = txtWrapWith settings $ T.pack t--safeTextWidth :: T.Text -> Int-safeTextWidth = V.safeWcswidth . T.unpack---- | 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 escapes.-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 escapes.-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-          [one] -> return $ emptyResult & imageL .~ (V.text' (c^.attrL) one)-          multiple ->-              let maxLength = maximum $ safeTextWidth <$> multiple-                  lineImgs = lineImg <$> multiple-                  lineImg lStr = V.text' (c^.attrL)-                                   (lStr <> T.replicate (maxLength - safeTextWidth lStr) " ")-              in return $ emptyResult & imageL .~ (V.vertCat lineImgs)---- | Build a widget from a 'String'. 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--- reinput string should not contain escapes.-str :: String -> Widget n-str s =-    Widget Fixed Fixed $ do-      c <- getContext-      let theLines = fixEmpty <$> (dropUnused . lines) s-          fixEmpty :: String -> String-          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 'T.Text' value. Behaves the same as 'str'--- 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--- reinput text should not contain escapes.-txt :: T.Text -> Widget n-txt = str . T.unpack---- | 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 = attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL) `V.withURL` url-        withReaderT (& ctxAttrMapL %~ setDefaultAttr attr) (render p)---- | 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-                , 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-                , limitSecondary = hLimit-                , 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-                , limitSecondary = vLimit-                , 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--      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-                  rest = remainingPrimary - (primaryPerLow * length ls)-                  secondaryPerLow = c^.(contextSecondary br)-                  primaries = replicate rest (primaryPerLow + 1) <>-                              replicate (length ls - rest) primaryPerLow--              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)-          (imageRewrites, newBorders) = catAllBorders br (borders <$> allTranslatedResults)-          rewrittenImages = zipWith (rewriteImage br) imageRewrites allImages-          paddedImages = padImage <$> rewrittenImages--      cropResultToContext $ Result (concatenatePrimary br paddedImages)-                            (concat $ cursors <$> allTranslatedResults)-                            (concat $ visibilityRequests <$> allTranslatedResults)-                            (concat $ 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 accomodate 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 synch 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 = img-        | otherwise = concatenatePrimary br-            [ go loRewrite (splitLoPrimary br 1 img)-            , splitHiPrimary br 1 img-            ]-    rewriteHi img-        | I.null hiRewrite = 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 =-    Widget Fixed (vSize p) $-      withReaderT (& availWidthL %~ (min 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 %~ (min h)) $ 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 =-    Widget Fixed Fixed $-      withReaderT (\c -> c & availHeightL .~ h & availWidthL .~ w) $-        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 and then modifying it with the--- specified function.-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 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 %~ (setDefaultAttr (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 =-    clickable vpname $ 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 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
@@ -5,21 +5,25 @@ -- 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?" 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.+-- 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@@ -30,24 +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 #endif-import Data.List (intersperse)+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@@ -63,71 +63,91 @@ -- -- * Tab or Right Arrow: select the next button -- * Shift-tab or Left Arrow: select the previous button-data Dialog a =-    Dialog { dialogTitle :: Maybe String+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 True d-        EvKey KBackTab [] -> nextButtonBy (-1) True d-        EvKey KRight [] -> nextButtonBy 1 False d-        EvKey KLeft [] -> nextButtonBy (-1) False 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) $@@ -136,24 +156,12 @@             , hCenter buttons             ] -nextButtonBy :: Int -> Bool -> Dialog a -> Dialog a-nextButtonBy amt wrapCycle 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 newIndex)-               where-                   addedIndex = i + amt-                   newIndex = if wrapCycle-                              then addedIndex `mod` numButtons-                              else max 0 $ min addedIndex $ numButtons - 1---- | 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
@@ -25,6 +25,7 @@   , editorText   -- * Reading editor contents   , getEditContents+  , getCursorPosition   -- * Handling events   , handleEditorEvent   -- * Editing text@@ -36,6 +37,8 @@   -- * Attributes   , editAttr   , editFocusedAttr+  -- * UTF-8 decoding of editor pastes+  , DecodeUtf8(..)   ) where @@ -45,9 +48,13 @@ 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@@ -55,14 +62,25 @@  -- | 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@@ -83,37 +101,75 @@ 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)-       -> 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)@@ -125,28 +181,34 @@        -> Editor a n 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
+ 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
@@ -4,44 +4,79 @@   , 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, Edges(..))+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 False-        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@@ -58,11 +93,11 @@                     & 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.@@ -75,42 +110,36 @@                , 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 -> BorderMap DynBorder -> BorderMap DynBorder+cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder cropBorders ctx = BM.crop Edges     { eTop = 0     , eBottom = availHeight ctx - 1@@ -119,17 +148,52 @@     }  renderDynBorder :: DynBorder -> V.Image-renderDynBorder db = V.char (dbAttr db) . ($dbStyle db) $ case bsDraw <$> dbSegments db of-    --    top   bot   left  right-    Edges False False False False -> const ' ' -- dunno lol (but should never happen, so who cares)-    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+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,15 +1,23 @@ {-# 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+  ( GenericList+  , List    -- * Constructing a list   , list@@ -27,6 +35,7 @@   , listSelectedL   , listNameL   , listItemHeightL+  , listSelectedElementL    -- * Accessors   , listElements@@ -38,11 +47,15 @@   -- * Manipulating a list   , listMoveBy   , listMoveTo+  , listMoveToElement+  , listFindBy   , listMoveUp   , listMoveDown   , listMoveByPages   , listMovePageUp   , listMovePageDown+  , listMoveToBeginning+  , listMoveToEnd   , listInsert   , listRemove   , listReplace@@ -50,24 +63,38 @@   , 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 ((<>))+#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)@@ -75,143 +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's vector of elements.+--+-- 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-         -- ^ The height of the list items.-         } 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 [] -> listMovePageDown theList-        EvKey KPageUp [] -> listMovePageUp theList-        _ -> return theList+        EvKey KUp [] -> modify listMoveUp+        EvKey KDown [] -> modify listMoveDown+        EvKey KHome [] -> modify listMoveToBeginning+        EvKey KEnd [] -> modify listMoveToEnd+        EvKey KPageDown [] -> listMovePageDown+        EvKey KPageUp [] -> listMovePageUp+        _ -> return () --- | Enable list movement with the vi keys with a fallback if none--- match. Use (handleListEventVi handleListEvent) in place of--- handleListEvent to add the vi keys bindings to the standard ones.--- Movements handled include:+-- | 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)+-- * Up (k)+-- * Down (j)+-- * Page Up (Ctrl-b)+-- * Page Down (Ctrl-f)+-- * Half Page Up (Ctrl-u) -- * Half Page Down (Ctrl-d)--- * Top            (g)--- * Bottom         (G)-handleListEventVi :: (Ord n)-                  => (Event -> List n e -> EventM n (List n e))+-- * 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-                  -> List n e-                  -> EventM n (List n e)-handleListEventVi fallback e theList =+                  -> EventM n (GenericList n t e) ()+handleListEventVi fallback e =     case e of-        EvKey (KChar 'k') [] -> return $ listMoveUp theList-        EvKey (KChar 'j') [] -> return $ listMoveDown theList-        EvKey (KChar 'g') [] -> return $ listMoveTo 0 theList-        EvKey (KChar 'G') [] -> return $ listMoveTo (V.length $ listElements theList) theList-        EvKey (KChar 'f') [MCtrl] -> listMovePageDown theList-        EvKey (KChar 'b') [MCtrl] -> listMovePageUp theList-        EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double) theList-        EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double) theList-        _ -> fallback e theList+        EvKey (KChar 'k') []      -> modify listMoveUp+        EvKey (KChar 'j') []      -> modify listMoveDown+        EvKey (KChar 'g') []      -> modify listMoveToBeginning+        EvKey (KChar 'G') []      -> modify listMoveToEnd+        EvKey (KChar 'f') [MCtrl] -> listMovePageDown+        EvKey (KChar 'b') [MCtrl] -> listMovePageUp+        EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double)+        EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double)+        _                         -> fallback e +-- | Move the list selection to the first element in the list.+listMoveToBeginning :: (Foldable t, Splittable t)+                    => 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 = renderListWithIndex $ const drawElem --- | Like 'renderList', except the render function is also provided--- with the index of each element.-renderListWithIndex :: (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-           -> List n e-           -- ^ The List to be rendered-           -> Widget n-           -- ^ rendered widget+-- | 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 -> (Int -> 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@@ -228,7 +369,7 @@              off = start * (l^.listItemHeightL) -            drawnElements = flip V.imap es $ \i e ->+            drawnElements = flip imap es $ \i e ->                 let j = i + start                     isSelected = Just j == l^.listSelectedL                     elemWidget = drawElem j isSelected e@@ -242,134 +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 :: (Ord n) => List n e -> EventM n (List n e)-listMovePageUp theList = listMoveByPages (-1::Double) theList+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 down by one page.-listMovePageDown :: (Ord n) => List n e -> EventM n (List n e)-listMovePageDown theList = listMoveByPages (1::Double) theList+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 :: (Ord n, RealFrac m) => m -> List n e -> EventM n (List n e)-listMoveByPages pages theList = do+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 theList-        Just vp -> let-            nElems = round $ pages * (fromIntegral $ vp^.vpSize._2) / (fromIntegral $ theList^.listItemHeightL)-          in-            return $ listMoveBy nElems theList+        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 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.-listMoveBy :: Int -> List n e -> List n e+-- | 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 current = case l^.listSelectedL of-          Nothing-            | amt > 0 -> Just 0-            | otherwise -> Just (V.length (l^.listElementsL) - 1)-          cur -> cur-        clamp' a b c-          | a <= b = Just (clamp a b c)-          | otherwise = Nothing-        newSel = clamp' 0 (V.length (l^.listElementsL) - 1) =<< (amt +) <$> current-    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
@@ -3,6 +3,7 @@ -- | This module provides a progress bar widget. module Brick.Widgets.ProgressBar   ( progressBar+  , customProgressBar   -- * Attributes   , progressCompleteAttr   , progressIncompleteAttr@@ -22,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@@ -37,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
@@ -1,4 +1,6 @@ {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Data.IMap     ( IMap     , Run(..)@@ -22,13 +24,15 @@ 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)+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@@ -72,7 +76,7 @@ data Run a = Run     { len :: !Int     , val :: !a-    } deriving (Eq, Ord, Read, Show, Functor)+    } 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
− src/Data/Text/Markup.hs 
@@ -1,85 +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 qualified Data.Semigroup as Sem-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 Sem.Semigroup (Markup a) where-    (Markup t1) <> (Markup t2) = Markup (t1 `mappend` t2)--instance Monoid (Markup a) where-    mempty = Markup mempty-    mappend = (Sem.<>)--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
@@ -1,13 +1,21 @@+{-# 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 @@ -54,16 +62,16 @@ prop_compare l r = compare l r == compare (lower l) (lower r)  prop_applicativeIdentity :: I -> Bool-prop_applicativeIdentity v = (pure id <*> v) == v+prop_applicativeIdentity v = (id <$> v) == v  prop_applicativeComposition :: IMap (O -> O) -> IMap (O -> O) -> IMap O -> Bool-prop_applicativeComposition u v w = (pure (.) <*> u <*> v <*> w) == (u <*> (v <*> w))+prop_applicativeComposition u v w = ((.) <$> u <*> v <*> w) == (u <*> (v <*> w))  prop_applicativeHomomorphism :: (O -> O) -> O -> Bool-prop_applicativeHomomorphism f x = (pure f <*> pure x :: I) == pure (f x)+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) == (pure ($ y) <*> u)+prop_applicativeInterchange u y = (u <*> pure y) == (($ y) <$> u)  prop_empty :: Bool prop_empty = lower (IMap.empty :: I) == IntMap.empty@@ -103,5 +111,7 @@  return [] -main :: IO Bool-main = $quickCheckAll+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