packages feed

brick 0.2.3 → 2.12

raw patch · 79 files changed

Files

CHANGELOG.md view
@@ -2,98 +2,1963 @@ Brick changelog --------------- -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-  handled sanely (fixes #22; reported by Hans-Peter Deifel)--0.2.2--------Demo changes:-* Improved the list demo by using characters instead of integers in the-  demo list and cleaned up item-adding code (thanks Jøhannes Lippmann-  <code@schauderbasis.de>)--0.2.1--------Bug fixes:-* List:-  * Fixed size policy of lists so that rather than being Fixed/Fixed,-    they are Greedy/Greedy. This resolves issues that arise when the box-    layout widget renders a list widget alongside a Fixed/Fixed one.-    (Closes issue #17, thanks Karl Voelker)-* Scrolling:-  * vScrollPage actually scrolls vertically now rather than horizontally-    (Thanks Hans-Peter Deifel <hpd@hpdeifel.de>)--0.2------API changes:-* Added top-level `Brick` module that re-exports the most important-  modules in the library.-* List:-  * Now instead of passing the item-drawing function to the `list` state-    constructor, it is passed to `renderList`-  * `renderList` now takes the row height of the list's item widgets.-    The list item-drawing function must respect this in order for-    scrolling to work properly. This change made it possible to optimize-    the list so that it only draws widgets visible in the viewport-    rather than rendering all of the list's items (even the ones-    off-screen). But to do this we must be able to tell in advance-    how high each one is, so we require this parameter. In addition-    this change means that lists no longer support items of different-    heights.-  * The list now uses Data.Vector instead of [a] to store items; this-    permits efficient slicing so we can do the optimized rendering-    described above.-* The `HandleEvent` type class `handleEvent` method now runs in-  `EventM`. This permits event-handling code implemented in terms of-  `HandleEvent` to do get access to viewport state and to run IO code,-  making it just as powerful as code in the top-level `EventM` handler.-* Many types were moved from `Brick.Widgets.Core` and `Brick.Main` to-  `Brick.Types`, making the former module merely a home for `Widget`-  constructors and combinators.-* The `IsString` instance for `Widget` was removed; this might be-  reinstated later, but this package provides enough `IsString`-  instances that things can get confusing.-* `EventM` is now reader monad over the most recent rendering pass's-  viewport state, in addition to being a state monad over viewport-  requests for the renderer. Added the `lookupViewport` function to-  provide access to the most recent viewport state. Exported the-  `Viewport` type and lenses.-* Now that `handleEvent` is now an `EventM` action, composition with-  `continue` et al got a little messier when using lenses to-  update the application state. To help with this, there is now-  `handleEventLensed`.--Bugfixes:-* Lists now perform well with 10 items or a million (see above; fixes-  #7, thanks Simon Michael)-* Added more haddock notes to `Brick.Widgets.Core` about growth-  policies.-* Forced evaluation of render states to address a space leak in the-  renderer (fixes #14, thanks Sebastian Reuße <seb@wirrsal.net>)-* str: only reference string content that can be shown (eliminates a-  space leak, fixes #14, thanks Sebastian Reuße <seb@wirrsal.net>)--Misc:-* Added a makefile for the user guide.-* List: added support for Home and End keys (thanks Simon Michael)-* Viewports: when rendering viewports, scroll requests from `EventM` are-  processed before visibility requests from the rendering process; this-  reverses this previous order of operations but permits user-supplied-  event handlers to reset viewports when desired.--Package changes:-* Added `deepseq` dependency--0.1----+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+-----++Demo changes:+* Improved the list demo by using characters instead of integers in the+  demo list and cleaned up item-adding code (thanks Jøhannes Lippmann+  <code@schauderbasis.de>)++0.2.1+-----++Bug fixes:+* List:+  * Fixed size policy of lists so that rather than being Fixed/Fixed,+    they are Greedy/Greedy. This resolves issues that arise when the box+    layout widget renders a list widget alongside a Fixed/Fixed one.+    (Closes issue #17, thanks Karl Voelker)+* Scrolling:+  * vScrollPage actually scrolls vertically now rather than horizontally+    (Thanks Hans-Peter Deifel <hpd@hpdeifel.de>)++0.2+---++API changes:+* Added top-level `Brick` module that re-exports the most important+  modules in the library.+* List:+  * Now instead of passing the item-drawing function to the `list` state+    constructor, it is passed to `renderList`+  * `renderList` now takes the row height of the list's item widgets.+    The list item-drawing function must respect this in order for+    scrolling to work properly. This change made it possible to optimize+    the list so that it only draws widgets visible in the viewport+    rather than rendering all of the list's items (even the ones+    off-screen). But to do this we must be able to tell in advance+    how high each one is, so we require this parameter. In addition+    this change means that lists no longer support items of different+    heights.+  * The list now uses Data.Vector instead of [a] to store items; this+    permits efficient slicing so we can do the optimized rendering+    described above.+* The `HandleEvent` type class `handleEvent` method now runs in+  `EventM`. This permits event-handling code implemented in terms of+  `HandleEvent` to do get access to viewport state and to run IO code,+  making it just as powerful as code in the top-level `EventM` handler.+* Many types were moved from `Brick.Widgets.Core` and `Brick.Main` to+  `Brick.Types`, making the former module merely a home for `Widget`+  constructors and combinators.+* The `IsString` instance for `Widget` was removed; this might be+  reinstated later, but this package provides enough `IsString`+  instances that things can get confusing.+* `EventM` is now reader monad over the most recent rendering pass's+  viewport state, in addition to being a state monad over viewport+  requests for the renderer. Added the `lookupViewport` function to+  provide access to the most recent viewport state. Exported the+  `Viewport` type and lenses.+* Now that `handleEvent` is now an `EventM` action, composition with+  `continue` et al got a little messier when using lenses to+  update the application state. To help with this, there is now+  `handleEventLensed`.++Bugfixes:+* Lists now perform well with 10 items or a million (see above; fixes+  #7, thanks Simon Michael)+* Added more haddock notes to `Brick.Widgets.Core` about growth+  policies.+* Forced evaluation of render states to address a space leak in the+  renderer (fixes #14, thanks Sebastian Reuße <seb@wirrsal.net>)+* str: only reference string content that can be shown (eliminates a+  space leak, fixes #14, thanks Sebastian Reuße <seb@wirrsal.net>)++Misc:+* Added a makefile for the user guide.+* List: added support for Home and End keys (thanks Simon Michael)+* Viewports: when rendering viewports, scroll requests from `EventM` are+  processed before visibility requests from the rendering process; this+  reverses this previous order of operations but permits user-supplied+  event handlers to reset viewports when desired.++Package changes:+* Added `deepseq` dependency++0.1+---+ Initial release
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015, Jonathan Daugherty.+Copyright (c) 2015-2025, Jonathan Daugherty. All rights reserved.  Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,108 +1,211 @@-brick--------[![Build Status](https://travis-ci.org/jtdaugherty/brick.png)](https://travis-ci.org/jtdaugherty/brick)+![](logo/brick-final-clearbg-with-text.svg) -`brick` is a terminal user interface programming-library written in Haskell, 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 -- even the bits that are stateful -- using a set of-declarative combinators. Then you provide a function to transform your-own 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).+Under the hood, this library builds upon+[vty](http://hackage.haskell.org/package/vty), so some knowledge of Vty+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. -This library deprecates [vty-ui](https://github.com/jtdaugherty/vty-ui).+Example+------- -Feature Overview-----------------+Here's an example interface (see `programs/ReadmeDemo.hs`): -`brick` comes with a bunch of widget types to get you started:+```+joinBorders $+withBorderStyle unicode $+borderWithLabel (str "Hello!") $+(center (str "Left") <+> vBorder <+> center (str "Right"))+``` - * Vertical and horizontal box layout widgets- * Basic single- and multi-line text editor widgets- * List widget- * Progress bar widget- * Simple dialog box widget- * Border-drawing widgets (put borders around or in between things)- * Generic scrollable viewports- * Extensible widget-building API- * (And many more general-purpose layout control combinators)+Result: -In addition, some of `brick`'s more powerful features may not be obvious-right away:+```+┌─────────Hello!─────────┐+│           │            │+│           │            │+│   Left    │   Right    │+│           │            │+│           │            │+└───────────┴────────────┘+``` - * All widgets can be arranged in predictable layouts so you don't have-   to worry about terminal resizes.- * Most widgets can be made scrollable *for free*.- * Attribute management is flexible and can be customized at runtime on-   a per-widget basis.+Featured Projects+----------------- -`brick` exports [lens](http://github.com/ekmett/lens) and non-`lens`-interfaces for most things, so you can get the full power of `lens` if-you want it or use plain Haskell if you don't. If a `brick` library-function named `thing` has a `lens` version, the `lens` version is named-`thingL`.+To get an idea of what some people have done with `brick`, check out+these projects. If you have made something and would like me to include+it, get in touch! +| Project | Description |+| ------- | ----------- |+| [`2048Haskell`](https://github.com/8Gitbrix/2048Haskell) | An implementation of the 2048 game |+| [`babel-cards`](https://github.com/srhoulam/babel-cards) | A TUI spaced-repetition memorization tool. Similar to Anki. |+| [`bhoogle`](https://github.com/andrevdm/bhoogle) | A [Hoogle](https://www.haskell.org/hoogle/) client |+| [`bollama`](https://github.com/andrevdm/bollama) | A simple [Ollama](https://ollama.com/) TUI |+| [`brewsage`](https://github.com/gerdreiss/brewsage#readme) | A TUI for Homebrew |+| [`brick-trading-journal`](https://codeberg.org/amano.kenji/brick-trading-journal) | A TUI program that calculates basic statistics from trades |+| [`Brickudoku`](https://github.com/Thecentury/brickudoku) | A hybrid of Tetris and Sudoku |+| [`cbookview`](https://github.com/mlang/cbookview) | A TUI for exploring polyglot chess opening book files |+| [`clifm`](https://github.com/pasqu4le/clifm) | A file manager |+| [`codenames-haskell`](https://github.com/VigneshN1997/codenames-haskell) | An implementation of the Codenames game |+| [`fifteen`](https://github.com/benjaminselfridge/fifteen) | An implementation of the [15 puzzle](https://en.wikipedia.org/wiki/15_puzzle) |+| [`ghcup`](https://www.haskell.org/ghcup/) | A TUI for `ghcup`, the Haskell toolchain manager |+| [`git-brunch`](https://github.com/andys8/git-brunch) | A git branch checkout utility |+| [`Giter`](https://gitlab.com/refaelsh/giter) | A UI wrapper around Git CLI inspired by [Magit](https://magit.vc/). |+| [`gotta-go-fast`](https://github.com/callum-oakley/gotta-go-fast) | A typing tutor |+| [`haradict`](https://github.com/srhoulam/haradict) | A TUI Arabic dictionary powered by [ElixirFM](https://github.com/otakar-smrz/elixir-fm) |+| [`hascard`](https://github.com/Yvee1/hascard) | A program for reviewing "flash card" notes |+| [`haskell-player`](https://github.com/potomak/haskell-player) | An `afplay` frontend |+| [`herms`](https://github.com/jackkiefer/herms) | A command-line tool for managing kitchen recipes |+| [`hic-hac-hoe`](https://github.com/blastwind/hic-hac-hoe) | Play tic tac toe in terminal! |+| [`hledger-iadd`](http://github.com/rootzlevel/hledger-iadd) | An interactive terminal UI for adding hledger journal entries |+| [`hledger-ui`](https://github.com/simonmichael/hledger) | A terminal UI for the hledger accounting system. |+| [`homodoro`](https://github.com/c0nradLC/homodoro) | A terminal application to use the pomodoro technique and keep track of daily tasks |+| [`hskanban`](https://github.com/vincentaxhe/hskanban) | A Kanban organizer |+| [`htyper`](https://github.com/Simon-Hostettler/htyper) | A typing speed test program |+| [`hyahtzee2`](https://github.com/DamienCassou/hyahtzee2#readme) | Famous Yahtzee dice game |+| [`kpxhs`](https://github.com/akazukin5151/kpxhs) | An interactive [Keepass](https://github.com/keepassxreboot/keepassxc/) database viewer |+| [`matterhorn`](https://github.com/matterhorn-chat/matterhorn) | A client for [Mattermost](https://about.mattermost.com/) |+| [`maze`](https://github.com/benjaminselfridge/maze) | A Brick-based maze game |+| [`monad-torrent`](https://github.com/davorluc/monad-torrent) | A simple and minimal torrent client |+| [`monalog`](https://github.com/goosedb/Monalog) | Terminal logs observer |+| [`mushu`](https://github.com/elaye/mushu) | An `MPD` client |+| [`mywork`](https://github.com/kquick/mywork) [[Hackage]](https://hackage.haskell.org/package/mywork) | A tool to keep track of the projects you are working on |+| [`pboy`](https://github.com/2mol/pboy) | A tiny PDF organizer |+| [`purebred`](https://github.com/purebred-mua/purebred) | A mail user agent |+| [`sandwich`](https://codedownio.github.io/sandwich/) | A test framework with a TUI interface |+| [`silly-joy`](https://github.com/rootmos/silly-joy) | An interpreter for Joy |+| [`solitaire`](https://github.com/ambuc/solitaire) | The card game |+| [`sudoku-tui`](https://github.com/evanrelf/sudoku-tui) | A Sudoku implementation |+| [`summoner-tui`](https://github.com/kowainik/summoner/tree/master/summoner-tui) | An interactive frontend to the Summoner tool |+| [`swarm`](https://github.com/byorgey/swarm/) | A 2D programming and resource gathering game |+| [`tart`](https://github.com/jtdaugherty/tart) | A mouse-driven ASCII art drawing program |+| [`tick-tock-tui`](https://github.com/sectore/tick-tock-tui) | A stylish TUI app to handle Bitcoin data provided by [Mempool REST API](https://mempool.space/docs/api/rest) incl. blocks, fees and price converter. |+| [`tetris`](https://github.com/SamTay/tetris) | An implementation of the Tetris game |+| [`thock`](https://github.com/rmehri01/thock) | A modern TUI typing game featuring online racing against friends |+| [`timeloop`](https://github.com/cdupont/timeloop) | A time-travelling demonstrator |+| [`towerHanoi`](https://github.com/shajenM/projects/tree/master/towerHanoi) | Animated solutions to The Tower of Hanoi |+| [`ttyme`](https://github.com/evuez/ttyme) | A TUI for [Harvest](https://www.getharvest.com/) |+| [`ullekha`](https://github.com/ajithnn/ullekha) | An interactive terminal notes/todo app with file/redis persistence |+| [`viewprof`](https://github.com/maoe/viewprof) | A GHC profile viewer |+| [`VOIDSPACE`](https://github.com/ChrisPenner/void-space) | A space-themed typing-tutor game |+| [`wordle`](https://github.com/ivanjermakov/wordle) | An implementation of the Wordle game |+| [`wrapping-editor`](https://github.com/ta0kira/wrapping-editor) | An embeddable editor with support for Brick |+| [`youbrick`](https://github.com/florentc/youbrick) | A feed aggregator and launcher for Youtube channels |++These additional packages also extend `brick`:++| Project | Description | Hackage |+| ------- | ----------- | ------- |+| [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories | [Hackage](https://hackage.haskell.org/package/brick-filetree) |+| [`brick-panes`](https://github.com/kquick/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. | [Hackage](https://hackage.haskell.org/package/brick-panes) |+| [`brick-calendar`](https://github.com/ldgrp/brick-calendar) | A library providing a calendar widget for Brick-based applications. | [Hackage](https://hackage.haskell.org/package/brick-calendar) |+| [`brick-skylighting`](https://github.com/jtdaugherty/brick-skylighting) | A library providing integration support for [Skylighting](https://hackage.haskell.org/package/skylighting)-based syntax highlighting. | [Hackage](https://hackage.haskell.org/package/brick-skylighting) |+ Getting Started --------------- -TLDR:+Check out the many demo programs to get a feel for different aspects of+the library:  ```-$ cabal sandbox init-$ cabal install -j -f demos-$ .cabal-sandbox/bin/brick-???-demo+$ cabal new-build -f demos+$ find dist-newstyle -type f -name \*-demo ``` -To get started, see the [first few sections of the brick-user guide](docs/guide.rst).+To get started, see the [user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst).  Documentation ------------- -Your documentation options, in recommended order, are:+Documentation for `brick` comes in a variety of forms: -* [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md)-* [The brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-* Haddock (all modules)+* [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)+* [Haddock documentation](https://hackage.haskell.org/package/brick) * [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs)+* [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md) +Feature Overview+----------------++`brick` comes with a bunch of batteries included:++ * Vertical and horizontal box layout widgets+ * Basic single- and multi-line text editor widgets+ * List and table widgets+ * Progress bar widget+ * Simple dialog box widget+ * Border-drawing widgets (put borders around or in between things)+ * 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 Discussion+----------------++There are two forums for discussing brick-related things:++1. The [Discussions page](https://github.com/jtdaugherty/brick/discussions) on the github repo, and+1. The `brick-users` Google Group / e-mail list. You can subscribe+   [here](https://groups.google.com/group/brick-users).+ Status ------ -`brick` is young and may be missing some essential features. There are-some places were I have deliberately chosen to worry about performance-later for the sake of spending more time on the design (and to wait on-performance issues to arise first). `brick` exports an extension API-that makes it possible to make your own packages and widgets. If you-use that, you'll also be helping to test whether the exported interface-is usable and complete!+There are some places were I have deliberately chosen to worry about+performance later for the sake of spending more time on the design+(and to wait on performance issues to arise first). `brick` is also+something of an experimental project of mine and some aspects of the+design involve trade-offs that might not be right for your application.+Brick is not intended to be all things to all people; rather, I want it+to provide a good foundation for building complex terminal interfaces+in a declarative style to take away specific headaches of building,+modifying, and working with such interfaces, all while seeing how far we+can get with a pure function to specify the interface. -The development of this library has revealed some bugs in `vty`, and-I've tried to report those as I go. If they haven't been resolved,-you'll see them arise when using `brick`.+`brick` exports an extension API that makes it possible to make your own+packages and widgets. If you use that, you'll also be helping to test+whether the exported interface is usable and complete! +A note on Windows support+-------------------------++Brick supports Windows implicitly by way of Vty's Windows support.+While I don't (and can't) personally test Brick on Windows hosts,+it should be possible to use Brick on Windows. If you have any+trouble, report any issues here. If needed, we'll migrate them to the+[vty-windows](https://github.com/chhackett/vty-windows) repository if+they need to be fixed there.+ Reporting bugs --------------  Please file bug reports as GitHub issues.  For best results:   - Include the versions of relevant software packages: your terminal-   emulator, `brick`, `ghc`, and `vty` will be the most important-   ones. Even better, the output of `cabal freeze` would probably be-   helpful in making the problem reproducible.+   emulator, `brick`, `ghc`, `vty`, and Vty platform packages will be+   the most important ones.   - Clearly describe the behavior you expected ... - - ... and include a mininal demonstration program that exhibits the+ - ... and include a minimal demonstration program that exhibits the    behavior you actually observed.  Contributing@@ -111,10 +214,22 @@ 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.- - If you make changes, try to make them consistent with the syntactic-   conventions I've used in the codebase.- - Please provide Haddock and/or user guide documentation for any-   changes you make.+ - Please make changes consistent with the conventions I've used in the+   codebase.+ - Please adjust or provide Haddock and/or user guide documentation+   relevant to any changes you make.+ - Please ensure that commits are `-Wall` clean.+ - Please ensure that each commit makes a single, logical, isolated+   change as much as possible.+ - Please do not submit changes that your linter told you to make. I+   will probably decline them. Relatedly: please do not submit changes+   that change only style without changing functionality.+ - Please do NOT include package version changes in your patches.+   Package version changes are only done at release time when the full+   scope of a release's changes can be evaluated to determine the+   appropriate version change.
brick.cabal view
@@ -1,16 +1,17 @@ name:                brick-version:             0.2.3+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   >   > import Brick   >-  > ui :: Widget+  > ui :: Widget ()   > ui = str "Hello, world!"   >   > main :: IO ()@@ -31,20 +32,34 @@ license-file:        LICENSE author:              Jonathan Daugherty <cygnus@foobox.com> maintainer:          Jonathan Daugherty <cygnus@foobox.com>-copyright:           (c) Jonathan Daugherty 2015+copyright:           (c) Jonathan Daugherty 2015-2025 category:            Graphics build-type:          Simple-cabal-version:       >=1.10+cabal-version:       1.18 Homepage:            https://github.com/jtdaugherty/brick/ Bug-reports:         https://github.com/jtdaugherty/brick/issues+tested-with:         GHC == 8.2.2+                      || == 8.4.4+                      || == 8.6.5+                      || == 8.8.4+                      || == 8.10.7+                      || == 9.0.2+                      || == 9.2.8+                      || == 9.4.8+                      || == 9.6.7+                      || == 9.8.4+                      || == 9.10.3+                      || == 9.12.2 -data-files:          README.md,+extra-doc-files:     README.md,                      docs/guide.rst,-                     CHANGELOG.md+                     docs/snake-demo.gif,+                     CHANGELOG.md,+                     programs/custom_keys.ini  Source-Repository head   type:     git-  location: git://github.com/jtdaugherty/brick.git+  location: http://github.com/jtdaugherty/brick  Flag demos     Description:     Build demonstration programs@@ -52,14 +67,26 @@  library   default-language:    Haskell2010-  ghc-options:         -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -Wall -Wcompat -O2 -Wunused-packages+  default-extensions:  CPP   hs-source-dirs:      src   exposed-modules:     Brick+    Brick.Animation     Brick.AttrMap+    Brick.BChan+    Brick.BorderMap+    Brick.Keybindings+    Brick.Keybindings.KeyConfig+    Brick.Keybindings.KeyEvents+    Brick.Keybindings.KeyDispatcher+    Brick.Keybindings.Normalize+    Brick.Keybindings.Parse+    Brick.Keybindings.Pretty     Brick.Focus+    Brick.Forms     Brick.Main-    Brick.Markup+    Brick.Themes     Brick.Types     Brick.Util     Brick.Widgets.Border@@ -68,207 +95,466 @@     Brick.Widgets.Core     Brick.Widgets.Dialog     Brick.Widgets.Edit+    Brick.Widgets.FileBrowser     Brick.Widgets.List     Brick.Widgets.ProgressBar-    Data.Text.Markup+    Brick.Widgets.Table+    Data.IMap   other-modules:+    Brick.Animation.Clock+    Brick.Types.Common     Brick.Types.TH+    Brick.Types.EventM     Brick.Types.Internal     Brick.Widgets.Internal -  build-depends:       base <= 5,-                       vty >= 5.3.1,-                       transformers,-                       data-default,-                       Diff,-                       containers,-                       lens,+  build-depends:       base >= 4.9.0.0 && < 4.23.0.0,+                       vty >= 6.0,+                       vty-crossplatform,+                       bimap >= 0.5 && < 0.6,+                       data-clist >= 0.1,+                       directory >= 1.2.5.0,+                       exceptions >= 0.10.0,+                       filepath,+                       containers >= 0.5.7,+                       microlens >= 0.3.0.0 && < 0.6,+                       microlens-th,+                       microlens-mtl,+                       mtl,+                       config-ini,                        vector,-                       contravariant,+                       stm >= 2.4.3,                        text,-                       text-zipper >= 0.2.1,+                       text-zipper >= 0.13,                        template-haskell,-                       deepseq >= 1.3 && < 1.5+                       deepseq >= 1.3 && < 1.6,+                       unix-compat,+                       bytestring,+                       word-wrap >= 0.2,+                       unordered-containers,+                       hashable,+                       time +executable brick-custom-keybinding-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             CustomKeybindingDemo.hs+  build-depends:       base,+                       brick,+                       text,+                       vty,+                       containers,+                       microlens,+                       microlens-mtl,+                       microlens-th++executable brick-table-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             TableDemo.hs+  build-depends:       base,+                       brick++executable brick-tail-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             TailDemo.hs+  build-depends:       base,+                       brick,+                       text,+                       vty,+                       random,+                       microlens-th,+                       microlens-mtl++executable brick-readme-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -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,+                       mtl++executable brick-form-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             FormDemo.hs+  build-depends:       base,+                       brick,+                       text,+                       microlens,+                       microlens-th,+                       vty-crossplatform,+                       vty++executable brick-text-wrap-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             TextWrapDemo.hs+  build-depends:       base,+                       brick,+                       word-wrap++executable brick-cache-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             CacheDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       mtl+ executable brick-visibility-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             VisibilityDemo.hs   build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-th,+                       microlens-mtl +executable brick-viewport-scrollbars-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             ViewportScrollbarsDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       vty-crossplatform,+                       microlens-mtl,+                       microlens-th+ executable brick-viewport-scroll-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010+  default-extensions:  CPP   main-is:             ViewportScrollDemo.hs   build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty  executable brick-dialog-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             DialogDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty +executable brick-mouse-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             MouseDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-th,+                       microlens-mtl,+                       mtl+ executable brick-layer-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             LayerDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-th,+                       microlens-mtl  executable brick-suspend-resume-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             SuspendAndResumeDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-th +executable brick-cropping-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             CroppingDemo.hs+  build-depends:       base,+                       brick,+                       vty+ executable brick-padding-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             PaddingDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty +executable brick-theme-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             ThemeDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       mtl+ executable brick-attr-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             AttrDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty -executable brick-markup-demo+executable brick-tabular-list-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010-  main-is:             MarkupDemo.hs-  build-depends:       base <= 5,+  main-is:             TabularListDemo.hs+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-mtl,+                       microlens-th,+                       vector  executable brick-list-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             ListDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens,+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-mtl,+                       mtl,                        vector +executable brick-list-vi-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             ListViDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-mtl,+                       mtl,+                       vector++executable brick-animation-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             AnimationDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       vty-crossplatform,+                       containers,+                       microlens-platform+ executable brick-custom-event-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             CustomEventDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-th,+                       microlens-mtl +executable brick-fill-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             FillDemo.hs+  build-depends:       base,+                       brick+ executable brick-hello-world-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             HelloWorldDemo.hs-  build-depends:       base <= 5,-                       brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+  build-depends:       base,+                       brick  executable brick-edit-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs-  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010   main-is:             EditDemo.hs-  build-depends:       base <= 5,+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty,+                       microlens >= 0.3.0.0,+                       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++executable brick-dynamic-border-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-extensions:  CPP+  default-language:    Haskell2010+  main-is:             DynamicBorderDemo.hs   build-depends:       base <= 5,+                       brick++executable brick-progressbar-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-extensions:  CPP+  default-language:    Haskell2010+  main-is:             ProgressBarDemo.hs+  build-depends:       base,                        brick,-                       vty >= 5.3.1,-                       data-default,-                       text,-                       lens+                       vty,+                       microlens-mtl,+                       microlens-th++test-suite brick-tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  ghc-options:         -Wall -Wcompat -Wno-orphans -O2+  default-language:    Haskell2010+  main-is:             Main.hs+  other-modules:       List Render+  build-depends:       base <=5,+                       brick,+                       containers,+                       microlens,+                       vector,+                       vty,+                       vty-crossplatform,+                       QuickCheck
docs/guide.rst view
@@ -11,867 +11,2147 @@ and as direct as possible. ``brick`` builds on `vty`_; `vty` provides the terminal input and output interface and drawing primitives, while ``brick`` builds on those to provide a high-level application-abstraction and combinators for expressing user interface layouts.--This documentation is intended to provide a high-level overview of-the library's design along with guidance for using it, but details on-specific functions can be found in the Haddock documentation.--The process of writing an application using ``brick`` entails writing-two important functions:--- A *drawing function* that turns your application state into a-  specification of how your interface should look, and-- An *event handler* that takes your application state and an input-  event and decides whether to change the state or quit the program.--We write drawing functions in ``brick`` using an extensive set of-primitives and combinators to place text on the screen, set its-attributes (e.g. foreground color), and express layout constraints (e.g.-padding, centering, box layouts, scrolling viewports, etc.).--These functions get packaged into a structure that we hand off to the-``brick`` library's main event loop. We'll cover that in detail in `The-App Type`_.--Installation---------------``brick`` can be installed in the "usual way," either by installing-the latest `Hackage`_ release or by cloning the GitHub repository and-building locally.--To install from Hackage::--   $ cabal update-   $ cabal install brick--To clone and build locally::--   $ git clone https://github.com/jtdaugherty/brick.git-   $ cd brick-   $ cabal sandbox init-   $ cabal install -j--Building the Demonstration Programs--------------------------------------``brick`` includes a large collection of feature-specific demonstration-programs. These programs are not built by default but can be built by-passing the ``demos`` flag to `cabal install`, e.g.::--   $ cabal install brick -f demos--Conventions-===========--``brick`` has some API conventions worth knowing about as you read this-documentation and as you explore the library source and write your own-programs.--- Use of `lens`_: ``brick`` uses ``lens`` functions internally and also-  exposes lenses for many types in the library. However, if you prefer-  not to use the ``lens`` interface in your program, all ``lens``-  interfaces have non-`lens` equivalents exported by the same module. In-  general, the "``L``" suffix on something tells you it is a ``lens``;-  the name without the "``L``" suffix is the non-`lens` version. You can-  get by without using ``brick``'s ``lens`` interface but your life will-  probably be much more pleasant once your application state becomes-  sufficiently complex if you use lenses to modify it (see-  `appHandleEvent: Handling Events`_).-- Attribute names: some modules export attribute names (see `How-  Attributes Work`_) associated with user interface elements. These tend-  to end in an "``Attr``" suffix (e.g. ``borderAttr``). In addition,-  hierarchical relationships between attributes are documented in-  Haddock documentation.-- Use of qualified names: in this document, where sensible, I will use-  fully-qualified names whenever I mention something for the first time-  or whenever I use something that is not part of ``brick``. Use of-  names in this way is not intended to produce executable examples, but-  rather to guide you in writing your ``import`` statements.--The App Type-============--To use the library we must provide it with a value of type-``Brick.Main.App``. This type is a record type whose fields perform-various functions:--.. code:: haskell--   data App s e =-       App { appDraw :: s -> [Widget]-           , appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation-           , appHandleEvent :: s -> e -> EventM (Next s)-           , appStartEvent :: s -> EventM s-           , appAttrMap :: s -> AttrMap-           , appLiftVtyEvent :: Event -> e-           }--The ``App`` type is polymorphic over two types: your application state-type ``s`` and event type ``e``.--The application state type is the type of data that will evolve over the-course of the application's execution; we will provide the library with-its starting value and event handling will transform it as the program-executes.--The event type is the type of events that your event handler-(``appHandleEvent``) will handle. The underlying ``vty`` library-provides ``Graphics.Vty.Event`` and this forms the basis of all events-we will handle with ``brick`` applications. The-``Brick.Main.defaultMain`` function expects an ``App s Event`` since-this is a common case.--However, we often need to extend our notion of events beyond those-originating from the keyboard. Imagine an application with multiple-threads and network or disk I/O. Such an application will need to have-its own internal events to pass to the event handler as (for example)-network data arrives. To accommodate this we allow an ``App`` to use an-event type of your own design, so long as it provides a constructor for-``vty``'s ``Event`` type (``appLiftVtyEvent``). For more details, see-`Using Your Own Event Type`_.--The various fields of ``App`` will be described in the sections below.--To run an ``App``, we pass it to ``Brick.Main.defaultMain`` or-``Brick.Main.customMain`` along with an initial application state value.--appDraw: Drawing an Interface--------------------------------The value of ``appDraw`` is a function that turns the current-application state into a list of *layers* of type ``Widget``, listed-topmost first, that will make up the interface. Each ``Widget`` gets-turned into a ``vty`` layer and the resulting layers are drawn to the-terminal.--The ``Widget`` type is the type of *drawing instructions*.  The body of-your drawing function will use one or more drawing functions to build or-transform ``Widget`` values to describe your interface. These-instructions will then be executed with respect to three things:--- The size of the terminal: the size of the terminal determines how many-  ``Widget`` values behave. For example, fixed-size ``Widget`` values-  such as text strings behave the same under all conditions (and get-  cropped if the terminal is too small) but layout combinators such as-  ``Brick.Widgets.Core.vBox`` or ``Brick.Widgets.Center.center`` use the-  size of the terminal to determine how to lay other widgets out. See-  `How Widgets and Rendering Work`_.-- The application's attribute map (``appAttrMap``): drawing functions-  requesting the use of attributes cause the attribute map to be-  consulted. See `How Attributes Work`_.-- The state of scrollable viewports: the state of any scrollable-  viewports on the *previous* drawing will be considered. For more-  details, see `Viewports`_.--The ``appDraw`` function is called when the event loop begins to draw-the application as it initially appears. It is also called right after-an event is processed by ``appHandleEvent``. Even though the function-returns a specification of how to draw the entire screen, the underlying-``vty`` library goes to some trouble to efficiently update only the-parts of the screen that have changed so you don't need to worry about-this.--Where do I find drawing functions?-**********************************--The most important module providing drawing functions is-``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets``-namespace provides specific kinds of functionality.--appHandleEvent: Handling Events----------------------------------The value of ``appHandleEvent`` is a function that decides how to modify-the application state as a result of an event. It also decides whether-to continue program execution. The function takes the current-application state and the event and returns the *next application-state*:--.. code:: haskell--   appHandleEvent :: s -> e -> EventM (Next s)--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 just used to make scrolling-requests to the renderer (see `Viewports`_). 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 ``Next s`` value describes what should happen after the event-handler is finished. We have three choices:--* ``Brick.Main.continue s``: continue executing the event loop with the-  specified application state ``s`` as the next value. Commonly this is-  where you'd modify the state based on the event and return it.-* ``Brick.Main.halt s``: halt the event loop and return the final-  application state value ``s``. This state value is returned to the-  caller of ``defaultMain`` or ``customMain`` where it can be used prior-  to finally exiting ``main``.-* ``Brick.Main.suspendAndResume act``: suspend the ``brick`` event loop-  and execute the specified ``IO`` action ``act``. The action ``act``-  must be of type ``IO s``, so when it executes it must return the next-  application state. When ``suspendAndResume`` is used, the ``brick``-  event loop is shut down and the terminal state is restored to its-  state when the ``brick`` event loop began execution. When it finishes-  executing, the event loop will be resumed using the returned state-  value. This is useful for situations where your program needs to-  suspend your interface and execute some other program that needs to-  gain control of the terminal (such as an external editor).--The HandleEvent Type Class-**************************--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 support another interface: the ``Brick.Types.HandleEvent`` type-class.--The ``HandleEvent`` type class has only one method:--.. code:: haskell--   handleEvent :: Event -> a -> EventM a--Instances of ``HandleEvent`` provide reasonable default behavior for-handling input events; for example, arrow keys change the ``List``-selection and input keys modify the text in ``Editor`` states.--Since ``handleEvent`` runs in ``EventM``, event handlers-written this way have access to rendering viewport states via-``Brick.Main.lookupViewport`` and the ``IO`` monad via ``liftIO``.--To use ``handleEvent`` in your program, invoke it on the relevant piece-of state in your event handler, e.g.,--.. code:: haskell--   myEvent :: s -> e -> EventM (Next s)-   myEvent s e = continue =<< handleEvent e s--This pattern works fine when your application state instances-``HandleEvent``, but it can become unpleasant if the value on which-you want to invoke ``handleEvent`` is embedded deeply within your-application state. If you have chosen to generate lenses for your-application state fields, you can use the convenience function-``handleEventLensed`` by specifying your state, a lens, and the event:--.. code:: haskell--   myEvent :: s -> e -> EventM (Next s)-   myEvent s e = continue =<< handleEventLensed s someLens e--Compare that with the more verbose explicit version:--.. code:: haskell--   myEvent :: s -> e -> EventM (Next s)-   myEvent s e = do-     newVal <- handleEvent e (s^.someLens)-     continue $ s & someLens .~ newVal--Using Your Own Event Type-*************************--Since we often need to communicate application-specific events-beyond input events to the event handler, the ``App`` type is-polymorphic over the event type we want to handle. If we use-``Brick.Main.defaultMain`` to run our ``App``, we have to use-``Graphics.Vty.Event`` as our event type. But if our application has-other event-handling needs, we need to use our own event type.--To do this, we first define an event type:--.. code:: haskell--   data CustomEvent =-       VtyEvent Graphics.Vty.Event-       | CustomEvent1-       | CustomEvent2--Our custom event type *must* provide a constructor capable of taking-a ``Graphics.Vty.Event`` value. This allows the ``brick`` event loop-to send us ``vty`` events in the midst of our custom ones. To allow-``brick`` to do this, we provide this constructor as the value of-``appLiftVtyEvent``. This way, ``brick`` can wrap a ``vty`` event using-our custom event type and then pass it to our event handler (which takes-``CustomEvent`` values). In this case we'd set ``appLiftVtyEvent =-VtyEvent``.--Once we have set ``appLiftVtyEvent`` in this way, we also need to set up-a mechanism for getting our custom events into the ``brick`` event loop-from other threads. To do this we use a ``Control.Concurrent.Chan`` and-call ``Brick.Main.customMain`` instead of ``Brick.Main.defaultMain``:--.. code:: haskell--   main :: IO ()-   main = do-       eventChan <- Control.Concurrent.newChan-       finalState <- customMain (Graphics.Vty.mkVty Data.Default.def) eventChan app initialState-       -- Use finalState and exit--Beyond just the application and its initial state, 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.--Starting up: appStartEvent-**************************--When an application starts, it may be desirable to perform some of-the duties typically only possible when an event has arrived, such as-setting up initial scrolling viewport state. Since such actions can only-be performed in ``EventM`` and since we do not want to wait until the-first event arrives to do this work in ``appHandleEvent``, the ``App``-type provides ``appStartEvent`` function for this purpose:--.. code:: haskell--   appStartEvent :: s -> EventM s--This function takes the initial application state and returns it in-``EventM``, possibly changing it and possibly making viewport requests.-For more details, see `Viewports`_. You will probably just want to use-``return`` as the implementation of this function for most applications.--appChooseCursor: Placing the Cursor--------------------------------------The rendering process for a ``Widget`` may return information about-where that widget would like to place the cursor. For example, a text-editor will need to report a cursor position. However, since a-``Widget`` may be a composite of many such cursor-placing widgets, we-have to have a way of choosing which of the reported cursor positions,-if any, is the one we actually want to honor.--To decide which cursor placement to use, or to decide not to show one at-all, we set the ``App`` type's ``appChooseCursor`` function:--.. code:: haskell--   appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation--The event loop renders the interface and collects the-``Brick.Types.CursorLocation`` values produced by the rendering process-and passes those, along with the current application state, to this-function. Using your application state (to track which text input box-is "focused," say) you can decide which of the locations to return or-return ``Nothing`` if you do not want to show a cursor.--We decide which location to show by looking at the ``Brick.Types.Name``-value contained in the ``cursorLocationName`` field. The ``Name``-value associated with a cursor location will be the ``Name`` of the-``Widget`` that requested it; this is why constructors for widgets like-``Brick.Widgets.Edit.editor`` require a ``Name`` parameter. The ``Name``-lets us distinguish between many cursor-placing widgets of the same-type.--``Brick.Main`` provides various convenience functions to make cursor-selection easy in common cases:--* ``neverShowCursor``: never show any cursor.-* ``showFirstCursor``: always show the first cursor request given; good-  for applications with only one cursor-placing widget.-* ``showCursorNamed``: show the cursor with the specified name or-  ``Nothing`` if it is not requested.--Widgets request cursor placement by using the-``Brick.Widgets.Core.showCursor`` combinator. For example, this widget-places a cursor on the first "``o``" in "``foo``" assocated with the-cursor name "``myCursor``":--.. code:: haskell--   let w = showCursor (Name "myCursor") (Brick.Types.Location (1, 0))-             (Brick.Widgets.Core.str "foobar")--appAttrMap: Managing Attributes----------------------------------In ``brick`` we use an *attribute map* to assign attibutes to elements-of the interface. Rather than specifying specific attributes when-drawing a widget (e.g. red-on-black text) we specify an *attribute name*-that is an abstract name for the kind of thing we are drawing, e.g.-"keyword" or "e-mail address." We then provide an attribute map which-maps those attribute names to actual attributes.  This approach lets us:--* Change the attributes at runtime, letting the user change the-  attributes of any element of the application arbitrarily without-  forcing anyone to build special machinery to make this configurable;-* Write routines to load saved attribute maps from disk;-* Provide modular attribute behavior for third-party components, where-  we would not want to have to recompile third-party code just to change-  attributes, and where we would not want to have to pass in attribute-  arguments to third-party drawing functions.--This lets us put the attribute mapping for an entire app, regardless of-use of third-party widgets, in one place.--To create a map we use ``Brick.AttrMap.attrMap``, e.g.,--.. code:: haskell--   App { ...-       , appAttrMap = const $ attrMap Graphics.Vty.defAttr [(someAttrName, fg blue)]-       }--To use an attribute map, we specify the ``App`` field ``appAttrMap`` as-the function to return the current attribute map each time rendering-occurs. This function takes the current application state, so you may-choose to store the attribute map in your application state. You may-also choose not to bother with that and to just set ``appAttrMap = const-someMap``.--To draw a widget using an attribute name in the map, use-``Brick.Widgets.Core.withAttr``. For example, this draws a string with a-``blue`` background:--.. code:: haskell--   let w = withAttr blueBg $ str "foobar"-       blueBg = attrName "blueBg"-       myMap = attrMap defAttr [ (blueBg, Brick.Util.bg Graphics.Vty.blue)-                               ]--For complete details on how attribute maps and attribute names work, see-the Haddock documentation for the ``Brick.AttrMap`` module. See also-`How Attributes Work`_.--How Widgets and Rendering Work-==============================--When ``brick`` renders a ``Widget``, the widget's rendering routine is-evaluated to produce a ``vty`` ``Image`` of the widget. The widget's-rendering routine runs with some information called the *rendering-context* that contains:--* The size of the area in which to draw things-* The name of the current attribute to use to draw things-* The map of attributes to use to look up attribute names-* The active border style to use when drawing borders--Available Rendering Area---------------------------The most important element in the rendering context is the rendering-area: This part of the context tells the widget being drawn how many-rows and columns are available for it to consume. When rendering begins,-the widget being rendered (i.e. a layer returned by an ``appDraw``-function) gets a rendering context whose rendering area is the size of-the terminal. This size information is used to let widgets take up that-space if they so choose. For example, a string "Hello, world!" will-always take up one row and 13 columns, but the string "Hello, world!"-*centered* will always take up one row and *all available columns*.--How widgets use space when rendered is described in two pieces of-information in each ``Widget``: the widget's horizontal and vertical-growth policies. These fields have type ``Brick.Types.Size`` and can-have the values ``Fixed`` and ``Greedy``.--A widget advertising a ``Fixed`` size in a given dimension is a widget-that will always consume the same number of rows or columns no-matter how many it is given. Widgets can advertise different-vertical and horizontal growth policies for example, the-``Brick.Widgets.Border.hCenter`` function centers a widget and is-``Greedy`` horizontally and defers to the widget it centers for vertical-growth behavior.--These size policies govern the box layout algorithm that is at-the heart of every non-trivial drawing specification. When we use-``Brick.Widgets.Core.vBox`` and ``Brick.Widgets.Core.hBox`` to-lay things out (or use their binary synonyms ``<=>`` and ``<+>``,-respectively), the box layout algorithm looks at the growth policies of-the widgets it receives to determine how to allocate the available space-to them.--For example, imagine that the terminal window is currently 10 rows high-and 50 columns wide.  We wish to render the following widget:--.. code:: haskell--   let w = (str "Hello," <=> str "World!")--Rendering this to the terminal will result in "Hello," and "World!"-underneath it, with 8 rows unoccupied by anything. But if we wished to-render a vertical border underneath those strings, we would write:--.. code:: haskell--   let w = (str "Hello," <=> str "World!" <=> vBorder)--Rendering this to the terminal will result in "Hello," and "World!"-underneath it, with 8 rows remaining occupied by vertical border-characters ("``|``") one column wide. The vertical border widget is-designed to take up however many rows it was given, but rendering the-box layout algorithm has to be careful about rendering such ``Greedy``-widgets because the won't leave room for anything else. Since the box-widget cannot know the sizes of its sub-widgets until they are rendered,-the ``Fixed`` widgets get rendered and their sizes are used to determine-how much space is left for ``Greedy`` widgets.--When using widgets it is important to understand their horizontal and-vertical space behavior by knowing their ``Size`` values. Those should-be made clear in the Haddock documentation.--Limiting Rendering Area--------------------------If you'd like to use a ``Greedy`` widget but want to limit how much-space it consumes, you can turn it into a ``Fixed`` widget by using-one of the *limiting combinators*, ``Brick.Widgets.Core.hLimit`` and-``Brick.Widgets.Core.vLimit``. These combinators take widgets and turn-them into widgets with a ``Fixed`` size (in the relevant dimension) and-run their rendering functions in a modified rendering context with a-restricted rendering area.--For example, the following will center a string in 30 columns, leaving-room for something to be placed next to it as the terminal width-changes:--.. code:: haskell--   let w = hLimit 30 $ hCenter $ str "Hello, world!"--The Attribute Map--------------------The rendering context contains an attribute map (see `How Attributes-Work`_ and `appAttrMap: Managing Attributes`_) which is used to look up-attribute names from the drawing specification. The map originates from-``Brick.Main.appAttrMap`` and can be manipulated on a per-widget basis-using ``Brick.Widgets.Core.updateAttrMap``.--The Active Border Style--------------------------Widgets in the ``Brick.Widgets.Border`` module draw border characters-(horizontal, vertical, and boxes) between and around other widgets. To-ensure that widgets across your application share a consistent visual-style, border widgets consult the rendering context's *active border-style*, a value of type ``Brick.Widgets.Border.Style``, to get the-characters used to draw borders.--The default border style is ``Brick.Widgets.Border.Style.unicode``. To-change border styles, use the ``Brick.Widgets.Core.withBorderStyle``-combinator to wrap a widget and change the border style it uses when-rendering. For example, this will use the ``ascii`` border style instead-of ``unicode``:--.. code:: haskell--   let w = withBorderStyle Brick.Widgets.Border.Style.ascii $-             Brick.Widgets.Border.border $ str "Hello, world!"--How Attributes Work-===================--In addition to letting us map names to attributes, attribute maps-provide hierarchical attribute inheritance: a more specific attribute-derives any properties (e.g. background color) that it does not specify-from more general attributes in hierarchical relationship to it, letting-us customize only the parts of attributes that we want to change without-having to repeat ourselves.--For example, this draws a string with a foreground color of ``white`` on-a background color of ``blue``:--.. code:: haskell--   let w = withAttr specificAttr $ str "foobar"-       generalAttr = attrName "general"-       specificAttr = attrName "general" <> attrName "specific"-       myMap = attrMap defAttr [ (generalAttr, bg blue)-                               , (specificAttr, fg white)-                               ]--Functions ``Brick.Util.fg`` and ``Brick.Util.bg`` specify-partial attributes, and map lookups start with the desired name-(``general/specific`` in this case) and walk up the name hierarchy (to-``general``), merging partial attribute settings as they go, letting-already-specified attribute settings take precedence. Finally, any-attribute settings not specified by map lookups fall back to the map's-*default attribute*, specified above as ``Graphics.Vty.defAttr``. In-this way, if you want everything in your application to have a ``blue``-background color, you only need to specify it *once*: in the attribute-map's default attribute. Any other attribute names can merely customize-the foreground color.--In addition to using the attribute map provided by ``appAttrMap``,-the map can be customized on a per-widget basis by using the attribute-map combinators:--* ``Brick.Widgets.Core.updateAttrMap``-* ``Brick.Widgets.Core.forceAttr``-* ``Brick.Widgets.Core.withDefAttr``--Viewports-=========--A *viewport* is a scrollable window onto another widget. Viewports have-a *scrolling direction* of type ``Brick.Types.ViewportType`` which can-be one of:--* ``Horizontal``: the viewport can only scroll horizontally.-* ``Vertical``: the viewport can only scroll vertically.-* ``Both``: the viewport can scroll both horizontally and vertically.--The ``Brick.Widgets.Core.viewport`` combinator takes another widget and-embeds it in a named viewport. We name the viewport so that we can-keep track of its scrolling state in the renderer, and so that you can-make scrolling requests. The viewport's name is its handle for these-operations (see `Scrolling Viewports in Event Handlers`_). *The viewport-name must be unique across your interface.*--For example, the following puts a string in a horizontally-scrollable-viewport:--.. code:: haskell--   let w = viewport (Name "myViewport") Horizontal $ str "Hello, world!"--The above example is incomplete. A ``viewport`` specification means that-the widget in the viewport will be placed in a viewport window that is-``Greedy`` in both directions (see `Available Rendering Area`_). This-is suitable if we want the viewport size to be the size of the entire-terminal window, but if we want to embed this scrollable viewport-somewhere in our interface, we want to control its dimensions. To do so,-we use the limiting combinators (see `Limiting Rendering Area`_):--.. code:: haskell--   let w = hLimit 5 $-           vLimit 1 $-           viewport (Name "myViewport") Horizontal $ str "Hello, world!"--Now the example produces a scrollable window one row high and five-columns wide initially showing "Hello". The next two sections discuss-the two ways in which this viewport can be scrolled.--Scrolling Viewports in Event Handlers----------------------------------------The most direct way to scroll a viewport is to make *scrolling requests*-in the ``EventM`` event-handling monad. Scrolling requests ask the-render to update the state of a viewport the next time the user-interface is rendered. Those state updates will be made with respect to-the *previous* viewport state. This approach is the best approach to use-to scroll widgets that have no notion of a cursor. For cursor-based-scrolling, see `Scrolling Viewports With Visibility Requests`_.--To make scrolling requests, we first create a-``Brick.Main.ViewportScroll`` from a viewport name with-``Brick.Main.viewportScroll``:--.. code:: haskell--   let vp = viewportScroll (Name "myViewport")--The ``ViewportScroll`` record type contains a number of scrolling-functions for making scrolling requests:--.. code:: haskell--   hScrollPage :: Direction -> EventM ()-   hScrollBy :: Int -> EventM ()-   hScrollToBeginning :: EventM ()-   hScrollToEnd :: EventM ()-   vScrollPage :: Direction -> EventM ()-   vScrollBy :: Int -> EventM ()-   vScrollToBeginning :: EventM ()-   vScrollToEnd :: EventM ()--In each case the scrolling function scrolls the viewport by the-specified amount in the specified direction; functions prefixed with-``h`` scroll horizontally and functions prefixed with ``v`` scroll-vertically.--Scrolling operations do nothing when they don't make sense for the-specified viewport; scrolling a ``Vertical`` viewport horizontally is a-no-op, for example.--Using ``viewportScroll`` and the ``myViewport`` example given above, we-can write an event handler that scrolls the "Hello, world!" viewport one-column to the right:--.. code:: haskell--   myHandler :: s -> e -> EventM (Next s)-   myHandler s e = do-       let vp = viewportScroll (Name "myViewport")-       hScrollBy vp 1-       continue s--Scrolling Viewports With Visibility Requests-----------------------------------------------When we need to scroll widgets only when a cursor in the viewport leaves-the viewport's bounds, we need to use *visibility requests*. A-visibility request is a hint to the renderer that some element of a-widget inside a viewport should be made visible, i.e., that the viewport-should be scrolled to bring the requested element into view.--To use a visibility request to make a widget in a viewport visible, we-simply wrap it with ``visible``:--.. code:: haskell--   let w = viewport (Name "myViewport") Horizontal $-           (visible $ str "Hello," <+> (str " world!")--This example requests that the "``myViewport``" viewport be scrolled so-that "Hello," is visible. We could extend this example with a value-in the application state indicating which word in our string should-be visible and then use that to change which string gets wrapped with-``visible``; this is the basis of cursor-based scrolling.--Note that a visibility request does not change the state of a viewport-*if the requested widget is already visible*! This important detail is-what makes visibility requests so powerful, because they can be used to-capture various cursor-based scenarios:--* The ``Brick.Widgets.Edit`` widget uses a visibility request to make its-  1x1 cursor position visible, thus making the text editing widget fully-  scrollable *while being entirely scrolling-unaware*.-* The ``Brick.Widgets.List`` widget uses a visibility request to make-  its selected item visible regardless of its size, which makes-  the list widget both scrolling-unaware and also makes it support-  variable-height items for free.--Viewport Restrictions------------------------Viewports impose one restriction: a viewport that is scrollable in some-direction can only embed a widget that has a ``Fixed`` size in that-direction. This extends to ``Both`` type viewports: they can only embed-widgets that are ``Fixed`` in both directions. This restriction is-because when viewports embed a widget, they relax the rendering area-constraint in the rendering context, but doing so to a large enough-number for ``Greedy`` widgets would result in a widget that is too big-and not scrollable in a useful way.--Violating this restriction will result in a runtime exception.--Implementing Your Own Widgets-=============================--``brick`` exposes all of the internals you need to implement your own-widgets. Those internals, together with ``Graphics.Vty``, can be used to-create widgets from the ground up. We start by writing a constructor-function:--.. code:: haskell--   myWidget :: ... -> Widget-   myWidget ... =-       Widget Fixed Fixed $ do-           ...--We specify the horizontal and vertical growth policies of the widget-as ``Fixed`` in this example, although they should be specified-appropriately (see `How Widgets and Rendering Work`_). Lastly we specify-the *rendering function*, a function of type--.. code:: haskell--   render :: RenderM Result--which is a function returning a ``Brick.Types.Result``:--.. code:: haskell--    data Result =-        Result { image :: Graphics.Vty.Image-               , cursors :: [Brick.Types.CursorLocation]-               , visibilityRequests :: [Brick.Types.VisibilityRequest]-               }--The ``RenderM`` monad gives us access to the rendering context (see `How-Widgets and Rendering Work`_) via the ``Brick.Types.getContext``-function. The context type is:--.. code:: haskell--    data Context =-        Context { ctxAttrName :: AttrName-                , availWidth :: Int-                , availHeight :: Int-                , ctxBorderStyle :: BorderStyle-                , ctxAttrMap :: AttrMap-                }--and has `lens` fields exported as described in `Conventions`_.--The job of the rendering function is to return a rendering result which,-at a minimum, means producing a ``vty`` ``Image``. In addition, if you-so choose, you can also return one or more cursor positions in the-``cursors`` field of the ``Result`` as well as visibility requests (see-`Viewports`_) in the ``visibilityRequests`` field. Returned visibility-requests and cursor positions should be relative to the upper-left-corner of your widget, ``Location (0, 0)``. When your widget is placed-in others, such as boxes, the ``Result`` data you returned will be-offset (as described in `Rendering Sub-Widgets`_) to result in correct-coordinates once the entire interface has been rendered.--Using the Rendering Context------------------------------The most important fields of the context are the rendering area fields-``availWidth`` and ``availHeight``. These fields must be used to-determine how much space your widget has to render.--To perform an attribute lookup in the attribute map for the context's-current attribute, use ``Brick.Types.attrL``.--For example, to build a widget that always fills the available width and-height with a fill character using the current attribute, we could-write:--.. code:: haskell--   myFill :: Char -> Widget-   myFill ch =-       Widget Greedy Greedy $ do-           ctx <- getContext-           let a = ctx^.attrL-           return $ Result (Graphics.Vty.charFill ch a (ctx^.availWidth) (ctx^.availHeight))-                           [] []--Rendering Sub-Widgets------------------------If your custom widget wraps another, then in addition to rendering the-wrapped widget and augmenting its returned ``Result`` *it must also-translate the resulting cursor locations and visibility requests*.-This is vital to maintaining the correctness of cursor locations and-visbility locations as widget layout proceeds. To do so, use the-``Brick.Widgets.Core.addResultOffset`` function to offset the elements-of a ``Result`` by a specified amount. The amount depends on the nature-of the offset introduced by your wrapper widget's logic.--Widgets are not required to respect the rendering context's width and-height restrictions. Widgets may be embedded in viewports or translated-so they must render without cropping to work in those scenarios.-However, widgets rendering other widgets *should* enforce the rendering-context's constraints to avoid using more space than is available. The-``Brick.Widgets.Core.cropToContext`` function is provided to make this-easy:--.. code:: haskell--   let w = cropToContext someWidget--Widgets wrapped with ``cropToContext`` can be safely embedded in other-widgets. If you don't want to crop in this way, you can use any of-``vty``'s cropping functions to operate on the ``Result`` image as-desired.--.. _vty: https://github.com/coreyoconnor/vty-.. _Hackage: http://hackage.haskell.org/-.. _lens: http://hackage.haskell.org/package/lens+abstraction, combinators for expressing user interface layouts, and+infrastructure for handling events.++This documentation is intended to provide a high-level overview of+the library's design along with guidance for using it, but details on+specific functions can be found in the Haddock documentation.++The process of writing an application using ``brick`` entails writing+two important functions:++- A *drawing function* that turns your application state into a+  specification of how your interface should be drawn, and+- An *event handler* that takes your application state and an input+  event and decides whether to change the state or quit the program.++We write drawing functions in ``brick`` using an extensive set of+primitives and combinators to place text on the screen, set its+attributes (e.g. foreground color), and express layout constraints (e.g.+padding, centering, box layouts, scrolling viewports, etc.).++These functions get packaged into an ``App`` structure that we hand off+to the ``brick`` library's main event loop. We'll cover that in detail+in `The App Type`_.++Installation+------------++``brick`` can be installed in the "usual way," either by installing+the latest `Hackage`_ release or by cloning the GitHub repository and+building locally.++To install from Hackage::++   $ cabal update+   $ cabal install brick++To clone and build locally::++   $ git clone https://github.com/jtdaugherty/brick.git+   $ cd brick+   $ cabal new-build++Your package will need some dependencies:++* ``brick``,+* ``vty >= 6.0``, and+* ``vty-crossplatform`` or ``vty-unix`` or ``vty-windows``, depending+  on which platform(s) your application supports.++Building the Demonstration Programs+-----------------------------------++``brick`` includes a large collection of feature-specific demonstration+programs. These programs are not built by default but can be built by+passing the ``demos`` flag to ``cabal install``, e.g.::++   $ cabal install brick -f demos++Conventions+===========++``brick`` has some API conventions worth knowing about as you read this+documentation and as you explore the library source and write your own+programs.++- Use of `microlens`_ packages: ``brick`` uses the ``microlens`` family+  of packages internally and also exposes lenses for many types in the+  library. However, if you prefer not to use the lens interface in your+  program, all lens interfaces have non-lens equivalents exported by+  the same module. In general, the "``L``" suffix on something tells+  you it is a lens; the name without the "``L``" suffix is the non-lens+  version. You can get by without using ``brick``'s lens interface+  but your life will probably be much more pleasant if you use lenses+  to modify your application state once it becomes sufficiently+  complex (see `appHandleEvent: Handling Events`_ and `Event Handlers+  for Component State`_).+- Attribute names: some modules export attribute names (see `How+  Attributes Work`_) associated with user interface elements. These tend+  to end in an "``Attr``" suffix (e.g. ``borderAttr``). In addition,+  hierarchical relationships between attributes are documented in+  Haddock documentation.+- Use of qualified Haskell identifiers: in this document, where+  sensible, I will use fully-qualified identifiers whenever I mention+  something for the first time or whenever I use something that is+  not part of ``brick``. Use of qualified names is not intended to+  produce executable examples, but rather to guide you in writing your+  ``import`` statements.++Compiling Brick Applications+============================++Brick applications must be compiled with the threaded RTS using the GHC+``-threaded`` option.++The ``App`` Type+================++To use the library we must provide it with a value of type+``Brick.Main.App``. This type is a record type whose fields perform+various functions:++.. code:: haskell++   data App s e n =+       App { appDraw         :: s -> [Widget n]+           , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)+           , appHandleEvent  :: BrickEvent n e -> EventM n s ()+           , appStartEvent   :: EventM n s ()+           , appAttrMap      :: s -> AttrMap+           }++The ``App`` type is parameterized over three types. These type variables+will appear in the signatures of many library functions and types. They+are:++- The **application state type** ``s``: the type of data that will+  evolve over the course of the application's execution. Your+  application will provide the library with its starting value and event+  handling will transform it as the program executes. When a ``brick``+  application exits, the final application state will be returned.+- The **event type** ``e``: the type of custom application events+  that your application will need to produce and handle in+  ``appHandleEvent``. All applications will be provided with events from+  the underlying ``vty`` library, such as keyboard events or resize+  events; this type variable indicates the type of *additional* events+  the application will need. For more details, see `Using Your Own Event+  Type`_.+- The **resource name type** ``n``: during application execution we+  sometimes need a way to refer to rendering state, such as the space+  taken up by a given widget, the state for a scrollable viewport, a+  mouse click, or a cursor position. For these situations we need a+  unique handle called a *resource name*. The type ``n`` specifies the+  name type the application will use to identify these bits of state+  produced and managed by the renderer. The resource name type must be+  provided by your application; for more details, see `Resource Names`_.++The various fields of ``App`` will be described in the sections below.++Running an Application+----------------------++To run an ``App``, we pass it to ``Brick.Main.defaultMain`` or+``Brick.Main.customMain`` along with an initial application state value:++.. code:: haskell++   main :: IO ()+   main = do+       let app = App { ... }+           initialState = ...+       finalState <- defaultMain app initialState+       -- Use finalState and exit++The ``customMain`` function is for more advanced uses; for details see+`Using Your Own Event Type`_.++``appDraw``: Drawing an Interface+---------------------------------++The value of ``appDraw`` is a function that turns the current+application state into a list of *layers* of type ``Widget``, listed+topmost first, that will make up the interface. Each ``Widget`` gets+turned into a ``vty`` layer and the resulting layers are drawn to the+terminal.++The ``Widget`` type is the type of *drawing instructions*.  The body of+your drawing function will use one or more drawing functions to build or+transform ``Widget`` values to describe your interface. These+instructions will then be executed with respect to three things:++- The size of the terminal: the size of the terminal determines how many+  ``Widget`` values behave. For example, fixed-size ``Widget`` values+  such as text strings behave the same under all conditions (and get+  cropped if the terminal is too small) but layout combinators such as+  ``Brick.Widgets.Core.vBox`` or ``Brick.Widgets.Center.center`` use the+  size of the terminal to determine how to lay other widgets out. See+  `How Widgets and Rendering Work`_.+- The application's attribute map (``appAttrMap``): drawing functions+  requesting the use of attributes cause the attribute map to be+  consulted. See `How Attributes Work`_.+- The state of scrollable viewports: the state of any scrollable+  viewports on the *previous* drawing will be considered. For more+  details, see `Viewports`_.++The ``appDraw`` function is called when the event loop begins to draw+the application as it initially appears. It is also called right after+an event is processed by ``appHandleEvent``. Even though the function+returns a specification of how to draw the entire screen, the underlying+``vty`` library goes to some trouble to efficiently update only the+parts of the screen that have changed so you don't need to worry about+this.++Where do I find drawing functions?+**********************************++The most important module providing drawing functions is+``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets``+namespace provides specific kinds of functionality.++``appHandleEvent``: Handling Events+-----------------------------------++The value of ``appHandleEvent`` is a function that decides how to modify+the application state as a result of an event:++.. code:: haskell++   appHandleEvent :: BrickEvent n e -> EventM n s ()++``appHandleEvent`` is responsible for deciding how to change the state+based on incoming events. The single parameter to the event handler is+the event to be handled. Its type variables ``n`` and ``e`` correspond+to the *resource name type* and *event type* of your application,+respectively, and must match the corresponding types in ``App`` and+``EventM``.++The ``EventM`` monad is parameterized on the *resource name type*+``n`` and your application's state type ``s``. The ``EventM`` monad+is a state monad over ``s``, so one way to access and modify your+application's state in an event handler is to use the ``MonadState``+type class and associated operations from the ``mtl`` package. The+recommended approach, however, is to use the lens operations from the+``microlens-mtl`` package with lenses to perform concise state updates.+We'll cover this topic in more detail in `Event Handlers for Component+State`_.++Once the event handler has performed any relevant state updates, it can+also indicate what should happen once the event handler has finished+executing. By default, after an event handler has completed, Brick will+redraw the screen with the application state (by calling ``appDraw``)+and wait for the next input event. However, there are two other options:++* ``Brick.Main.halt``: halt the event loop. The application state as it+  exists after the event handler completes is returned to the caller+  of ``defaultMain`` or ``customMain``.+* ``Brick.Main.continueWithoutRedraw``: continue executing the event+  loop, but do not redraw the screen using the new state before waiting+  for another input event. This is faster than the default continue+  behavior since it doesn't redraw the screen; it just leaves up the+  previous screen contents. This function is only useful when you know+  that your event handler's state change(s) won't cause anything on+  the screen to change. Use this only when you are certain that no+  redraw of the screen is needed *and* when you are trying to address a+  performance problem. (See also `The Rendering Cache`_ for details on+  how to deal with rendering performance issues.)++The ``EventM`` monad is a transformer around ``IO`` so I/O is possible+in this monad by using ``liftIO``. Keep in mind, however, that event+handlers should execute as quickly as possible to avoid introducing+screen redraw latency. Consider using background threads to work+asynchronously when handling an event would otherwise cause redraw+latency.++``EventM`` is also used to make scrolling requests to the renderer (see+`Viewports`_), obtain named extents (see `Extents`_), and other duties.++Event Handlers for Component State+**********************************++The top-level ``appHandleEvent`` handler is responsible for managing+the application state, but it also needs to be able to update the state+associated with UI components such as those that come with Brick.++For example, consider an application that uses Brick's built-in text+editor from ``Brick.Widgets.Edit``. The built-in editor is similar to+the main application in that it has three important elements:++* The editor state of type ``Editor t n``: this stores the editor's+  contents, cursor position, etc.+* The editor's drawing function, ``renderEditor``: this is responsible+  for drawing the editor in the UI.+* The editor's event handler, ``handleEditorEvent``: this is responsible+  for updating the editor's contents and cursor position in response to+  key events.++To use the built-in editor, the application must:++* Embed an ``Editor t n`` somewhere in the application state ``s``,+* Render the editor's state at the appropriate place in ``appDraw`` with+  ``renderEditor``, and+* Dispatch events to the editor in the ``appHandleEvent`` with+  ``handleEditorEvent``.++An example application state using an editor might look like this:++.. code:: haskell++   data MyState n = MyState { _editor :: Editor Text n }+   makeLenses ''MyState++This declares the ``MyState`` type with an ``Editor`` contained within+it and uses Template Haskell to generate a lens, ``editor``, to allow us+to easily update the editor state in our event handler.++To dispatch events to the ``editor`` we'd start by writing the+application event handler:++.. code:: haskell++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       ...++But there's a problem: ``handleEditorEvent``'s type indicates that it+can only run over a state of type ``Editor t n``, but our handler runs+on ``MyState``. Specifically, ``handleEditorEvent`` has this type:++.. code:: haskell++   handleEditorEvent :: BrickEvent n e -> EventM n (Editor t n) ()++This means that to use ``handleEditorEvent``, it must be composed+into the application's event handler, but since the state types ``s``+and ``Editor t n`` do not match, we need a way to compose these event+handlers. There are two ways to do this:++* Use ``Lens.Micro.Mtl.zoom`` from the ``microlens-mtl`` package+  (re-exported by ``Brick.Types`` for convenience). This function is+  required when you want to change the state type to a field embedded in+  your application state using a lens. For example:++.. code:: haskell++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       zoom editor $ handleEditorEvent e++* Use ``Brick.Types.nestEventM``: this function lets you provide a state+  value and run ``EventM`` using that state. The following+  ``nestEventM`` example is equivalent to the ``zoom`` example above:++.. code:: haskell++   import Lens.Micro (_1)+   import Lens.Micro.Mtl (use, (.=))++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       editorState <- use editor+       (newEditorState, ()) <- nestEventM editorState $ do+           handleEditorEvent e+       editor .= newEditorState++The ``zoom`` function, together with lenses for your application state's+fields, is by far the best way to manage your state in ``EventM``. As+you can see from the examples above, the ``zoom`` approach avoids a lot+of boilerplate. The ``nestEventM`` approach is provided in cases where+the state that you need to mutate is not easily accessed by ``zoom``.++Finally, if you prefer to avoid the use of lenses, you can always use+the ``MonadState`` API to get, put, and modify your state. Keep in+mind that the ``MonadState`` approach will still require the use of+``nestEventM`` when events scoped to widget states such as ``Editor``+need to be handled.++Using Your Own Event Type+*************************++Since we often need to communicate application-specific events beyond+Vty input events to the event handler, brick supports embedding your+application's custom events in the stream of ``BrickEvent``-s that+your handler will receive. The type of these events is the type ``e``+mentioned in ``BrickEvent n e`` and ``App s e n``.++Note: ordinarily your application will not have its own custom event+type, so you can leave this type unused (e.g. ``App MyState e MyName``)+or just set it to unit (``App MyState () MyName``).++Here's an example of using a custom event type. Suppose that you'd like+to be able to handle counter events in your event handler. First we+define the counter event type:++.. code:: haskell++   data CounterEvent = Counter Int++With this type declaration we can now use counter events in our app by+using the application type ``App s CounterEvent n``. To handle these+events we'll just need to check for ``AppEvent`` values in the event+handler:++.. code:: haskell++   myEvent :: BrickEvent n CounterEvent -> EventM n s ()+   myEvent (AppEvent (Counter i)) = ...++The next step is to actually *generate* our custom events and+inject them into the ``brick`` event stream so they make it to the+event handler. To do that we need to create a ``BChan`` for our+custom events, provide that ``BChan`` to ``brick``, and then send+our events over that channel. Once we've created the channel with+``Brick.BChan.newBChan``, we provide it to ``brick`` with+``customMain`` instead of ``defaultMain``:++.. code:: haskell++   main :: IO ()+   main = do+       eventChan <- Brick.BChan.newBChan 10+       let buildVty = Graphics.Vty.CrossPlatform.mkVty Graphics.Vty.Config.defaultConfig+       initialVty <- buildVty+       finalState <- customMain initialVty buildVty+                       (Just eventChan) app initialState+       -- Use finalState and exit++The ``customMain`` function lets us have control over how the ``vty``+library is initialized *and* how ``brick`` gets custom events to give to+our event handler. ``customMain`` is the entry point into ``brick`` when+you need to use your own event type as shown here. In this example we're+using ``mkVty`` provided by the ``vty-crossplatform`` package, which+provides build-time support for both Unix and Windows. If you prefer,+you can use either the ``vty-unix`` package or the ``vty-windows``+package directly instead if you only want to support one platform.++With all of this in place, sending our custom events to the event+handler is straightforward:++.. code:: haskell++   counterThread :: Brick.BChan.BChan CounterEvent -> IO ()+   counterThread chan = do+       Brick.BChan.writeBChan chan $ Counter 1++Bounded Channels+****************++A ``BChan``, or *bounded channel*, can hold a limited number of+items before attempts to write new items will block. In the call to+``newBChan`` above, the created channel has a capacity of 10 items.+Use of a bounded channel ensures that if the program cannot process+events quickly enough then there is a limit to how much memory will+be used to store unprocessed events. Thus the chosen capacity should+be large enough to buffer occasional spikes in event handling latency+without inadvertently blocking custom event producers. Each application+will have its own performance characteristics that determine the best+bound for the event channel. In general, consider the performance of+your event handler when choosing the channel capacity and design event+producers so that they can block if the channel is full.++``appStartEvent``: Starting up+------------------------------++When an application starts, it may be desirable to perform some of+the duties typically only possible when an event has arrived, such as+setting up initial scrolling viewport state. Since such actions can only+be performed in ``EventM`` and since we do not want to wait until the+first event arrives to do this work in ``appHandleEvent``, the ``App``+type provides ``appStartEvent`` function for this purpose:++.. code:: haskell++   appStartEvent :: EventM n s ()++This function is a handler action to run on the initial application+state. This function is invoked once and only once, at application+startup. This might be a place to make initial viewport scroll requests+or make changes to the Vty environment. You will probably just want+to use ``return ()`` as the implementation of this function for most+applications.++``appChooseCursor``: Placing the Cursor+---------------------------------------++The rendering process for a ``Widget`` may return information about+where that widget would like to place the cursor. For example, a text+editor will need to report a cursor position. However, since a+``Widget`` may be a composite of many such cursor-placing widgets, we+have to have a way of choosing which of the reported cursor positions,+if any, is the one we actually want to honor.++To decide which cursor placement to use, or to decide not to show one at+all, we set the ``App`` type's ``appChooseCursor`` function:++.. code:: haskell++   appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)++The event loop renders the interface and collects the+``Brick.Types.CursorLocation`` values produced by the rendering process+and passes those, along with the current application state, to this+function. Using your application state (to track which text input box+is "focused," say) you can decide which of the locations to return or+return ``Nothing`` if you do not want to show a cursor.++Many widgets in the rendering process can request cursor placements, but+it is up to our application to determine which one (if any) should be+used. Since we can only show at most a single cursor in the terminal,+we need to decide which location to show. One way is by looking at the+resource name contained in the ``cursorLocationName`` field. The name+value associated with a cursor location will be the name used to request+the cursor position with ``Brick.Widgets.Core.showCursor``.++``Brick.Main`` provides various convenience functions to make cursor+selection easy in common cases:++* ``neverShowCursor``: never show any cursor.+* ``showFirstCursor``: always show the first cursor request given; good+  for applications with only one cursor-placing widget.+* ``showCursorNamed``: show the cursor with the specified resource name+  or show no cursor if the name was not associated with any requested+  cursor position.++For example, this widget requests a cursor placement on the first+"``o``" in "``foo``" associated with the cursor name ``CustomName``:++.. code:: haskell++   data MyName = CustomName++   let w = showCursor CustomName (Brick.Types.Location (1, 0))+             (Brick.Widgets.Core.str "foobar")++The event handler for this application would use ``MyName`` as its+resource name type ``n`` and would be able to pattern-match on+``CustomName`` to match cursor requests when this widget is rendered:++.. code:: haskell++   myApp =+       App { ...+           , appChooseCursor = \_ -> showCursorNamed CustomName+           }++See the next section for more information on using names.++Resource Names+--------------++We saw above in `appChooseCursor: Placing the Cursor`_ that resource+names are used to describe cursor locations. Resource names are also+used to name other kinds of resources:++* viewports (see `Viewports`_)+* rendering extents (see `Extents`_)+* mouse events (see `Mouse Support`_)++Assigning names to these resource types allows us to distinguish between+events based on the part of the interface to which an event is related.++Your application must provide some type of name. For simple applications+that don't make use of resource names, you may use ``()``. But if your+application has more than one named resource, you *must* provide a type+capable of assigning a unique name to every resource that needs one.++A Note of Caution+*****************++Resource names can be assigned to any of the resource types mentioned+above, but some resource types--viewports, extents, the render cache,+and cursor locations--form separate resource namespaces. So, for+example, the same name can be assigned to both a viewport and an extent,+since the ``brick`` API provides access to viewports and extents using+separate APIs and data structures. However, if the same name is used for+two resources of the same kind, it is undefined *which* of those you'll+be getting access to when you go to use one of those resources in your+event handler.++For example, if the same name is assigned to two viewports:++.. code:: haskell++   data Name = Viewport1++   ui :: Widget Name+   ui = (viewport Viewport1 Vertical $ str "Foo") <+>+        (viewport Viewport1 Vertical $ str "Bar") <+>++then in ``EventM`` when we attempt to scroll the viewport ``Viewport1``+we don't know which of the two uses of ``Viewport1`` will be affected:++.. code:: haskell++   let vp = viewportScroll Viewport1+   vScrollBy vp 1++The solution is to ensure that for a given resource type (in this case+viewport), a unique name is assigned in each use.++.. code:: haskell++   data Name = Viewport1 | Viewport2++   ui :: Widget Name+   ui = (viewport Viewport1 Vertical $ str "Foo") <+>+        (viewport Viewport2 Vertical $ str "Bar") <+>++``appAttrMap``: Managing Attributes+-----------------------------------++In ``brick`` we use an *attribute map* to assign attributes to elements+of the interface. Rather than specifying specific attributes when+drawing a widget (e.g. red-on-black text) we specify an *attribute name*+that is an abstract name for the kind of thing we are drawing, e.g.+"keyword" or "e-mail address." We then provide an attribute map which+maps those attribute names to actual attributes.  This approach lets us:++* Change the attributes at runtime, letting the user change the+  attributes of any element of the application arbitrarily without+  forcing anyone to build special machinery to make this configurable;+* Write routines to load saved attribute maps from disk;+* Provide modular attribute behavior for third-party components, where+  we would not want to have to recompile third-party code just to change+  attributes, and where we would not want to have to pass in attribute+  arguments to third-party drawing functions.++This lets us put the attribute mapping for an entire app, regardless of+use of third-party widgets, in one place.++To create a map we use ``Brick.AttrMap.attrMap``, e.g.,++.. code:: haskell++   App { ...+       , appAttrMap = const $ attrMap Graphics.Vty.defAttr [(someAttrName, fg blue)]+       }++To use an attribute map, we specify the ``App`` field ``appAttrMap`` as+the function to return the current attribute map each time rendering+occurs. This function takes the current application state, so you may+choose to store the attribute map in your application state. You may+also choose not to bother with that and to just set ``appAttrMap = const+someMap``.++To draw a widget using an attribute name in the map, use+``Brick.Widgets.Core.withAttr``. For example, this draws a string with a+``blue`` background:++.. code:: haskell++   let w = withAttr blueBg $ str "foobar"+       blueBg = attrName "blueBg"+       myMap = attrMap defAttr [ (blueBg, Brick.Util.bg Graphics.Vty.blue)+                               ]++For complete details on how attribute maps and attribute names work, see+the Haddock documentation for the ``Brick.AttrMap`` module. See also+`How Attributes Work`_.++How Widgets and Rendering Work+==============================++When ``brick`` renders a ``Widget``, the widget's rendering routine is+evaluated to produce a ``vty`` ``Image`` of the widget. The widget's+rendering routine runs with some information called the *rendering+context* that contains:++* The size of the area in which to draw things+* The name of the current attribute to use to draw things+* The map of attributes to use to look up attribute names+* The active border style to use when drawing borders++Available Rendering Area+------------------------++The most important element in the rendering context is the rendering+area: This part of the context tells the widget being drawn how many+rows and columns are available for it to consume. When rendering begins,+the widget being rendered (i.e. a layer returned by an ``appDraw``+function) gets a rendering context whose rendering area is the size of+the terminal. This size information is used to let widgets take up that+space if they so choose. For example, a string "Hello, world!" will+always take up one row and 13 columns, but the string "Hello, world!"+*centered* will always take up one row and *all available columns*.++How widgets use space when rendered is described in two pieces of+information in each ``Widget``: the widget's horizontal and vertical+growth policies. These fields have type ``Brick.Types.Size`` and can+have the values ``Fixed`` and ``Greedy``. Note that these values are+merely *descriptive hints* about the behavior of the rendering function,+so it's important that they accurately describe the widget's use of+space.++A widget advertising a ``Fixed`` size in a given dimension is a widget+that will always consume the same number of rows or columns no+matter how many it is given. Widgets can advertise different+vertical and horizontal growth policies for example, the+``Brick.Widgets.Center.hCenter`` function centers a widget and is+``Greedy`` horizontally and defers to the widget it centers for vertical+growth behavior.++These size policies govern the box layout algorithm that is at+the heart of every non-trivial drawing specification. When we use+``Brick.Widgets.Core.vBox`` and ``Brick.Widgets.Core.hBox`` to+lay things out (or use their binary synonyms ``<=>`` and ``<+>``,+respectively), the box layout algorithm looks at the growth policies of+the widgets it receives to determine how to allocate the available space+to them.++For example, imagine that the terminal window is currently 10 rows high+and 50 columns wide.  We wish to render the following widget:++.. code:: haskell++   let w = (str "Hello," <=> str "World!")++Rendering this to the terminal will result in "Hello," and "World!"+underneath it, with 8 rows unoccupied by anything. But if we wished to+render a vertical border underneath those strings, we would write:++.. code:: haskell++   let w = (str "Hello," <=> str "World!" <=> vBorder)++Rendering this to the terminal will result in "Hello," and "World!"+underneath it, with 8 rows remaining occupied by vertical border+characters ("``|``") one column wide. The vertical border widget is+designed to take up however many rows it was given, but rendering the+box layout algorithm has to be careful about rendering such ``Greedy``+widgets because they won't leave room for anything else. Since the box+widget cannot know the sizes of its sub-widgets until they are rendered,+the ``Fixed`` widgets get rendered and their sizes are used to determine+how much space is left for ``Greedy`` widgets.++When using widgets it is important to understand their horizontal and+vertical space behavior by knowing their ``Size`` values. Those should+be made clear in the Haddock documentation.++The rendering context's specification of available space will also+govern how widgets get cropped, since all widgets are required to render+to an image no larger than the rendering context specifies. If they do,+they will be forcibly cropped.++Limiting Rendering Area+-----------------------++If you'd like to use a ``Greedy`` widget but want to limit how much+space it consumes, you can turn it into a ``Fixed`` widget by using+one of the *limiting combinators*, ``Brick.Widgets.Core.hLimit`` and+``Brick.Widgets.Core.vLimit``. These combinators take widgets and turn+them into widgets with a ``Fixed`` size (in the relevant dimension) and+run their rendering functions in a modified rendering context with a+restricted rendering area.++For example, the following will center a string in 30 columns, leaving+room for something to be placed next to it as the terminal width+changes:++.. code:: haskell++   let w = hLimit 30 $ hCenter $ str "Hello, world!"++The Attribute Map+-----------------++The rendering context contains an attribute map (see `How Attributes+Work`_ and `appAttrMap: Managing Attributes`_) which is used to look up+attribute names from the drawing specification. The map originates from+``Brick.Main.appAttrMap`` and can be manipulated on a per-widget basis+using ``Brick.Widgets.Core.updateAttrMap``.++The Active Border Style+-----------------------++Widgets in the ``Brick.Widgets.Border`` module draw border characters+(horizontal, vertical, and boxes) between and around other widgets. To+ensure that widgets across your application share a consistent visual+style, border widgets consult the rendering context's *active border+style*, a value of type ``Brick.Widgets.Border.Style``, to get the+characters used to draw borders.++The default border style is ``Brick.Widgets.Border.Style.unicode``. To+change border styles, use the ``Brick.Widgets.Core.withBorderStyle``+combinator to wrap a widget and change the border style it uses when+rendering. For example, this will use the ``ascii`` border style instead+of ``unicode``:++.. code:: haskell++   let w = withBorderStyle Brick.Widgets.Border.Style.ascii $+             Brick.Widgets.Border.border $ str "Hello, world!"++By default, borders in adjacent widgets do not connect to each other.+This can lead to visual oddities, for example, when horizontal borders+are drawn next to vertical borders by leaving a small gap like this:++.. code:: text++    │─++You can request that adjacent borders connect to each other with+``Brick.Widgets.Core.joinBorders``. Two borders drawn with the+same attribute and border style, and both under the influence of+``joinBorders``, will produce a border like this instead:++.. code:: text++    ├─++See `Joining Borders`_ for further details.++How Attributes Work+===================++In addition to letting us map names to attributes, attribute maps+provide hierarchical attribute inheritance: a more specific attribute+derives any properties (e.g. background color) that it does not specify+from more general attributes in hierarchical relationship to it, letting+us customize only the parts of attributes that we want to change without+having to repeat ourselves.++For example, this draws a string with a foreground color of ``white`` on+a background color of ``blue``:++.. code:: haskell++   let w = withAttr specificAttr $ str "foobar"+       generalAttr = attrName "general"+       specificAttr = attrName "general" <> attrName "specific"+       myMap = attrMap defAttr [ (generalAttr, bg blue)+                               , (specificAttr, fg white)+                               ]++When drawing a widget, Brick keeps track of the current attribute it+is using to draw to the screen. The attribute it tracks is specified+by its *attribute name*, which is a hierarchical name referring to the+attribute in the attribute map. In the example above, the map contains+two attribute names: ``generalAttr`` and ``specificAttr``. Both names+are made up of segments: ``general`` is the first segment for both+names, and ``specific`` is the second segment for ``specificAttr``.+This tells Brick that ``specificAttr`` is a more specialized version+of ``generalAttr``. We'll see below how that affects the resulting+attributes that Brick uses.++When it comes to drawing something on the screen with either of these+attributes, Brick looks up the desired attribute name in the map+and uses the result to draw to the screen. In the example above,+``withAttr`` is used to tell Brick that when drawing ``str "foobar"``,+the attribute ``specificAttr`` should be used. Brick looks that name+up in the attribute map and finds a match: an attribute with a white+foreground color. However, what happens next is important: Brick then+looks up the more general attribute name derived from ``specificAttr``,+which it gets by removing the last segment in the name, ``specific``.+The resulting name, ``general``, is then looked up. The new result is+then *merged* with the initial lookup, yielding an attribute with a+white foreground color and a blue background color. This happens because+the ``specificAttr`` entry did not specify a background color. If it+had, that would have been used instead. In this way, we can create+inheritance relationships between attributes, much the same way CSS+supports inheritance of styles based on rule specificity.++Brick uses Vty's attribute type, ``Attr``, which has three components:+foreground color, background color, and style. These three components+can be independently specified to have an explicit value, and any+component not explicitly specified can default to whatever the terminal+is currently using. Vty styles can be combined together, e.g. underline+and bold, so styles are cumulative.++What if a widget attempts to draw with an attribute name that is not+specified in the map at all? In that case, the attribute map's "default+attribute" is used. In the example above, the default attribute for the+map is Vty's ``defAttr`` value, which means that the terminal's default+colors and style should be used. But that attribute can be customized+as well, and any attribute map lookup results will get merged with the+default attribute for the map. So, for example, if you'd like your+entire application background to be blue unless otherwise specified, you+could create an attribute map as follows:++.. code:: haskell++   let myMap = attrMap (bg blue) [ ... ]++This way, we can avoid repeating the desired background color and all of+the other map entries can just set foreground colors and styles where+needed.++In addition to using the attribute map provided by ``appAttrMap``, the+map and attribute lookup behavior can be customized on a per-widget+basis by using various functions from ``Brick.Widgets.Core``:++* ``updateAttrMap`` -- allows transformations of the attribute map,+* ``forceAttr`` -- forces all attribute lookups to map to the value of+  the specified attribute name,+* ``withDefAttr`` -- changes the default attribute for the attribute map+  to the one with the specified name, and+* ``overrideAttr`` -- creates attribute map lookup synonyms between+  attribute names.++Attribute Themes+================++Brick provides support for customizable attribute themes. This works as+follows:++* The application provides a default theme built in to the program.+* The application customizes the theme by loading theme customizations+  from a user-specified customization file.+* The application can save new customizations to files for later+  re-loading.++Customizations are written in an INI-style file. Here's an example:++.. code:: ini++   [default]+   default.fg = blue+   default.bg = black++   [other]+   someAttribute.fg = red+   someAttribute.style = underline+   otherAttribute.style = [underline, bold]+   otherAttribute.inner.fg = white++In the above example, the theme's *default attribute* -- the one that is+used when no other attributes are used -- is customized. Its foreground+and background colors are set. Then, other attributes specified by+the theme -- ``someAttribute`` and ``otherAttribute`` -- are also+customized. This example shows that styles can be customized, too, and+that a custom style can either be a single style (in this example,+``underline``) or a collection of styles to be applied simultaneously+(in this example, ``underline`` and ``bold``). Lastly, the hierarchical+attribute name ``otherAttribute.inner`` refers to an attribute name+with two components, ``otherAttribute <> inner``, similar to the+``specificAttr`` attribute described in `How Attributes Work`_. Full+documentation for the format of theme customization files can be found+in the module documentation for ``Brick.Themes``.++The above example can be used in a ``brick`` application as follows.+First, the application provides a default theme:++.. code:: haskell++   import Brick.Themes (Theme, newTheme)+   import Brick (attrName)+   import Brick.Util (fg, on)+   import Graphics.Vty (defAttr, white, blue, yellow, magenta)++   defaultTheme :: Theme+   defaultTheme =+       newTheme (white `on` blue)+                [ (attrName "someAttribute",  fg yellow)+                , (attrName "otherAttribute", fg magenta)+                ]++Notice that the attributes in the theme have defaults: ``someAttribute``+will default to a yellow foreground color if it is not customized. (And+its background will default to the theme's default background color,+blue, if it not customized either.) Then, the application can customize+the theme with the user's customization file:++.. code:: haskell++   import Brick.Themes (loadCustomizations)++   main :: IO ()+   main = do+       customizedTheme <- loadCustomizations "custom.ini" defaultTheme++Now we have a customized theme based on ``defaultTheme``. The next step+is to build an ``AttrMap`` from the theme:++.. code:: haskell++   import Brick.Themes (themeToAttrMap)++   main :: IO ()+   main = do+       customizedTheme <- loadCustomizations "custom.ini" defaultTheme+       let mapping = themeToAttrMap customizedTheme++The resulting ``AttrMap`` can then be returned by ``appAttrMap``+as described in `How Attributes Work`_ and `appAttrMap: Managing+Attributes`_.++If the theme is further customized at runtime, any changes can be saved+with ``Brick.Themes.saveCustomizations``.++Wide Character Support and the ``TextWidth`` class+==================================================++Brick attempts to support rendering wide characters in all widgets,+and the brick editor supports entering and editing wide characters.+Wide characters are those such as many Asian characters and emoji+that need more than a single terminal column to be displayed.++Unfortunately, there is not a fully correct solution to determining+the character width that the user's terminal will use for a given+character. The current recommendation is to avoid use of wide characters+due to these issues. If you still must use them, you can read `vty`_'s+documentation for options that will affect character width calculations.++As a result of supporting wide characters, it is important to know that+computing the length of a string to determine its screen width will+*only* work for single-column characters. So, for example, if you want+to support wide characters in your application, this will not work:++.. code:: haskell++   let width = Data.Text.length t++If the string contains any wide characters, their widths will not be+counted properly. In order to get this right, use the ``TextWidth`` type+class to compute the width:++.. code:: haskell++   let width = Brick.Widgets.Core.textWidth t++The ``TextWidth`` type class uses Vty's character width routine to+compute the width by looking up the string's characters in a Unicode+width table. If you need to compute the width of a single character, use+``Graphics.Text.wcwidth``.++Extents+=======++When an application needs to know where a particular widget was drawn+by the renderer, the application can request that the renderer record+the *extent* of the widget--its upper-left corner and size--and provide+access to it in an event handler. Extents are represented using Brick's+``Brick.Types.Extent`` type. In the following example, the application+needs to know where the bordered box containing "Foo" is rendered:++.. code:: haskell++   ui = center $ border $ str "Foo"++We don't want to have to care about the particulars of the layout to+find out where the bordered box got placed during rendering. To get this+information we request that the extent of the box be reported to us by+the renderer using a resource name:++.. code:: haskell++   data Name = FooBox++   ui = center $+        reportExtent FooBox $+        border $ str "Foo"++Now, whenever the ``ui`` is rendered, the extent of the bordered box+containing "Foo" will be recorded. We can then look it up in event+handlers in ``EventM``:++.. code:: haskell++   mExtent <- Brick.Main.lookupExtent FooBox+   case mExtent of+       Nothing -> ...+       Just (Extent _ upperLeft (width, height)) -> ...++Paste Support+=============++Some terminal emulators support "bracketed paste" mode. This feature+enables OS-level paste operations to send the pasted content as a+single chunk of data and bypass the usual input processing that the+application does. This enables more secure handling of pasted data since+the application can detect that a paste occurred and avoid processing+the pasted data as ordinary keyboard input. For more information, see+`bracketed paste mode`_.++The Vty library used by brick provides support for bracketed pastes, but+this mode must be enabled. To enable paste mode, we need to get access+to the Vty library handle in ``EventM`` (in e.g. ``appHandleEvent``):++.. code:: haskell++   import Control.Monad (when)+   import qualified Graphics.Vty as V++   do+       vty <- Brick.Main.getVtyHandle+       let output = V.outputIface vty+       when (V.supportsMode output V.BracketedPaste) $+           liftIO $ V.setMode output V.BracketedPaste True++Once enabled, paste mode will generate Vty ``EvPaste`` events. These+events will give you the entire pasted content as a ``ByteString`` which+you must decode yourself if, for example, you expect it to contain UTF-8+text data.++Mouse Support+=============++Some terminal emulators support mouse interaction. The Vty library used+by brick provides these low-level events if mouse mode has been enabled.+To enable mouse mode, we need to get access to the Vty library handle in+``EventM``:++.. code:: haskell++   do+       vty <- Brick.Main.getVtyHandle+       let output = outputIface vty+       when (supportsMode output Mouse) $+           liftIO $ setMode output Mouse True++Bear in mind that some terminals do not support mouse interaction, so+use Vty's ``getModeStatus`` to find out whether your terminal will+provide mouse events.++Also bear in mind that terminal users will usually expect to be able+to interact with your application entirely without a mouse, so if you+do choose to enable mouse interaction, consider using it to improve+existing interactions rather than provide new functionality that cannot+already be managed with a keyboard.++Low-level Mouse Events+----------------------++Once mouse events have been enabled, Vty will generate ``EvMouseDown``+and ``EvMouseUp`` events containing the mouse button clicked, the+location in the terminal, and any modifier keys pressed.++.. code:: haskell++   handleEvent (VtyEvent (EvMouseDown col row button mods) = ...++Brick Mouse Events+------------------++Although these events may be adequate for your needs, ``brick`` provides+a higher-level mouse event interface that ties into the drawing+language. The disadvantage to the low-level interface described above is+that you still need to determine *what* was clicked, i.e., the part of+the interface that was under the mouse cursor. There are two ways to do+this with ``brick``: with *click reporting* and *extent checking*.++Click reporting+***************++The *click reporting* approach is the most high-level approach offered+by ``brick`` and the one that we recommend you use. In this approach,+we use ``Brick.Widgets.Core.clickable`` when drawing the interface to+request that a given widget generate ``MouseDown`` and ``MouseUp``+events when it is clicked.++.. code:: haskell++   data Name = MyButton++   ui :: Widget Name+   ui = center $+        clickable MyButton $+        border $+        str "Click me"++   handleEvent (MouseDown MyButton button modifiers coords) = ...+   handleEvent (MouseUp MyButton button coords) = ...++This approach enables event handlers to use pattern matching to check+for mouse clicks on specific regions; this uses `Extent checking`_+under the hood but makes it possible to denote which widgets are+clickable in the interface description. The event's click coordinates+are local to the widget being clicked. In the above example, a click+on the upper-left corner of the border would result in coordinates of+``(0,0)``.++Extent checking+***************++The *extent checking* approach entails requesting extents (see+`Extents`_) for parts of your interface, then checking the Vty mouse+click event's coordinates against one or more extents. This approach+is slightly lower-level than the direct mouse click reporting approach+above but is provided in case you need more control over how mouse+clicks are dealt with.++The most direct way to do this is to check a specific extent:++.. code:: haskell++   handleEvent (VtyEvent (EvMouseDown col row _ _)) = do+       mExtent <- lookupExtent SomeExtent+       case mExtent of+           Nothing -> return ()+           Just e -> do+               if Brick.Main.clickedExtent (col, row) e+                   then ...+                   else ...++This approach works well enough if you know which extent you're+interested in checking, but what if there are many extents and you+want to know which one was clicked? And what if those extents are in+different layers? The next approach is to find all clicked extents:++.. code:: haskell++   handleEvent (VtyEvent (EvMouseDown col row _ _)) = do+       extents <- Brick.Main.findClickedExtents (col, row)+       -- Then check to see if a specific extent is in the list, or just+       -- take the first one in the list.++This approach finds all clicked extents and returns them in a list with+the following properties:++* For extents ``A`` and ``B``, if ``A``'s layer is higher than ``B``'s+  layer, ``A`` comes before ``B`` in the list.+* For extents ``A`` and ``B``, if ``A`` and ``B`` are in the same layer+  and ``A`` is contained within ``B``, ``A`` comes before ``B`` in the+  list.++As a result, the extents are ordered in a natural way, starting with the+most specific extents and proceeding to the most general.++Viewports+=========++A *viewport* is a scrollable window onto a widget. Viewports have a+*scrolling direction* of type ``Brick.Types.ViewportType`` which can be+one of:++* ``Horizontal``: the viewport can only scroll horizontally.+* ``Vertical``: the viewport can only scroll vertically.+* ``Both``: the viewport can scroll both horizontally and vertically.++The ``Brick.Widgets.Core.viewport`` combinator takes another widget+and embeds it in a named viewport. We name the viewport so that we can+keep track of its scrolling state in the renderer, and so that you can+make scrolling requests. The viewport's name is its handle for these+operations (see `Scrolling Viewports in Event Handlers`_ and `Resource+Names`_). **The viewport name must be unique across your application.**++For example, the following puts a string in a horizontally-scrollable+viewport:++.. code:: haskell++   -- Assuming that App uses 'Name' for its resource names:+   data Name = Viewport1+   let w = viewport Viewport1 Horizontal $ str "Hello, world!"++A ``viewport`` specification means that the widget in the viewport will+be placed in a viewport window that is ``Greedy`` in both directions+(see `Available Rendering Area`_). This is suitable if we want the+viewport size to be the size of the entire terminal window, but if+we want to limit the size of the viewport, we might use limiting+combinators (see `Limiting Rendering Area`_):++.. code:: haskell++   let w = hLimit 5 $+           vLimit 1 $+           viewport Viewport1 Horizontal $ str "Hello, world!"++Now the example produces a scrollable window one row high and five+columns wide initially showing "Hello". The next two sections discuss+the two ways in which this viewport can be scrolled.++Scrolling Viewports in Event Handlers+-------------------------------------++The most direct way to scroll a viewport is to make *scrolling requests*+in the ``EventM`` event-handling monad. Scrolling requests ask the+renderer to update the state of a viewport the next time the user+interface is rendered. Those state updates will be made with respect+to the *previous* viewport state, i.e., the state of the viewports as+of the end of the most recent rendering. This approach is the best+approach to use to scroll widgets that have no notion of a cursor.+For cursor-based scrolling, see `Scrolling Viewports With Visibility+Requests`_.++To make scrolling requests, we first create a+``Brick.Main.ViewportScroll`` from a viewport name with+``Brick.Main.viewportScroll``:++.. code:: haskell++   -- Assuming that App uses 'Name' for its resource names:+   data Name = Viewport1+   let vp = viewportScroll Viewport1++The ``ViewportScroll`` record type contains a number of scrolling+functions for making scrolling requests:++.. code:: haskell++   hScrollPage        :: Direction -> EventM n s ()+   hScrollBy          :: Int       -> EventM n s ()+   hScrollToBeginning ::              EventM n s ()+   hScrollToEnd       ::              EventM n s ()+   vScrollPage        :: Direction -> EventM n s ()+   vScrollBy          :: Int       -> EventM n s ()+   vScrollToBeginning ::              EventM n s ()+   vScrollToEnd       ::              EventM n s ()++In each case the scrolling function scrolls the viewport by the+specified amount in the specified direction; functions prefixed with+``h`` scroll horizontally and functions prefixed with ``v`` scroll+vertically.++Scrolling operations do nothing when they don't make sense for the+specified viewport; scrolling a ``Vertical`` viewport horizontally is a+no-op, for example.++Using ``viewportScroll`` we can write an event handler that scrolls the+``Viewport1`` viewport one column to the right:++.. code:: haskell++   myHandler :: e -> EventM n s ()+   myHandler e = do+       let vp = viewportScroll Viewport1+       hScrollBy vp 1++Scrolling Viewports With Visibility Requests+--------------------------------------------++When we need to scroll widgets only when a cursor in the viewport+leaves the viewport's bounds, we need to use *visibility requests*. A+visibility request is a hint to the renderer that some element of a+widget inside a viewport should be made visible, i.e., that the viewport+should be scrolled to bring the requested element into view.++To use a visibility request to make a widget in a viewport visible, we+simply wrap it with ``visible``:++.. code:: haskell++   -- Assuming that App uses 'Name' for its resource names:+   data Name = Viewport1+   let w = viewport Viewport1 Horizontal $+           (visible $ str "Hello,") <+> (str " world!")++This example requests that the ``Viewport1`` viewport be scrolled so+that "Hello," is visible. We could extend this example with a value+in the application state indicating which word in our string should+be visible and then use that to change which string gets wrapped with+``visible``; this is the basis of cursor-based scrolling.++Note that a visibility request does not change the state of a viewport+*if the requested widget is already visible*! This important detail is+what makes visibility requests so powerful, because they can be used to+capture various cursor-based scenarios:++* The ``Brick.Widgets.Edit`` widget uses a visibility request to make its+  1x1 cursor position visible, thus making the text editing widget fully+  scrollable *while being entirely scrolling-unaware*.+* The ``Brick.Widgets.List`` widget uses a visibility request to make+  its selected item visible regardless of its size, which makes+  the list widget scrolling-unaware.++Showing Scroll Bars on Viewports+--------------------------------++Brick supports drawing both vertical and horizontal scroll bars on+viewports. To enable scroll bars, wrap your call to ``viewport`` with+a call to ``withVScrollBars`` and/or ``withHScrollBars``. If you don't+like the appearance of the resulting scroll bars, you can customize+how they are drawn by making your own ``ScrollbarRenderer`` and using+``withVScrollBarRenderer`` and/or ``withHScrollBarRenderer``. Note that+when you enable scrollbars, the content of your viewport will lose one+column of available space if vertical scroll bars are enabled and one+row of available space if horizontal scroll bars are enabled.++Scroll bars can also be configured to draw "handles" with+``withHScrollBarHandles`` and ``withVScrollBarHandles``.++Lastly, scroll bars can be configured to report mouse events on+each scroll bar element. To enable mouse click reporting, use+``withClickableHScrollBars`` and ``withClickableVScrollBars``.++For a demonstration of the scroll bar API in action, see the+``ViewportScrollbarsDemo.hs`` demonstration program.++Viewport Restrictions+---------------------++Viewports impose one restriction: a viewport that is scrollable in+some direction can only embed a widget that has a ``Fixed`` size in+that direction. This extends to ``Both`` type viewports: they can only+embed widgets that are ``Fixed`` in both directions. This restriction+is because when viewports embed a widget, they relax the rendering area+constraint in the rendering context, but doing so to a large enough+number for ``Greedy`` widgets would result in a widget that is too big+and not scrollable in a useful way.++Violating this restriction will result in a runtime exception.++Input Forms+===========++While it's possible to construct interfaces with editors and other+interactive inputs manually, this process is somewhat tedious: all of+the event dispatching has to be written by hand, a focus ring or other+construct needs to be managed, and most of the rendering code needs to+be written. Furthermore, this process makes it difficult to follow some+common patterns:++* We typically want to validate the user's input, and only collect it+  once it has been validated.+* We typically want to notify the user when a particular field's+  contents are invalid.+* It is often helpful to be able to create a new data type to represent+  the fields in an input interface, and use it to initialize the input+  elements and later collect the (validated) results.+* A lot of the rendering and event-handling work to be done is+  repetitive.++The ``Brick.Forms`` module provides a high-level API to automate all of+the above work in a type-safe manner.++A Form Example+--------------++Let's consider an example data type that we'd want to use as the+basis for an input interface. This example comes directly from the+``FormDemo.hs`` demonstration program.++.. code:: haskell++   data UserInfo =+       FormState { _name      :: T.Text+                 , _age       :: Int+                 , _address   :: T.Text+                 , _ridesBike :: Bool+                 , _handed    :: Handedness+                 , _password  :: T.Text+                 } deriving (Show)++   data Handedness = LeftHanded+                   | RightHanded+                   | Ambidextrous+                   deriving (Show, Eq)++Suppose we want to build an input form for the above data. We might want+to use an editor to allow the user to enter a name and an age. We'll+need to ensure that the user's input for age is a valid integer. For+``_ridesBike`` we might want a checkbox-style input, and for ``_handed``+we might want a radio button input. For ``_password``, we'd definitely+like a password input box that conceals the input.++If we were to build an interface for this data manually, we'd need to+deal with converting the data above to the right types for inputs. For+example, for ``_age`` we'd need to convert an initial age value to+``Text``, put it in an editor with ``Brick.Widgets.Edit.editor``, and+then at a later time, parse the value and reconstruct an age from the+editor's contents. We'd also need to tell the user if the age value was+invalid.++Brick's ``Forms`` API provides input field types for all of the above+use cases. Here's the form that we can use to allow the user to edit a+``UserInfo`` value:++.. code:: haskell++   mkForm :: UserInfo -> Form UserInfo e Name+   mkForm =+       newForm [ editTextField name NameField (Just 1)+               , editTextField address AddressField (Just 3)+               , editShowableField age AgeField+               , editPasswordField password PasswordField+               , radioField handed [ (LeftHanded, LeftHandField, "Left")+                                   , (RightHanded, RightHandField, "Right")+                                   , (Ambidextrous, AmbiField, "Both")+                                   ]+               , checkboxField ridesBike BikeField "Do you ride a bicycle?"+               ]++A form is represented using a ``Form s e n`` value and is parameterized+with some types:++* ``s`` - the type of *form state* managed by the form (in this case+  ``UserInfo``)+* ``e`` - the event type of the application (must match the event type+  used with ``App``)+* ``n`` - the resource name type of the application (must match the+  resource name type used with ``App``)++First of all, the above code assumes we've derived lenses for+``UserInfo`` using ``Lens.Micro.TH.makeLenses``. Once we've done+that, each field that we specify in the form must provide a lens into+``UserInfo`` so that we can declare the particular field of ``UserInfo``+that will be edited by the field. For example, to edit the ``_name``+field we use the ``name`` lens to create a text field editor with+``editTextField``. All of the field constructors above are provided by+``Brick.Forms``.++Each form field also needs a resource name (see `Resource Names`_). The+resource names are assigned to the individual form inputs so the form+can automatically track input focus and handle mouse click events.++The form carries with it the value of ``UserInfo`` that reflects the+contents of the form. Whenever an input field in the form handles an+event, its contents are validated and rewritten to the form state (in+this case, a ``UserInfo`` record).++The ``mkForm`` function takes a ``UserInfo`` value, which is really+just an argument to ``newForm``. This ``UserInfo`` value will be used+to initialize all of the form fields. Each form field will use the lens+provided to extract the initial value from the ``UserInfo`` record,+convert it into an appropriate state type for the field in question, and+later validate that state and convert it back into the appropriate type+for storage in ``UserInfo``.++The form value itself -- of type ``Form`` -- must be stored in your+application state. You should only ever call ``newForm`` when you need+to initialize a totally new form. Once initialized, the form needs to be+kept around and updated by event handlers in order to work.++For example, if the initial ``UserInfo`` value's ``_age`` field has the+value ``0``, the ``editShowableField`` will call ``show`` on ``0``,+convert that to ``Text``, and initialize the editor for ``_age`` with+the text string ``"0"``. Later, if the user enters more text -- changing+the editor contents to ``"10"``, say -- the ``Read`` instance for+``Int`` (the type of ``_age``) will be used to parse ``"10"``. The+successfully-parsed value ``10`` will then be written to the ``_age``+field of the form's ``UserInfo`` state using the ``age`` lens. The use+of ``Show`` and ``Read`` here is a feature of the field type we have+chosen for ``_age``, ``editShowableField``.++For other field types we may have other needs. For instance,+``Handedness`` is a data type representing all the possible choices+we want to provide for a user's handedness. We wouldn't want the user+to have to type in a text string for this option. A more appropriate+input interface is a list of radio buttons to choose from amongst+the available options. For that we have ``radioField``. This field+constructor takes a list of all of the available options, and updates+the form state with the value of the currently-selected option.++Rendering Forms+---------------++Rendering forms is done easily using the ``Brick.Forms.renderForm``+function. However, as written above, the form will not look especially+nice. We'll see a few text editors followed by some radio buttons and a+check box. But we'll need to customize the output a bit to make the form+easier to use. For that, we have the ``Brick.Forms.@@=`` operator. This+operator lets us provide a function to augment the ``Widget`` generated+by the field's rendering function so we can do things like add labels,+control layout, or change attributes:++.. code:: haskell++    (str "Name: " <+>) @@=+        editTextField name NameField (Just 1)++Now when we invoke ``renderForm`` on a form using the above example,+we'll see a ``"Name:"`` label to the left of the editor field for+the ``_name`` field of ``UserInfo``.++Brick provides this interface to controlling per-field rendering because+many form fields either won't have labels or will have different layout+requirements, so an alternative API such as building the label into the+field API doesn't always make sense.++Brick defaults to rendering individual fields' inputs, and the entire+form, in a vertical box using ``vBox``. Use ``setFormConcat`` and+``setFieldConcat`` to change this behavior to, e.g., ``hBox``.++Form Attributes+---------------++The ``Brick.Forms`` module uses and exports two attribute names (see+`How Attributes Work`_):++* ``focusedFormInputAttr`` - this attribute is used to render the form+  field that has the focus.+* ``invalidFormInputAttr`` - this attribute is used to render any form+  field that has user input that has invalid validation.++Your application should set both of these. Some good mappings in the+attribute map are:++* ``focusedFormInputAttr`` - ``black `on` yellow``+* ``invalidFormInputAttr`` - ``white `on` red``++Handling Form Events+--------------------++Handling form events is easy: we just use ``zoom`` to call+``Brick.Forms.handleFormEvent`` with the ``BrickEvent`` and a lens+to access the ``Form`` in the application state. This automatically+dispatches input events to the currently-focused input field, and it+also manages focus changes with ``Tab`` and ``Shift-Tab`` keybindings.+(For details on all of its behaviors, see the Haddock documentation for+``handleFormEvent``.) It's still up to the application to decide when+events should go to the form in the first place.++Since the form field handlers take ``BrickEvent`` values, that means+that custom fields could even handle application-specific events (of the+type ``e`` above).++Once the application has decided that the user should be done with the+form editing session, the current state of the form can be obtained+with ``Brick.Forms.formState``. In the example above, this would+return a ``UserInfo`` record containing the values for each field in+the form *as of the last time it was valid input*. This means that+the user might have provided invalid input to a form field that is+not reflected in the form state due to failing validation.++Since the ``formState`` is always a valid set of values, it might+be surprising to the user if the values used do not match the last+values they saw on the screen; the ``Brick.Forms.allFieldsValid``+can be used to determine if the last visual state of the form had+any invalid entries and doesn't match the value of ``formState``. A+list of any fields which had invalid values can be retrieved with the+``Brick.Forms.invalidFields`` function.++While each form field type provides a validator function to validate+its current user input value, that function is pure. As a result it's+not suitable for doing validation that requires I/O such as searching+a database or making network requests. If your application requires+that kind of validation, you can use the ``Brick.Forms.setFieldValid``+function to set the validation state of any form field as you see+fit. The validation state set by that function will be considered by+``allFieldsValid`` and ``invalidFields``. See ``FormDemo.hs`` for an+example of this API.++Note that if mouse events are enabled in your application (see `Mouse+Support`_), all built-in form fields will respond to mouse interaction.+Radio buttons and check boxes change selection on mouse clicks and+editors change cursor position on mouse clicks.++Writing Custom Form Field Types+-------------------------------++If the built-in form field types don't meet your needs, ``Brick.Forms``+exposes all of the data types needed to implement your own field types.+For more details on how to do this, see the Haddock documentation for+the ``FormFieldState`` and ``FormField`` data types along with the+implementations of the built-in form field types.++Customizable Keybindings+========================++Brick applications typically start out by explicitly checking incoming+events for specific keys in ``appHandleEvent``. While this works well+enough, it results in *tight coupling* between the input key events and+the event handlers that get run. As applications evolve, it becomes+important to decouple the input key events and their handlers to allow+the input keys to be customized by the user. That's where Brick's+customizable keybindings API comes in.++The customizable keybindings API provides:++* ``Brick.Keybindings.Parse``: parsing and loading user-provided+  keybinding configuration files,+* ``Brick.Keybindings.Pretty``: pretty-printing keybindings and+  generating keybinding help text in ``Widget``, plain text, and+  Markdown formats so you can provide help to users both within the+  program and outside of it,+* ``Brick.Keybindings.KeyEvents``: specifying the application's abstract+  key events and their configuration names,+* ``Brick.Keybindings.KeyConfig``: bundling default and customized+  keybindings for each abstract event into a structure for use by the+  dispatcher, and+* ``Brick.Keybindings.KeyDispatcher``: specifying handlers and+  dispatching incoming key events to them.++This section of the User Guide describes the API at a high level,+but Brick also provides a complete working example of the custom+keybinding API in ``programs/CustomKeybindingDemo.hs`` and+provides detailed documentation on how to use the API, including a+step-by-step process for using it, in the module documentation for+``Brick.Keybindings.KeyDispatcher``.++The following table compares Brick application design decisions and+runtime behaviors in a typical application to those of an application+that uses the customizable keybindings API:+++---------------------+------------------------+-------------------------++| **Approach**        | **Before runtime**     | **At runtime**          |++---------------------+------------------------+-------------------------++| Typical application | The application author | #. An input event       |+| (no custom          | decides which keys will|    arrives when the user|+| keybindings)        | trigger application    |    presses a key.       |+|                     | behaviors. The event   | #. The event handler    |+|                     | handler is written to  |    pattern-matches on   |+|                     | pattern-match on       |    the input event to   |+|                     | specific keys.         |    check for a match and|+|                     |                        |    then runs the        |+|                     |                        |    corresponding        |+|                     |                        |    handler.             |++---------------------+------------------------+-------------------------++| Application with    | The application author | #. A Vty input event    |+| custom keybindings  | specifies the possible |    arrives when the user|+| API integrated      | *abstract events* that |    presses a key.       |+|                     | correspond to the      | #. The input event is   |+|                     | application's          |    provided to          |+|                     | behaviors. The events  |    ``appHandleEvent``.  |+|                     | are given default      | #. ``appHandleEvent``   |+|                     | keybindings. The       |    passes the event on  |+|                     | application provides   |    to a                 |+|                     | event handlers for the |    ``KeyDispatcher``.   |+|                     | abstract events, not   | #. The key dispatcher   |+|                     | specific keys. If      |    checks to see whether|+|                     | desired, the           |    the input key event  |+|                     | application can load   |    maps to an abstract  |+|                     | user-defined custom    |    event.               |+|                     | keybindings from an INI| #. If the dispatcher    |+|                     | file at startup to     |    finds a match, the   |+|                     | override the           |    corresponding        |+|                     | application's defaults.|    abstract event's key |+|                     |                        |    handler is run.      |++---------------------+------------------------+-------------------------+++Keybinding Collisions+---------------------++An important issue to consider in using the custom keybinding API is+that it is possible for the user to map the same key to more than one+event. We refer to this situation as a *keybinding collision*. Whether+the collision represents a problem depends on how the events in question+are going to be handled by the application. This section provides an+example scenario and describes a way to deal with this situation.++Suppose an application has two key events:++.. code:: haskell++   data KeyEvent = QuitEvent+                 | CloseWindowEvent++   allKeyEvents :: KeyEvents KeyEvent+   allKeyEvents =+       K.keyEvents [ ("quit",         QuitEvent)+                   , ("close-window", CloseWindowEvent)+                   ]++   defaultBindings :: [(KeyEvent, [Binding])]+   defaultBindings =+       [ (QuitEvent,        [ctrl 'q'])+       , (CloseWindowEvent, [bind KEsc])+       ]++Suppose also that the application using the above key events has a+feature that opens a window, and that ``CloseWindowEvent`` is used to+close the window, while ``QuitEvent`` is used to quit the application.++A user might then provide a custom INI file to rebind keys as follows::++   [keybindings]+   quit = Esc+   close-window = Esc++While this is a valid configuration for the user to provide, it would+result in a keybinding collision for ``Esc`` since it is now bound+to two events. Whether that's a problem depends entirely on how+``QuitEvent`` and ``CloseWindowEvent`` are handled:++* If the application handles both events in the same event handler,+  the ``KeyDispatcher`` for those events would fail to construct since+  ``Esc`` maps to more than one event. Building a ``KeyDispatcher``+  from a ``KeyConfig`` with such a collision would fail and return+  information about the collisions.+* If the application handles the two events in different dispatchers+  then the collision has no effect and is not a problem since different+  ``KeyDispatcher`` values would be constructed to handle the events+  separately. This could happen, for instance, if the application only+  ever handled ``CloseWindowEvent`` when the window in question was+  open and only handled ``QuitEvent`` when the window had been closed.+  This kind of "modal" approach to handling events means that we only+  consider a key to have a collision if it is bound to two or more+  events that are handled in the same event handling context.++There's also another situation that would be problematic, which is+when an abstract event like ``QuitEvent`` has a key mapping that+collides with a key handler that is bound to a specific key using+``Brick.Keybindings.KeyDispatcher.onKey`` rather than an abstract event:++.. code:: haskell++    K.onKey (K.bind '\t') "Increment the counter by 10" $+        counter %= (+ 10)++If ``onKey`` is used, the handler it creates is only triggered by the+specified key (``Tab`` in the example above). But the handler may be+included alongside handlers in the same dispatcher that are *also*+triggered by ``Tab``, so if those event handlers were provided together+when creating a ``KeyDispatcher`` then it would fail to construct due to+the collision.++Brick provides ``Brick.Keybindings.KeyConfig.keyEventMappings`` to help+finding collisions at the key configuration level. Finding out about+collisions at the dispatcher level is possible by handling the failure+case when calling ``Brick.Keybindings.KeyDispatcher.keyDispatcher``.++Joining Borders+===============++Brick supports a feature called "joinable borders" which means that+borders drawn in adjacent widgets can be configured to automatically+"join" with each other using the appropriate intersection characters.+This feature is helpful for creating seamless connected borders without+the need for manual calculations to determine where to draw intersection+characters.++Under normal circumstances, widgets are self-contained in that their+renderings do not interact with the appearance of adjacent widgets. This+is unfortunate for borders: one often wants to draw a T-shaped character+at the intersection of a vertical and horizontal border, for example.+To facilitate automatically adding such characters, ``brick`` offers+some border-specific capabilities for widgets to re-render themselves+as information about neighboring widgets becomes available during the+rendering process.++Border-joining works by iteratively *redrawing* the edges of widgets as+those edges come into contact with other widgets during rendering. If+the adjacent edge locations of two widgets both use joinable borders,+the Brick will re-draw one of the characters so that it connects+seamlessly with the adjacent border.++How Joining Works+-----------------++When a widget is rendered, it can report supplementary information+about each position on its edges. Each position has four notional line+segments extending from its center, arranged like this:++.. code:: text++            top+             |+             |+    left ----+---- right+             |+             |+           bottom++These segments can independently be *drawn*, *accepting*, and+*offering*, as captured in the ``Brick.Types.BorderSegment`` type:++.. code:: haskell++    data BorderSegment = BorderSegment+        { bsAccept :: Bool+        , bsOffer :: Bool+        , bsDraw :: Bool+        }++If no information is reported for a position, it assumed that it is+not drawn, not accepting, and not offering -- and so it will never+be rewritten. This situation is the ordinary situation where an edge+location is not a border at all, or is a border that we don't want to+join to other borders.++Line segments that are *drawn* are used for deciding which part of the+``BorderStyle`` to use if this position needs to be updated. (See also+`The Active Border Style`_.) For example, suppose a position needs to+be redrawn, and already has the left and bottom segments drawn; then it+will replace the current character with the upper-right corner drawing+character ``bsCornerTR`` from its border style.++The *accepting* and *offering* properties are used to perform a small+handshake between neighboring widgets; when the handshake is successful,+one segment will transition to being drawn. For example, suppose a+horizontal and vertical border widget are drawn next to each other:++.. code:: text++            top+         (offering)                 top+             |+             |+    left     +     right    left ----+---- right+             |           (offering)     (offering)+             |+           bottom                  bottom+         (offering)++These borders are accepting in all directions, drawn in the directions+signified by visible lines, and offering in the directions written.+Since the horizontal border on the right is offering towards the+vertical border, and the vertical border is accepting from the direction+towards the horizontal border, the right segment of the vertical+border will transition to being drawn. This will trigger an update of+the ``Image`` associated with the left widget, overwriting whatever+character is there currently with a ``bsIntersectL`` character instead.+The state of the segments afterwards will be the same, but the fact that+there is one more segment drawn will be recorded:++.. code:: text++            top+         (offering)                 top+             |+             |+    left     +---- right    left ----+---- right+             |           (offering)     (offering)+             |+           bottom                  bottom+         (offering)++It is important that this be recorded: we may later place this combined+widget to the right of another horizontal border, in which case we+would want to transition again from a ``bsIntersectL`` character to a+``bsIntersectFull`` character that represents all four segments being+drawn.++Because this involves an interaction between multiple widgets, we+may find that the two widgets involved were rendered under different+rendering contexts. To avoid mixing and matching border styles and+drawing attributes, each location records not just the state of its+four segments but also the border style and attribute that were active+at the time the border was drawn. This information is stored in+``Brick.Types.DynBorder``.++.. code:: haskell++    data DynBorder = DynBorder+        { dbStyle :: BorderStyle+        , dbAttr :: Attr+        , dbSegments :: Edges BorderSegment+        }++The ``Brick.Types.Edges`` type has one field for each direction:++.. code:: haskell++    data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }++In addition to the offer/accept handshake described above, segments also+check that their neighbor's ``BorderStyle`` and ``Attr`` match their own+before transitioning from undrawn to drawn to avoid visual glitches from+trying to connect e.g. ``unicode`` borders to ``ascii`` ones or green+borders to red ones.++The above description applies to a single location; any given widget's+result may report information about any location on its border using the+``Brick.BorderMap.BorderMap`` type. A ``BorderMap a`` is close kin to a+``Data.Map.Map Location a`` except that each ``BorderMap`` has a fixed+rectangle on which keys are retained. Values inserted at other keys are+silently discarded.++For backwards compatibility, all the widgets that ship with ``brick``+avoid reporting any border information by default, but ``brick`` offers+three ways of modifying the border-joining behavior of a widget.++* ``Brick.Widgets.Core.joinBorders`` instructs any borders drawn in its+  child widget to report their edge information. It does this+  by setting a flag in the rendering context that tells the+  ``Brick.Widgets.Border`` widgets to report the information described+  above. Consequently, widgets drawn in this context will join their+  borders with neighbors.+* ``Brick.Widgets.Core.separateBorders`` does the opposite of+  ``joinBorders`` by unsetting the same context flag, preventing border+  widgets from attempting to connect.+* ``Brick.Widgets.Core.freezeBorders`` lets its child widget connect its+  borders internally but prevents it from connecting with anything+  outside the ``freezeBorders`` call. It does this by deleting the edge+  metadata about its child widget. This means that any connections+  already made within the child widget will stay as they are but no new+  connections will be made to adjacent widgets. For example, one might+  use this to create a box with internal but no external connections:++  .. code:: haskell++      joinBorders . freezeBorders . border . hBox $+          [str "left", vBorder, str "right"]++  Or to create a box that allows external connections but not internal+  ones:++  .. code:: haskell++      joinBorders . border . freezeBorders . hBox $+          [str "left", vBorder, str "right"]++When creating new widgets, if you would like ``joinBorders`` and+``separateBorders`` to affect the behavior of your widget, you may do+so by consulting the ``ctxDynBorders`` field of the rendering context+before writing to your ``Result``'s ``borders`` field.++Animations+==========++Brick provides animation support in ``Brick.Animation``. See the Haddock+documentation in that module for a complete explanation of the API; see+``programs/AnimationDemo.hs`` (``brick-animation-demo``) for a working+example.++The Rendering Cache+===================++When widgets become expensive to render, ``brick`` provides a *rendering+cache* that automatically caches and re-uses stored Vty images from+previous renderings to avoid expensive renderings. To cache the+rendering of a widget, just wrap it in the ``Brick.Widgets.Core.cached``+function:++.. code:: haskell++   data Name = ExpensiveThing++   ui :: Widget Name+   ui = center $+        cached ExpensiveThing $+        border $+        str "This will be cached"++In the example above, the first time the ``border $ str "This will be cached"``+widget is rendered, the resulting Vty image will be stored+in the rendering cache under the key ``ExpensiveThing``. On subsequent+renderings the cached Vty image will be used instead of re-rendering the+widget. This example doesn't need caching to improve performance, but+more sophisticated widgets might.++Once ``cached`` has been used to store something in the rendering cache,+periodic cache invalidation may be required. For example, if the cached+widget is built from application state, the cache will need to be+invalidated when the relevant state changes. The cache may also need to+be invalidated when the terminal is resized. To invalidate the cache, we+use the cache invalidation functions in ``EventM``:++.. code:: haskell++   handleEvent ... = do+       -- Invalidate just a single cache entry:+       Brick.Main.invalidateCacheEntry ExpensiveThing++       -- Invalidate the entire cache (useful on a resize):+       Brick.Main.invalidateCache++Implementing Custom Widgets+===========================++``brick`` exposes all of the internals you need to implement your+own widgets. Those internals, together with ``Graphics.Vty``, can be+used to create widgets from the ground up. You'll need to implement+your own widget if you can't write what you need in terms of existing+combinators. For example, an ordinary widget like++.. code:: haskell++   myWidget :: Widget n+   myWidget = str "Above" <=> str "Below"++can be expressed with ``<=>`` and ``str`` and needs no custom behavior.+But suppose we want to write a widget that renders some string followed+by the number of columns in the space available to the widget. We can't+do this without writing a custom widget because we need access to the+rendering context. We can write such a widget as follows:++.. code:: haskell++   customWidget :: String -> Widget n+   customWidget s =+       Widget Fixed Fixed $ do+           ctx <- getContext+           render $ str (s <> " " <> show (ctx^.availWidthL))++The ``Widget`` constructor takes the horizontal and vertical growth+policies as described in `How Widgets and Rendering Work`_. Here we just+provide ``Fixed`` for both because the widget will not change behavior+if we give it more space. We then get the rendering context and append+the context's available columns to the provided string. Lastly we call+``render`` to render the widget we made with ``str``. The ``render``+function returns a ``Brick.Types.Result`` value:++.. code:: haskell++    data Result n =+        Result { image              :: Graphics.Vty.Image+               , cursors            :: [Brick.Types.CursorLocation n]+               , visibilityRequests :: [Brick.Types.VisibilityRequest]+               , extents            :: [Extent n]+               , borders            :: BorderMap DynBorder+               }++The rendering function runs in the ``RenderM`` monad, which gives us+access to the rendering context (see `How Widgets and Rendering Work`_)+via the ``Brick.Types.getContext`` function as shown above. The context+tells us about the dimensions of the rendering area and the current+attribute state of the renderer, among other things:++.. code:: haskell++    data Context =+        Context { ctxAttrName    :: AttrName+                , availWidth     :: Int+                , availHeight    :: Int+                , ctxBorderStyle :: BorderStyle+                , ctxAttrMap     :: AttrMap+                , ctxDynBorders  :: Bool+                }++and has lens fields exported as described in `Conventions`_.++As shown here, the job of the rendering function is to return a+rendering result which means producing a ``vty`` ``Image``. In addition,+if you so choose, you can also return one or more cursor positions in+the ``cursors`` field of the ``Result`` as well as visibility requests+(see `Viewports`_) in the ``visibilityRequests`` field. Returned+visibility requests and cursor positions should be relative to the+upper-left corner of your widget, ``Location (0, 0)``. When your widget+is placed in others, such as boxes, the ``Result`` data you returned+will be offset (as described in `Rendering Sub-Widgets`_) to result in+correct coordinates once the entire interface has been rendered.++Using the Rendering Context+---------------------------++The most important fields of the context are the rendering area fields+``availWidth`` and ``availHeight``. These fields must be used to+determine how much space your widget has to render.++To perform an attribute lookup in the attribute map for the context's+current attribute, use ``Brick.Types.attrL``.++For example, to build a widget that always fills the available width and+height with a fill character using the current attribute, we could+write:++.. code:: haskell++   myFill :: Char -> Widget n+   myFill ch =+       Widget Greedy Greedy $ do+           ctx <- getContext+           let a = ctx^.attrL+           return $ Result (Graphics.Vty.charFill a ch (ctx^.availWidthL) (ctx^.availHeightL))+                           [] [] [] Brick.BorderMap.empty++Rendering Sub-Widgets+---------------------++If your custom widget wraps another, then in addition to rendering+the wrapped widget and augmenting its returned ``Result`` *it must+also translate the resulting cursor locations, visibility requests,+and extents*. This is vital to maintaining the correctness of+rendering metadata as widget layout proceeds. To do so, use the+``Brick.Widgets.Core.addResultOffset`` function to offset the elements+of a ``Result`` by a specified amount. The amount depends on the nature+of the offset introduced by your wrapper widget's logic.++Widgets are not required to respect the rendering context's width and+height restrictions. Widgets may be embedded in viewports or translated+so they must render without cropping to work in those scenarios.+However, widgets rendering other widgets *should* enforce the rendering+context's constraints to avoid using more space than is available. The+``Brick.Widgets.Core.cropToContext`` function is provided to make this+easy:++.. code:: haskell++   let w = cropToContext someWidget++Widgets wrapped with ``cropToContext`` can be safely embedded in other+widgets. If you don't want to crop in this way, you can use any of+``vty``'s cropping functions to operate on the ``Result`` image as+desired.++Sub-widgets may specify specific attribute name values influencing+that sub-widget.  If the custom widget utilizes its own attribute+names but needs to render the sub-widget, it can use ``overrideAttr``+or ``mapAttrNames`` to convert its custom names to the names that the+sub-widget uses for rendering its output.++.. _vty: https://github.com/jtdaugherty/vty+.. _Hackage: http://hackage.haskell.org/+.. _microlens: http://hackage.haskell.org/package/microlens+.. _bracketed paste mode: https://cirw.in/blog/bracketed-paste
+ docs/snake-demo.gif view

binary file changed (absent → 406517 bytes)

+ programs/AnimationDemo.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+module Main where++import Control.Monad (void)+import Lens.Micro.Platform+import Data.List (intersperse)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Data.Map as M+import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import Brick.BChan+import Brick.Util (fg)+import Brick.Main (App(..), neverShowCursor, customMain, halt)+import Brick.AttrMap (AttrName, AttrMap, attrMap, attrName)+import Brick.Types (Widget, EventM, BrickEvent(..), Location(..))+import Brick.Widgets.Border (border)+import Brick.Widgets.Center (center)+import Brick.Widgets.Core ((<+>), str, vBox, hBox, hLimit, vLimit, translateBy, withDefAttr)+import qualified Brick.Animation as A++data CustomEvent =+    AnimationUpdate (EventM () St ())+    -- ^ The state update constructor required by the animation API++data St =+    St { _stAnimationManager :: A.AnimationManager St CustomEvent ()+       -- ^ The animation manager that will run all of our animations+       , _animation1 :: Maybe (A.Animation St ())+       , _animation2 :: Maybe (A.Animation St ())+       , _animation3 :: Maybe (A.Animation St ())+       , _clickAnimations :: M.Map Location (A.Animation St ())+       -- ^ The various fields for storing animation states. For mouse+       -- animations, we store animations for each screen location that+       -- was clicked.+       }++makeLenses ''St++drawUI :: St -> [Widget ()]+drawUI st = drawClickAnimations st <> [drawAnimations st]++drawClickAnimations :: St -> [Widget ()]+drawClickAnimations st =+    drawClickAnimation st <$> M.toList (st^.clickAnimations)++drawClickAnimation :: St -> (Location, A.Animation St ()) -> Widget ()+drawClickAnimation st (l, a) =+    translateBy l $+    A.renderAnimation (const $ str " ") st (Just a)++drawAnimations :: St -> Widget ()+drawAnimations st =+    let animStatus label key a =+            str (label <> ": ") <+>+            maybe (str "Not running") (const $ str "Running") a <+>+            str (" (Press " <> key <> " to toggle)")+        statusMessages = statusMessage <$> zip [(0::Int)..] animations+        statusMessage (i, (c, config)) =+            animStatus ("Animation #" <> (show $ i + 1)) [c]+                       (st^.(animationTarget config))+        animationDrawings = hBox $ intersperse (str " ") $+                            drawSingleAnimation <$> animations+        drawSingleAnimation (_, config) =+            A.renderAnimation (const $ str " ") st (st^.(animationTarget config))+    in vBox [ str "Click and drag the mouse or press keys to start animations."+            , str " "+            , vBox statusMessages+            , animationDrawings+            ]++clip1 :: A.Clip a ()+clip1 = A.newClip_ $ str <$> [".", "o", "O", "^", " "]++clip2 :: A.Clip a ()+clip2 = A.newClip_ $ str <$> ["|", "/", "-", "\\"]++clip3 :: A.Clip a ()+clip3 =+    A.newClip_ $+    (hLimit 9 . vLimit 9 . border . center) <$>+    [ border $ str " "+    , border $ vBox $ replicate 3 $ str $ replicate 3 ' '+    , border $ vBox $ replicate 5 $ str $ replicate 5 ' '+    ]++mouseClickClip :: A.Clip a ()+mouseClickClip =+    A.newClip_+    [ withDefAttr attr6 $ str "0"+    , withDefAttr attr5 $ str "O"+    , withDefAttr attr4 $ str "o"+    , withDefAttr attr3 $ str "•"+    , withDefAttr attr2 $ str "*"+    , withDefAttr attr2 $ str "."+    ]++attr6 :: AttrName+attr6 = attrName "attr6"++attr5 :: AttrName+attr5 = attrName "attr5"++attr4 :: AttrName+attr4 = attrName "attr4"++attr3 :: AttrName+attr3 = attrName "attr3"++attr2 :: AttrName+attr2 = attrName "attr2"++attr1 :: AttrName+attr1 = attrName "attr1"++attrs :: AttrMap+attrs =+    attrMap V.defAttr+        [ (attr6, fg V.white)+        , (attr5, fg V.brightYellow)+        , (attr4, fg V.brightGreen)+        , (attr3, fg V.cyan)+        , (attr2, fg V.blue)+        , (attr1, fg V.black)+        ]++-- | Animation settings grouped together for lookup by keystroke.+data AnimationConfig =+    AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ()))+                    , animationClip :: A.Clip St ()+                    , animationFrameTime :: Integer+                    , animationMode :: A.RunMode+                    }++animations :: [(Char, AnimationConfig)]+animations =+    [ ('1', AnimationConfig animation1 clip1 1000 A.Loop)+    , ('2', AnimationConfig animation2 clip2 100 A.Loop)+    , ('3', AnimationConfig animation3 clip3 100 A.Once)+    ]++-- | Start the animation specified by this config.+startAnimationFromConfig :: AnimationConfig -> EventM () St ()+startAnimationFromConfig config = do+    mgr <- use stAnimationManager+    A.startAnimation mgr (animationClip config)+                         (animationFrameTime config)+                         (animationMode config)+                         (animationTarget config)++-- | If the animation specified in this config is not running, start it.+-- Otherwise stop it.+toggleAnimationFromConfig :: AnimationConfig -> EventM () St ()+toggleAnimationFromConfig config = do+    mgr <- use stAnimationManager+    mOld <- use (animationTarget config)+    case mOld of+        Just a -> A.stopAnimation mgr a+        Nothing -> startAnimationFromConfig config++-- | Start a new mouse click animation at the specified location if one+-- is not already running there.+startMouseClickAnimation :: Location -> EventM () St ()+startMouseClickAnimation l = do+    mgr <- use stAnimationManager+    a <- use (clickAnimations.at l)+    case a of+        Just {} -> return ()+        Nothing -> A.startAnimation mgr mouseClickClip 100 A.Once (clickAnimations.at l)++appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e = do+    case e of+        -- A mouse click starts an animation at the click location.+        VtyEvent (V.EvMouseDown col row _ _) ->+            startMouseClickAnimation (Location (col, row))++        -- If we got a character keystroke, see if there is a specific+        -- animation mapped to that character and toggle the resulting+        -- animation.+        VtyEvent (V.EvKey (V.KChar c) [])+            | Just aConfig <- lookup c animations ->+                toggleAnimationFromConfig aConfig++        -- Apply a state update from the animation manager.+        AppEvent (AnimationUpdate act) -> act++        VtyEvent (V.EvKey V.KEsc []) -> halt++        _ -> return ()++theApp :: App St CustomEvent ()+theApp =+    App { appDraw = drawUI+        , appChooseCursor = neverShowCursor+        , appHandleEvent = appEvent+        , appStartEvent = return ()+        , appAttrMap = const attrs+        }++main :: IO ()+main = do+    chan <- newBChan 10+    mgr <- A.startAnimationManager 50 chan AnimationUpdate++    let initialState =+            St { _stAnimationManager = mgr+               , _animation1 = Nothing+               , _animation2 = Nothing+               , _animation3 = Nothing+               , _clickAnimations = mempty+               }+        buildVty = do+            v <- mkVty V.defaultConfig+            V.setMode (V.outputIface v) V.Mouse True+            return v++    initialVty <- buildVty+    void $ customMain initialVty buildVty (Just chan) theApp initialState
programs/AttrDemo.hs view
@@ -1,10 +1,13 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Main where +#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import Graphics.Vty-  ( Event, Attr, white, blue, cyan, green, red, yellow-  , black+  ( Attr, white, blue, cyan, green, red, yellow+  , black, withURL   )  import Brick.Main@@ -16,28 +19,39 @@   , withAttr   , vBox   , str+  , hyperlink+  , modifyDefAttr   ) import Brick.Util (on, fg)-import Brick.AttrMap (attrMap, AttrMap)+import Brick.AttrMap (attrMap, AttrMap, attrName) -ui :: Widget+ui :: Widget n ui =     vBox [ str "This text uses the global default attribute."-         , withAttr "foundFull" $+         , withAttr (attrName "foundFull") $            str "Specifying an attribute name means we look it up in the attribute tree."-         , (withAttr "foundFgOnly" $-           str ("When we find a value, we merge it with its parent in the attribute")-           <=> str "name tree all the way to the root (the global default).")-         , withAttr "missing" $+         , withAttr (attrName "foundFgOnly") $+           str "When we find a value, we merge it with its parent in the attribute"+           <=> str "name tree all the way to the root (the global default)."+         , withAttr (attrName "missing") $            str "A missing attribute name just resumes the search at its parent."-         , withAttr ("general" <> "specific") $+         , withAttr (attrName "general" <> attrName "specific") $            str "In this way we build complete attribute values by using an inheritance scheme."-         , withAttr "foundFull" $+         , withAttr (attrName "foundFull") $            str "You can override everything ..."-         , withAttr "foundFgOnly" $-           str "... or only you want to change and inherit the rest."+         , withAttr (attrName "foundFgOnly") $+           str "... or only what you want to change and inherit the rest."          , str "Attribute names are assembled with the Monoid append operation to indicate"-         , str "hierarchy levels, e.g. \"window\" <> \"title\"."+         , str "hierarchy levels, e.g. attrName \"window\" <> attrName \"title\"."+         , str " "+         , withAttr (attrName "linked") $+           str "This text is hyperlinked in terminals that support hyperlinking."+         , str " "+         , hyperlink "http://www.google.com/" $+           str "This text is also hyperlinked in terminals that support hyperlinking."+         , str " "+         , modifyDefAttr (`withURL` "http://www.google.com/") $+           str "This text is hyperlinked by modifying the default attribute."          ]  globalDefault :: Attr@@ -45,20 +59,21 @@  theMap :: AttrMap theMap = attrMap globalDefault-    [ ("foundFull",               white `on` green)-    , ("foundFgOnly",             fg red)-    , ("general",                 yellow `on` black)-    , ("general" <> "specific",   fg cyan)+    [ (attrName "foundFull",               white `on` green)+    , (attrName "foundFgOnly",             fg red)+    , (attrName "general",                 yellow `on` black)+    , (attrName "general" <> attrName "specific",+                                           fg cyan)+    , (attrName "linked",                  fg yellow `withURL` "http://www.google.com/")     ] -app :: App () Event+app :: App () e () app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const theMap         , appChooseCursor = neverShowCursor-        , appLiftVtyEvent = id         }  main :: IO ()
programs/BorderDemo.hs view
@@ -1,27 +1,32 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Main where -import Control.Applicative ((<$>))-import Data.Monoid+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+ import qualified Data.Text as T import qualified Graphics.Vty as V  import qualified Brick.Main as M-import Brick.Util (fg, bg, on)+import Brick.Util (fg, on) import qualified Brick.AttrMap as A import Brick.Types   ( Widget   ) import Brick.Widgets.Core-  ( (<=>)-  , (<+>)+  ( (<+>)+  , withAttr   , vLimit   , hLimit   , hBox+  , vBox   , updateAttrMap   , withBorderStyle   , txt   , str+  , padLeftRight   ) import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B@@ -52,47 +57,48 @@                    , BS.bsVertical = '!'                    } -borderDemos :: [Widget]+borderDemos :: [Widget ()] borderDemos = mkBorderDemo <$> styles -mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget+mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget () mkBorderDemo (styleName, sty) =     withBorderStyle sty $     B.borderWithLabel (str "label") $     vLimit 5 $     C.vCenter $-    txt $ "  " <> styleName <> " style  "+    padLeftRight 2 $+    txt $ styleName <> " style" -borderMappings :: [(A.AttrName, V.Attr)]-borderMappings =+titleAttr :: A.AttrName+titleAttr = A.attrName "title"++attrs :: [(A.AttrName, V.Attr)]+attrs =     [ (B.borderAttr,         V.yellow `on` V.black)-    , (B.vBorderAttr,        V.green `on` V.red)-    , (B.hBorderAttr,        V.white `on` V.green)-    , (B.hBorderLabelAttr,   fg V.blue)-    , (B.tlCornerAttr,       bg V.red)-    , (B.trCornerAttr,       bg V.blue)-    , (B.blCornerAttr,       bg V.yellow)-    , (B.brCornerAttr,       bg V.green)+    , (B.vBorderAttr,        fg V.cyan)+    , (B.hBorderAttr,        fg V.magenta)+    , (titleAttr,            fg V.cyan)     ] -colorDemo :: Widget+colorDemo :: Widget () colorDemo =-    updateAttrMap (A.applyAttrMappings borderMappings) $-    B.borderWithLabel (str "title") $+    updateAttrMap (A.applyAttrMappings attrs) $+    B.borderWithLabel (withAttr titleAttr $ str "title") $     hLimit 20 $     vLimit 5 $     C.center $     str "colors!" -ui :: Widget+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
@@ -0,0 +1,81 @@+{-# LANGUAGE CPP #-}+module Main where++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+import qualified Brick.Main as M+import qualified Brick.Widgets.Center as C+import Brick.Types+  ( Widget+  , BrickEvent(..)+  )+import Brick.Widgets.Core+  ( Padding(..)+  , vBox+  , padTopBottom+  , withDefAttr+  , cached+  , padBottom+  , str+  )+import Brick (on)+import Brick.Widgets.Center+  ( hCenter+  )+import Brick.AttrMap+  ( AttrName+  , attrName+  , attrMap+  )++data Name = ExpensiveWidget+          deriving (Ord, Show, Eq)++drawUi :: Int -> [Widget Name]+drawUi i = [ui]+    where+        ui = C.vCenter $+             vBox $ hCenter <$>+             [ str "This demo shows how cached widgets behave. The top widget below"+             , str "is cacheable, so once it's rendered, brick re-uses the rendering"+             , str "each time it is drawn. The bottom widget is not cacheable so it is"+             , str "drawn on every request. Brick supports cache invalidation to force"+             , str "a redraw of cached widgets; we can trigger that here with 'i'. Notice"+             , str "how state changes with '+' aren't reflected in the cached widget"+             , str "until the cache is invalidated with 'i'."+             , padTopBottom 1 $+               cached ExpensiveWidget $+               withDefAttr emphAttr $ str $ "This widget is cached (state = " <> show i <> ")"+             , 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 :: 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 = attrName "emphasis"++app :: M.App Int e Name+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = return ()+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const $ attrMap V.defAttr [(emphAttr, V.white `on` V.blue)]+          , M.appChooseCursor = M.neverShowCursor+          }++main :: IO ()+main = void $ M.defaultMain app 0
+ programs/CroppingDemo.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain)+import Brick.Types+  ( Widget+  )+import Brick.Widgets.Core+  ( vBox+  , hBox+  , txt+  , (<=>)+  , padRight+  , cropLeftBy+  , cropRightBy+  , cropTopBy+  , cropBottomBy+  , cropLeftTo+  , cropRightTo+  , cropTopTo+  , cropBottomTo+  , Padding(..)+  )+import Brick.Widgets.Border (border)+import Brick.AttrMap (attrMap)+import qualified Graphics.Vty as V++example :: Widget n+example =+    border+    (txt "Example" <=> txt "Widget")++mkExample :: Widget n -> Widget n+mkExample = padRight (Pad 2)++ui :: Widget ()+ui =+    vBox [ txt "Uncropped" <=> example+         , hBox [ mkExample $ txt "cropLeftBy 2"   <=> cropLeftBy 2 example+                , mkExample $ txt "cropRightBy 2"  <=> cropRightBy 2 example+                , mkExample $ txt "cropTopBy 2"    <=> cropTopBy 2 example+                , mkExample $ txt "cropBottomBy 2" <=> cropBottomBy 2 example+                ]+         , hBox [ mkExample $ txt "cropLeftTo 4"   <=> cropLeftTo 4 example+                , mkExample $ txt "cropRightTo 4"  <=> cropRightTo 4 example+                , mkExample $ txt "cropTopTo 1"    <=> cropTopTo 1 example+                , mkExample $ txt "cropBottomTo 1" <=> cropBottomTo 1 example+                ]+         ]++app :: App () e ()+app =+    App { appDraw = const [ui]+        , appHandleEvent = resizeOrQuit+        , appStartEvent = return ()+        , appAttrMap = const $ attrMap V.defAttr []+        , appChooseCursor = neverShowCursor+        }++main :: IO ()+main = defaultMain app ()
programs/CustomEventDemo.hs view
@@ -1,77 +1,86 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} module Main where -import Control.Lens (makeLenses, (^.), (&), (.~), (%~))+import Lens.Micro ((^.))+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void, forever)-import Control.Concurrent (newChan, writeChan, threadDelay, forkIO)-import Data.Default+import Control.Concurrent (threadDelay, forkIO)+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import qualified Graphics.Vty as V +import Brick.BChan import Brick.Main   ( App(..)   , showFirstCursor-  , customMain-  , continue+  , customMainWithDefaultVty   , halt   )+import Brick.AttrMap+  ( attrMap+  ) import Brick.Types   ( Widget-  , Next   , EventM+  , BrickEvent(..)   ) import Brick.Widgets.Core   ( (<=>)   , str   ) +data CustomEvent = Counter deriving Show+ data St =-    St { _stLastVtyEvent :: Maybe V.Event+    St { _stLastBrickEvent :: Maybe (BrickEvent () CustomEvent)        , _stCounter :: Int        }  makeLenses ''St -data CustomEvent = VtyEvent V.Event-                 | Counter--drawUI :: St -> [Widget]+drawUI :: St -> [Widget ()] drawUI st = [a]     where-        a = (str $ "Last Vty event: " <> (show $ st^.stLastVtyEvent))+        a = (str $ "Last event: " <> (show $ st^.stLastBrickEvent))             <=>             (str $ "Counter value is: " <> (show $ st^.stCounter)) -appEvent :: St -> 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 ev -> continue $ st & stLastVtyEvent .~ (Just ev)-        Counter -> continue $ st & stCounter %~ (+1)+        VtyEvent (V.EvKey V.KEsc []) -> halt+        VtyEvent _ -> stLastBrickEvent .= (Just e)+        AppEvent Counter -> do+            stCounter %= (+1)+            stLastBrickEvent .= (Just e)+        _ -> return ()  initialState :: St initialState =-    St { _stLastVtyEvent = Nothing+    St { _stLastBrickEvent = Nothing        , _stCounter = 0        } -theApp :: App St CustomEvent+theApp :: App St CustomEvent () theApp =     App { appDraw = drawUI         , appChooseCursor = showFirstCursor         , appHandleEvent = appEvent-        , appStartEvent = return-        , appAttrMap = def-        , appLiftVtyEvent = VtyEvent+        , appStartEvent = return ()+        , appAttrMap = const $ attrMap V.defAttr []         }  main :: IO () main = do-    chan <- newChan+    chan <- newBChan 10 -    forkIO $ forever $ do-        writeChan chan Counter+    void $ forkIO $ forever $ do+        writeBChan chan Counter         threadDelay 1000000 -    void $ customMain (V.mkVty def) chan theApp initialState+    (_, vty) <- customMainWithDefaultVty (Just chan) theApp initialState+    V.shutdown vty
+ programs/CustomKeybindingDemo.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl ((<~), (.=), (%=), use)+import Control.Monad (void, forM_, when)+import qualified Data.Set as S+import Data.Maybe (fromJust)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Graphics.Vty as V+import System.Environment (getArgs)+import System.Exit (exitFailure)++import qualified Brick.Types as T+import Brick.Types (Widget)+import qualified Brick.Keybindings as K+import Brick.AttrMap+import Brick.Util (fg)+import qualified Brick.Main as M+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C+import Brick.Widgets.Core++-- | The abstract key events for the application.+data KeyEvent = QuitEvent+              | IncrementEvent+              | DecrementEvent+              deriving (Ord, Eq, Show)++-- | The mapping of key events to their configuration field names.+allKeyEvents :: K.KeyEvents KeyEvent+allKeyEvents =+    K.keyEvents [ ("quit",      QuitEvent)+                , ("increment", IncrementEvent)+                , ("decrement", DecrementEvent)+                ]++-- | Default key bindings for each abstract key event.+defaultBindings :: [(KeyEvent, [K.Binding])]+defaultBindings =+    [ (QuitEvent,      [K.ctrl 'q', K.bind V.KEsc])+    , (IncrementEvent, [K.bind '+'])+    , (DecrementEvent, [K.bind '-'])+    ]++data St =+    St { _keyConfig :: K.KeyConfig KeyEvent+       -- ^ The key config to use.+       , _lastKey :: Maybe (V.Key, [V.Modifier])+       -- ^ The last key that was pressed.+       , _lastKeyHandled :: Bool+       -- ^ Whether the last key was handled by a handler.+       , _counter :: Int+       -- ^ The counter value to manipulate in the handlers.+       , _customBindingsPath :: Maybe FilePath+       -- ^ Set if the application found custom keybindings in the+       -- specified file.+       , _dispatcher :: K.KeyDispatcher KeyEvent (T.EventM () St)+       -- ^ The key dispatcher we'll use to dispatch input events.+       }++makeLenses ''St++-- | Key event handlers for our application.+handlers :: [K.KeyEventHandler KeyEvent (T.EventM () St)]+handlers =+    -- The first three handlers are triggered by keys mapped to abstract+    -- events, thus decoupling the configured key bindings from these+    -- handlers.+    [ K.onEvent QuitEvent "Quit the program"+          M.halt+    , K.onEvent IncrementEvent "Increment the counter" $+          counter %= succ+    , K.onEvent DecrementEvent "Decrement the counter" $+          counter %= subtract 1++    -- These handlers are always triggered by specific keys and thus+    -- cannot be rebound.+    , K.onKey (K.bind '\t') "Increment the counter by 10" $+          counter %= (+ 10)+    , K.onKey (K.bind V.KBackTab) "Decrement the counter by 10" $+          counter %= subtract 10+    ]++appEvent :: T.BrickEvent () e -> T.EventM () St ()+appEvent (T.VtyEvent (V.EvKey k mods)) = do+    -- Dispatch the key to the event handler to which the key is mapped,+    -- if any. Also record in lastKeyHandled whether the dispatcher+    -- found a matching handler.+    d <- use dispatcher+    lastKey .= Just (k, mods)+    lastKeyHandled <~ K.handleKey d k mods+appEvent _ =+    return ()++drawUi :: St -> [Widget ()]+drawUi st = [body]+    where+        binding = uncurry K.binding <$> st^.lastKey++        -- Generate key binding help using the library so we can embed+        -- it in the UI.+        keybindingHelp = B.borderWithLabel (txt "Active Keybindings") $+                         K.keybindingHelpWidget (st^.keyConfig) handlers++        lastKeyDisplay = withDefAttr lastKeyAttr $+                         txt $ maybe "(none)" K.ppBinding binding++        -- Show the status of the last pressed key, whether we handled+        -- it, and other bits of the application state.+        status = B.borderWithLabel (txt "Status") $+                 hLimit 40 $+                 padRight Max $+                 vBox [ txt   "Last key:         " <+> lastKeyDisplay+                      , str $ "Last key handled: " <> show (st^.lastKeyHandled)+                      , str $ "Counter:          " <> show (st^.counter)+                      ]++        -- Show info about whether the application is currently using+        -- custom bindings loaded from an INI file.+        customBindingInfo =+            B.borderWithLabel (txt "Custom Bindings") $+            case st^.customBindingsPath of+                Nothing ->+                    hLimit 40 $+                    txtWrap $ "No custom bindings loaded. Create an INI file with a " <>+                              (Text.pack $ show sectionName) <>+                              " section or use 'programs/custom_keys.ini'. " <>+                              "Pass its path to this program on the command line."+                Just f -> str "Loaded custom bindings from:" <=> str (show f)++        body = C.center $+               (padRight (Pad 2) $ status <=> customBindingInfo) <+>+               keybindingHelp++lastKeyAttr :: AttrName+lastKeyAttr = attrName "lastKey"++app :: M.App St e ()+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = return ()+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const $ attrMap V.defAttr [ (K.eventNameAttr, fg V.magenta)+                                                     , (K.eventDescriptionAttr, fg V.cyan)+                                                     , (K.keybindingAttr, fg V.yellow)+                                                     , (lastKeyAttr, fg V.white `V.withStyle` V.bold)+                                                     ]+          , M.appChooseCursor = M.showFirstCursor+          }++sectionName :: Text.Text+sectionName = "keybindings"++main :: IO ()+main = do+    args <- getArgs++    -- If the command line specified the path to an INI file with custom+    -- bindings, attempt to load it.+    (customBindings, customFile) <- case args of+        [iniFilePath] -> do+            result <- K.keybindingsFromFile allKeyEvents sectionName iniFilePath+            case result of+                -- A section was found and had zero more bindings.+                Right (Just bindings) ->+                    return (bindings, Just iniFilePath)++                -- No section was found at all.+                Right Nothing -> do+                    putStrLn $ "Error: found no section " <> show sectionName <> " in " <> show iniFilePath+                    exitFailure++                -- There was some problem parsing the file as an INI+                -- file.+                Left e -> do+                    putStrLn $ "Error reading keybindings file " <> show iniFilePath <> ": " <> e+                    exitFailure++        _ -> return ([], Nothing)++    -- Create a key config that includes the default bindings as well as+    -- the custom bindings we loaded from the INI file, if any.+    let kc = K.newKeyConfig allKeyEvents defaultBindings customBindings++    -- Before starting the application, check on whether any events have+    -- colliding bindings. Exit if so.+    --+    -- Note that in a Real Application, we would more than likely+    -- want to check for collisions among specific sets of+    -- events. For example, if 'Esc' was bound to both 'quit' and+    -- 'close-dialog-box', we might not care about such a collision+    -- if the application only ever handled the 'close-dialog-box'+    -- event in a separate mode and only ever handled 'quit' at the+    -- top-level of the event handler. But if we had two events such as+    -- 'dialog-box-okay' and 'dialog-box-cancel' that were intended to+    -- be handled in the same mode, we might want to check that those+    -- two events did not have the same binding.+    forM_ (K.keyEventMappings kc) $ \(b, evs) -> do+        when (S.size evs > 1) $ do+            Text.putStrLn $ "Error: key '" <> K.ppBinding b <> "' is bound to multiple events:"+            forM_ evs $ \e ->+                Text.putStrLn $ "  " <> Text.pack (show e) <> " (" <> fromJust (K.keyEventName allKeyEvents e) <> ")"+            exitFailure++    -- Now build a key dispatcher for our event handlers. If this fails+    -- due to key collision detection, we'll print out info about the+    -- collisions.+    d <- case K.keyDispatcher kc handlers of+        Right d -> return d+        Left collisions -> do+            putStrLn "Error: some key events have the same keys bound to them."++            forM_ collisions $ \(b, hs) -> do+                Text.putStrLn $ "Handlers with the '" <> K.ppBinding b <> "' binding:"+                forM_ hs $ \h -> do+                    let trigger = case K.kehEventTrigger $ K.khHandler h of+                            K.ByKey k   -> "triggered by the key '" <> K.ppBinding k <> "'"+                            K.ByEvent e -> "triggered by the event '" <> fromJust (K.keyEventName allKeyEvents e) <> "'"+                        desc = K.handlerDescription $ K.kehHandler $ K.khHandler h++                    Text.putStrLn $ "  " <> desc <> " (" <> trigger <> ")"++            exitFailure++    void $ M.defaultMain app $ St { _keyConfig = kc+                                  , _lastKey = Nothing+                                  , _lastKeyHandled = False+                                  , _counter = 0+                                  , _customBindingsPath = customFile+                                  , _dispatcher = d+                                  }++    -- Now demonstrate how the library's generated key binding help text+    -- looks in plain text and Markdown formats. These can be used to+    -- generate documentation for users. Note that the output generated+    -- here takes the active bindings into account! If you don't want+    -- that, use a key config that doesn't have any custom bindings+    -- applied.+    let sections = [("Main", handlers)]++    putStrLn "Generated plain text help:"+    Text.putStrLn $ K.keybindingTextTable kc sections++    putStrLn "Generated Markdown help:"+    Text.putStrLn $ K.keybindingMarkdownTable kc sections
programs/DialogDemo.hs view
@@ -1,12 +1,16 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Main where +#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import qualified Graphics.Vty as V  import qualified Brick.Main as M import Brick.Types   ( Widget+  , BrickEvent(..)   ) import Brick.Widgets.Core   ( padAll@@ -21,24 +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 -> V.Event -> T.EventM (T.Next (D.Dialog Choice))-appEvent d 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 =<< T.handleEvent ev 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 "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@@ -48,14 +59,13 @@     , (D.buttonSelectedAttr, bg V.yellow)     ] -theApp :: M.App (D.Dialog Choice) V.Event+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-          , M.appLiftVtyEvent = id           }  main :: IO ()
+ programs/DynamicBorderDemo.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Brick.Main as M+import Brick.Types+  ( Widget+  )+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Core as C+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Border.Style as BS++doubleHorizontal :: BS.BorderStyle+doubleHorizontal = BS.BorderStyle+    { BS.bsCornerTL = '╒'+    , BS.bsCornerTR = '╕'+    , BS.bsCornerBR = '╛'+    , BS.bsCornerBL = '╘'+    , BS.bsIntersectL = '╞'+    , BS.bsIntersectR = '╡'+    , BS.bsIntersectT = '╤'+    , BS.bsIntersectB = '╧'+    , BS.bsIntersectFull = '╪'+    , BS.bsHorizontal = '═'+    , BS.bsVertical = '│'+    }++box1 :: Widget ()+box1+    = C.withBorderStyle doubleHorizontal . B.border+    . C.withBorderStyle BS.unicodeRounded . B.border+    $ C.str "25 kg"++weights :: Widget ()+weights = C.withBorderStyle doubleHorizontal $ C.hBox+    [ box1+    , C.str "\n\n" C.<=> B.hBorder+    , box1+    ]++box2 :: Widget ()+box2 = C.freezeBorders $ C.vBox+    [ C.hBox+        [ C.vLimit 3 B.vBorder+        , C.str "Resize horizontally to\nmove across the label\nbelow"+        , C.vLimit 3 B.vBorder+        ]+    , B.borderWithLabel (B.vBorder C.<+> C.str " Label " C.<+> B.vBorder) $ C.hBox+        [ C.str "               "+        , C.vBox [B.vBorder, C.str "L\na\nb\ne\nl", C.vLimit 3 B.vBorder]+        , C.str "\n\n\n Resize vertically to\n move across the label\n to the left\n\n\n\n\n" C.<=> B.hBorder+        ]+    ]++-- BYOB: build your own border+byob :: Widget ()+byob = C.vBox+    [              C.hBox [ corner   , top      , corner   ]+    , C.vLimit 6 $ C.hBox [ B.vBorder, mid      , B.vBorder]+    ,              C.hBox [ corner   , B.hBorder, corner   ]+    ]+    where+    top = B.hBorderWithLabel (C.str "BYOB")+    mid = C.center (C.str "If `border` is too easy,\nyou can build it yourself")+    corner = B.joinableBorder (pure False)++ui :: Widget ()+ui = C.vBox [weights, box2, byob]++main :: IO ()+main = M.simpleMain (C.joinBorders ui)
programs/EditDemo.hs view
@@ -3,7 +3,9 @@ {-# LANGUAGE RankNTypes #-} module Main where -import Control.Lens+import Lens.Micro+import Lens.Micro.TH+import Lens.Micro.Mtl import qualified Graphics.Vty as V  import qualified Brick.Main as M@@ -18,72 +20,70 @@ import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Edit as E import qualified Brick.AttrMap as A+import qualified Brick.Focus as F import Brick.Util (on) +data Name = Edit1+          | Edit2+          deriving (Ord, Show, Eq)+ data St =-    St { _currentEditor :: T.Name-       , _edit1 :: E.Editor-       , _edit2 :: E.Editor+    St { _focusRing :: F.FocusRing Name+       , _edit1 :: E.Editor String Name+       , _edit2 :: E.Editor String Name        }  makeLenses ''St -firstEditor :: T.Name-firstEditor = "edit1"--secondEditor :: T.Name-secondEditor = "edit2"--switchEditors :: St -> St-switchEditors st =-    let next = if st^.currentEditor == firstEditor-               then secondEditor else firstEditor-    in st & currentEditor .~ next--currentEditorL :: St -> Lens' St E.Editor-currentEditorL st =-    if st^.currentEditor == firstEditor-    then edit1-    else edit2--drawUI :: St -> [T.Widget]+drawUI :: St -> [T.Widget Name] drawUI st = [ui]     where-        ui = C.center $ (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 $ E.renderEditor $ st^.edit1)) <=>-                        str " " <=>-                        (str "Input 2 (limited to 2 lines): " <+> (hLimit 30 $ E.renderEditor $ st^.edit2)) <=>-                        str " " <=>-                        str "Press Tab to switch between editors, Esc to quit."+        e1 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit1)+        e2 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit2) -appEvent :: St -> V.Event -> T.EventM (T.Next St)-appEvent st ev =-    case ev of-        V.EvKey V.KEsc [] -> M.halt st-        V.EvKey (V.KChar '\t') [] -> M.continue $ switchEditors st-        _ -> M.continue =<< T.handleEventLensed st (currentEditorL st) ev+        ui = C.center $+            (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 e1)) <=>+            str " " <=>+            (str "Input 2 (limited to 2 lines): " <+> (hLimit 30 e2)) <=>+            str " " <=>+            str "Press Tab to switch between editors, Esc to quit." +appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    M.halt+appEvent (T.VtyEvent (V.EvKey (V.KChar '\t') [])) =+    focusRing %= F.focusNext+appEvent (T.VtyEvent (V.EvKey V.KBackTab [])) =+    focusRing %= F.focusPrev+appEvent ev = do+    r <- use focusRing+    case F.focusGetCurrent r of+      Just Edit1 -> zoom edit1 $ E.handleEditorEvent ev+      Just Edit2 -> zoom edit2 $ E.handleEditorEvent ev+      Nothing -> return ()+ initialState :: St initialState =-    St firstEditor-       (E.editor firstEditor (str . unlines) Nothing "")-       (E.editor secondEditor (str . unlines) (Just 2) "")+    St (F.focusRing [Edit1, Edit2])+       (E.editor Edit1 Nothing "")+       (E.editor Edit2 (Just 2) "")  theMap :: A.AttrMap theMap = A.attrMap V.defAttr-    [ (E.editAttr, V.white `on` V.blue)+    [ (E.editAttr,                   V.white `on` V.blue)+    , (E.editFocusedAttr,            V.black `on` V.yellow)     ] -appCursor :: St -> [T.CursorLocation] -> Maybe T.CursorLocation-appCursor st = M.showCursorNamed (st^.currentEditor)+appCursor :: St -> [T.CursorLocation Name] -> Maybe (T.CursorLocation Name)+appCursor = F.focusRingCursor (^.focusRing) -theApp :: M.App St V.Event+theApp :: M.App St e Name theApp =     M.App { M.appDraw = drawUI           , M.appChooseCursor = appCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap-          , M.appLiftVtyEvent = id           }  main :: IO ()
+ programs/EditorLineNumbersDemo.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Main where++import Control.Monad (void)+import Lens.Micro+import Lens.Micro.TH+import Lens.Micro.Mtl+import qualified Graphics.Vty as V+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif++import qualified Brick.Main as M+import qualified Brick.Types as T+import Brick.Widgets.Core+  ( (<+>)+  , vBox+  , hLimit+  , vLimit+  , str+  , visible+  , viewport+  , withDefAttr+  )+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Edit as E+import qualified Brick.AttrMap as A+import Brick.Util (on, fg)++data Name = Edit+          | EditLines+          deriving (Ord, Show, Eq)++data St =+    St { _edit :: E.Editor String Name+       }++makeLenses ''St++drawUI :: St -> [T.Widget Name]+drawUI st = [ui]+    where+        e = renderWithLineNumbers (st^.edit)+        ui = C.center $ hLimit 50 $ vLimit 10 e++-- | Given an editor, render the editor with line numbers to the left of+-- the editor.+--+-- This essentially exploits knowledge of how the editor is implemented:+-- we make a viewport containing line numbers that is just as high as+-- the editor, then request that the line number associated with the+-- editor's current line position be made visible, thus scrolling it+-- into view. This is slightly brittle, however, because it relies on+-- essentially keeping the line number viewport and the editor viewport+-- in the same vertical scrolling state; with direct scrolling requests+-- from EventM it is easily possible to put the two viewports into a+-- state where they do not have the same vertical scrolling offset. That+-- means that visibility requests made with 'visible' won't necessarily+-- have the same effect in each viewport in that case. So this is+-- only really usable in the case where you're sure that the editor's+-- viewport and the line number viewports will not be managed by direct+-- viewport operations in EventM. That's what I'd recommend anyway, but+-- still, this is an important caveat.+--+-- There's another important caveat here: this particular implementation+-- has @O(n)@ performance for editor height @n@ because we generate+-- the entire list of line numbers on each rendering depending on the+-- height of the editor. That means that for sufficiently large files,+-- it will get more expensive to render the line numbers. There is a way+-- around this problem, which is to take the approach that the @List@+-- implementation takes: only render a region of visible line numbers+-- around the currently-edited line that is just large enough to be+-- guaranteed to fill the viewport, then translate that so that it+-- appears at the right viewport offset, thus faking a viewport filled+-- with line numbers when in fact we'd only ever render at most @2 * K ++-- 1@ line numbers for a viewport height of @K@. That's more involved,+-- so I didn't do it here, but that would be the way to go for a Real+-- Application.+renderWithLineNumbers :: E.Editor String Name -> T.Widget Name+renderWithLineNumbers e =+    lineNumbersVp <+> editorVp+    where+        lineNumbersVp = hLimit (maxNumWidth + 1) $ viewport EditLines T.Vertical body+        editorVp = E.renderEditor (str . unlines) True e+        body = withDefAttr lineNumberAttr $ vBox numWidgets+        numWidgets = mkNumWidget <$> numbers+        mkNumWidget i = maybeVisible i $ str $ show i+        maybeVisible i+            | i == curLine + 1 =+                visible . withDefAttr currentLineNumberAttr+            | otherwise =+                id+        numbers = [1..h]+        contents = E.getEditContents e+        h = length contents+        curLine = fst $ E.getCursorPosition e+        maxNumWidth = length $ show h++appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    M.halt+appEvent ev = do+    zoom edit $ E.handleEditorEvent ev++initialState :: St+initialState =+    St (E.editor Edit Nothing "")++lineNumberAttr :: A.AttrName+lineNumberAttr = A.attrName "lineNumber"++currentLineNumberAttr :: A.AttrName+currentLineNumberAttr = lineNumberAttr <> A.attrName "current"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (E.editAttr,              V.white `on` V.blue)+    , (E.editFocusedAttr,       V.black `on` V.yellow)+    , (lineNumberAttr,          fg V.cyan)+    , (currentLineNumberAttr,   V.defAttr `V.withStyle` V.bold)+    ]++theApp :: M.App St e Name+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = const $ M.showCursorNamed Edit+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = do+    void $ M.defaultMain theApp initialState
+ programs/FileBrowserDemo.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+module Main where++import qualified Control.Exception as E+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V++import Control.Monad.State (get)+import qualified Data.Text as Text+import qualified Brick.Main as M+import qualified Brick.Widgets.List as L+import Brick.AttrMap (AttrName, attrName)+import Brick.Types+  ( Widget+  , BrickEvent(..)+  )+import Brick.Widgets.Center+  ( center+  , hCenter+  )+import Brick.Widgets.Border+  ( borderWithLabel+  )+import Brick.Widgets.Core+  ( vBox, (<=>), padTop+  , hLimit, vLimit, txt+  , withDefAttr, emptyWidget+  , Padding(..)+  )+import qualified Brick.Widgets.FileBrowser as FB+import qualified Brick.AttrMap as A+import Brick.Util (on, fg)+import qualified Brick.Types as T++data Name = FileBrowser1+          deriving (Eq, Show, Ord)++drawUI :: FB.FileBrowser Name -> [Widget Name]+drawUI b = [center $ ui <=> help]+    where+        ui = hCenter $+             vLimit 15 $+             hLimit 50 $+             borderWithLabel (txt "Choose a file") $+             FB.renderFileBrowser True b+        help = padTop (Pad 1) $+               vBox [ case FB.fileBrowserException b of+                          Nothing -> emptyWidget+                          Just e -> hCenter $ withDefAttr errorAttr $+                                    txt $ Text.pack $ E.displayException e+                    , hCenter $ txt "Up/Down: select"+                    , hCenter $ txt "/: search, Ctrl-C or Esc: cancel search"+                    , hCenter $ txt "Enter: change directory or select file"+                    , hCenter $ txt "Esc: quit"+                    ]++appEvent :: BrickEvent Name e -> T.EventM Name (FB.FileBrowser Name) ()+appEvent (VtyEvent ev) = do+    b <- get+    case ev of+        V.EvKey V.KEsc [] | not (FB.fileBrowserIsSearching b) ->+            M.halt+        _ -> do+            FB.handleFileBrowserEvent ev+            -- If the browser has a selected file after handling the+            -- event (because the user pressed Enter), shut down.+            case ev of+                V.EvKey V.KEnter [] -> do+                    b' <- get+                    case FB.fileBrowserSelection b' of+                        [] -> return ()+                        _ -> M.halt+                _ -> return ()+appEvent _ = return ()++errorAttr :: AttrName+errorAttr = attrName "error"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (L.listSelectedFocusedAttr, V.black `on` V.yellow)+    , (FB.fileBrowserCurrentDirectoryAttr, V.white `on` V.blue)+    , (FB.fileBrowserSelectionInfoAttr, V.white `on` V.blue)+    , (FB.fileBrowserDirectoryAttr, fg V.blue)+    , (FB.fileBrowserBlockDeviceAttr, fg V.magenta)+    , (FB.fileBrowserCharacterDeviceAttr, fg V.green)+    , (FB.fileBrowserNamedPipeAttr, fg V.yellow)+    , (FB.fileBrowserSymbolicLinkAttr, fg V.cyan)+    , (FB.fileBrowserUnixSocketAttr, fg V.red)+    , (FB.fileBrowserSelectedAttr, V.white `on` V.magenta)+    , (errorAttr, fg V.red)+    ]++theApp :: M.App (FB.FileBrowser Name) e Name+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = M.showFirstCursor+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = do+    b <- M.defaultMain theApp =<< FB.newFileBrowser FB.selectNonDirectories FileBrowser1 Nothing+    putStrLn $ "Selected entry: " <> show (FB.fileBrowserSelection b)
+ programs/FillDemo.hs view
@@ -0,0 +1,16 @@+module Main where++import Brick+import Brick.Widgets.Border++ui :: Widget ()+ui = vBox [ vLimitPercent 20 $ vBox [ str "This text is in the top 20% of the window due to a fill and vLimitPercent."+                                    , fill ' '+                                    , hBorder+                                    ]+          , str "This text is at the bottom with another fill beneath it."+          , fill 'x'+          ]++main :: IO ()+main = simpleMain ui
+ programs/FormDemo.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Data.Text as T+import Lens.Micro ((^.))+import Lens.Micro.TH+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif++import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import Brick+import Brick.Forms+  ( Form+  , newForm+  , formState+  , formFocus+  , setFieldValid+  , renderForm+  , handleFormEvent+  , invalidFields+  , allFieldsValid+  , focusedFormInputAttr+  , invalidFormInputAttr+  , checkboxField+  , radioField+  , editShowableField+  , editTextField+  , editPasswordField+  , (@@=)+  )+import Brick.Focus+  ( focusGetCurrent+  , focusRingCursor+  )+import qualified Brick.Widgets.Edit as E+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C++data Name = NameField+          | AgeField+          | BikeField+          | HandedField+          | PasswordField+          | LeftHandField+          | RightHandField+          | AmbiField+          | AddressField+          deriving (Eq, Ord, Show)++data Handedness = LeftHanded | RightHanded | Ambidextrous+                deriving (Show, Eq)++data UserInfo =+    UserInfo { _name      :: T.Text+             , _age       :: Int+             , _address   :: T.Text+             , _ridesBike :: Bool+             , _handed    :: Handedness+             , _password  :: T.Text+             }+             deriving (Show)++makeLenses ''UserInfo++-- This form is covered in the Brick User Guide; see the "Input Forms"+-- section.+mkForm :: UserInfo -> Form UserInfo e Name+mkForm =+    let label s w = padBottom (Pad 1) $+                    (vLimit 1 $ hLimit 15 $ str s <+> fill ' ') <+> w+    in newForm [ label "Name" @@=+                   editTextField name NameField (Just 1)+               , label "Address" @@=+                 B.borderWithLabel (str "Mailing") @@=+                   editTextField address AddressField (Just 3)+               , label "Age" @@=+                   editShowableField age AgeField+               , label "Password" @@=+                   editPasswordField password PasswordField+               , label "Dominant hand" @@=+                   radioField handed [ (LeftHanded, LeftHandField, "Left")+                                     , (RightHanded, RightHandField, "Right")+                                     , (Ambidextrous, AmbiField, "Both")+                                     ]+               , label "" @@=+                   checkboxField ridesBike BikeField "Do you ride a bicycle?"+               ]++theMap :: AttrMap+theMap = attrMap V.defAttr+  [ (E.editAttr, V.white `on` V.black)+  , (E.editFocusedAttr, V.black `on` V.yellow)+  , (invalidFormInputAttr, V.white `on` V.red)+  , (focusedFormInputAttr, V.black `on` V.yellow)+  ]++draw :: Form UserInfo e Name -> [Widget Name]+draw f = [C.vCenter $ C.hCenter form <=> C.hCenter help]+    where+        form = B.border $ padTop (Pad 1) $ hLimit 50 $ renderForm f+        help = padTop (Pad 1) $ B.borderWithLabel (str "Help") body+        body = str $ "- Name is free-form text\n" <>+                     "- Age must be an integer (try entering an\n" <>+                     "  invalid age!)\n" <>+                     "- Handedness selects from a list of options\n" <>+                     "- The last option is a checkbox\n" <>+                     "- Enter/Esc quit, mouse interacts with fields"++app :: App (Form UserInfo e Name) e Name+app =+    App { appDraw = draw+        , appHandleEvent = \ev -> do+            f <- gets formFocus+            case ev of+                VtyEvent (V.EvResize {}) -> return ()+                VtyEvent (V.EvKey V.KEsc []) -> halt+                -- Enter quits only when we aren't in the multi-line editor.+                VtyEvent (V.EvKey V.KEnter [])+                    | focusGetCurrent f /= Just AddressField -> halt+                _ -> do+                    handleFormEvent ev++                    -- Example of external validation:+                    -- Require age field to contain a value that is at least 18.+                    st <- gets formState+                    modify $ setFieldValid (st^.age >= 18) AgeField++        , appChooseCursor = focusRingCursor formFocus+        , appStartEvent = return ()+        , appAttrMap = const theMap+        }++main :: IO ()+main = do+    let buildVty = do+          v <- mkVty V.defaultConfig+          V.setMode (V.outputIface v) V.Mouse True+          return v++        initialUserInfo = UserInfo { _name = ""+                                   , _address = ""+                                   , _age = 0+                                   , _handed = RightHanded+                                   , _ridesBike = False+                                   , _password = ""+                                   }+        f = setFieldValid False AgeField $+            mkForm initialUserInfo++    initialVty <- buildVty+    f' <- customMain initialVty buildVty Nothing app f++    putStrLn "The starting form state was:"+    print initialUserInfo++    putStrLn "The final form state was:"+    print $ formState f'++    if allFieldsValid f'+       then putStrLn "The final form inputs were valid."+       else putStrLn $ "The final form had invalid inputs: " <> show (invalidFields f')
programs/HelloWorldDemo.hs view
@@ -2,7 +2,7 @@  import Brick -ui :: Widget+ui :: Widget () ui = str "Hello, world!"  main :: IO ()
programs/LayerDemo.hs view
@@ -1,70 +1,108 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Main where -import Control.Lens (makeLenses, (^.), (&), (%~))+#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 Data.Default import qualified Graphics.Vty as V  import qualified Brick.Types as T-import Brick.Types (rowL, columnL)+import Brick.Types (locationRowL, locationColumnL, Location(..), Widget) import qualified Brick.Main as M import qualified Brick.Widgets.Border as B-import Brick.Types-  ( Widget-  )+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 =-    [ topLayer st-    , bottomLayer st+    [ C.centerLayer $+      B.border $ str "This layer is centered but other\nlayers are placed underneath it."+    , 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 -> V.Event -> T.EventM (T.Next St)-appEvent st (V.EvKey V.KDown [])  = M.continue $ st & topLayerLocation.rowL %~ (+ 1)-appEvent st (V.EvKey V.KUp [])    = M.continue $ st & topLayerLocation.rowL %~ (subtract 1)-appEvent st (V.EvKey V.KRight []) = M.continue $ st & topLayerLocation.columnL %~ (+ 1)-appEvent st (V.EvKey V.KLeft [])  = M.continue $ st & topLayerLocation.columnL %~ (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 (V.EvKey V.KDown  [V.MCtrl]) = M.continue $ st & bottomLayerLocation.rowL %~ (+ 1)-appEvent st (V.EvKey V.KUp    [V.MCtrl]) = M.continue $ st & bottomLayerLocation.rowL %~ (subtract 1)-appEvent st (V.EvKey V.KRight [V.MCtrl]) = M.continue $ st & bottomLayerLocation.columnL %~ (+ 1)-appEvent st (V.EvKey V.KLeft  [V.MCtrl]) = M.continue $ st & bottomLayerLocation.columnL %~ (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 (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 V.Event+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 def-          , M.appLiftVtyEvent = id+          , M.appAttrMap = const $ attrMap V.defAttr [(arrowAttr, fg V.cyan)]           , M.appChooseCursor = M.neverShowCursor           }  main :: IO ()-main = void $ M.defaultMain app $ St (T.Location (0, 0)) (T.Location (0, 0))+main = void $ M.defaultMain app $ St (T.Location (20, 5)) (T.Location (0, 0))
programs/ListDemo.hs view
@@ -1,9 +1,13 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Main where -import Control.Lens ((^.))+import Lens.Micro ((^.))+import Lens.Micro.Mtl import Control.Monad (void)+import Control.Monad.State (modify)+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import Data.Maybe (fromMaybe) import qualified Graphics.Vty as V @@ -13,7 +17,7 @@ import qualified Brick.Widgets.List as L import qualified Brick.Widgets.Center as C import qualified Brick.AttrMap as A-import qualified Data.Vector as V+import qualified Data.Vector as Vec import Brick.Types   ( Widget   )@@ -27,56 +31,59 @@   ) import Brick.Util (fg, on) -drawUI :: (Show a) => L.List a -> [Widget]+drawUI :: (Show a) => L.List () a -> [Widget ()] drawUI l = [ui]     where         label = str "Item " <+> cur <+> str " of " <+> total         cur = case l^.(L.listSelectedL) of                 Nothing -> str "-"                 Just i -> str (show (i + 1))-        total = str $ show $ V.length $ l^.(L.listElementsL)+        total = str $ show $ Vec.length $ l^.(L.listElementsL)         box = B.borderWithLabel label $               hLimit 25 $               vLimit 15 $-              L.renderList l listDrawElement+              L.renderList listDrawElement True l         ui = C.vCenter $ vBox [ C.hCenter box                               , str " "                               , C.hCenter $ str "Press +/- to add/remove list elements."                               , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List Char -> V.Event -> T.EventM (T.Next (L.List Char))-appEvent l 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 = V.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 =<< T.handleEvent ev l+        ev -> L.handleListEvent ev     where-      nextElement :: V.Vector Char -> Char-      nextElement v = fromMaybe '?' $ V.find (flip V.notElem v) (V.fromList ['a' .. 'z'])+      nextElement :: Vec.Vector Char -> Char+      nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])+appEvent _ = return () -listDrawElement :: (Show a) => Bool -> a -> Widget+listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a =     let selStr s = if sel                    then withAttr customAttr (str $ "<" <> s <> ">")                    else str s     in C.hCenter $ str "Item " <+> (selStr $ show a) -initialState :: L.List Char-initialState = L.list (T.Name "list") (V.fromList ['a','b','c']) 1+initialState :: L.List () Char+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,14 +92,13 @@     , (customAttr,            fg V.cyan)     ] -theApp :: M.App (L.List Char) V.Event+theApp :: M.App (L.List () Char) e () theApp =     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap-          , M.appLiftVtyEvent = id           }  main :: IO ()
+ programs/ListViDemo.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}+module Main where++import Control.Monad (void)+import Control.Monad.State (modify)+import Data.Maybe (fromMaybe)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V+import Lens.Micro ((^.))+import Lens.Micro.Mtl++import qualified Brick.AttrMap as A+import qualified Brick.Main as M+import Brick.Types (Widget)+import qualified Brick.Types as T+import Brick.Util (fg, on)+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C+import Brick.Widgets.Core (hLimit, str, vBox, vLimit, withAttr, (<+>))+import qualified Brick.Widgets.List as L+import qualified Data.Vector as Vec++drawUI :: (Show a) => L.List () a -> [Widget ()]+drawUI l = [ui]+    where+        label = str "Item " <+> cur <+> str " of " <+> total+        cur = case l^.(L.listSelectedL) of+                Nothing -> str "-"+                Just i  -> str (show (i + 1))+        total = str $ show $ Vec.length $ l^.(L.listElementsL)+        box = B.borderWithLabel label $+              hLimit 25 $+              vLimit 15 $+              L.renderList listDrawElement True l+        ui = C.vCenter $ vBox [ C.hCenter box+                              , str " "+                              , C.hCenter $ str "Press +/- to add/remove list elements."+                              , C.hCenter $ str "Press Esc to exit."+                              ]++appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent (T.VtyEvent e) =+    case e of+        V.EvKey (V.KChar '+') [] -> do+            els <- use L.listElementsL+            let el = nextElement els+                pos = Vec.length els+            modify $ L.listInsert pos el++        V.EvKey (V.KChar '-') [] -> do+            sel <- use L.listSelectedL+            case sel of+                Nothing -> return ()+                Just i  -> modify $ L.listRemove i++        V.EvKey V.KEsc [] -> M.halt++        ev -> L.handleListEventVi L.handleListEvent ev+    where+      nextElement :: Vec.Vector Char -> Char+      nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])+appEvent _ = return ()++listDrawElement :: (Show a) => Bool -> a -> Widget ()+listDrawElement sel a =+    let selStr s = if sel+                   then withAttr customAttr (str $ "<" <> s <> ">")+                   else str s+    in C.hCenter $ str "Item " <+> (selStr $ show a)++initialState :: L.List () Char+initialState = L.list () (Vec.fromList ['a','b','c']) 1++customAttr :: A.AttrName+customAttr = L.listSelectedAttr <> A.attrName "custom"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (L.listAttr,            V.white `on` V.blue)+    , (L.listSelectedAttr,    V.blue `on` V.white)+    , (customAttr,            fg V.cyan)+    ]++theApp :: M.App (L.List () Char) e ()+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = M.showFirstCursor+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = void $ M.defaultMain theApp initialState
− programs/MarkupDemo.hs 
@@ -1,42 +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-  )-import Brick.Widgets.Core-  ( (<=>)-  )-import Brick.Util (on, fg)-import Brick.Markup (markup, (@?))-import Brick.AttrMap (attrMap, AttrMap)-import Data.Text.Markup ((@@))--ui :: Widget-ui = m1 <=> m2-    where-        m1 = markup $ ("Hello" @@ fg V.blue) <> ", " <> ("world!" @@ fg V.red)-        m2 = markup $ ("Hello" @? "keyword1") <> ", " <> ("world!" @? "keyword2")--theMap :: AttrMap-theMap = attrMap V.defAttr-    [ ("keyword1",      fg V.magenta)-    , ("keyword2",      V.white `on` V.blue)-    ]--app :: App () V.Event-app =-    App { appDraw = const [ui]-        , appHandleEvent = resizeOrQuit-        , appAttrMap = const theMap-        , appStartEvent = return-        , appChooseCursor = neverShowCursor-        , appLiftVtyEvent = id-        }--main :: IO ()-main = defaultMain app ()
+ programs/MouseDemo.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++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+import Brick.AttrMap+import Brick.Util+import Brick.Types (Widget, ViewportType(Vertical))+import qualified Brick.Main as M+import qualified Brick.Widgets.Edit as E+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Border as B+import Brick.Widgets.Core++data Name = Info | Button1 | Button2 | Button3 | Prose | TextBox+          deriving (Show, Ord, Eq)++data St =+    St { _clicked :: [T.Extent Name]+       , _lastReportedClick :: Maybe (Name, T.Location)+       , _prose :: String+       , _edit :: E.Editor String Name+       }++makeLenses ''St++drawUi :: St -> [Widget Name]+drawUi st =+    [ buttonLayer st+    , proseLayer st+    , infoLayer st+    ]++buttonLayer :: St -> Widget Name+buttonLayer st =+    C.vCenterLayer $+      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", attrName "button1")+                     , (Button2, "Button 2", attrName "button2")+                     , (Button3, "Button 3", attrName "button3")+                     ]+        mkButton (name, label, attr) =+            let wasClicked = (fst <$> st^.lastReportedClick) == Just name+            in clickable name $+               withDefAttr attr $+               B.border $+               padTopBottom 1 $+               padLeftRight (if wasClicked then 2 else 3) $+               str (if wasClicked then "<" <> label <> ">" else label)++proseLayer :: St -> Widget Name+proseLayer st =+  B.border $+  C.hCenterLayer $+  vLimit 8 $+  viewport Prose Vertical $+  vBox $ map str $ lines (st^.prose)++infoLayer :: St -> Widget Name+infoLayer st = T.Widget T.Fixed T.Fixed $ do+    c <- T.getContext+    let h = c^.T.availHeightL+        msg = case st^.lastReportedClick of+                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 (attrName "info") $+               C.hCenter $ str msg++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+    [ (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 = do+              vty <- M.getVtyHandle+              liftIO $ V.setMode (V.outputIface vty) V.Mouse True+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const aMap+          , M.appChooseCursor = M.showFirstCursor+          }++main :: IO ()+main = do+    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
@@ -1,13 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Data.Default-import qualified Graphics.Vty as V- import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain) import Brick.Types   ( Widget-  , Padding(..)   ) import Brick.Widgets.Core   ( vBox@@ -20,20 +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 :: 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"@@ -46,14 +45,13 @@          , padAll 2 $ str "Padded by 2 on all sides"          ] -app :: App () V.Event+app :: App () e () app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return-        , appAttrMap = const def+        , appStartEvent = return ()+        , appAttrMap = const $ attrMap V.defAttr []         , appChooseCursor = neverShowCursor-        , appLiftVtyEvent = id         }  main :: IO ()
+ programs/ProgressBarDemo.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V+import Lens.Micro.Mtl+import Lens.Micro.TH++import qualified Brick.AttrMap as A+import qualified Brick.Main as M+import qualified Brick.Types as T+import qualified Brick.Widgets.ProgressBar as P+import Brick.Types+  ( Widget+  )+import Brick.Widgets.Core+  ( (<+>), (<=>)+  , str+  , strWrap+  , updateAttrMap+  , overrideAttr+  )+import Brick.Util (fg, bg, on, clamp)++data MyAppState n = MyAppState { _x, _y, _z :: Float, _showLabel :: Bool }++makeLenses ''MyAppState++drawUI :: MyAppState () -> [Widget ()]+drawUI p = [ui]+    where+      -- use mapAttrNames+      xBar = updateAttrMap+             (A.mapAttrNames [ (xDoneAttr, P.progressCompleteAttr)+                             , (xToDoAttr, P.progressIncompleteAttr)+                             ]+             ) $ bar $ _x p+      -- or use individual mapAttrName calls+      yBar = updateAttrMap+             (A.mapAttrName yDoneAttr P.progressCompleteAttr .+              A.mapAttrName yToDoAttr P.progressIncompleteAttr) $+             bar $ _y p+      -- or use overrideAttr calls+      zBar = overrideAttr P.progressCompleteAttr zDoneAttr $+             overrideAttr P.progressIncompleteAttr zToDoAttr $+             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 "" <=>+           (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 :: 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') [] -> 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 True++theBaseAttr :: A.AttrName+theBaseAttr = A.attrName "theBase"++xDoneAttr, xToDoAttr :: A.AttrName+xDoneAttr = theBaseAttr <> A.attrName "X:done"+xToDoAttr = theBaseAttr <> A.attrName "X:remaining"++yDoneAttr, yToDoAttr :: A.AttrName+yDoneAttr = theBaseAttr <> A.attrName "Y:done"+yToDoAttr = theBaseAttr <> A.attrName "Y:remaining"++zDoneAttr, zToDoAttr :: A.AttrName+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)+         , (xDoneAttr,                 V.black `on` V.white)+         , (xToDoAttr,                 V.white `on` V.black)+         , (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)+         ]++theApp :: M.App (MyAppState ()) 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/ReadmeDemo.hs view
@@ -0,0 +1,16 @@+module Main where++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"))++main :: IO ()+main = simpleMain ui
programs/SuspendAndResumeDemo.hs view
@@ -1,21 +1,27 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} module Main where -import Control.Lens (makeLenses, (.~), (^.), (&))+import Lens.Micro ((^.))+import Lens.Micro.TH (makeLenses) import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid-import Data.Default+#endif import qualified Graphics.Vty as V  import Brick.Main   ( App(..), neverShowCursor, defaultMain-  , suspendAndResume, halt, continue+  , suspendAndResume, halt   )+import Brick.AttrMap+  ( attrMap+  ) import Brick.Types   ( Widget   , EventM-  , Next+  , BrickEvent(..)   ) import Brick.Widgets.Core   ( vBox@@ -28,38 +34,38 @@  makeLenses ''St -drawUI :: St -> [Widget]+drawUI :: St -> [Widget ()] drawUI st = [ui]     where         ui = vBox [ str $ "External input: \"" <> st^.stExternalInput <> "\""                   , str "(Press Esc to quit or Space to ask for input)"                   ] -appEvent :: St -> V.Event -> EventM (Next St)-appEvent st 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+            return $ St { _stExternalInput = s }+        _ -> return ()+appEvent _ = return ()  initialState :: St initialState =     St { _stExternalInput = ""        } -theApp :: App St V.Event+theApp :: App St e () theApp =     App { appDraw = drawUI         , appChooseCursor = neverShowCursor         , appHandleEvent = appEvent-        , appStartEvent = return-        , appAttrMap = const def-        , appLiftVtyEvent = id+        , appStartEvent = return ()+        , appAttrMap = const $ attrMap V.defAttr []         }  main :: IO ()-main = do+main =     void $ defaultMain theApp initialState
+ programs/TableDemo.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+module Main where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Brick+import Brick.Widgets.Table+import Brick.Widgets.Center (center)++ui :: Widget ()+ui = center $ renderTable leftTable <+>+              padLeft (Pad 5) (renderTable rightTableA <=>+                               renderTable rightTableB <=>+                               renderTable rightTableC)++innerTable :: Table ()+innerTable =+    surroundingBorder False $+    table [ [txt "inner", txt "table"]+          , [txt "is",    txt "here"]+          ]++leftTable :: Table ()+leftTable =+    alignCenter 1 $+    alignRight 2 $+    alignMiddle 2 $+    table [ [txt "Left",             txt "Center",      txt "Right"]+          , [txt "X",                txt "Some things", txt "A"]+          , [renderTable innerTable, txt "are",         txt "B"]+          , [txt "Z",                txt "centered",    txt "C"]+          ]++rightTableA :: Table ()+rightTableA =+    rowBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",     txt "without"]+          , [txt "table", txt "row borders"]+          ]++rightTableB :: Table ()+rightTableB =+    columnBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",       txt "table"]+          , [txt "without", txt "column borders"]+          ]++rightTableC :: Table ()+rightTableC =+    surroundingBorder False $+    rowBorders False $+    columnBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",       txt "table"]+          , [txt "without", txt "any borders"]+          ]++main :: IO ()+main = simpleMain ui
+ programs/TabularListDemo.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.Mtl+import Lens.Micro.TH+import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V++import qualified Brick.Main as M+import qualified Brick.Types as T+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.List as L+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Table as Table+import qualified Brick.AttrMap as A+import qualified Data.Vector as Vec+import Brick.Types+  ( Widget+  )+import Brick.Widgets.Core+  ( (<=>)+  , str+  , vLimit+  , hLimit+  , vBox+  , hBox+  , withDefAttr+  )+import Brick.Util (on)++data Row = Row String String String++data AppState =+    AppState { _tabularList :: L.List () Row+             , _colIndex :: Int+             }++makeLenses ''AppState++drawUI :: AppState -> [Widget ()]+drawUI s = [ui]+    where+        l = s^.tabularList+        label = str $ "Row " <> cur <> " / col " <> show (s^.colIndex + 1)+        cur = case l^.(L.listSelectedL) of+                Nothing -> "-"+                Just i -> show (i + 1)+        box = B.borderWithLabel label $+              hLimit totalWidth $+              vLimit 15 $+              listDrawElement 0 False headerRow <=>+              L.renderList (listDrawElement (s^.colIndex)) True l+        ui = C.vCenter $ vBox [ C.hCenter box+                              , str " "+                              , C.hCenter $ str "Press +/- to add/remove list elements."+                              , C.hCenter $ str "Use arrow keys to change selection."+                              , C.hCenter $ str "Press Esc to exit."+                              ]++appEvent :: T.BrickEvent () e -> T.EventM () AppState ()+appEvent (T.VtyEvent e) =+    case e of+        V.EvKey (V.KChar '+') [] -> do+            els <- use (tabularList.L.listElementsL)+            let el = Row (show pos) (show $ pos * 3) (show $ pos * 9)+                pos = Vec.length els+            tabularList %= L.listInsert pos el++        V.EvKey (V.KChar '-') [] -> do+            sel <- use (tabularList.L.listSelectedL)+            case sel of+                Nothing -> return ()+                Just i -> tabularList %= L.listRemove i++        V.EvKey V.KLeft [] ->+            colIndex %= (\i -> max 0 (i - 1))+        V.EvKey V.KRight [] ->+            colIndex %= (\i -> min (length columnAlignments - 1) (i + 1))++        V.EvKey V.KEsc [] -> M.halt++        ev -> T.zoom tabularList $ L.handleListEvent ev+appEvent _ = return ()++listDrawElement :: Int -> Bool -> Row -> Widget ()+listDrawElement colIdx sel (Row a b c) =+    let ws = [str a, str b, str c]+        maybeSelect es = selectCell <$> zip [0..] es+        selectCell (i, w) = if sel && i == colIdx+                            then withDefAttr selectedCellAttr w+                            else w+    in hLimit totalWidth $+       hBox $+       maybeSelect $+       Table.alignColumns columnAlignments columnWidths ws++initialState :: AppState+initialState =+    AppState { _tabularList = L.list () (Vec.fromList initialRows) 1+             , _colIndex = 0+             }++selectedCellAttr :: A.AttrName+selectedCellAttr = A.attrName "selectedCell"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (L.listAttr,            V.white `on` V.blue)+    , (selectedCellAttr,      V.blue `on` V.white)+    ]++columnWidths :: [Int]+columnWidths = [10, 15, 20]++totalWidth :: Int+totalWidth = sum columnWidths++headerRow :: Row+headerRow = Row "Col 1" "Col 2" "Col 3"++columnAlignments :: [Table.ColumnAlignment]+columnAlignments = [Table.AlignLeft, Table.AlignCenter, Table.AlignRight]++initialRows :: [Row]+initialRows =+    [ Row "one" "two" "three"+    , Row "foo" "bar" "baz"+    , Row "stuff" "things" "blah"+    ]++theApp :: M.App AppState e ()+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = M.showFirstCursor+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = void $ M.defaultMain theApp initialState
+ programs/TailDemo.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Text as T+import Control.Monad (void)+import Control.Concurrent+import Lens.Micro.TH+import Lens.Micro.Mtl+import System.Random++import Brick+import Brick.BChan+import Brick.Widgets.Border+import qualified Graphics.Vty as V++data AppState =+    AppState { _textAreaHeight :: Int+             , _textAreaWidth :: Int+             , _textAreaContents :: [T.Text]+             }++makeLenses ''AppState++draw :: AppState -> Widget n+draw st =+    header st <=> box st++header :: AppState -> Widget n+header st =+    padBottom (Pad 1) $+    hBox [ padRight (Pad 7) $+           (str $ "Max width: " <> show (_textAreaWidth st)) <=>+           (str "Left(-)/Right(+)")+         , (str $ "Max height: " <> show (_textAreaHeight st)) <=>+           (str "Down(-)/Up(+)")+         ]++box :: AppState -> Widget n+box st =+    border $+    hLimit (_textAreaWidth st) $+    vLimit (_textAreaHeight st) $+    (renderBottomUp (txtWrap <$> _textAreaContents st))++-- | Given a list of widgets, draw them bottom-up in a vertical+-- arrangement, i.e., the first widget in this list will appear at the+-- bottom of the rendering area. Rendering stops when the rendering area+-- is full, i.e., items that cannot be rendered are never evaluated or+-- drawn.+renderBottomUp :: [Widget n] -> Widget n+renderBottomUp ws =+    Widget Greedy Greedy $ do+        let go _ [] = return V.emptyImage+            go remainingHeight (c:cs) = do+                cResult <- render c+                let img = image cResult+                    newRemainingHeight = remainingHeight - V.imageHeight img+                if newRemainingHeight == 0+                   then return img+                   else if newRemainingHeight < 0+                        then return $ V.cropTop remainingHeight img+                        else do+                            rest <- go newRemainingHeight cs+                            return $ V.vertCat [rest, img]++        ctx <- getContext+        img <- go (availHeight ctx) ws+        render $ fill ' ' <=> raw img++textLines :: [T.Text]+textLines =+    [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut"+    , "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco"+    , "laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit"+    , "in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat"+    , "cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."+    ]++handleEvent :: BrickEvent n CustomEvent -> EventM n AppState ()+handleEvent (AppEvent (NewLine l)) =+    textAreaContents %= (l :)+handleEvent (VtyEvent (V.EvKey V.KUp [])) =+    textAreaHeight %= (+ 1)+handleEvent (VtyEvent (V.EvKey V.KDown [])) =+    textAreaHeight %= max 0 . subtract 1+handleEvent (VtyEvent (V.EvKey V.KRight [])) =+    textAreaWidth %= (+ 1)+handleEvent (VtyEvent (V.EvKey V.KLeft [])) =+    textAreaWidth %= max 0 . subtract 1+handleEvent (VtyEvent (V.EvKey V.KEsc [])) =+    halt+handleEvent _ =+    return ()++data CustomEvent =+    NewLine T.Text++app :: App AppState CustomEvent ()+app =+    App { appDraw = (:[]) . draw+        , appChooseCursor = neverShowCursor+        , appHandleEvent = handleEvent+        , appAttrMap = const $ attrMap V.defAttr []+        , appStartEvent = return ()+        }++initialState :: AppState+initialState =+    AppState { _textAreaHeight = 20+             , _textAreaWidth = 40+             , _textAreaContents = []+             }++-- | Run forever, generating new lines of text for the application+-- window, prefixed with a line number. This function simulates the kind+-- of behavior that you'd get from running 'tail -f' on a file.+generateLines :: BChan CustomEvent -> IO ()+generateLines chan = go (1::Integer)+    where+        go lineNum = do+            -- Wait a random amount of time (in milliseconds)+            let delayOptions = [500, 1000, 2000]+            delay <- randomVal delayOptions+            threadDelay $ delay * 1000++            -- Choose a random line of text from our collection+            l <- randomVal textLines++            -- Send it to the application to be added to the UI+            writeBChan chan $ NewLine $ (T.pack $ "Line " <> show lineNum <> " - ") <> l++            go $ lineNum + 1++randomVal :: [a] -> IO a+randomVal as = do+    idx <- randomRIO (0, length as - 1)+    return $ as !! idx++main :: IO ()+main = do+    chan <- newBChan 10++    -- Run thread to simulate incoming data+    void $ forkIO $ generateLines chan++    (_, vty) <- customMainWithDefaultVty (Just chan) app initialState+    V.shutdown vty
+ programs/TextWrapDemo.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE CPP #-}+module Main where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Brick+import Text.Wrap (defaultWrapSettings, preserveIndentation)++ui :: Widget ()+ui =+    t1 <=> (padTop (Pad 1) t2)+    where+      t1 = strWrap $ "Hello, world! This line is long enough that " <>+                     "it's likely to wrap on your terminal if your window " <>+                     "isn't especially wide. Try narrowing and widening " <>+                     "the window to see what happens to this text."+      settings = defaultWrapSettings { preserveIndentation = True }+      t2 = strWrapWith settings $+          "This text wraps\n" <>+          "   with different settings to preserve indentation\n" <>+          "   so that long lines wrap in nicer way."++main :: IO ()+main = simpleMain ui
+ programs/ThemeDemo.hs view
@@ -0,0 +1,86 @@+module Main where++import Control.Monad (void)+import Control.Monad.State (put)+import Graphics.Vty+  ( white, blue, green, yellow, black, magenta+  , Event(EvKey)+  , Key(KChar, KEsc)+  )++import Brick.Main+import Brick.Themes+  ( Theme+  , newTheme+  , themeToAttrMap+  )+import Brick.Types+  ( Widget+  , BrickEvent(VtyEvent)+  , EventM+  )+import Brick.Widgets.Center+  ( hCenter+  , center+  )+import Brick.Widgets.Core+  ( (<+>)+  , vBox+  , str+  , hLimit+  , withDefAttr+  )+import Brick.Util (on, fg)+import Brick.AttrMap (AttrName, attrName)++ui :: Widget n+ui =+    center $+    hLimit 40 $+    vBox $ hCenter <$>+         [ str "Press " <+> (withDefAttr keybindingAttr $ str "1") <+> str " to switch to theme 1."+         , str "Press " <+> (withDefAttr keybindingAttr $ str "2") <+> str " to switch to theme 2."+         ]++keybindingAttr :: AttrName+keybindingAttr = attrName "keybinding"++theme1 :: Theme+theme1 =+    newTheme (white `on` blue)+             [ (keybindingAttr, fg magenta)+             ]++theme2 :: Theme+theme2 =+    newTheme (green `on` black)+             [ (keybindingAttr, fg yellow)+             ]++appEvent :: BrickEvent () e -> EventM () Int ()+appEvent (VtyEvent (EvKey (KChar '1') [])) = put 1+appEvent (VtyEvent (EvKey (KChar '2') [])) = put 2+appEvent (VtyEvent (EvKey (KChar 'q') [])) = halt+appEvent (VtyEvent (EvKey KEsc [])) = halt+appEvent _ = return ()++app :: App Int e ()+app =+    App { appDraw = const [ui]+        , appHandleEvent = appEvent+        , appStartEvent = return ()+        , appAttrMap = \s ->+            -- Note that in practice this is not ideal: we don't want+            -- to build an attribute map from a theme every time this is+            -- invoked, because it gets invoked once per redraw. Instead+            -- we'd build the attribute map at startup and store it in+            -- the application state. Here I just use themeToAttrMap to+            -- show the mechanics of the API.+            themeToAttrMap $ if s == 1+                             then theme1+                             else theme2+        , appChooseCursor = neverShowCursor+        }++main :: IO ()+main = void $ defaultMain app 1
programs/ViewportScrollDemo.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Main where -import Control.Applicative import Control.Monad (void)-import Data.Monoid-import Data.Default+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif import qualified Graphics.Vty as V  import qualified Brick.Types as T@@ -16,6 +16,9 @@   ( Widget   , ViewportType(Horizontal, Vertical, Both)   )+import Brick.AttrMap+  ( attrMap+  ) import Brick.Widgets.Core   ( hLimit   , vLimit@@ -25,60 +28,55 @@   , str   ) -vp1Name :: T.Name-vp1Name = "demo1"--vp2Name :: T.Name-vp2Name = "demo2"--vp3Name :: T.Name-vp3Name = "demo3"+data Name = VP1+          | VP2+          | VP3+          deriving (Ord, Show, Eq) -drawUi :: () -> [Widget]+drawUi :: () -> [Widget Name] drawUi = const [ui]     where         ui = C.center $ B.border $ hLimit 60 $ vLimit 21 $              vBox [ pair, B.hBorder, singleton ]-        singleton = viewport vp3Name Both $+        singleton = viewport VP3 Both $                     vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."                          : (str <$> [ "Line " <> show i | i <- [2..25::Int] ])-        pair = hBox [ viewport vp1Name Vertical $+        pair = hBox [ viewport VP1 Vertical $                       vBox $ str "Press up and down arrow keys" :                              str "to scroll this viewport." :                              (str <$> [ "Line " <> (show i) | i <- [3..50::Int] ])                     , B.vBorder-                    , viewport vp2Name Horizontal $+                    , viewport VP2 Horizontal $                       str "Press left and right arrow keys to scroll this viewport."                     ] -vp1Scroll :: M.ViewportScroll-vp1Scroll = M.viewportScroll vp1Name+vp1Scroll :: M.ViewportScroll Name+vp1Scroll = M.viewportScroll VP1 -vp2Scroll :: M.ViewportScroll-vp2Scroll = M.viewportScroll vp2Name+vp2Scroll :: M.ViewportScroll Name+vp2Scroll = M.viewportScroll VP2 -vp3Scroll :: M.ViewportScroll-vp3Scroll = M.viewportScroll vp3Name+vp3Scroll :: M.ViewportScroll Name+vp3Scroll = M.viewportScroll VP3 -appEvent :: () -> V.Event -> T.EventM (T.Next ())-appEvent _ (V.EvKey V.KDown  [V.MCtrl]) = M.vScrollBy vp3Scroll 1 >> M.continue ()-appEvent _ (V.EvKey V.KUp    [V.MCtrl]) = M.vScrollBy vp3Scroll (-1) >> M.continue ()-appEvent _ (V.EvKey V.KRight [V.MCtrl]) = M.hScrollBy vp3Scroll 1 >> M.continue ()-appEvent _ (V.EvKey V.KLeft  [V.MCtrl]) = M.hScrollBy vp3Scroll (-1) >> M.continue ()-appEvent _ (V.EvKey V.KDown [])  = M.vScrollBy vp1Scroll 1 >> M.continue ()-appEvent _ (V.EvKey V.KUp [])    = M.vScrollBy vp1Scroll (-1) >> M.continue ()-appEvent _ (V.EvKey V.KRight []) = M.hScrollBy vp2Scroll 1 >> M.continue ()-appEvent _ (V.EvKey V.KLeft [])  = M.hScrollBy vp2Scroll (-1) >> M.continue ()-appEvent _ (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 () V.Event+app :: M.App () e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent-          , M.appAttrMap = const def-          , M.appLiftVtyEvent = id+          , 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,17 +1,21 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} module Main where  import Control.Monad (void)-import Control.Lens+import Lens.Micro+import Lens.Micro.TH+import Lens.Micro.Mtl+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif import qualified Graphics.Vty as V  import qualified Brick.Types as T import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B-import Brick.AttrMap (AttrMap, AttrName, attrMap)+import Brick.AttrMap (AttrMap, AttrName, attrMap, attrName) import Brick.Util (on) import Brick.Types   ( Widget@@ -36,28 +40,24 @@  makeLenses ''St -vp1Name :: T.Name-vp1Name = "demo1"+data Name = VP1+          | VP2+          | VP3+          deriving (Show, Ord, Eq)  vp1Size :: Int vp1Size = 15 -vp2Name :: T.Name-vp2Name = "demo2"- vp2Size :: Int vp2Size = 15 -vp3Name :: T.Name-vp3Name = "demo3"- vp3Size :: (Int, Int) vp3Size = (25, 25)  selectedAttr :: AttrName-selectedAttr = "selected"+selectedAttr = attrName "selected" -drawUi :: St -> [Widget]+drawUi :: St -> [Widget Name] drawUi st = [ui]     where         ui = C.center $ hLimit 60 $ vLimit 30 $@@ -66,7 +66,7 @@                           "- Left/right arrow keys scroll the top-right viewport\n" <>                           "- Ctrl-arrow keys move the bottom viewport"                   ]-        singleton = viewport vp3Name Both $+        singleton = viewport VP3 Both $                     vBox $ do                          i <- [1..vp3Size^._1]                          let row = do@@ -78,14 +78,14 @@                          return $ hBox row          pair = hBox [ vp1, B.vBorder, vp2 ]-        vp1 = viewport vp1Name Vertical $+        vp1 = viewport VP1 Vertical $                   vBox $ do                       i <- [1..vp1Size]                       let mkItem = if i == st^.vp1Index                                    then withAttr selectedAttr . visible                                    else id                       return $ mkItem $ str $ "Item " <> show i-        vp2 = viewport vp2Name Horizontal $+        vp2 = viewport VP2 Horizontal $                   hBox $ do                       i <- [1..vp2Size]                       let mkItem = if i == st^.vp2Index@@ -93,39 +93,38 @@                                    else id                       return $ mkItem $ str $ "Item " <> show i <> " " -vp1Scroll :: M.ViewportScroll-vp1Scroll = M.viewportScroll vp1Name+vp1Scroll :: M.ViewportScroll Name+vp1Scroll = M.viewportScroll VP1 -vp2Scroll :: M.ViewportScroll-vp2Scroll = M.viewportScroll vp2Name+vp2Scroll :: M.ViewportScroll Name+vp2Scroll = M.viewportScroll VP2 -vp3Scroll :: M.ViewportScroll-vp3Scroll = M.viewportScroll vp3Name+vp3Scroll :: M.ViewportScroll Name+vp3Scroll = M.viewportScroll VP3 -appEvent :: St -> V.Event -> T.EventM (T.Next St)-appEvent st (V.EvKey V.KDown  [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1)-appEvent st (V.EvKey V.KUp    [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1-appEvent st (V.EvKey V.KRight [V.MCtrl]) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1)-appEvent st (V.EvKey V.KLeft  [V.MCtrl]) = M.continue $ st & vp3Index._2 %~ max 1 .  subtract 1-appEvent st (V.EvKey V.KDown [])         = M.continue $ st & vp1Index %~ min vp1Size . (+ 1)-appEvent st (V.EvKey V.KUp [])           = M.continue $ st & vp1Index %~ max 1 . subtract 1-appEvent st (V.EvKey V.KRight [])        = M.continue $ st & vp2Index %~ min vp2Size . (+ 1)-appEvent st (V.EvKey V.KLeft [])         = M.continue $ st & vp2Index %~ max 1 . subtract 1-appEvent st (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     [ (selectedAttr, V.black `on` V.yellow)     ] -app :: M.App St V.Event+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.appLiftVtyEvent = id           , M.appChooseCursor = M.neverShowCursor           }
+ programs/custom_keys.ini view
@@ -0,0 +1,4 @@+[keybindings]+quit = x+increment = i+decrement = d
src/Brick.hs view
@@ -1,5 +1,11 @@ -- | This module is provided as a convenience to import the most--- important parts of the API all at once.+-- important parts of the API all at once. If you are new to Brick and+-- are looking to learn it, the best place to start is the+-- [Brick User Guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst).+-- The README also has links to other learning resources. Unlike+-- most Haskell libraries that only have API documentation, Brick+-- is best learned by reading the User Guide and other materials and+-- referring to the API docs only as needed. Enjoy! module Brick   ( module Brick.Main   , module Brick.Types
+ src/Brick/Animation.hs view
@@ -0,0 +1,588 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+-- | This module provides some infrastructure for adding animations to+-- Brick applications. See @programs/AnimationDemo.hs@ for a complete+-- working example of this API.+--+-- At a high level, this works as follows:+--+-- This module provides a threaded animation manager that manages a set+-- of running animations. The application creates the manager and starts+-- animations, which automatically loop or run once, depending on their+-- configuration. Each animation has some state in the application's+-- state that is automatically managed by the animation manager using a+-- lens-based API. Whenever animations need to be redrawn, the animation+-- manager sends a custom event with a state update to the application,+-- which must be evaluated by the main event loop to update animation+-- states. Each animation is associated with a 'Clip' -- sequence of+-- frames -- which may be static or may be built from the application+-- state at rendering time.+--+-- To use this module:+--+-- * Use a custom event type @e@ in your 'Brick.Main.App' and give the+--   event type a constructor @EventM n s () -> e@ (where @s@ and+--   @n@ are those in @App s e n@). This will require the use of+--   'Brick.Main.customMain' and will also require the creation of a+--   'Brick.BChan.BChan' for custom events.+--+-- * Add an 'AnimationManager' field to the application state @s@.+--+-- * Create an 'AnimationManager' at startup with+--   'startAnimationManager', providing the custom event constructor and+--   'BChan' created above. Store the manager in the application state.+--+-- * For each animation you want to run at any given time, add a field+--   to the application state of type @Maybe (Animation s n)@,+--   initialized to 'Nothing'. A value of 'Nothing' indicates that the+--   animation is not running.+--+-- * Ensure that each animation state field in @s@ has a lens, usually+--   by using 'Lens.Micro.TH.makeLenses'.+--+-- * Start new animations in 'EventM' with 'startAnimation'; stop them+--   with 'stopAnimation'. Supply clips for new animations with+--   'newClip', 'newClip_', and the clip transformation functions.+--+-- * Call 'renderAnimation' in 'Brick.Main.appDraw' for each animation in the+--   application state.+--+-- * If needed, stop the animation manager with 'stopAnimationManager'.+--+-- See 'AnimationManager' and the docs for the rest of this module for+-- details.+module Brick.Animation+  ( -- * Animation managers+    AnimationManager+  , startAnimationManager+  , stopAnimationManager+  , minTickTime++  -- * Animations+  , Animation+  , animationFrameIndex++  -- * Starting and stopping animations+  , RunMode(..)+  , startAnimation+  , stopAnimation++  -- * Rendering animations+  , renderAnimation++  -- * Creating clips+  , Clip+  , newClip+  , newClip_+  , clipLength++  -- * Transforming clips+  , pingPongClip+  , reverseClip+  )+where++import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread, myThreadId)+import qualified Control.Concurrent.STM as STM+import Control.Monad (forever, when)+import Control.Monad.State.Strict+import Data.Foldable (foldrM)+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+import qualified Data.Vector as V+import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just)+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl++import Brick.BChan+import Brick.Types (EventM, Widget)+import qualified Brick.Animation.Clock as C++-- | A sequence of a animation frames.+newtype Clip s n = Clip (V.Vector (s -> Widget n))+                     deriving (Semigroup)++-- | Get the number of frames in a clip.+clipLength :: Clip s n -> Int+clipLength (Clip fs) = V.length fs++-- | Build a clip.+--+-- Each frame in a clip is represented by a function from a state to a+-- 'Widget'. This allows applications to determine on a per-frame basis+-- what should be drawn in an animation based on application state, if+-- desired, in the same style as 'Brick.Main.appDraw'.+--+-- If the provided list is empty, this calls 'error'.+newClip :: [s -> Widget n] -> Clip s n+newClip [] = error "clip: got an empty list"+newClip fs = Clip $ V.fromList fs++-- | Like 'newClip' but for static frames.+newClip_ :: [Widget n] -> Clip s n+newClip_ ws = newClip $ const <$> ws++-- | Extend a clip so that when the end of the original clip is reached,+-- it continues in reverse order to create a loop.+--+-- For example, if this is given a clip with frames A, B, C, and D, then+-- this returns a clip with frames A, B, C, D, C, and B.+--+-- If the given clip contains less than two frames, this is equivalent+-- to 'id'.+pingPongClip :: Clip s n -> Clip s n+pingPongClip (Clip fs) | V.length fs >= 2 =+    Clip $ fs <> V.reverse (V.init $ V.tail fs)+pingPongClip c = c++-- | Reverse a clip.+reverseClip :: Clip s n -> Clip s n+reverseClip (Clip fs) = Clip $ V.reverse fs++data AnimationManagerRequest s n =+    Tick C.Time+    | StartAnimation (Clip s n) Integer RunMode (Traversal' s (Maybe (Animation s n)))+    -- ^ Clip, frame duration in milliseconds, run mode, updater+    | StopAnimation (Animation s n)+    | Shutdown++-- | The running mode for an animation.+data RunMode =+    Once+    -- ^ Run the animation once and then end+    | Loop+    -- ^ Run the animation in a loop forever+    deriving (Eq, Show, Ord)++newtype AnimationID = AnimationID Int+                    deriving (Eq, Ord, Show, Hashable)++-- | The state of a running animation.+--+-- Put one of these (wrapped in 'Maybe') in your application state for+-- each animation that you'd like to run concurrently.+data Animation s n =+    Animation { animationFrameIndex :: Int+              -- ^ The animation's current frame index, provided for+              -- convenience. Applications won't need to access this in+              -- most situations; use 'renderAnimation' instead.+              , animationID :: AnimationID+              -- ^ The animation's internally-managed ID+              , animationClip :: Clip s n+              -- ^ The animation's clip+              }++-- | Render an animation.+renderAnimation :: (s -> Widget n)+                -- ^ The fallback function to use for drawing if the+                -- animation is not running+                -> s+                -- ^ The state to provide when rendering the animation's+                -- current frame+                -> Maybe (Animation s n)+                -- ^ The animation state itself+                -> Widget n+renderAnimation fallback input mAnim =+    draw input+    where+        draw = fromMaybe fallback $ do+            a <- mAnim+            let idx = animationFrameIndex a+                Clip fs = animationClip a+            fs V.!? idx++data AnimationState s n =+    AnimationState { _animationStateID :: AnimationID+                   , _animationNumFrames :: Int+                   , _animationCurrentFrame :: Int+                   , _animationFrameMilliseconds :: Integer+                   , _animationRunMode :: RunMode+                   , animationFrameUpdater :: Traversal' s (Maybe (Animation s n))+                   , _animationNextFrameTime :: C.Time+                   }++makeLenses ''AnimationState++-- | A manager for animations. The type variables for this type are the+-- same as those for 'Brick.Main.App'.+--+-- This asynchronously manages a set of running animations, advancing+-- each one over time. When a running animation's current frame needs+-- to be changed, the manager sends an 'EventM' update for that+-- animation to the application's event loop to perform the update to+-- the animation in the application state. The manager will batch such+-- updates if more than one animation needs to be changed at a time.+--+-- The manager has a /tick duration/ in milliseconds which is the+-- resolution at which animations are checked to see if they should+-- be updated. Animations also have their own frame duration in+-- milliseconds. For example, if a manager has a tick duration of 50+-- milliseconds and is running an animation with a frame duration of 100+-- milliseconds, then the manager will advance that animation by one+-- frame every two ticks. On the other hand, if a manager has a tick+-- duration of 100 milliseconds and is running an animation with a frame+-- duration of 50 milliseconds, the manager will advance that animation+-- by two frames on each tick.+--+-- Animation managers are started with 'startAnimationManager' and+-- stopped with 'stopAnimationManager'.+--+-- Animations are started with 'startAnimation' and stopped with+-- 'stopAnimation'. Each animation must be associated with an+-- application state field accessible with a traversal given to+-- 'startAnimation'.+--+-- When an animation is started, every time it advances a frame, and+-- when it is ended, the manager communicates these changes to the+-- application by using the custom event constructor provided to+-- 'startAnimationManager'. The manager uses that to schedule a state+-- update which the application is responsible for evaluating. The state+-- updates are built from the traversals provided to 'startAnimation'.+--+-- The manager-updated 'Animation' values in the application state are+-- then drawn with 'renderAnimation'.+--+-- Animations in 'Loop' mode are run forever until stopped with+-- 'stopAnimation'; animations in 'Once' mode run once and are removed+-- from the application state (set to 'Nothing') when they finish. All+-- state updates to the application state are performed by the manager's+-- custom event mechanism; the application never needs to directly+-- modify the 'Animation' application state fields except to initialize+-- them to 'Nothing'.+--+-- There is nothing here to prevent an application from running multiple+-- managers, each at a different tick rate. That may have performance+-- consequences, though, due to the loss of batch efficiency in state+-- updates, so we recommend using only one manager per application at a+-- sufficiently short tick duration.+data AnimationManager s e n =+    AnimationManager { animationMgrRequestThreadId :: ThreadId+                     , animationMgrTickThreadId :: ThreadId+                     , animationMgrOutputChan :: BChan e+                     , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s n)+                     , animationMgrEventConstructor :: EventM n s () -> e+                     , animationMgrRunning :: STM.TVar Bool+                     }++tickThreadBody :: Int+               -> STM.TChan (AnimationManagerRequest s n)+               -> IO ()+tickThreadBody tickMilliseconds outChan = do+    let nextTick = C.addOffset tickOffset+        tickOffset = C.offsetFromMs $ toInteger tickMilliseconds+        go targetTime = do+            now <- C.getTime+            STM.atomically $ STM.writeTChan outChan $ Tick now++            -- threadDelay does not guarantee that we will wake up on+            -- time; it only ensures that we won't wake up earlier than+            -- requested. Since we can therefore oversleep, instead of+            -- always sleeping for tickMilliseconds (which would cause+            -- us to drift off of schedule as delays accumulate) we+            -- determine sleep time by measuring the distance between+            -- now and the next scheduled tick. This is still unreliable+            -- as we can still oversleep, but it keeps the oversleeping+            -- under control over time. It means most ticks may be+            -- slightly late (about 1-2 milliseconds is common) but this+            -- will prevent that per-tick error from accumulating.+            let nextTickTime = nextTick targetTime+                sleepMs = fromInteger $+                          C.offsetToMs $+                          C.subtractTime nextTickTime now++            -- threadDelay works microseconds.+            threadDelay $ sleepMs * 1000+            go nextTickTime++    go =<< C.getTime++setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n+setNextFrameTime t a = a & animationNextFrameTime .~ t++data ManagerState s e n =+    ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n)+                 , _managerStateOutChan :: BChan e+                 , _managerStateEventBuilder :: EventM n s () -> e+                 , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s n)+                 , _managerStateIDVar :: STM.TVar AnimationID+                 }++makeLenses ''ManagerState++animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s n)+                           -> BChan e+                           -> (EventM n s () -> e)+                           -> IO ()+animationManagerThreadBody inChan outChan mkEvent = do+    idVar <- STM.newTVarIO $ AnimationID 1+    let initial = ManagerState { _managerStateInChan = inChan+                               , _managerStateOutChan = outChan+                               , _managerStateEventBuilder = mkEvent+                               , _managerStateAnimations = mempty+                               , _managerStateIDVar = idVar+                               }+    evalStateT runManager initial++type ManagerM s e n a = StateT (ManagerState s e n) IO a++getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s n)+getNextManagerRequest = do+    inChan <- use managerStateInChan+    liftIO $ STM.atomically $ STM.readTChan inChan++sendApplicationStateUpdate :: EventM n s () -> ManagerM s e n ()+sendApplicationStateUpdate act = do+    outChan <- use managerStateOutChan+    mkEvent <- use managerStateEventBuilder+    liftIO $ writeBChan outChan $ mkEvent act++removeAnimation :: AnimationID -> ManagerM s e n ()+removeAnimation aId =+    managerStateAnimations %= HM.delete aId++lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s n))+lookupAnimation aId =+    HM.lookup aId <$> use managerStateAnimations++insertAnimation :: AnimationState s n -> ManagerM s e n ()+insertAnimation a =+    managerStateAnimations %= HM.insert (a^.animationStateID) a++getNextAnimationID :: ManagerM s e n AnimationID+getNextAnimationID = do+    var <- use managerStateIDVar+    liftIO $ STM.atomically $ do+        AnimationID i <- STM.readTVar var+        let next = AnimationID $ i + 1+        STM.writeTVar var next+        return $ AnimationID i++runManager :: ManagerM s e n ()+runManager = forever $ do+    getNextManagerRequest >>= handleManagerRequest++handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n ()+handleManagerRequest (StartAnimation clip frameMs runMode updater) = do+    aId <- getNextAnimationID+    now <- liftIO C.getTime+    let next = C.addOffset frameOffset now+        frameOffset = C.offsetFromMs frameMs+        a = AnimationState { _animationStateID = aId+                           , _animationNumFrames = clipLength clip+                           , _animationCurrentFrame = 0+                           , _animationFrameMilliseconds = frameMs+                           , _animationRunMode = runMode+                           , animationFrameUpdater = updater+                           , _animationNextFrameTime = next+                           }++    insertAnimation a+    sendApplicationStateUpdate $ updater .= Just (Animation { animationID = aId+                                                            , animationFrameIndex = 0+                                                            , animationClip = clip+                                                            })+handleManagerRequest (StopAnimation a) = do+    let aId = animationID a+    mA <- lookupAnimation aId+    case mA of+        Nothing -> return ()+        Just aState -> do+            -- Remove the animation from the manager+            removeAnimation aId++            -- Set the current animation state in the application state+            -- to none+            sendApplicationStateUpdate $ clearStateAction aState+handleManagerRequest Shutdown = do+    as <- HM.elems <$> use managerStateAnimations++    let updater = sequence_ $ clearStateAction <$> as+    when (not $ null as) $ do+        sendApplicationStateUpdate updater++    liftIO $ myThreadId >>= killThread+handleManagerRequest (Tick tickTime) = do+    -- Check all animation states for frame advances+    -- based on the relationship between the tick time+    -- and each animation's next frame time+    mUpdateAct <- checkAnimations tickTime+    case mUpdateAct of+        Nothing -> return ()+        Just act -> sendApplicationStateUpdate act++clearStateAction :: AnimationState s n -> EventM n s ()+clearStateAction a = animationFrameUpdater a .= Nothing++frameUpdateAction :: AnimationState s n -> EventM n s ()+frameUpdateAction a =+    animationFrameUpdater a._Just %=+        (\an -> an { animationFrameIndex = a^.animationCurrentFrame })++updateAnimationState :: C.Time -> AnimationState s n -> AnimationState s n+updateAnimationState now a =+    let differenceMs = C.offsetToMs $+                       C.subtractTime now (a^.animationNextFrameTime)+        numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds))+        newNextTime = C.addOffset (C.offsetFromMs $ numFrames * (a^.animationFrameMilliseconds))+                                  (a^.animationNextFrameTime)++    -- The new frame is obtained by advancing from the current frame by+    -- numFrames.+    in setNextFrameTime newNextTime $ advanceBy numFrames a++checkAnimations :: C.Time -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimations now = do+    let go a updaters = do+          result <- checkAnimation now a+          return $ case result of+              Nothing -> updaters+              Just u  -> u : updaters++    anims <- use managerStateAnimations+    updaters <- foldrM go [] anims++    case updaters of+        [] -> return Nothing+        _ -> return $ Just $ sequence_ updaters++-- For each active animation, check to see if the animation's next frame+-- time has passed. If it has, advance its frame counter as appropriate+-- and schedule its frame index to be updated in the application state.+checkAnimation :: C.Time -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimation now a+    | isFinished a = do+        -- This animation completed in a previous check, so clear it+        -- from the manager and the application state.+        removeAnimation (a^.animationStateID)+        return $ Just $ clearStateAction a+    | (now < a^.animationNextFrameTime) =+        -- This animation is not due for an update, so don't do+        -- anything.+        return Nothing+    | otherwise = do+        -- This animation is still running, so determine how many frames+        -- have elapsed for it and then advance the frame index based+        -- the elapsed time. Also set its next frame time.+        let a' = updateAnimationState now a+        managerStateAnimations %= HM.insert (a'^.animationStateID) a'+        return $ Just $ frameUpdateAction a'++isFinished :: AnimationState s n -> Bool+isFinished a =+    case a^.animationRunMode of+        Once -> a^.animationCurrentFrame == a^.animationNumFrames - 1+        Loop -> False++advanceBy :: Integer -> AnimationState s n -> AnimationState s n+advanceBy n a+    | n <= 0 = a+    | otherwise =+        advanceBy (n - 1) $+        advanceByOne a++advanceByOne :: AnimationState s n -> AnimationState s n+advanceByOne a =+    if a^.animationCurrentFrame == a^.animationNumFrames - 1+    then case a^.animationRunMode of+        Loop -> a & animationCurrentFrame .~ 0+        Once -> a+    else a & animationCurrentFrame %~ (+ 1)++-- | The minimum tick duration in milliseconds allowed by+-- 'startAnimationManager'.+minTickTime :: Int+minTickTime = 25++-- | Start a new animation manager. For full details about how managers+-- work, see 'AnimationManager'.+--+-- If the specified tick duration is less than 'minTickTime', this will+-- call 'error'. This bound is in place to prevent API misuse leading to+-- ticking so fast that the terminal can't keep up with redraws.+startAnimationManager :: (MonadIO m)+                      => Int+                      -- ^ The tick duration for this manager in milliseconds+                      -> BChan e+                      -- ^ The event channel to use to send updates to+                      -- the application (i.e. the same one given to+                      -- e.g. 'Brick.Main.customVty')+                      -> (EventM n s () -> e)+                      -- ^ A constructor for building custom events+                      -- that perform application state updates. The+                      -- application must evaluate these custom events'+                      -- 'EventM' actions in order to record animation+                      -- updates in the application state.+                      -> m (AnimationManager s e n)+startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime =+    error $ "startAnimationManager: tick duration too small (minimum is " <> show minTickTime <> ")"+startAnimationManager tickMilliseconds outChan mkEvent = liftIO $ do+    inChan <- STM.newTChanIO+    reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent+    tickTid <- forkIO $ tickThreadBody tickMilliseconds inChan+    runningVar <- STM.newTVarIO True+    return $ AnimationManager { animationMgrRequestThreadId = reqTid+                              , animationMgrTickThreadId = tickTid+                              , animationMgrEventConstructor = mkEvent+                              , animationMgrOutputChan = outChan+                              , animationMgrInputChan = inChan+                              , animationMgrRunning = runningVar+                              }++-- | Execute the specified action only when this manager is running.+whenRunning :: (MonadIO m) => AnimationManager s e n -> IO () -> m ()+whenRunning mgr act = do+    running <- liftIO $ STM.atomically $ STM.readTVar (animationMgrRunning mgr)+    when running $ liftIO act++-- | Stop the animation manager, ending all running animations.+stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m ()+stopAnimationManager mgr =+    whenRunning mgr $ do+        tellAnimationManager mgr Shutdown+        killThread $ animationMgrTickThreadId mgr+        STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False++-- | Send a request to an animation manager.+tellAnimationManager :: (MonadIO m)+                     => AnimationManager s e n+                     -- ^ The manager+                     -> AnimationManagerRequest s n+                     -- ^ The request to send+                     -> m ()+tellAnimationManager mgr req =+    liftIO $+    STM.atomically $+    STM.writeTChan (animationMgrInputChan mgr) req++-- | Start a new animation at its first frame.+--+-- This will result in an application state update to initialize the+-- animation state at the provided traversal's location.+startAnimation :: (MonadIO m)+               => AnimationManager s e n+               -- ^ The manager to run the animation+               -> Clip s n+               -- ^ The frames for the animation+               -> Integer+               -- ^ The animation's frame duration in milliseconds+               -> RunMode+               -- ^ The animation's run mode+               -> Traversal' s (Maybe (Animation s n))+               -- ^ Where in the application state to manage this+               -- animation's state+               -> m ()+startAnimation mgr frames frameMs runMode updater =+    tellAnimationManager mgr $ StartAnimation frames frameMs runMode updater++-- | Stop an animation.+--+-- This will result in an application state update to remove the+-- animation state.+stopAnimation :: (MonadIO m)+              => AnimationManager s e n+              -> Animation s n+              -> m ()+stopAnimation mgr a =+    tellAnimationManager mgr $ StopAnimation a
+ src/Brick/Animation/Clock.hs view
@@ -0,0 +1,64 @@+-- | This module provides an API for working with+-- 'Data.Time.Clock.System.SystemTime' values similar to that of+-- 'Data.Time.Clock.UTCTime'. @SystemTime@s are more efficient to+-- obtain than @UTCTime@s, which is important to avoid animation+-- tick thread delays associated with expensive clock reads. In+-- addition, the @UTCTime@-based API provides unpleasant @Float@-based+-- conversions. Since the @SystemTime@-based API doesn't provide some+-- of the operations we need, and since it is easier to work with at+-- millisecond granularity, it is extended here for internal use.+module Brick.Animation.Clock+  ( Time+  , getTime+  , addOffset+  , subtractTime++  , Offset+  , offsetFromMs+  , offsetToMs+  )+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Time.Clock.System as C++newtype Time = Time C.SystemTime+             deriving (Ord, Eq)++-- | Signed difference in milliseconds+newtype Offset = Offset Integer+               deriving (Ord, Eq)++offsetFromMs :: Integer -> Offset+offsetFromMs = Offset++offsetToMs :: Offset -> Integer+offsetToMs (Offset ms) = ms++getTime :: (MonadIO m) => m Time+getTime = Time <$> liftIO C.getSystemTime++addOffset :: Offset -> Time -> Time+addOffset (Offset ms) (Time (C.MkSystemTime s ns)) =+    Time $ C.MkSystemTime (fromInteger s') (fromInteger ns')+    where+        -- Note that due to the behavior of divMod, this works even when+        -- the offset is negative: the number of seconds is decremented+        -- and the remainder of nanoseconds is correct.+        s' = newSec + toInteger s+        (newSec, ns') = (nsPerMs * ms + toInteger ns)+                          `divMod` (msPerS * nsPerMs)++subtractTime :: Time -> Time -> Offset+subtractTime t1 t2 = Offset $ timeToMs t1 - timeToMs t2++timeToMs :: Time -> Integer+timeToMs (Time (C.MkSystemTime s ns)) =+    (toInteger s) * msPerS ++    (toInteger ns) `div` nsPerMs++nsPerMs :: Integer+nsPerMs = 1000000++msPerS :: Integer+msPerS = 1000
src/Brick/AttrMap.hs view
@@ -1,8 +1,7 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} -- | This module provides types and functions for managing an attribute -- map which maps attribute names ('AttrName') to attributes ('Attr').--- This module is designed to be used with the 'OverloadedStrings'--- language extension to permit easy construction of 'AttrName' values--- and you should also use 'mappend' ('<>') to combine names. -- -- Attribute maps work by mapping hierarchical attribute names to -- attributes and inheriting parent names' attributes when child names@@ -15,7 +14,7 @@ -- Attribute names are mapped to attributes, but some attributes may -- be partial (specify only a foreground or background color). When -- attribute name lookups occur, the attribute corresponding to a more--- specific name ('parent <> child' as above) is sucessively merged with+-- specific name ('parent <> child' as above) is successively merged with -- the parent attribute ('parent' as above) all the way to the "root" -- of the attribute map, the map's default attribute. In this way, more -- specific attributes inherit what they don't specify from more general@@ -28,63 +27,69 @@   -- * Construction   , attrMap   , forceAttrMap+  , forceAttrMapAllowStyle   , attrName+  -- * Inspection+  , attrNameComponents   -- * Finding attributes from names   , attrMapLookup   -- * Manipulating attribute maps-  , setDefault+  , setDefaultAttr+  , getDefaultAttr   , applyAttrMappings   , mergeWithDefault+  , mapAttrName+  , mapAttrNames   ) where -import Control.Applicative ((<$>))+import qualified Data.Semigroup as Sem++import Control.DeepSeq+import Data.Bits ((.|.)) import qualified Data.Map as M-import Data.Monoid-import Data.Maybe (catMaybes)+import Data.Maybe (mapMaybe) import Data.List (inits)-import Data.String (IsString(..))-import Data.Default (Default(..))+import GHC.Generics (Generic) -import Graphics.Vty (Attr(..), MaybeDefault(..))+import Graphics.Vty (Attr(..), MaybeDefault(..), Style)  -- | An attribute name. Attribute names are hierarchical; use 'mappend'--- ('<>') to assemble them. Hierachy in an attribute name is used to+-- ('<>') to assemble them. Hierarchy in an attribute name is used to -- represent increasing levels of specificity in referring to the -- attribute you want to use for a visual element, with names to the -- left being general and names to the right being more specific. For -- example: -- -- @--- "window" <> "border"--- "window" <> "title"--- "header" <> "clock" <> "seconds"+-- attrName "window" <> attrName "border"+-- attrName "window" <> attrName "title"+-- attrName "header" <> attrName "clock" <> attrName "seconds" -- @ data AttrName = AttrName [String]-              deriving (Show, Eq, Ord)+              deriving (Show, Read, Eq, Ord, Generic, NFData) -instance Default AttrName where-    def = mempty+instance Sem.Semigroup AttrName where+    (AttrName as) <> (AttrName bs) = AttrName $ as `mappend` bs  instance Monoid AttrName where     mempty = AttrName []-    mappend (AttrName as) (AttrName bs) = AttrName $ as `mappend` bs--instance IsString AttrName where-    fromString = AttrName . (:[])+    mappend = (Sem.<>)  -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr)              | ForceAttr Attr-             deriving Show--instance Default AttrMap where-    def = AttrMap def mempty+             | ForceAttrAllowStyle Attr AttrMap+             deriving (Show, Generic, NFData)  -- | Create an attribute name from a string. attrName :: String -> AttrName attrName = AttrName . (:[]) +-- | Get the components of an attribute name.+attrNameComponents :: AttrName -> [String]+attrNameComponents (AttrName cs) = cs+ -- | Create an attribute map. attrMap :: Attr         -- ^ The map's default attribute to be returned when a name@@ -96,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@@ -119,50 +129,92 @@ -- @ mergeWithDefault :: Attr -> AttrMap -> Attr mergeWithDefault _ (ForceAttr a) = a+mergeWithDefault _ (ForceAttrAllowStyle f _) = f mergeWithDefault a (AttrMap d _) = combineAttrs d a  -- | Look up the specified attribute name in the map. Map lookups -- proceed as follows. If the attribute map is forcing all lookups to a--- specific attribute, that attribute is returned. If the attribute name--- is empty, the map's default attribute is returned. If the attribute--- name is non-empty, very subsequence of names from the specified name--- are used to perform a lookup, and the results are combined as in--- 'mergeWithDefault', with more specific results taking precedence over--- less specific ones.+-- specific attribute, that attribute is returned along with its style+-- settings. If the attribute name is empty, the map's default attribute+-- is returned. If the attribute name is non-empty, every subsequence of+-- names from the specified name are used to perform a lookup and the+-- results are combined as in 'mergeWithDefault', with more specific+-- results taking precedence over less specific ones. As attributes are+-- merged, styles are also merged. If a more specific attribute name+-- introduces a style (underline, say) and a less specific attribute+-- name introduces an additional style (bold, say) then the final result+-- will include both styles. -- -- For example: -- -- @--- attrMapLookup ("foo" <> "bar") (attrMap a []) == a--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red)]) == red \`on\` blue--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", red `on` cyan)]) == red \`on\` cyan--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red), ("foo", bg cyan)]) == red \`on\` cyan--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo", fg red)]) == red \`on\` blue+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap a []) == a+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", fg red)]) == red \`on\` blue+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", red `on` cyan)]) == red \`on\` cyan+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", fg red), ("foo", bg cyan)]) == red \`on\` cyan+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo", fg red)]) == red \`on\` blue -- @ attrMapLookup :: AttrName -> AttrMap -> Attr attrMapLookup _ (ForceAttr a) = a+attrMapLookup a (ForceAttrAllowStyle forced m) =+    -- Look up the attribute in the contained map, then keep only its+    -- style.+    let result = attrMapLookup a m+    in forced { attrStyle = attrStyle forced `combineStyles` attrStyle result+              } attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault attrMapLookup (AttrName ns) (AttrMap theDefault m) =-    let results = catMaybes $ (\n -> M.lookup n m) <$> (AttrName <$> (inits ns))+    let results = mapMaybe (\n -> M.lookup (AttrName n) m) (inits ns)     in foldl combineAttrs theDefault results  -- | Set the default attribute value in an attribute map.-setDefault :: Attr -> AttrMap -> AttrMap-setDefault _ (ForceAttr a) = ForceAttr a-setDefault newDefault (AttrMap _ m) = AttrMap newDefault m+setDefaultAttr :: Attr -> AttrMap -> AttrMap+setDefaultAttr _ (ForceAttr a) = ForceAttr a+setDefaultAttr newDefault (ForceAttrAllowStyle a m) =+    ForceAttrAllowStyle a (setDefaultAttr newDefault m)+setDefaultAttr newDefault (AttrMap _ m) = AttrMap newDefault m +-- | Get the default attribute value in an attribute map.+getDefaultAttr :: AttrMap -> Attr+getDefaultAttr (ForceAttr a) = a+getDefaultAttr (ForceAttrAllowStyle _ m) = getDefaultAttr m+getDefaultAttr (AttrMap d _) = d+ combineAttrs :: Attr -> Attr -> Attr-combineAttrs (Attr s1 f1 b1) (Attr s2 f2 b2) =-    Attr (s1 `combineMDs` s2)+combineAttrs (Attr s1 f1 b1 u1) (Attr s2 f2 b2 u2) =+    Attr (s1 `combineStyles` s2)          (f1 `combineMDs` f2)          (b1 `combineMDs` b2)+         (u1 `combineMDs` u2)  combineMDs :: MaybeDefault a -> MaybeDefault a -> MaybeDefault a combineMDs _ (SetTo v) = SetTo v combineMDs (SetTo v) _ = SetTo v combineMDs _ v = v +combineStyles :: MaybeDefault Style -> MaybeDefault Style -> MaybeDefault Style+combineStyles (SetTo a) (SetTo b) = SetTo $ a .|. b+combineStyles _ (SetTo v) = SetTo v+combineStyles (SetTo v) _ = SetTo v+combineStyles _ v = v+ -- | Insert a set of attribute mappings to an attribute map. applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap applyAttrMappings _ (ForceAttr a) = ForceAttr a applyAttrMappings ms (AttrMap d m) = AttrMap d ((M.fromList ms) `M.union` m)+applyAttrMappings ms (ForceAttrAllowStyle a m) = ForceAttrAllowStyle a (applyAttrMappings ms m)++-- | Update an attribute map such that a lookup of 'ontoName' returns+-- the attribute value specified by 'fromName'.  This is useful for+-- composite widgets with specific attribute names mapping those names+-- to the sub-widget's expected name when calling that sub-widget's+-- rendering function.  See the ProgressBarDemo for an example usage,+-- and 'overrideAttr' for an alternate syntax.+mapAttrName :: AttrName -> AttrName -> AttrMap -> AttrMap+mapAttrName fromName ontoName inMap =+    applyAttrMappings [(ontoName, attrMapLookup fromName inMap)] inMap++-- | Map several attributes to return the value associated with an+-- alternate name.  Applies 'mapAttrName' across a list of mappings.+mapAttrNames :: [(AttrName, AttrName)] -> AttrMap -> AttrMap+mapAttrNames names inMap = foldr (uncurry mapAttrName) inMap names
+ src/Brick/BChan.hs view
@@ -0,0 +1,44 @@+module Brick.BChan+  ( BChan+  , newBChan+  , writeBChan+  , writeBChanNonBlocking+  , readBChan+  , readBChan2+  )+where++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@.+newBChan :: Int   -- ^ maximum number of elements the channel can hold+          -> IO (BChan a)+newBChan size = atomically $ BChan <$> newTBQueue (fromIntegral size)++-- | 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++-- | 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.+readBChan2 :: BChan a -> BChan b -> IO (Either a b)+readBChan2 (BChan q1) (BChan q2) = atomically $+  (Left <$> readTBQueue q1) `orElse` (Right <$> readTBQueue q2)
+ src/Brick/BorderMap.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+module Brick.BorderMap+    ( BorderMap+    , Edges(..)+    , eTopL, eBottomL, eRightL, eLeftL+    , empty, clear, emptyCoordinates, singleton+    , insertH, insertV, insert+    , unsafeUnion+    , coordinates, bounds+    , values+    , lookupRow, lookupCol, lookupH, lookupV, lookup+    , setCoordinates, crop, expand+    , translate+    ) where++import Brick.Types.Common (Edges(..), Location(..), eTopL, eBottomL, eRightL, eLeftL, origin)+#if !(MIN_VERSION_base(4,18,0))+import Control.Applicative (liftA2)+#endif+import Data.IMap (IMap, Run(Run))+import GHC.Generics+import Control.DeepSeq+import Prelude hiding (lookup)+import qualified Data.IMap as IM++-- | Internal use only.+neighbors :: Edges a -> Edges (a, a)+neighbors (Edges vt vb vl vr) = Edges horiz horiz vert vert where+    horiz = (vl, vr)+    vert  = (vt, vb)++-- Invariant: corner values are present on all the edges incident on that+-- corner. Widthless or heightless rectangles replicate the IMaps exactly on+-- the two coincident edges.+--+-- Practically speaking, this means for lookup you can look on any edge that+-- could contain the key you care about, while for insertion you must insert on+-- every edge that could contain the keys being inserted.++-- | A @BorderMap a@ is like a @Map Location a@, except that there is a+-- rectangle, and only 'Location's on the border of this rectangle are+-- retained. The 'BorderMap' can be queried for the position and size of the+-- rectangle. There are also efficient bulk query and bulk update operations+-- for adjacent positions on the border.+data BorderMap a = BorderMap+    { _coordinates :: Edges Int+    , _values :: Edges (IMap a)+    } deriving (Eq, Ord, Show, Functor, Read, Generic, NFData)++-- | Given a rectangle (specified as the coordinates of the top, left, bottom,+-- and right sides), initialize an empty 'BorderMap'.+emptyCoordinates :: Edges Int -> BorderMap a+emptyCoordinates cs = BorderMap { _coordinates = cs, _values = pure IM.empty }++-- | An empty 'BorderMap' that tracks the same points as the input.+clear :: BorderMap a -> BorderMap b+clear = emptyCoordinates . coordinates++-- | An empty 'BorderMap' that does not track any points.+empty :: BorderMap a+empty = emptyCoordinates Edges+    { eTop = 0+    , eBottom = -1+    , eLeft = 0+    , eRight = -1+    }++-- | A 'BorderMap' that tracks only the given the point (and initially maps it+-- to the given value).+singleton :: Location -> a -> BorderMap a+singleton l v = translate l . insert origin v . emptyCoordinates $ pure 0++{-# INLINE coordinates #-}+-- | The positions of the edges of the rectangle whose border is retained in a+-- 'BorderMap'. For example, if @coordinates m = e@, then the top border+-- contains the 'Location's on row @eTop e@ and between columns @eLeft e@ to+-- @eRight e@ inclusive.+coordinates :: BorderMap a -> Edges Int+coordinates = _coordinates++-- | A complementary way to query the edges of the rectangle whose border is+-- retained in a 'BorderMap'. For example, if @bounds m = b@, then a+-- 'Location'\'s column must be between @fst (eTop b)@ and @snd (eTop b)@ to be+-- retained. See also 'coordinates', which is in most cases a more natural+-- border query.+bounds :: BorderMap a -> Edges (Int, Int)+bounds = neighbors . coordinates++{-# INLINE values #-}+-- | Maps giving the values along each edge. Corner values are replicated in+-- all relevant edges.+values :: BorderMap a -> Edges (IMap a)+values = _values++-- | Bulk insertion of horizontally-adjacent values. The 'Location' gives the+-- start point, and the 'Run' extends in the "larger columns" direction.+insertH :: Location -> Run a -> BorderMap a -> BorderMap a+insertH = insertDirAgnostic (Edges insertPar insertPar insertPerp insertPerp) . swapLoc+    where+    swapLoc (Location (col, row)) = Location (row, col)++-- | Bulk insertion of vertically-adjacent values. The 'Location' gives the+-- start point, and the 'Run' extends in the "larger rows" direction.+insertV :: Location -> Run a -> BorderMap a -> BorderMap a+insertV = insertDirAgnostic (Edges insertPerp insertPerp insertPar insertPar)++insertDirAgnostic+    :: Edges (Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a)+    -> Location -> Run a -> BorderMap a -> BorderMap a+insertDirAgnostic insertions l r m =+    m { _values = insertions <*> pure l <*> pure r <*> coordinates m <*> bounds m <*> _values m }++insertPar, insertPerp :: Location -> Run a -> Int -> (Int, Int) -> IMap a -> IMap a+insertPar (Location (kPar, kPerp)) r herePar (loPerp, hiPerp)+    | kPar == herePar && loPerp <= kPerp + IM.len r - 1 && kPerp <= hiPerp+        = IM.insert beg r { IM.len = end - beg + 1 }+    | otherwise = id+    where+    beg = max kPerp loPerp+    end = min (kPerp + IM.len r - 1) hiPerp+insertPerp (Location (kPar, kPerp)) r herePerp (loPar, hiPar)+    | loPar <= kPar && kPar <= hiPar && kPerp <= herePerp && herePerp <= kPerp + IM.len r - 1+        = IM.insert kPar r { IM.len = 1 }+    | otherwise = id++-- | Insert a single value at the given location.+insert :: Location -> a -> BorderMap a -> BorderMap a+insert l = insertV l . Run 1++-- | Look up all values on a given row. The 'IMap' returned maps columns to+-- values.+lookupRow :: Int -> BorderMap a -> IMap a+lookupRow row m+    | row == eTop    (coordinates m) = eTop    (_values m)+    | row == eBottom (coordinates m) = eBottom (_values m)+    | otherwise = IM.fromList+        $  [(eLeft   (coordinates m), Run 1 a) | Just a <- [IM.lookup row (eLeft   (_values m))]]+        ++ [(eRight  (coordinates m), Run 1 a) | Just a <- [IM.lookup row (eRight  (_values m))]]++-- | Look up all values on a given column. The 'IMap' returned maps rows to+-- values.+lookupCol :: Int -> BorderMap a -> IMap a+lookupCol col m+    | col == eLeft   (coordinates m) = eLeft   (_values m)+    | col == eRight  (coordinates m) = eRight  (_values m)+    | otherwise = IM.fromList+        $  [(eTop    (coordinates m), Run 1 a) | Just a <- [IM.lookup col (eTop    (_values m))]]+        ++ [(eBottom (coordinates m), Run 1 a) | Just a <- [IM.lookup col (eBottom (_values m))]]++-- | Bulk lookup of horizontally-adjacent values. The 'Location' gives the+-- starting point, and the 'Run' extends in the "larger columns" direction. The+-- 'IMap' returned maps columns to values.+lookupH :: Location -> Run ignored -> BorderMap a -> IMap a+lookupH (Location (col, row)) r = IM.restrict col r . lookupRow row++-- | Bulk lookup of vertically-adjacent values. The 'Location' gives the+-- starting point, and the 'Run' extends in the "larger rows" direction. The+-- 'IMap' returned maps rows to values.+lookupV :: Location -> Run ignored -> BorderMap a -> IMap a+lookupV (Location (col, row)) r = IM.restrict row r . lookupCol col++-- | Look up a single position.+lookup :: Location -> BorderMap a -> Maybe a+lookup (Location (col, row)) = IM.lookup row . lookupCol col++-- | Set the rectangle being tracked by this 'BorderMap', throwing away any+-- values that do not lie on this new rectangle.+setCoordinates :: Edges Int -> BorderMap a -> BorderMap a+setCoordinates coordinates' m = BorderMap+    { _values = values'+    , _coordinates = coordinates'+    }+    where+    bounds' = neighbors coordinates'+    values' = gc+        <$> _coordinates m+        <*> coordinates'+        <*> bounds'+        <*> _values m+        <*> Edges { eTop = lookupRow, eBottom = lookupRow, eLeft = lookupCol, eRight = lookupCol }+    gc oldPar newPar (loPerp, hiPerp) imPar lookupPerp+        | oldPar == newPar = IM.restrict loPerp (Run (hiPerp-loPerp+1) ()) imPar+        | otherwise = lookupPerp newPar m++-- | Ensure that the rectangle being tracked by this 'BorderMap' extends no+-- farther than the given one.+crop :: Edges Int -> BorderMap a -> BorderMap a+crop cs m = setCoordinates (shrink <*> cs <*> coordinates m) m where+    shrink = Edges+        { eTop    = max+        , eBottom = min+        , eLeft   = max+        , eRight  = min+        }++-- | Ensure that the rectangle being tracked by this 'BorderMap' extends at+-- least as far as the given one.+expand :: Edges Int -> BorderMap a -> BorderMap a+expand cs m = setCoordinates (grow <*> cs <*> coordinates m) m where+    grow = Edges+        { eTop    = min+        , eBottom = max+        , eLeft   = min+        , eRight  = max+        }++-- | Move a 'BorderMap' by adding the given 'Location' to all keys in the map.+translate :: Location -> BorderMap a -> BorderMap a+-- fast path: do nothing for (0,0)+translate (Location (0, 0)) m = m+translate (Location (c, r)) m = BorderMap+    { _coordinates = liftA2 (+)          cOffsets (_coordinates m)+    , _values      = liftA2 IM.addToKeys vOffsets (_values      m)+    }+    where+    cOffsets = Edges { eTop = r, eBottom = r, eLeft = c, eRight = c }+    vOffsets = Edges { eTop = c, eBottom = c, eLeft = r, eRight = r }++-- | Assumes the two 'BorderMap's are tracking the same rectangles, but have+-- disjoint keys. This property is not checked.+unsafeUnion :: BorderMap a -> BorderMap a -> BorderMap a+unsafeUnion m m' = m { _values = liftA2 IM.unsafeUnion (_values m) (_values m') }
src/Brick/Focus.hs view
@@ -1,68 +1,112 @@ -- | This module provides a type and functions for handling focus rings--- of widgets. Note that this interface is merely provided for managing--- the focus state for a sequence of widget names; it does not do--- anything beyond keep track of that.------ This interface is experimental.+-- of values. module Brick.Focus   ( FocusRing   , focusRing   , focusNext   , focusPrev   , focusGetCurrent+  , focusSetCurrent+  , focusRingLength+  , focusRingToList   , focusRingCursor+  , withFocusRing+  , focusRingModify   ) where -import Control.Lens ((^.))-import Data.Maybe (listToMaybe)+import Lens.Micro ((^.))+import Data.List (find)+import qualified Data.CircularList as C  import Brick.Types+import Brick.Widgets.Core (Named(..)) --- | A focus ring containing a sequence of widget names to focus and a--- currently-focused widget name.-data FocusRing = FocusRingEmpty-               | FocusRingNonempty ![Name] !Int+-- | 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 names.-focusRing :: [Name] -> FocusRing-focusRing [] = FocusRingEmpty-focusRing names = FocusRingNonempty names 0+-- | Construct a focus ring from the list of resource names.+focusRing :: [n] -> FocusRing n+focusRing = FocusRing . C.fromList --- | Advance focus to the next widget in the ring.-focusNext :: FocusRing -> FocusRing-focusNext FocusRingEmpty = FocusRingEmpty-focusNext (FocusRingNonempty ns i) = FocusRingNonempty ns i'-    where-        i' = (i + 1) `mod` (length ns)+-- | Advance focus to the next value in the ring.+focusNext :: FocusRing n -> FocusRing n+focusNext r@(FocusRing l)+    | C.isEmpty l = r+    | otherwise = FocusRing $ C.rotR l --- | Advance focus to the previous widget in the ring.-focusPrev :: FocusRing -> FocusRing-focusPrev FocusRingEmpty = FocusRingEmpty-focusPrev (FocusRingNonempty ns i) = FocusRingNonempty ns i'-    where-        i' = (i + (length ns) - 1) `mod` (length ns)+-- | Advance focus to the previous value in the ring.+focusPrev :: FocusRing n -> FocusRing n+focusPrev r@(FocusRing l)+    | C.isEmpty l = r+    | otherwise = FocusRing $ C.rotL l --- | Get the currently-focused widget name from the ring. If the ring is--- emtpy, return 'Nothing'.-focusGetCurrent :: FocusRing -> Maybe Name-focusGetCurrent FocusRingEmpty = Nothing-focusGetCurrent (FocusRingNonempty ns i) = Just $ ns !! i+-- | This function is a convenience function to look up a widget state+-- value's resource name in a focus ring and set its focus setting+-- according to the focus ring's state. This function determines whether+-- a given widget state value is the focus of the ring and passes the+-- resulting boolean to a rendering function, along with the state value+-- (a), to produce whatever comes next (b).+--+-- Focus-aware widgets have rendering functions that should be+-- usable with this combinator; see 'Brick.Widgets.List.List' and+-- 'Brick.Widgets.Edit.Edit'.+withFocusRing :: (Eq n, Named a n)+              => FocusRing n+              -- ^ The focus ring to use as the source of focus state.+              -> (Bool -> a -> b)+              -- ^ A function that takes a value and its focus state.+              -> a+              -- ^ 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 empty, return 'Nothing'.+focusGetCurrent :: FocusRing n -> Maybe n+focusGetCurrent (FocusRing l) = C.focus l++-- | Set the currently-focused resource name in the ring, provided the+-- name is in the ring. Otherwise return the ring unmodified.+focusSetCurrent :: (Eq n) => n -> FocusRing n -> FocusRing n+focusSetCurrent n r@(FocusRing l) =+    case C.rotateTo n l of+        Nothing -> r+        Just l' -> FocusRing l'++-- | Get the size of the FocusRing.+focusRingLength :: FocusRing n -> Int+focusRingLength (FocusRing l) = C.size l++-- | Return all of the entries in the focus ring, starting with the+-- currently-focused entry and wrapping around the ring.+--+-- For example, if a ring contains A, B, C, and D, and the current entry+-- is B, the result will be [B, C, D, A].+focusRingToList :: FocusRing n -> [n]+focusRingToList (FocusRing l) = C.rightElements l++-- | Modify the internal circular list structure of a focus ring+-- directly. This function permits modification of the circular list+-- using the rich Data.CircularList API.+focusRingModify :: (C.CList n -> C.CList n) -> FocusRing n -> FocusRing n+focusRingModify f (FocusRing l) = FocusRing $ f l+ -- | Cursor selection convenience function for use as an -- 'Brick.Main.appChooseCursor' value.-focusRingCursor :: (a -> FocusRing)+focusRingCursor :: (Eq n)+                => (a -> FocusRing n)                 -- ^ The function used to get the focus ring out of your                 -- application state.                 -> a                 -- ^ Your application state.-                -> [CursorLocation]+                -> [CursorLocation n]                 -- ^ The list of available cursor positions.-                -> Maybe CursorLocation-                -- ^ The cursor position, if any, that matches the name-                -- currently focused by the 'FocusRing'.-focusRingCursor getRing st ls =-    listToMaybe $ filter isCurrent ls-    where-        isCurrent cl = cl^.cursorLocationNameL ==-                       (focusGetCurrent $ getRing st)+                -> Maybe (CursorLocation n)+                -- ^ The cursor position, if any, that matches the+                -- resource name currently focused by the 'FocusRing'.+focusRingCursor getRing st = find $ \cl ->+    cl^.cursorLocationNameL == focusGetCurrent (getRing st)
+ src/Brick/Forms.hs view
@@ -0,0 +1,970 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+-- | Note - this API is designed to support a narrow (but common!) set+-- of use cases. If you find that you need more customization than this+-- offers, then you will need to consider building your own layout and+-- event handling for input fields.+--+-- For a fuller introduction to this API, see the "Input Forms" section+-- of the Brick User Guide. Also see the demonstration programs for+-- examples of forms in action.+--+-- This module provides an input form API. This API allows you to+-- construct an input interface based on a data type of your choice.+-- Each input in the form corresponds to a field in your data type. This+-- API then automatically dispatches keyboard and mouse input events to+-- each form input field, manages rendering of the form, notifies the+-- user when a form field's value is invalid, and stores valid inputs in+-- your data type when possible.+--+-- A form has both a visual representation and a corresponding data+-- structure representing the latest valid values for that form+-- (referred to as the "state" of the form). A 'FormField' is a single+-- input component in the form and a 'FormFieldState' defines the+-- linkage between that visual input and the corresponding portion+-- of the state represented by that visual; there may be multiple+-- 'FormField's combined for a single 'FormFieldState' (e.g. a radio+-- button sequence).+--+-- To use a 'Form', you must include it within your application state+-- type. You can use 'formState' to access the underlying state whenever+-- you need it. See @programs/FormDemo.hs@ for a complete working+-- example.+--+-- Also note that, by default, forms and their field inputs are+-- concatenated together in a 'vBox'. This can be customized on a+-- per-field basis and for the entire form by using the functions+-- 'setFieldConcat' and 'setFormConcat', respectively.+--+-- Bear in mind that for most uses, the 'FormField' and 'FormFieldState'+-- types will not be used directly. Instead, the constructors for+-- various field types (such as 'editTextField') will be used instead.+module Brick.Forms+  ( -- * Data types+    Form+  , FormFieldState(..)+  , FormField(..)+  , FormFieldVisibilityMode(..)++  -- * Creating and using forms+  , newForm+  , formFocus+  , formState+  , handleFormEvent+  , renderForm+  , renderFormFieldState+  , (@@=)+  , allFieldsValid+  , invalidFields+  , setFieldValid+  , setFormConcat+  , setFieldConcat+  , setFormFocus+  , updateFormState+  , setFieldVisibilityMode++  -- * Simple form field constructors+  , editTextField+  , editShowableField+  , editShowableFieldWithValidate+  , editPasswordField+  , radioField+  , checkboxField+  , listField++  -- * Advanced form field constructors+  , editField+  , radioCustomField+  , checkboxCustomField++  -- * Attributes+  , formAttr+  , invalidFormInputAttr+  , focusedFormInputAttr+  )+where++import Graphics.Vty hiding (showCursor)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import Data.Maybe (fromJust, isJust, isNothing)+import Data.List (elemIndex)+import Data.Vector (Vector)++import Brick+import Brick.Focus+import Brick.Widgets.Edit+import Brick.Widgets.List+import qualified Data.Text.Zipper as Z++import qualified Data.Text as T+import Text.Read (readMaybe)++import Lens.Micro+import Lens.Micro.Mtl++-- | A form field. This represents an interactive input field in the+-- form. Its user input is validated and thus converted into a type of+-- your choosing.+--+-- Type variables are as follows:+--+--  * @a@ - the type of the field in your form state that this field+--    manipulates+--  * @b@ - the form field's internal state type+--  * @e@ - your application's event type+--  * @n@ - your application's resource name type+data FormField a b e n =+    FormField { formFieldName :: n+              -- ^ The name identifying this form field.+              , formFieldValidate :: b -> Maybe a+              -- ^ A validation function converting this field's state+              -- into a value of your choosing. @Nothing@ indicates a+              -- validation failure. For example, this might validate+              -- an 'Editor' state value by parsing its text contents as+              -- an integer and return 'Maybe' 'Int'. This is for pure+              -- value validation; if additional validation is required+              -- (e.g. via 'IO'), use this field's state value in an+              -- external validation routine and use 'setFieldValid' to+              -- feed the result back into the form.+              , formFieldExternallyValid :: Bool+              -- ^ Whether the field is valid according to an external+              -- validation source. Defaults to always being 'True' and+              -- can be set with 'setFieldValid'. The value of this+              -- field also affects the behavior of 'allFieldsValid' and+              -- 'getInvalidFields'.+              , formFieldRender :: Bool -> b -> Widget n+              -- ^ A function to render this form field. Parameters are+              -- whether the field is currently focused, followed by the+              -- field state.+              , formFieldHandleEvent :: BrickEvent n e -> EventM n b ()+              -- ^ An event handler for this field.+              }++-- | How to bring form fields into view when a form is rendered in a+-- viewport with 'viewport'.+data FormFieldVisibilityMode =+    ShowFocusedFieldOnly+    -- ^ Make only the focused field's selected input visible. For+    -- composite fields this will not bring all options into view.+    | ShowCompositeField+    -- ^ Make all inputs in the focused field visible. For composite+    -- fields this will bring all options into view as long as the+    -- viewport is large enough to show them all.+    | ShowAugmentedField+    -- ^ Like 'ShowCompositeField' but includes rendering augmentations+    -- applied with '@@='.+    deriving (Eq, Show)++-- | A form field state accompanied by the fields that manipulate that+-- state. The idea is that some record field in your form state has+-- one or more form fields that manipulate that value. This data type+-- maps that state field (using a lens into your state) to the form+-- input fields responsible for managing that state field, along with+-- a current value for that state field and an optional function to+-- control how the form inputs are rendered.+--+-- Most form fields will just have one input, such as text editors, but+-- others, such as radio button collections, will have many, which is+-- why this type supports more than one input corresponding to a state+-- field.+--+-- Type variables are as follows:+--+--  * @s@ - the data type containing the value manipulated by these form+--    fields.+--  * @e@ - your application's event type+--  * @n@ - your application's resource name type+data FormFieldState s e n where+    FormFieldState :: { formFieldState :: b+                      -- ^ The current state value associated with+                      -- the field collection. Note that this type is+                      -- existential. All form fields in the collection+                      -- must validate to this type.+                      , formFieldLens :: Lens' s a+                      -- ^ A lens to extract and store a+                      -- successfully-validated form input back into+                      -- your form state.+                      , formFieldUpdate :: a -> b -> b+                      -- ^ Given a new form state value, update the form+                      -- field state in place.+                      , formFields :: [FormField a b e n]+                      -- ^ The form fields, in order, that the user will+                      -- interact with to manipulate this state value.+                      , formFieldRenderHelper :: Widget n -> Widget n+                      -- ^ A helper function to augment the rendered+                      -- representation of this collection of form+                      -- fields. It receives the default representation+                      -- and can augment it, for example, by adding a+                      -- label on the left.+                      , formFieldConcat :: [Widget n] -> Widget n+                      -- ^ Concatenation function for this field's input+                      -- renderings.+                      , formFieldVisibilityMode :: FormFieldVisibilityMode+                      -- ^ This field's visibility mode for use in+                      -- viewports.+                      } -> FormFieldState s e n++-- | A form: a sequence of input fields that manipulate the fields of an+-- underlying state that you choose. This value must be stored in the+-- Brick application's state.+--+-- Type variables are as follows:+--+--  * @s@ - the data type of your choosing containing the values+--    manipulated by the fields in this form.+--  * @e@ - your application's event type+--  * @n@ - your application's resource name type+data Form s e n =+    Form { formFieldStates  :: [FormFieldState s e n]+         , formFocus :: FocusRing n+         -- ^ The focus ring for the form, indicating which form field+         -- has input focus.+         , formState :: s+         -- ^ The current state of the form. Forms guarantee that only+         -- valid inputs ever get stored in the state, and that after+         -- each input event on a form field, if that field contains a+         -- valid state value then the value is immediately saved to its+         -- corresponding field in this state value using the form+         -- field's lens over @s@.+         , formConcatAll :: [Widget n] -> Widget n+         -- ^ Concatenation function for this form's field renderings.+         }++suffixLenses ''Form++-- | Compose a new rendering augmentation function with the one in the+-- form field collection. For example, we might put a label on the left+-- side of a form field:+--+-- > (str "Please check: " <+>) @@= checkboxField alive AliveField "Alive?"+--+-- This can also be used to add multiple augmentations and associates+-- right:+--+-- > (withDefAttr someAttribute) @@=+-- > (str "Please check: " <+>) @@=+-- >   checkboxField alive AliveField "Alive?"+infixr 5 @@=+(@@=) :: (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n+(@@=) h mkFs s =+    let v = mkFs s+    in v { formFieldRenderHelper = h . (formFieldRenderHelper v) }++-- | Update the state contained in a form.+--+-- This updates all form fields to be consistent with the new form+-- state. Where possible, this attempts to maintain other input state,+-- such as text editor cursor position.+--+-- Note that since this updates the form fields, this means that any+-- field values will be completely overwritten! This may or may not+-- be what you want, since a user actively using the form could get+-- confused if their edits go away. Use carefully.+updateFormState :: s -> Form s e n -> Form s e n+updateFormState newState f =+    let updateField fs = case fs of+            FormFieldState st l upd s rh concatAll visMode ->+                FormFieldState (upd (newState^.l) st) l upd s rh concatAll visMode+    in f { formState = newState+         , formFieldStates = updateField <$> formFieldStates f+         }++-- | Set the focused field of a form.+setFormFocus :: (Eq n) => n -> Form s e n -> Form s e n+setFormFocus n f = f { formFocus = focusSetCurrent n $ formFocus f }++-- | Set a form field's concatenation function.+setFieldConcat :: ([Widget n] -> Widget n) -> FormFieldState s e n -> FormFieldState s e n+setFieldConcat f s = s { formFieldConcat = f }++-- | Set a form's concatenation function.+setFormConcat :: ([Widget n] -> Widget n) -> Form s e n -> Form s e n+setFormConcat func f = f { formConcatAll = func }++-- | Create a new form with the specified input fields and an initial+-- form state. The fields are initialized from the state using their+-- state lenses and the first form input is focused initially.+newForm :: [s -> FormFieldState s e n]+        -- ^ The form field constructors. This is intended to be+        -- populated using the various field constructors in this+        -- module.+        -> s+        -- ^ The initial form state used to populate the fields.+        -> Form s e n+newForm mkEs s =+    let es = mkEs <*> pure s+    in Form { formFieldStates = es+            , formFocus       = focusRing $ concatMap formFieldNames es+            , formState       = s+            , formConcatAll   = vBox+            }++formFieldNames :: FormFieldState s e n -> [n]+formFieldNames (FormFieldState _ _ _ fields _ _ _) = formFieldName <$> fields++-- | A form field for manipulating a boolean value. This represents+-- 'True' as @[X] label@ and 'False' as @[ ] label@.+--+-- This field responds to `Space` keypresses to toggle the checkbox and+-- to mouse clicks.+checkboxField :: (Ord n, Show n)+              => Lens' s Bool+              -- ^ The state lens for this value.+              -> n+              -- ^ The resource name for the input field.+              -> T.Text+              -- ^ The label for the check box, to appear at its right.+              -> s+              -- ^ The initial form state.+              -> FormFieldState s e n+checkboxField = checkboxCustomField '[' 'X' ']'++-- | A form field for manipulating a boolean value. This represents+-- 'True' as @[X] label@ and 'False' as @[ ] label@. This function+-- permits the customization of the @[X]@ notation characters.+--+-- This field responds to `Space` keypresses to toggle the checkbox and+-- to mouse clicks.+checkboxCustomField :: (Ord n, Show n)+                    => Char+                    -- ^ Left bracket character.+                    -> Char+                    -- ^ Checkmark character.+                    -> Char+                    -- ^ Right bracket character.+                    -> Lens' s Bool+                    -- ^ The state lens for this value.+                    -> n+                    -- ^ The resource name for the input field.+                    -> T.Text+                    -- ^ The label for the check box, to appear at its right.+                    -> s+                    -- ^ The initial form state.+                    -> FormFieldState s e n+checkboxCustomField lb check rb stLens name label initialState =+    let initVal = initialState ^. stLens++        handleEvent (MouseDown n _ _ _) | n == name = modify not+        handleEvent (VtyEvent (EvKey (KChar ' ') [])) = modify not+        handleEvent _ = return ()++    in FormFieldState { formFieldState = initVal+                      , formFields = [ FormField name Just True+                                                 (renderCheckbox lb check rb label name)+                                                 handleEvent+                                     ]+                      , formFieldLens = stLens+                      , formFieldUpdate =+                          \val _ -> val+                      , formFieldRenderHelper = id+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly+                      }++renderCheckbox :: (Ord n) => Char -> Char -> Char -> T.Text -> n -> Bool -> Bool -> Widget n+renderCheckbox lb check rb label n foc val =+    let addAttr = if foc then withDefAttr focusedFormInputAttr else id+        csr = if foc then putCursor n (Location (1,0)) else id+    in clickable n $+       addAttr $ csr $+       (txt $ T.singleton lb <> (if val then T.singleton check else " ") <>+              T.singleton rb <> " ") <+> txt label++-- | A form field for selecting a single choice from a set of possible+-- choices in a scrollable list. This uses a 'List' internally.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.List'.+--+-- This field responds to the same input events that a 'List' does.+listField :: forall s e n a . (Ord n, Show n, Eq a)+          => (s -> Vector a)+          -- ^ Possible choices.+          -> Lens' s (Maybe a)+          -- ^ The state lens for the initially/finally selected+          -- element.+          -> (Bool -> a -> Widget n)+          -- ^ List item rendering function.+          -> Int+          -- ^ List item height in rows.+          -> n+          -- ^ The resource name for the input field.+          -> s+          -- ^ The initial form state.+          -> FormFieldState s e n+listField options stLens renderItem itemHeight name initialState =+    let optionsVector = options initialState+        initVal = initialState ^. customStLens++        customStLens :: Lens' s (List n a)+        customStLens = lens getList setList+            where+               getList s = let l = list name optionsVector itemHeight+                           in case s ^. stLens of+                               Nothing -> l+                               Just e -> listMoveToElement e l+               setList s l = s & stLens .~ (snd <$> listSelectedElement l)++        handleEvent (VtyEvent e) = handleListEvent e+        handleEvent _ = return ()++    in FormFieldState { formFieldState = initVal+                      , formFields = [ FormField name Just True+                                                 (renderList renderItem)+                                                 handleEvent+                                     ]+                      , formFieldLens = customStLens+                      , formFieldUpdate = \listState l ->+                           case listSelectedElement listState of+                               Nothing -> l+                               Just (_, e) -> listMoveToElement e l+                      , formFieldRenderHelper = id+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly+                      }++-- | A form field for selecting a single choice from a set of possible+-- choices. Each choice has an associated value and text label.+--+-- This field responds to `Space` keypresses to select a radio button+-- option and to mouse clicks.+radioField :: (Ord n, Show n, Eq a)+           => Lens' s a+           -- ^ The state lens for this value.+           -> [(a, n, T.Text)]+           -- ^ The available choices, in order. Each choice has a value+           -- of type @a@, a resource name, and a text label.+           -> s+           -- ^ The initial form state.+           -> FormFieldState s e n+radioField = radioCustomField '[' '*' ']'++-- | A form field for selecting a single choice from a set of possible+-- choices. Each choice has an associated value and text label. This+-- function permits the customization of the @[*]@ notation characters.+--+-- This field responds to `Space` keypresses to select a radio button+-- option and to mouse clicks.+radioCustomField :: (Ord n, Show n, Eq a)+                 => Char+                 -- ^ Left bracket character.+                 -> Char+                 -- ^ Checkmark character.+                 -> Char+                 -- ^ Right bracket character.+                 -> Lens' s a+                 -- ^ The state lens for this value.+                 -> [(a, n, T.Text)]+                 -- ^ The available choices, in order. Each choice has a value+                 -- of type @a@, a resource name, and a text label.+                 -> s+                 -- ^ The initial form state.+                 -> FormFieldState s e n+radioCustomField lb check rb stLens options initialState =+    let initVal = initialState ^. stLens++        lookupOptionValue n =+            let results = filter (\(_, n', _) -> n' == n) options+            in case results of+                [(val, _, _)] -> Just val+                _ -> Nothing++        handleEvent _ (MouseDown n _ _ _) =+            case lookupOptionValue n of+                Nothing -> return ()+                Just v -> put v+        handleEvent new (VtyEvent (EvKey (KChar ' ') [])) = put new+        handleEvent _ _ = return ()++        optionFields = mkOptionField <$> options+        mkOptionField (val, name, label) =+            FormField name+                      Just+                      True+                      (renderRadio lb check rb val name label)+                      (handleEvent val)++    in FormFieldState { formFieldState = initVal+                      , formFields = optionFields+                      , formFieldLens = stLens+                      , formFieldUpdate = \val _ -> val+                      , formFieldRenderHelper = id+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly+                      }++renderRadio :: (Eq a, Ord n) => Char -> Char -> Char -> a -> n -> T.Text -> Bool -> a -> Widget n+renderRadio lb check rb val name label foc cur =+    let addAttr = if foc+                  then withDefAttr focusedFormInputAttr+                  else id+        isSet = val == cur+        csr = if foc then putCursor name (Location (1,0)) else id+    in clickable name $+       addAttr $ csr $+       txt $ T.concat+       [ T.singleton lb+       , if isSet then T.singleton check else " "+       , T.singleton rb <> " " <> label+       ]++-- | A form field for using an editor to edit the text representation of+-- a value. The other editing fields in this module are special cases of+-- this function.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editField :: (Ord n, Show n)+          => Lens' s a+          -- ^ The state lens for this value.+          -> n+          -- ^ The resource name for the input field.+          -> Maybe Int+          -- ^ The optional line limit for the editor (see 'editor').+          -> (a -> T.Text)+          -- ^ The initialization function that turns your value into+          -- the editor's initial contents. The resulting text may+          -- contain newlines.+          -> ([T.Text] -> Maybe a)+          -- ^ The validation function that converts the editor's+          -- contents into a valid value of type @a@.+          -> ([T.Text] -> Widget n)+          -- ^ The rendering function for the editor's contents (see+          -- 'renderEditor').+          -> (Widget n -> Widget n)+          -- ^ A rendering augmentation function to adjust the+          -- representation of the rendered editor.+          -> s+          -- ^ The initial form state.+          -> FormFieldState s e n+editField stLens n limit ini val renderText wrapEditor initialState =+    let initVal = applyEdit gotoEnd $+                  editor n limit initialText+        gotoEnd = let ls = T.lines initialText+                      pos = (length ls - 1, T.length (last ls))+                  in if null ls+                     then id+                     else Z.moveCursor pos+        initialText = ini $ initialState ^. stLens++    in FormFieldState { formFieldState = initVal+                      , formFields = [ FormField n+                                                 (val . getEditContents)+                                                 True+                                                 (\b e -> wrapEditor $ renderEditor renderText b e)+                                                 handleEditorEvent+                                     ]+                      , formFieldLens = stLens+                      , formFieldUpdate = \newVal e ->+                          let newTxt = ini newVal+                          in if newTxt == (T.unlines $ getEditContents e)+                             then e+                             else applyEdit (Z.insertMany newTxt . Z.clearZipper) e+                      , formFieldRenderHelper = id+                      , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly+                      }++-- | A form field using a single-line editor to edit the 'Show'+-- representation of a state field value of type @a@. This automatically+-- uses its 'Read' instance to validate the input. This field is mostly+-- useful in cases where the user-facing representation of a value+-- matches the 'Show' representation exactly, such as with 'Int'.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editShowableField :: (Ord n, Show n, Read a, Show a)+                  => Lens' s a+                  -- ^ The state lens for this value.+                  -> n+                  -- ^ The resource name for the input field.+                  -> s+                  -- ^ The initial form state.+                  -> FormFieldState s e n+editShowableField stLens n =+    editShowableFieldWithValidate stLens n (const True)++-- | A form field using a single-line editor to edit the 'Show' representation+-- of a state field value of type @a@. This automatically uses its 'Read'+-- instance to validate the input, and also accepts an additional user-defined+-- pass for validation. This field is mostly useful in cases where the+-- user-facing representation of a value matches the 'Show' representation+-- exactly, such as with 'Int', but you don't want to accept just /any/ 'Int'.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editShowableFieldWithValidate :: (Ord n, Show n, Read a, Show a)+                              => Lens' s a+                              -- ^ The state lens for this value.+                              -> n+                              -- ^ The resource name for the input field.+                              -> (a -> Bool)+                              -- ^ Additional validation step for input.+                              -- 'True' indicates that the value is+                              -- valid.+                              -> s+                              -- ^ The initial form state.+                              -> FormFieldState s e n+editShowableFieldWithValidate stLens n isValid =+    let ini = T.pack . show+        val ls = do+            v <- readMaybe $ T.unpack $ T.intercalate "\n" ls+            if isValid v+               then return v+               else Nothing+        limit = Just 1+        renderText = txt . T.unlines+    in editField stLens n limit ini val renderText id++-- | A form field using an editor to edit a text value. Since the value+-- is free-form text, it is always valid.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editTextField :: (Ord n, Show n)+              => Lens' s T.Text+              -- ^ The state lens for this value.+              -> n+              -- ^ The resource name for the input field.+              -> Maybe Int+              -- ^ The optional line limit for the editor (see 'editor').+              -> s+              -- ^ The initial form state.+              -> FormFieldState s e n+editTextField stLens n limit =+    let ini = id+        val = Just . T.intercalate "\n"+        renderText = txt . T.intercalate "\n"+    in editField stLens n limit ini val renderText id++-- | A form field using a single-line editor to edit a free-form text+-- value represented as a password. The value is always considered valid+-- and is always represented with one asterisk per password character.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editPasswordField :: (Ord n, Show n)+                  => Lens' s T.Text+                  -- ^ The state lens for this value.+                  -> n+                  -- ^ The resource name for the input field.+                  -> s+                  -- ^ The initial form state.+                  -> FormFieldState s e n+editPasswordField stLens n =+    let ini = id+        val = Just . T.concat+        limit = Just 1+        renderText = toPassword+    in editField stLens n limit ini val renderText id++toPassword :: [T.Text] -> Widget a+toPassword s = txt $ T.replicate (T.length $ T.concat s) "*"++-- | The namespace for the other form attributes.+formAttr :: AttrName+formAttr = attrName "brickForm"++-- | The attribute for form input fields with invalid values. Note that+-- this attribute will affect any field considered invalid and will take+-- priority over any attributes that the field uses to render itself.+invalidFormInputAttr :: AttrName+invalidFormInputAttr = formAttr <> attrName "invalidInput"++-- | The attribute for form input fields that have the focus. Note that+-- this attribute only affects fields that do not already use their own+-- attributes when rendering, such as editor- and list-based fields.+-- Those need to be styled by setting the appropriate attributes; see+-- the documentation for field constructors to find out which attributes+-- need to be configured.+focusedFormInputAttr :: AttrName+focusedFormInputAttr = formAttr <> attrName "focusedInput"++-- | Returns whether all form fields in the form currently have valid+-- values according to the fields' validation functions. This is useful+-- when we need to decide whether the form state is up to date with+-- respect to the form input fields.+allFieldsValid :: Form s e n -> Bool+allFieldsValid = null . invalidFields++-- | Returns the resource names associated with all form input fields+-- that currently have invalid inputs. This is useful when we need to+-- force the user to repair invalid inputs before moving on from a form+-- editing session.+invalidFields :: Form s e n -> [n]+invalidFields f = concatMap getInvalidFields (formFieldStates f)++-- | Set the visibility mode of the specified form field's collection+-- when the form is rendered in viewport. This is used to change how+-- focused fields are brought into view when they're outside of view+-- in a viewport and gain focus. In practice, this means this function+-- need only be called on one form field name in a collection in order+-- to affect the visibility behavior of that field's entire input+-- collection.+--+-- There are two visibility modes:+--+-- * 'ShowFocusedFieldOnly' - this is the default behavior. In this+--   mode, when a field receives focus, it is brought into view but+--   other inputs in the same field collection (e.g. a set of radio+--   buttons) will not be brought into view along with it.+--+-- * 'ShowCompositeField' - in this mode, when a field receives focus,+--   all of the inputs in its collection (e.g. a set of radio buttons)+--   are brought into view as long as the viewport is large enough to+--   show them all. If it isn't, the viewport will show as many as space+--   allows.+--+-- * 'ShowAugmentedField' - in this mode, when a field receives focus,+--   all of the inputs in its collection (e.g. a set of radio buttons)+--   and its rendering augmentations (as applied with '@@=') are brought+--   into view as long as the viewport is large enough to show them all.+setFieldVisibilityMode :: (Eq n)+                       => n+                       -- ^ The name of the form field whose visibility mode is to be set.+                       -> FormFieldVisibilityMode+                       -- ^ The mode to set.+                       -> Form s e n+                       -- ^ The form to modify.+                       -> Form s e n+setFieldVisibilityMode n mode form =+    let go1 [] = []+        go1 (s:ss) =+            let s' = case s of+                       FormFieldState st l upd fs rh concatAll _ ->+                           if n `elem` formFieldNames s+                           then FormFieldState st l upd fs rh concatAll mode+                           else s+            in s' : go1 ss++    in form { formFieldStates = go1 (formFieldStates form) }++-- | Manually indicate that a field has invalid contents. This can be+-- useful in situations where validation beyond the form element's+-- validator needs to be performed and the result of that validation+-- needs to be fed back into the form state.+setFieldValid :: (Eq n)+              => Bool+              -- ^ Whether the field is considered valid.+              -> n+              -- ^ The name of the form field to set as (in)valid.+              -> Form s e n+              -- ^ The form to modify.+              -> Form s e n+setFieldValid v n form =+    let go1 [] = []+        go1 (s:ss) =+            let s' = case s of+                       FormFieldState st l upd fs rh concatAll visMode ->+                           let go2 [] = []+                               go2 (f@(FormField fn val _ r h):ff)+                                   | n == fn = FormField fn val v r h : ff+                                   | otherwise = f : go2 ff+                           in FormFieldState st l upd (go2 fs) rh concatAll visMode+            in s' : go1 ss++    in form { formFieldStates = go1 (formFieldStates form) }++getInvalidFields :: FormFieldState s e n -> [n]+getInvalidFields (FormFieldState st _ _ fs _ _ _) =+    let gather (FormField n validate extValid _ _) =+            if not extValid || isNothing (validate st) then [n] else []+    in concatMap gather fs++-- | Render a form.+--+-- For each form field, each input for the field is rendered using+-- the implementation provided by its 'FormField'. The inputs are+-- then concatenated with the field's concatenation function (see+-- 'setFieldConcat') and are then augmented using the form field's+-- rendering augmentation function (see '@@='). Fields with invalid+-- inputs (either due to built-in validator failure or due to external+-- validation failure via 'setFieldValid') will be displayed using the+-- 'invalidFormInputAttr' attribute.+--+-- Finally, all of the resulting field renderings are concatenated with+-- the form's concatenation function (see 'setFormConcat'). A visibility+-- request is also issued for the currently-focused form field in case+-- the form is rendered within a viewport.+renderForm :: (Eq n) => Form s e n -> Widget n+renderForm (Form es fr _ concatAll) =+    concatAll $ renderFormFieldState fr <$> es++-- | Render a single form field collection. This is called internally by+-- 'renderForm' but is exposed in cases where a form field state needs+-- to be rendered outside of a 'Form', so 'renderForm' is probably what+-- you want.+renderFormFieldState :: (Eq n)+                     => FocusRing n+                     -> FormFieldState s e n+                     -> Widget n+renderFormFieldState fr (FormFieldState st _ _ fields helper concatFields visMode) =+    let curFocus = focusGetCurrent fr+        foc = case curFocus of+                  Nothing -> False+                  Just n -> n `elem` fieldNames+        maybeVisible = if foc && visMode == ShowCompositeField then visible else id+        renderFields [] = []+        renderFields ((FormField n validate extValid renderField _):fs) =+            let maybeInvalid = if (isJust $ validate st) && extValid+                               then id+                               else forceAttr invalidFormInputAttr+                fieldFoc = Just n == curFocus+                maybeFieldVisible = if fieldFoc && visMode == ShowFocusedFieldOnly then visible else id+            in (n, maybeFieldVisible $ maybeInvalid $ renderField fieldFoc st) : renderFields fs+        (fieldNames, renderedFields) = unzip $ renderFields fields+        maybeHelperVisible =+            if foc && visMode == ShowAugmentedField then visible else id+    in maybeHelperVisible $ helper $ maybeVisible $ concatFields renderedFields++-- | Dispatch an event to the currently focused form field. This handles+-- the following events in this order:+--+-- * On @Tab@ keypresses, this changes the focus to the next field in+--   the form.+-- * On @Shift-Tab@ keypresses, this changes the focus to the previous+--   field in the form.+-- * On mouse button presses (regardless of button or modifier), the+--   focus is changed to the clicked form field and the event is+--   forwarded to the event handler for the clicked form field.+-- * On @Left@ or @Up@, if the currently-focused field is part of a+--   collection (e.g. radio buttons), the previous entry in the+--   collection is focused.+-- * On @Right@ or @Down@, if the currently-focused field is part of a+--   collection (e.g. radio buttons), the next entry in the collection+--   is focused.+-- * All other events are forwarded to the currently focused form field.+--+-- In all cases where an event is forwarded to a form field, validation+-- of the field's input state is performed immediately after the+-- event has been handled. If the form field's input state succeeds+-- validation using the field's validator function, its value is+-- immediately stored in the form state using the form field's state+-- lens. The external validation flag is ignored during this step to+-- ensure that external validators have a chance to get the intermediate+-- validated value.+handleFormEvent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()+handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) =+    formFocusL %= focusNext+handleFormEvent (VtyEvent (EvKey KBackTab [])) =+    formFocusL %= focusPrev+handleFormEvent e@(MouseDown n _ _ _) = do+    formFocusL %= focusSetCurrent n+    handleFormFieldEvent e n+handleFormEvent e@(MouseUp n _ _) = do+    formFocusL %= focusSetCurrent n+    handleFormFieldEvent e n+handleFormEvent e@(VtyEvent (EvKey KUp [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryBefore grp n)+handleFormEvent e@(VtyEvent (EvKey KDown [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryAfter grp n)+handleFormEvent e@(VtyEvent (EvKey KLeft [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryBefore grp n)+handleFormEvent e@(VtyEvent (EvKey KRight [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryAfter grp n)+handleFormEvent e =+    forwardToCurrent e++getFocusGrouping :: (Eq n) => Form s e n -> n -> Maybe [n]+getFocusGrouping f n = findGroup (formFieldStates f)+    where+        findGroup [] = Nothing+        findGroup (e:es) =+            let ns = formFieldNames e+            in if n `elem` ns && length ns > 1+               then Just ns+               else findGroup es++entryAfter :: (Eq a) => [a] -> a -> a+entryAfter as a =+    let i = fromJust $ elemIndex a as+        i' = if i == length as - 1 then 0 else i + 1+    in as !! i'++entryBefore :: (Eq a) => [a] -> a -> a+entryBefore as a =+    let i = fromJust $ elemIndex a as+        i' = if i == 0 then length as - 1 else i - 1+    in as !! i'++withFocusAndGrouping :: (Eq n)+                     => BrickEvent n e+                     -> (n -> [n] -> EventM n (Form s e n) ())+                     -> EventM n (Form s e n) ()+withFocusAndGrouping e act = do+    foc <- gets formFocus+    case focusGetCurrent foc of+        Nothing -> return ()+        Just n -> do+            f <- get+            case getFocusGrouping f n of+                Nothing -> forwardToCurrent e+                Just grp -> act n grp++withFocus :: (n -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()+withFocus act = do+    foc <- gets formFocus+    case focusGetCurrent foc of+        Nothing -> return ()+        Just n -> act n++forwardToCurrent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()+forwardToCurrent =+    withFocus . handleFormFieldEvent++handleFormFieldEvent :: (Eq n) => BrickEvent n e -> n -> EventM n (Form s e n) ()+handleFormFieldEvent ev n = do+    let findFieldState _ [] = return ()+        findFieldState prev (e:es) =+            case e of+                FormFieldState st stLens upd fields helper concatAll visMode -> do+                    let findField [] = return Nothing+                        findField (field:rest) =+                            case field of+                                FormField n' validate _ _ handleFunc | n == n' -> do+                                    (nextSt, ()) <- nestEventM st (handleFunc ev)+                                    -- If the new state validates, go ahead and update+                                    -- the form state with it.+                                    case validate nextSt of+                                        Nothing -> return $ Just (nextSt, Nothing)+                                        Just newSt -> return $ Just (nextSt, Just newSt)+                                _ -> findField rest++                    result <- findField fields+                    case result of+                        Nothing -> findFieldState (prev <> [e]) es+                        Just (newSt, maybeSt) -> do+                            let newFieldState = FormFieldState newSt stLens upd fields helper concatAll visMode+                            formFieldStatesL .= prev <> [newFieldState] <> es+                            case maybeSt of+                              Nothing -> return ()+                              Just s  -> formStateL.stLens .= s++    states <- gets formFieldStates+    findFieldState [] states
+ src/Brick/Keybindings.hs view
@@ -0,0 +1,20 @@+-- | The re-exporting catch-all module for the customizable keybindings+-- API.+--+-- To get started using this API, see the documentation in+-- @KeyDispatcher@ as well as the User Guide section on customizable+-- keybindings.+module Brick.Keybindings+  ( module Brick.Keybindings.KeyEvents+  , module Brick.Keybindings.KeyConfig+  , module Brick.Keybindings.KeyDispatcher+  , module Brick.Keybindings.Pretty+  , module Brick.Keybindings.Parse+  )+where++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.KeyDispatcher+import Brick.Keybindings.Pretty+import Brick.Keybindings.Parse
+ src/Brick/Keybindings/KeyConfig.hs view
@@ -0,0 +1,258 @@+-- | This module provides 'KeyConfig' and associated functions. A+-- 'KeyConfig' is the basis for the custom keybinding system in this+-- library.+--+-- To get started, see 'newKeyConfig'. Once a 'KeyConfig' has been+-- constructed, see 'Brick.Keybindings.KeyHandlerMap.keyDispatcher'.+--+-- Since a key configuration can have keys bound to multiple events, it+-- is the application author's responsibility to check for collisions+-- since the nature of the collisions will depend on how the application+-- is implemented. To check for collisions, use the result of+-- 'keyEventMappings'.+module Brick.Keybindings.KeyConfig+  ( KeyConfig+  , newKeyConfig+  , BindingState(..)++  -- * Specifying bindings+  , Binding(..)+  , ToBinding(..)+  , binding+  , fn+  , meta+  , ctrl+  , shift++  -- * Querying KeyConfigs+  , firstDefaultBinding+  , firstActiveBinding+  , allDefaultBindings+  , allActiveBindings+  , keyEventMappings++  -- * Misc+  , keyConfigEvents+  , lookupKeyConfigBindings+  )+where++import Data.List (nub)+import qualified Data.Map.Strict as M+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Set as S+import Data.Maybe (fromMaybe, listToMaybe, catMaybes)+import qualified Graphics.Vty as Vty++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.Normalize++-- | A key binding.+--+-- The easiest way to express 'Binding's is to use the helper functions+-- in this module that work with instances of 'ToBinding', e.g.+--+-- @+-- let ctrlB = 'ctrl' \'b\'+--     shiftX = 'shift' \'x\'+--     ctrlMetaK = 'ctrl' $ 'meta' \'k\'+--     -- Or with Vty keys directly:+--     ctrlDown = 'ctrl' 'Graphics.Vty.Input.KDown'+-- @+data Binding =+    Binding { kbKey :: Vty.Key+            -- ^ The key itself.+            , kbMods :: S.Set Vty.Modifier+            -- ^ The set of modifiers.+            } deriving (Eq, Show, Ord)++-- | Construct a 'Binding'. Modifier order is ignored. If modifiers+-- are given and the binding is for a character key, it is forced to+-- lowercase.+binding :: Vty.Key -> [Vty.Modifier] -> Binding+binding k mods =+    Binding { kbKey = normalizeKey mods k+            , kbMods = S.fromList mods+            }++-- | An explicit configuration of key bindings for a key event.+data BindingState =+    BindingList [Binding]+    -- ^ Bind the event to the specified list of bindings.+    | Unbound+    -- ^ Disable all bindings for the event, including default bindings.+    deriving (Show, Eq, Ord)++-- | A configuration of custom key bindings. A 'KeyConfig'+-- stores everything needed to resolve a key event into one or+-- more key bindings. Make a 'KeyConfig' with 'newKeyConfig',+-- then use it to dispatch to 'KeyEventHandler's with+-- 'Brick.Keybindings.KeyHandlerMap.keyDispatcher'.+--+-- Make a new 'KeyConfig' with 'newKeyConfig'.+--+-- A 'KeyConfig' stores:+--+-- * A collection of named key events, mapping the event type @k@ to+--   'Text' labels.+-- * For each event @k@, optionally store a list of default key bindings+--   for that event.+-- * An optional customized binding list for each event, setting the+--   event to either 'Unbound' or providing explicit overridden bindings+--   with 'BindingList'.+data KeyConfig k =+    KeyConfig { keyConfigCustomBindings :: [(k, BindingState)]+              -- ^ The list of custom binding states for events with+              -- custom bindings. We use a list to ensure that we+              -- preserve key bindings for keys that are mapped to more+              -- than one event. This may be valid or invalid depending+              -- on the events in question; whether those bindings+              -- constitute a collision is up to the application+              -- developer to check.+              , keyConfigEvents :: KeyEvents k+              -- ^ The base mapping of events and their names that is+              -- used in this configuration.+              , keyConfigDefaultBindings :: M.Map k [Binding]+              -- ^ A mapping of events and their default key bindings,+              -- if any.+              }+              deriving (Show, Eq)++-- | Build a 'KeyConfig' with the specified 'KeyEvents' event-to-name+-- mapping, list of default bindings by event, and list of custom+-- bindings by event.+newKeyConfig :: (Ord k)+             => KeyEvents k+             -- ^ The base mapping of key events and names to use.+             -> [(k, [Binding])]+             -- ^ Default bindings by key event, such as from a+             -- configuration file or embedded code. Optional on a+             -- per-event basis.+             -> [(k, BindingState)]+             -- ^ Custom bindings by key event, such as from a+             -- configuration file. Explicitly setting an event to+             -- 'Unbound' here has the effect of disabling its default+             -- bindings. Optional on a per-event basis. Note that this+             -- function does not check for collisions since it is up to+             -- the application to determine whether a key bound to more+             -- than one event constitutes a collision!+             -> KeyConfig k+newKeyConfig evs defaults bindings =+    KeyConfig { keyConfigCustomBindings = bindings+              , keyConfigEvents = evs+              , keyConfigDefaultBindings = M.fromList defaults+              }++-- | Return a list of mappings including each key bound to any event+-- combined with the list of events to which it is bound. This is useful+-- for identifying problematic key binding collisions. Since key binding+-- collisions cannot be determined in general, we leave it up to the+-- application author to determine which key-to-event bindings are+-- problematic.+keyEventMappings :: (Ord k, Eq k) => KeyConfig k -> [(Binding, S.Set k)]+keyEventMappings kc = M.toList resultMap+    where+        -- Get all default bindings+        defaultBindings = M.toList $ keyConfigDefaultBindings kc+        -- Get all explicitly unbound events+        explicitlyUnboundEvents = fmap fst $ filter ((== Unbound) . snd) $ keyConfigCustomBindings kc+        -- Remove explicitly unbound events from the default set of+        -- bindings+        defaultBindingsWithoutUnbound = filter ((`notElem` explicitlyUnboundEvents) . fst) defaultBindings+        -- Now get customized binding lists+        customizedKeybindingLists = catMaybes $ (flip fmap) (keyConfigCustomBindings kc) $ \(k, bState) -> do+            case bState of+                Unbound -> Nothing+                BindingList bs -> Just (k, bs)+        -- Now build a map from binding to event list+        allPairs = defaultBindingsWithoutUnbound <>+                   customizedKeybindingLists+        addBindings m (ev, bs) =+            M.unionWith S.union m $ M.fromList [(b, S.singleton ev) | b <- bs]+        resultMap = foldl addBindings mempty allPairs++-- | Look up the binding state for the specified event. This returns+-- 'Nothing' when the event has no explicitly configured custom+-- 'BindingState'.+lookupKeyConfigBindings :: (Ord k) => KeyConfig k -> k -> Maybe BindingState+lookupKeyConfigBindings kc e = lookup e $ keyConfigCustomBindings kc++-- | A convenience function to return the first result of+-- 'allDefaultBindings', if any.+firstDefaultBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding+firstDefaultBinding kc ev = do+    bs <- M.lookup ev (keyConfigDefaultBindings kc)+    case bs of+        (b:_) -> Just b+        _ -> Nothing++-- | Returns the list of default bindings for the specified event,+-- irrespective of whether the event has been explicitly configured with+-- other bindings or set to 'Unbound'.+allDefaultBindings :: (Ord k) => KeyConfig k -> k -> [Binding]+allDefaultBindings kc ev =+    fromMaybe [] $ M.lookup ev (keyConfigDefaultBindings kc)++-- | A convenience function to return the first result of+-- 'allActiveBindings', if any.+firstActiveBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding+firstActiveBinding kc ev = listToMaybe $ allActiveBindings kc ev++-- | Return all active key bindings for the specified event. This+-- returns customized bindings if any have been set in the 'KeyConfig',+-- no bindings if the event has been explicitly set to 'Unbound', or the+-- default bindings if the event is absent from the customized bindings.+allActiveBindings :: (Show k, Ord k) => KeyConfig k -> k -> [Binding]+allActiveBindings kc ev = nub foundBindings+    where+        defaultBindings = allDefaultBindings kc ev+        foundBindings = case lookupKeyConfigBindings kc ev of+            Just (BindingList bs) -> bs+            Just Unbound -> []+            Nothing -> defaultBindings++-- | The class of types that can form the basis of 'Binding's.+--+-- This is provided to make it easy to write and modify bindings in less+-- verbose ways.+class ToBinding a where+    -- | Binding constructor.+    bind :: a -> Binding++instance ToBinding Vty.Key where+    bind k = Binding { kbMods = mempty, kbKey = k }++instance ToBinding Char where+    bind = bind . Vty.KChar++instance ToBinding Binding where+    bind = id++addModifier :: (ToBinding a) => Vty.Modifier -> a -> Binding+addModifier m val =+    let b = bind val+        newMods = S.insert m $ kbMods b+    in b { kbMods = newMods+         , kbKey = normalizeKey (S.toList newMods) $ kbKey b+         }++-- | Add Meta to a binding. If the binding is for a character key, force+-- it to lowercase.+meta :: (ToBinding a) => a -> Binding+meta = addModifier Vty.MMeta++-- | Add Ctrl to a binding. If the binding is for a character key, force+-- it to lowercase.+ctrl :: (ToBinding a) => a -> Binding+ctrl = addModifier Vty.MCtrl++-- | Add Shift to a binding. If the binding is for a character key, force+-- it to lowercase.+shift :: (ToBinding a) => a -> Binding+shift = addModifier Vty.MShift++-- | Function key binding.+fn :: Int -> Binding+fn = bind . Vty.KFun
+ src/Brick/Keybindings/KeyDispatcher.hs view
@@ -0,0 +1,241 @@+-- | This is the entry point into the keybinding infrastructure in+-- this library. Note that usage of this API is not required to create+-- working Brick applications; this API is provided for applications+-- that need to support custom keybindings that are less tightly coupled+-- to application behavior.+--+-- The workflow for this API is as follows:+--+-- * Create a data type @k@ with a constructor for each abstract+--   application event that you want to trigger with an input key.+-- * To each event @k@, assign a unique user-readable name (such as a+--   name you could imagine using in a configuration file to refer to+--   the event) and a list of default key bindings.+-- * Use the resulting data to create a 'KeyConfig' with 'newKeyConfig'.+--   If desired, provide custom keybindings to 'newKeyConfig' from+--   within the program or load them from an INI file with routines like+--   'Brick.Keybindings.Parse.keybindingsFromFile'.+-- * Optionally check for configuration-wide keybinding collisions with+--   'Brick.Keybindings.KeyConfig.keyEventMappings'.+-- * Implement application event handlers that will be run in response+--   to either specific hard-coded keys or events @k@, both in some+--   monad @m@ of your choosing, using constructors 'onKey' and+--   'onEvent'.+-- * Use the created 'KeyConfig' and handlers to create a+--   'KeyDispatcher' with 'keyDispatcher', dealing with collisions if+--   they arise.+-- * As user input events arrive, dispatch them to the appropriate+--   handler in the dispatcher using 'handleKey'.+module Brick.Keybindings.KeyDispatcher+  ( -- * Key dispatching+    KeyDispatcher+  , keyDispatcher+  , handleKey++  -- * Building handlers+  , onEvent+  , onKey++  -- * Handlers and triggers+  , Handler(..)+  , KeyHandler(..)+  , KeyEventHandler(..)+  , EventTrigger(..)++  -- * Misc+  , keyDispatcherToList+  , lookupVtyEvent+  )+where++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Graphics.Vty as Vty+import Data.Function (on)+import Data.List (groupBy, sortBy)++import Brick.Keybindings.KeyConfig++-- | A dispatcher keys that map to abstract events @k@ and whose+-- handlers run in the monad @m@.+newtype KeyDispatcher k m = KeyDispatcher (M.Map Binding (KeyHandler k m))++-- | A 'Handler' represents a handler implementation to be invoked in+-- response to some event that runs in the monad @m@.+--+-- In general, you should never need to make one of these manually.+-- Instead, use 'onEvent' and 'onKey'. This type's internals are exposed+-- for easy inspection, not construction.+data Handler m =+    Handler { handlerDescription :: T.Text+            -- ^ The description of this handler's behavior.+            , handlerAction :: m ()+            -- ^ The action to take when this handler is invoked.+            }++-- | A handler for a specific key.+--+-- In general, you should never need to create one of these manually.+-- The internals are exposed to make inspection easy.+data KeyHandler k m =+    KeyHandler { khHandler :: KeyEventHandler k m+               -- ^ The handler to invoke. Note that this maintains+               -- the original abstract key event handler; this allows+               -- us to obtain the original 'EventTrigger' for the+               -- 'KeyEventHandler' upon which this 'KeyHandler'+               -- is built. This can be important for keybinding+               -- consistency checks or collision checks as well as help+               -- text generation.+               , khBinding :: Binding+               -- ^ The specific key binding that should trigger this+               -- handler.+               }++-- | Find the key handler that matches a Vty key event, if any. Modifier+-- order is unimportant since the lookup for a matching binding ignores+-- modifier order.+--+-- This works by looking up an event handler whose binding is the+-- specified key and modifiers based on the 'KeyConfig' that was used to+-- build the 'KeyDispatcher'.+--+-- Ordinarily you will not need to use this function; use 'handleKey'+-- instead. This is provided for more direct access to the+-- 'KeyDispatcher' internals.+lookupVtyEvent :: Vty.Key -> [Vty.Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)+lookupVtyEvent k mods (KeyDispatcher m) = M.lookup (Binding k $ S.fromList mods) m++-- | Handle a keyboard event by looking it up in the 'KeyDispatcher'+-- and invoking the matching binding's handler if one is found. Return+-- @True@ if the a matching handler was found and run; return @False@ if+-- no matching binding was found.+handleKey :: (Monad m)+          => KeyDispatcher k m+          -- ^ The dispatcher to use.+          -> Vty.Key+          -- ^ The key to handle.+          -> [Vty.Modifier]+          -- ^ The modifiers for the key, if any.+          -> m Bool+handleKey d k mods = do+    case lookupVtyEvent k mods d of+        Just kh -> (handlerAction $ kehHandler $ khHandler kh) >> return True+        Nothing -> return False++-- | Build a 'KeyDispatcher' to dispatch keys to handle events of type+-- @k@ using actions in a Monad @m@. If any collisions are detected,+-- this fails with 'Left' and returns the list of colliding event+-- handlers for each overloaded binding. (Each returned 'KeyHandler'+-- contains the original 'KeyEventHandler' that was used to build it so+-- those can be inspected to understand which handlers are mapped to the+-- same key, either via an abstract key event using 'onEvent' or via a+-- statically configured key using 'onKey'.)+--+-- This works by taking a list of abstract 'KeyEventHandler's and+-- building a 'KeyDispatcher' of event handlers based on specific Vty+-- keys using the provided 'KeyConfig' to map between abstract key+-- events of type @k@ and Vty keys. Event handlers triggered by an event+-- @k@ are set up to be triggered by either the customized bindings for+-- @k@ in the 'KeyConfig', no bindings at all if the 'KeyConfig' has+-- marked @k@ as 'Unbound', or the default bindings for @k@ otherwise.+--+-- Once you have a 'KeyDispatcher', you can dispatch an input key event+-- to it and invoke the corresponding handler (if any) with 'handleKey'.+keyDispatcher :: (Ord k)+              => KeyConfig k+              -> [KeyEventHandler k m]+              -> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)+keyDispatcher conf ks =+    let pairs = buildKeyDispatcherPairs ks conf+        groups = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) pairs+        badGroups = filter ((> 1) . length) groups+        combine :: [(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])+        combine as =+            let b = fst $ head as+            in (b, snd <$> as)+    in if null badGroups+       then Right $ KeyDispatcher $ M.fromList pairs+       else Left $ combine <$> badGroups++-- | Convert a key dispatcher to a list of pairs of bindings and their+-- handlers.+keyDispatcherToList :: KeyDispatcher k m+                    -> [(Binding, KeyHandler k m)]+keyDispatcherToList (KeyDispatcher m) = M.toList m++buildKeyDispatcherPairs :: (Ord k)+                        => [KeyEventHandler k m]+                        -> KeyConfig k+                        -> [(Binding, KeyHandler k m)]+buildKeyDispatcherPairs ks conf = pairs+    where+        pairs = mkPair <$> handlers+        mkPair h = (khBinding h, h)+        handlers = concatMap (keyHandlersFromConfig conf) ks++keyHandlersFromConfig :: (Ord k)+                      => KeyConfig k+                      -> KeyEventHandler k m+                      -> [KeyHandler k m]+keyHandlersFromConfig kc eh =+    let allBindingsFor ev | Just (BindingList ks) <- lookupKeyConfigBindings kc ev = ks+                          | Just Unbound <- lookupKeyConfigBindings kc ev = []+                          | otherwise = allDefaultBindings kc ev+        bindings = case kehEventTrigger eh of+            ByKey b    -> [b]+            ByEvent ev -> allBindingsFor ev+    in [ KeyHandler { khHandler = eh, khBinding = b } | b <- bindings ]++mkHandler :: T.Text -> m () -> Handler m+mkHandler msg action =+    Handler { handlerDescription = msg+            , handlerAction = action+            }++-- | Specify a handler for the specified key event.+onEvent :: k+        -- ^ The key event whose bindings should trigger this handler.+        -> T.Text+        -- ^ The description of the handler.+        -> m ()+        -- ^ The handler to invoke.+        -> KeyEventHandler k m+onEvent ev msg action =+    KeyEventHandler { kehHandler = mkHandler msg action+                    , kehEventTrigger = ByEvent ev+                    }++-- | Specify a handler for the specified key.+onKey :: (ToBinding a)+      => a+      -- ^ The binding that should trigger this handler.+      -> T.Text+      -- ^ The description of the handler.+      -> m ()+      -- ^ The handler to invoke.+      -> KeyEventHandler k m+onKey b msg action =+    KeyEventHandler { kehHandler = mkHandler msg action+                    , kehEventTrigger = ByKey $ bind b+                    }++-- | A trigger for an event handler.+data EventTrigger k =+    ByKey Binding+    -- ^ The key event is always triggered by a specific key.+    | ByEvent k+    -- ^ The trigger is an abstract key event.+    deriving (Show, Eq, Ord)++-- | A handler for an abstract key event.+--+-- In general, you should never need to create these manually. Instead,+-- use 'onEvent' and 'onKey'. The internals of this type are exposed to+-- allow inspection of handler data for e.g. custom help generation.+data KeyEventHandler k m =+    KeyEventHandler { kehHandler :: Handler m+                    -- ^ The handler to invoke.+                    , kehEventTrigger :: EventTrigger k+                    -- ^ The trigger for the handler.+                    }
+ src/Brick/Keybindings/KeyEvents.hs view
@@ -0,0 +1,52 @@+-- | This module provides 'KeyEvents', a data type for mapping+-- application-defined abstract events to user-facing names (e.g.+-- for use in configuration files and documentation). This data+-- structure gives you a place to define the correspondence between+-- your application's key events and their names. A 'KeyEvents' also+-- effectively tells the key binding system about the collection of+-- possible abstract events that can be handled.+--+-- A 'KeyEvents' is used to construct a+-- 'Brick.Keybindings.KeyConfig.KeyConfig' with+-- 'Brick.Keybindings.KeyConfig.newKeyConfig'.+module Brick.Keybindings.KeyEvents+  ( KeyEvents+  , keyEvents+  , keyEventsList+  , lookupKeyEvent+  , keyEventName+  )+where++import qualified Data.Bimap as B+import qualified Data.Text as T++-- | A bidirectional mapping between events @k@ and their user-readable+-- names.+data KeyEvents k = KeyEvents (B.Bimap T.Text k)+                 deriving (Eq, Show)++-- | Build a new 'KeyEvents' map from the specified list of events and+-- names. Key event names are stored in lowercase.+--+-- Calls 'error' if any events have the same name (ignoring case) or if+-- multiple names map to the same event.+keyEvents :: (Ord k) => [(T.Text, k)] -> KeyEvents k+keyEvents pairs =+    let m = B.fromList [(T.strip $ T.toLower n, e) | (n, e) <- pairs]+    in if B.size m /= length pairs+       then error "keyEvents: input list contains duplicates by name or by event value"+       else KeyEvents $ B.fromList pairs++-- | Convert the 'KeyEvents' to a list.+keyEventsList :: KeyEvents k -> [(T.Text, k)]+keyEventsList (KeyEvents m) = B.toList m++-- | Look up the specified event name to get its abstract event. The+-- lookup ignores leading and trailing whitespace as well as case.+lookupKeyEvent :: (Ord k) => KeyEvents k -> T.Text -> Maybe k+lookupKeyEvent (KeyEvents m) name = B.lookup (T.strip $ T.toLower name) m++-- | Given an abstract event, get its event name.+keyEventName :: (Ord k) => KeyEvents k -> k -> Maybe T.Text+keyEventName (KeyEvents m) e = B.lookupR e m
+ src/Brick/Keybindings/Normalize.hs view
@@ -0,0 +1,14 @@+module Brick.Keybindings.Normalize+  ( normalizeKey+  )+where++import Data.Char (toLower)+import qualified Graphics.Vty as Vty++-- | A keybinding involving modifiers should have its key character+-- normalized to lowercase since it's impossible to get uppercase keys+-- from the terminal when modifiers are present.+normalizeKey :: [Vty.Modifier] -> Vty.Key -> Vty.Key+normalizeKey (_:_) (Vty.KChar c) = Vty.KChar $ toLower c+normalizeKey _ k = k
+ src/Brick/Keybindings/Parse.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides key binding string parsing functions for use+-- in e.g. reading key bindings from configuration files.+module Brick.Keybindings.Parse+  ( parseBinding+  , parseBindingList+  , normalizeKey++  , keybindingsFromIni+  , keybindingsFromFile+  , keybindingIniParser+  )+where++import Control.Monad (forM)+import Data.Maybe (catMaybes)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Graphics.Vty as Vty+import Text.Read (readMaybe)+import qualified Data.Ini.Config as Ini++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.Normalize++-- | Parse a key binding list into a 'BindingState'.+--+-- A key binding list either the string @"unbound"@ or is a+-- comma-separated list of 'Binding's parsed with 'parseBinding'.+parseBindingList :: T.Text -> Either String BindingState+parseBindingList t =+    if T.toLower t == "unbound"+    then return Unbound+    else BindingList <$> mapM (parseBinding . T.strip) (T.splitOn "," $ T.strip t)++-- | Parse a key binding string. Key binding strings specify zero or+-- more modifier keys and a base key, separated by hyphens.+--+-- @+-- (modifier "-")* key+-- @+--+-- e.g. @c-down@, @backspace@, @ctrl-shift-f1@.+--+-- where each @modifier@ is parsed case-insensitively as follows:+--+-- * @"s", "shift"@: 'Vty.MShift'+-- * @"m", "meta"@: 'Vty.MMeta'+-- * @"a", "alt"@: 'Vty.MAlt'+-- * @"c", "ctrl", "control"@: 'Vty.MCtrl'+--+-- and @key@ is parsed case-insensitively as follows:+--+-- * "f1", "f2", ...: 'Vty.KFun'+-- * "esc": 'Vty.KEsc'+-- * "backspace": 'Vty.KBS'+-- * "enter": 'Vty.KEnter'+-- * "left": 'Vty.KLeft'+-- * "right": 'Vty.KRight'+-- * "up": 'Vty.KUp'+-- * "down": 'Vty.KDown'+-- * "upleft": 'Vty.KUpLeft'+-- * "upright": 'Vty.KUpRight'+-- * "downleft": 'Vty.KDownLeft'+-- * "downright": 'Vty.KDownRight'+-- * "center": 'Vty.KCenter'+-- * "backtab": 'Vty.KBackTab'+-- * "printscreen": 'Vty.KPrtScr'+-- * "pause": 'Vty.KPause'+-- * "insert": 'Vty.KIns'+-- * "home": 'Vty.KHome'+-- * "pgup": 'Vty.KPageUp'+-- * "del": 'Vty.KDel'+-- * "end": 'Vty.KEnd'+-- * "pgdown": 'Vty.KPageDown'+-- * "begin": 'Vty.KBegin'+-- * "menu": 'Vty.KMenu'+-- * "space": @' '@+-- * "tab": @'\\t'@+-- * Otherwise, 'Vty.KChar'+parseBinding :: T.Text -> Either String Binding+parseBinding s = go (T.splitOn "-" $ T.toLower s) []+  where go [k] mods = do+          k' <- pKey k+          return $ binding k' mods+        go (k:ks) mods = do+          m <- case k of+            "s"       -> return Vty.MShift+            "shift"   -> return Vty.MShift+            "m"       -> return Vty.MMeta+            "meta"    -> return Vty.MMeta+            "a"       -> return Vty.MAlt+            "alt"     -> return Vty.MAlt+            "c"       -> return Vty.MCtrl+            "ctrl"    -> return Vty.MCtrl+            "control" -> return Vty.MCtrl+            _         -> Left ("Unknown modifier prefix: " ++ show k)+          go ks (m:mods)+        go [] _ = Left "Empty keybinding not allowed"+        pKey "esc"       = return Vty.KEsc+        pKey "backspace" = return Vty.KBS+        pKey "enter"     = return Vty.KEnter+        pKey "left"      = return Vty.KLeft+        pKey "right"     = return Vty.KRight+        pKey "up"        = return Vty.KUp+        pKey "down"      = return Vty.KDown+        pKey "upleft"    = return Vty.KUpLeft+        pKey "upright"   = return Vty.KUpRight+        pKey "downleft"  = return Vty.KDownLeft+        pKey "downright" = return Vty.KDownRight+        pKey "center"    = return Vty.KCenter+        pKey "backtab"   = return Vty.KBackTab+        pKey "printscreen" = return Vty.KPrtScr+        pKey "pause"     = return Vty.KPause+        pKey "insert"    = return Vty.KIns+        pKey "home"      = return Vty.KHome+        pKey "pgup"      = return Vty.KPageUp+        pKey "del"       = return Vty.KDel+        pKey "end"       = return Vty.KEnd+        pKey "pgdown"    = return Vty.KPageDown+        pKey "begin"     = return Vty.KBegin+        pKey "menu"      = return Vty.KMenu+        pKey "space"     = return (Vty.KChar ' ')+        pKey "tab"       = return (Vty.KChar '\t')+        pKey t+          | T.length t == 1 =+              return (Vty.KChar $ T.last s)+          | Just n <- T.stripPrefix "f" t =+              case readMaybe (T.unpack n) of+                  Nothing -> Left ("Unknown keybinding: " ++ show t)+                  Just i -> return (Vty.KFun i)+          | otherwise = Left ("Unknown keybinding: " ++ show t)++-- | Parse custom key bindings from the specified INI file using the+-- provided event name mapping.+--+-- Each line in the specified section can take the form+--+-- > <event-name> = <"unbound"|[binding,...]>+--+-- where the event name must be a valid event name in the specified+-- 'KeyEvents' and each binding is valid as parsed by 'parseBinding'.+--+-- Returns @Nothing@ if the named section was not found; otherwise+-- returns a (possibly empty) list of binding states for each event in+-- @evs@.+keybindingsFromIni :: KeyEvents k+                   -- ^ The key event name mapping to use to parse the+                   -- configuration data.+                   -> T.Text+                   -- ^ The name of the INI configuration section to+                   -- read.+                   -> T.Text+                   -- ^ The text of the INI document to read.+                   -> Either String (Maybe [(k, BindingState)])+keybindingsFromIni evs section doc =+    Ini.parseIniFile doc (keybindingIniParser evs section)++-- | Parse custom key bindings from the specified INI file path. This+-- does not catch or convert any exceptions resulting from I/O errors.+-- See 'keybindingsFromIni' for details.+keybindingsFromFile :: KeyEvents k+                    -- ^ The key event name mapping to use to parse the+                    -- configuration data.+                    -> T.Text+                    -- ^ The name of the INI configuration section to+                    -- read.+                    -> FilePath+                    -- ^ The path to the INI file to read.+                    -> IO (Either String (Maybe [(k, BindingState)]))+keybindingsFromFile evs section path =+    keybindingsFromIni evs section <$> T.readFile path++-- | The low-level INI parser for custom key bindings used by this+-- module, exported for applications that use the @config-ini@ package.+keybindingIniParser :: KeyEvents k -> T.Text -> Ini.IniParser (Maybe [(k, BindingState)])+keybindingIniParser evs section =+    Ini.sectionMb section $ do+        fmap catMaybes $ forM (keyEventsList evs) $ \(name, e) -> do+            fmap (e,) <$> Ini.fieldMbOf name parseBindingList
+ src/Brick/Keybindings/Pretty.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides functions for pretty-printing key bindings+-- and for generating Markdown, plain text, and Brick displays of event+-- handler key binding configurations.+module Brick.Keybindings.Pretty+  (+  -- * Generating help output+    keybindingTextTable+  , keybindingMarkdownTable+  , keybindingHelpWidget++  -- * Pretty-printing primitives+  , ppBinding+  , ppMaybeBinding+  , ppKey+  , ppModifier++  -- * Attributes for Widget rendering+  , keybindingHelpBaseAttr+  , eventNameAttr+  , eventDescriptionAttr+  , keybindingAttr+  )+where++import Brick+import Data.List (sort, intersperse)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Graphics.Vty as Vty++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.KeyDispatcher++data TextHunk = Verbatim T.Text+              | Comment T.Text++-- | Generate a Markdown document of sections indicating the key binding+-- state for each event handler.+keybindingMarkdownTable :: (Ord k)+                        => KeyConfig k+                        -- ^ The key binding configuration in use.+                        -> [(T.Text, [KeyEventHandler k m])]+                        -- ^ Key event handlers by named section.+                        -> T.Text+keybindingMarkdownTable kc sections = title <> keybindSectionStrings+    where title = "# Keybindings\n"+          keybindSectionStrings = T.concat $ sectionText <$> sections+          sectionText (heading, handlers) =+              mkHeading heading <>+              mkKeybindEventSectionHelp kc keybindEventHelpMarkdown T.unlines handlers+          mkHeading n =+              "\n# " <> n <>+              "\n| Keybinding | Event Name | Description |" <>+              "\n| ---------- | ---------- | ----------- |\n"++-- | Generate a plain text document of sections indicating the key+-- binding state for each event handler.+keybindingTextTable :: (Ord k)+                    => KeyConfig k+                    -- ^ The key binding configuration in use.+                    -> [(T.Text, [KeyEventHandler k m])]+                    -- ^ Key event handlers by named section.+                    -> T.Text+keybindingTextTable kc sections = title <> keybindSectionStrings+    where title = "Keybindings\n===========\n"+          keybindSectionStrings = T.concat $ sectionText <$> sections+          sectionText (heading, handlers) =+              mkHeading heading <>+              mkKeybindEventSectionHelp kc (keybindEventHelpText keybindingWidth eventNameWidth) T.unlines handlers+          keybindingWidth = 15+          eventNameWidth = 30+          mkHeading n =+              "\n" <> n <>+              "\n" <> (T.replicate (T.length n) "=") <>+              "\n"++keybindEventHelpText :: Int -> Int -> (TextHunk, T.Text, [TextHunk]) -> T.Text+keybindEventHelpText width eventNameWidth (evName, desc, evs) =+    let getText (Comment s) = s+        getText (Verbatim s) = s+    in padTo width (T.intercalate ", " $ getText <$> evs) <> " " <>+       padTo eventNameWidth (getText evName) <> " " <>+       desc++padTo :: Int -> T.Text -> T.Text+padTo n s = s <> T.replicate (n - T.length s) " "++mkKeybindEventSectionHelp :: (Ord k)+                          => KeyConfig k+                          -> ((TextHunk, T.Text, [TextHunk]) -> a)+                          -> ([a] -> a)+                          -> [KeyEventHandler k m]+                          -> a+mkKeybindEventSectionHelp kc mkKeybindHelpFunc vertCat kbs =+  vertCat $ mkKeybindHelpFunc <$> (mkKeybindEventHelp kc <$> kbs)++keybindEventHelpMarkdown :: (TextHunk, T.Text, [TextHunk]) -> T.Text+keybindEventHelpMarkdown (evName, desc, evs) =+    let quote s = "`" <> s <> "`"+        format (Comment s) = s+        format (Verbatim s) = quote s+        name = case evName of+            Comment s -> s+            Verbatim s -> quote s+    in "| " <> (T.intercalate ", " $ format <$> evs) <>+       " | " <> name <>+       " | " <> desc <>+       " |"++mkKeybindEventHelp :: (Ord k)+                   => KeyConfig k+                   -> KeyEventHandler k m+                   -> (TextHunk, T.Text, [TextHunk])+mkKeybindEventHelp kc h =+  let trig = kehEventTrigger h+      unbound = [Comment "(unbound)"]+      (label, evText) = case trig of+          ByKey b ->+              (Comment "(non-customizable key)", [Verbatim $ ppBinding b])+          ByEvent ev ->+              let name = maybe (Comment "(unnamed)") Verbatim $ keyEventName (keyConfigEvents kc) ev+              in case lookupKeyConfigBindings kc ev of+                  Nothing ->+                      if not (null (allDefaultBindings kc ev))+                      then (name, Verbatim <$> ppBinding <$> allDefaultBindings kc ev)+                      else (name, unbound)+                  Just Unbound ->+                      (name, unbound)+                  Just (BindingList bs) ->+                      let result = if not (null bs)+                                   then Verbatim <$> ppBinding <$> bs+                                   else unbound+                      in (name, result)+  in (label, handlerDescription $ kehHandler h, evText)++-- | Build a 'Widget' displaying key binding information for a single+-- related group of event handlers. This is provided for convenience+-- so that basic help text for the application's event handlers can be+-- produced and embedded in the UI.+--+-- The resulting widget lists the key events (and keys) bound to the+-- specified handlers, along with the events' names and the list of+-- available key bindings for each handler.+keybindingHelpWidget :: (Ord k)+                     => KeyConfig k+                     -- ^ The key binding configuration in use.+                     -> [KeyEventHandler k m]+                     -- ^ The list of the event handlers to include in+                     -- the help display.+                     -> Widget n+keybindingHelpWidget kc =+    withDefAttr keybindingHelpBaseAttr .+    mkKeybindEventSectionHelp kc keybindEventHelpWidget (vBox . intersperse (str " "))++keybindEventHelpWidget :: (TextHunk, T.Text, [TextHunk]) -> Widget n+keybindEventHelpWidget (evName, desc, evs) =+    let evText = T.intercalate ", " (getText <$> evs)+        getText (Comment s) = s+        getText (Verbatim s) = s+        label = withDefAttr eventNameAttr $ case evName of+            Comment s -> txt s+            Verbatim s -> txt s+    in vBox [ withDefAttr eventDescriptionAttr $ txt desc+            , label <+> txt " = " <+> withDefAttr keybindingAttr (txt evText)+            ]++-- | Pretty-print a 'Binding' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppBinding :: Binding -> T.Text+ppBinding (Binding k mods) =+    T.intercalate "-" $ (ppModifier <$> modifierList mods) <> [ppKey k]++modifierList :: S.Set Vty.Modifier -> [Vty.Modifier]+modifierList = sort . S.toList++-- | Pretty-print a 'Binding' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'; if no binding is given,+-- produce a message indicating no binding.+ppMaybeBinding :: Maybe Binding -> T.Text+ppMaybeBinding Nothing =+    "(no binding)"+ppMaybeBinding (Just b) =+    ppBinding b++-- | Pretty-print a 'Vty.Key' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppKey :: Vty.Key -> T.Text+ppKey (Vty.KChar c)   = ppChar c+ppKey (Vty.KFun n)    = "F" <> (T.pack $ show n)+ppKey Vty.KBackTab    = "BackTab"+ppKey Vty.KEsc        = "Esc"+ppKey Vty.KBS         = "Backspace"+ppKey Vty.KEnter      = "Enter"+ppKey Vty.KUp         = "Up"+ppKey Vty.KDown       = "Down"+ppKey Vty.KLeft       = "Left"+ppKey Vty.KRight      = "Right"+ppKey Vty.KHome       = "Home"+ppKey Vty.KEnd        = "End"+ppKey Vty.KPageUp     = "PgUp"+ppKey Vty.KPageDown   = "PgDown"+ppKey Vty.KDel        = "Del"+ppKey Vty.KUpLeft     = "UpLeft"+ppKey Vty.KUpRight    = "UpRight"+ppKey Vty.KDownLeft   = "DownLeft"+ppKey Vty.KDownRight  = "DownRight"+ppKey Vty.KCenter     = "Center"+ppKey Vty.KPrtScr     = "PrintScreen"+ppKey Vty.KPause      = "Pause"+ppKey Vty.KIns        = "Insert"+ppKey Vty.KBegin      = "Begin"+ppKey Vty.KMenu       = "Menu"++-- | Pretty-print a character in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppChar :: Char -> T.Text+ppChar '\t' = "Tab"+ppChar ' '  = "Space"+ppChar c    = T.singleton c++-- | Pretty-print a 'Vty.Modifier' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppModifier :: Vty.Modifier -> T.Text+ppModifier Vty.MMeta  = "M"+ppModifier Vty.MAlt   = "A"+ppModifier Vty.MCtrl  = "C"+ppModifier Vty.MShift = "S"++-- | The base attribute for 'Widget' keybinding help.+keybindingHelpBaseAttr :: AttrName+keybindingHelpBaseAttr = attrName "keybindingHelp"++-- | The attribute for event names in keybinding help 'Widget's.+eventNameAttr :: AttrName+eventNameAttr = keybindingHelpBaseAttr <> attrName "eventName"++-- | The attribute for event descriptions in keybinding help 'Widget's.+eventDescriptionAttr :: AttrName+eventDescriptionAttr = keybindingHelpBaseAttr <> attrName "eventDescription"++-- | The attribute for keybinding lists in keybinding help 'Widget's.+keybindingAttr :: AttrName+keybindingAttr = keybindingHelpBaseAttr <> attrName "keybinding"
src/Brick/Main.hs view
@@ -1,15 +1,26 @@+{-# 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+  , clickedExtent+  , getVtyHandle    -- ** Viewport scrolling   , viewportScroll@@ -22,24 +33,37 @@   , hScrollPage   , hScrollToBeginning   , hScrollToEnd+  , setTop+  , setLeft    -- * Cursor management functions   , neverShowCursor   , showFirstCursor   , showCursorNamed++  -- * Rendering cache management+  , invalidateCacheEntry+  , invalidateCache++  -- * Renderer internals (for benchmarking)+  , renderFinal+  , getRenderState+  , resetRenderState+  , renderWidget   ) where -import Control.Exception (finally)-import Control.Lens ((^.))-import Control.Monad (forever)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State-import Control.Monad.Trans.Reader-import Control.Concurrent (forkIO, Chan, newChan, readChan, writeChan, killThread)-import Data.Default+import qualified Control.Exception as E+import Lens.Micro ((^.), (&), (.~), (%~), _1, _2)+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader+import Control.Concurrent (forkIO, killThread)+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 import Graphics.Vty   ( Vty   , Picture(..)@@ -50,26 +74,36 @@   , displayBounds   , shutdown   , nextEvent-  , mkVty+  , restoreInputState+  , inputIface   )+import Graphics.Vty.CrossPlatform (mkVty)+import Graphics.Vty.Config (defaultConfig)+import Graphics.Vty.Attributes (defAttr) -import Brick.Types (Viewport, Direction, Widget, rowL, columnL, CursorLocation(..), cursorLocationNameL, Name(..), EventM)-import Brick.Types.Internal (ScrollRequest(..), RenderState(..), Next(..))-import Brick.Widgets.Internal (renderFinal)+import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan)+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' and an application event type 'e'. In the simplest case 'e' is--- vty's 'Event' type, but you may define your own event type, permitted--- that it has a constructor for wrapping Vty events, so that Vty events--- can be handled by your event loop.-data App s e =-    App { appDraw :: s -> [Widget]+-- 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         -- widget layers. The layers are listed topmost first.-        , appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation+        , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)         -- ^ This function chooses which of the zero or more cursor         -- locations reported by the rendering process should be         -- selected as the one to use to place the cursor. If this@@ -77,228 +111,555 @@         -- 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 -> e -> EventM (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 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.         , appAttrMap :: s -> AttrMap         -- ^ The attribute map that should be used during rendering.-        , appLiftVtyEvent :: Event -> e-        -- ^ The event constructor to use to wrap Vty events in your own-        -- event type. For example, if the application's event type is-        -- 'Event', this is just 'id'.         }  -- | The default main entry point which takes an application and an--- initial state and returns the final state returned by a 'halt'--- operation.-defaultMain :: App s Event+-- initial state and returns the final state from 'EventM' once the+-- program exits.+defaultMain :: (Ord n)+            => App s e n             -- ^ The application.             -> s             -- ^ The initial application state.             -> IO s defaultMain app st = do-    chan <- newChan-    customMain (mkVty def) chan 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 -- resize events cause redraws.-simpleMain :: Widget+simpleMain :: (Ord n)+           => Widget n            -- ^ The widget to draw.            -> IO ()-simpleMain w =-    let app = App { appDraw = const [w]-                  , appHandleEvent = resizeOrQuit-                  , appStartEvent = return-                  , appAttrMap = def-                  , appLiftVtyEvent = id-                  , appChooseCursor = neverShowCursor-                  }-    in defaultMain app ()+simpleMain w = defaultMain (simpleApp w) () +-- | A simple application with reasonable defaults to be overridden as+-- desired:+--+-- * Draws only the specified widget+-- * Quits on any event other than resizes+-- * Has no start event handler+-- * Provides no attribute map+-- * Never shows any cursors+simpleApp :: Widget n -> App s e n+simpleApp w =+    App { appDraw = const [w]+        , appHandleEvent = resizeOrQuit+        , appStartEvent = return ()+        , appAttrMap = const $ attrMap defAttr []+        , appChooseCursor = neverShowCursor+        }+ -- | An event-handling function which continues execution of the event -- loop only when resize events occur; all other types of events trigger -- a halt. This is a convenience function useful as an 'appHandleEvent' -- value for simple applications using the 'Event' type that do not need -- to get more sophisticated user input.-resizeOrQuit :: s -> Event -> EventM (Next s)-resizeOrQuit s (EvResize _ _) = continue s-resizeOrQuit s _ = halt s+resizeOrQuit :: BrickEvent n e -> EventM n s ()+resizeOrQuit (VtyEvent (EvResize _ _)) = return ()+resizeOrQuit _ = halt -data InternalNext a = InternalSuspendAndResume RenderState (IO a)-                    | InternalHalt a+readBrickEvent :: BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e)+readBrickEvent brickChan userChan = either id AppEvent <$> readBChan2 brickChan userChan -runWithNewVty :: IO Vty -> Chan e -> App s e -> RenderState -> s -> IO (InternalNext s)-runWithNewVty buildVty chan app initialRS initialSt = do-    withVty buildVty $ \vty -> do-        pid <- forkIO $ supplyVtyEvents vty (appLiftVtyEvent app) chan-        let runInner rs st = do-              (result, newRS) <- runVty vty chan app st rs-              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.-customMain :: 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.-           -> Chan e+-- 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)+           => 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).-           -> App s e+           -- 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-customMain buildVty chan app initialAppState = do-    let run rs st = do-            result <- runWithNewVty buildVty chan app rs st-            case result of-                InternalHalt s -> return s-                InternalSuspendAndResume newRS action -> do-                    newAppState <- action-                    run newRS newAppState+customMain initialVty buildVty mUserChan app initialAppState = do+    let restoreInitialState = restoreInputState $ inputIface initialVty -    (st, initialScrollReqs) <- runStateT (runReaderT (appStartEvent app initialAppState) M.empty) []-    let initialRS = RS M.empty initialScrollReqs-    run initialRS st+    (s, vty) <- customMainWithVty initialVty buildVty mUserChan app initialAppState+        `E.catch` (\(e::E.SomeException) -> restoreInitialState >> E.throw e) -supplyVtyEvents :: Vty -> (Event -> e) -> Chan e -> IO ()-supplyVtyEvents vty mkEvent chan =-    forever $ do-        e <- nextEvent vty-        writeChan chan $ mkEvent e+    shutdown vty+    restoreInitialState+    return s -runVty :: Vty -> Chan e -> App s e -> s -> RenderState -> IO (Next s, RenderState)-runVty vty chan app appState rs = do-    firstRS <- renderApp vty app appState rs-    e <- readChan chan-    (next, scrollReqs) <- runStateT (runReaderT (appHandleEvent app appState e) (viewportMap rs)) []-    return (next, firstRS { scrollRequests = scrollReqs })+-- | 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+    vtyCtx <- newVtyContext buildVty (Just initialVty) (writeBChan brickChan . VtyEvent)++    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)+       => VtyContext+       -> IO (BrickEvent n e)+       -> App s e n+       -> s+       -> RenderState n+       -> [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+        -- If the event was a resize, redraw the UI to update the+        -- viewport states before we invoke the event handler since we+        -- want the event handler to have access to accurate viewport+        -- information.+        VtyEvent (EvResize _ _) -> do+            (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)) _:_) ->+                    -- If the clicked extent was registered as+                    -- clickable, send a click event. Otherwise, just+                    -- send the raw mouse event+                    if n `elem` firstRS^.clickableNamesL+                    then do+                        let localCoords = Location (lc, lr)+                            lc = c - ec+                            lr = r - er++                            -- If the clicked extent was a viewport,+                            -- adjust the local coordinates by+                            -- adding the viewport upper-left corner+                            -- offset.+                            newCoords = case M.lookup n (viewportMap firstRS) of+                              Nothing -> localCoords+                              Just vp -> localCoords & _1 %~ (+ (vp^.vpLeft))+                                                     & _2 %~ (+ (vp^.vpTop))++                        return (MouseDown n button mods newCoords, firstRS, exts)+                    else return (e, firstRS, exts)+                _ -> return (e, firstRS, exts)+        VtyEvent (EvMouseUp c r button) -> do+            let matching = findClickedExtents_ (c, r) exts+            case matching of+                (Extent n (Location (ec, er)) _:_) ->+                    -- If the clicked extent was registered as+                    -- clickable, send a click event. Otherwise, just+                    -- send the raw mouse event+                    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 mempty Continue vtyCtx+        eventRO = EventRO (viewportMap nextRS) nextExts 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 =+    if InvalidateEntire `S.member` ns+    then mempty+    else foldr (.) id (mkFunc <$> F.toList ns) cache+    where+        mkFunc InvalidateEntire = const mempty+        mkFunc (InvalidateSingle n) = M.delete n+ -- | Given a viewport name, get the viewport's size and offset -- information from the most recent rendering. Returns 'Nothing' if -- no such state could be found, either because the name was invalid -- or because no rendering has occurred (e.g. in an 'appStartEvent'--- handler).-lookupViewport :: Name -> EventM (Maybe Viewport)-lookupViewport = asks . M.lookup+-- 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) -withVty :: IO Vty -> (Vty -> IO a) -> IO a-withVty buildVty useVty = do-    vty <- buildVty-    useVty vty `finally` shutdown vty+-- | 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)) =+   c >= lc && c < (lc + w) &&+   r >= lr && r < (lr + h) -renderApp :: Vty -> App s e -> s -> RenderState -> IO RenderState-renderApp vty app appState rs = do-    sz <- displayBounds $ outputIface vty-    let (newRS, pic, theCursor) = renderFinal (appAttrMap app appState)-                                    (appDraw app appState)-                                    sz-                                    (appChooseCursor app appState)-                                    rs+-- | Given a resource name, get the most recent rendering extent for the+-- name (if any).+lookupExtent :: (Eq n) => n -> EventM n s (Maybe (Extent n))+lookupExtent n = EventM $ asks (find f . latestExtents)+    where+        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 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 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 s ()+invalidateCacheEntry n = EventM $ do+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })++-- | Invalidate the entire rendering cache.+invalidateCache :: (Ord n) => EventM n s ()+invalidateCache = EventM $ do+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s })++getRenderState :: EventM n s (RenderState n)+getRenderState = EventM $ asks oldState++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+                                        (appChooseCursor app appState)+                                        rs         picWithCursor = case theCursor of             Nothing -> pic { picCursor = NoCursor }-            Just loc -> pic { picCursor = Cursor (loc^.columnL) (loc^.rowL) }+            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+    return (newRS, exts)  -- | Ignore all requested cursor positions returned by the rendering -- process. This is a convenience function useful as an -- 'appChooseCursor' value when a simple application has no need to -- position the cursor.-neverShowCursor :: s -> [CursorLocation] -> Maybe CursorLocation+neverShowCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) neverShowCursor = const $ const Nothing  -- | Always show the first cursor, if any, returned by the rendering -- process. This is a convenience function useful as an -- 'appChooseCursor' value when a simple program has zero or more -- widgets that advertise a cursor position.-showFirstCursor :: s -> [CursorLocation] -> Maybe CursorLocation+showFirstCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) showFirstCursor = const listToMaybe --- | Show the cursor with the specified name, if such a cursor location--- has been reported.-showCursorNamed :: Name -> [CursorLocation] -> Maybe CursorLocation+-- | Show the cursor with the specified resource name, if such a cursor+-- location has been reported.+showCursorNamed :: (Eq n) => n -> [CursorLocation n] -> Maybe (CursorLocation n) showCursorNamed name locs =-    let matches loc = loc^.cursorLocationNameL == Just name-    in listToMaybe $ filter matches locs+    let matches l = l^.cursorLocationNameL == Just name+    in find matches locs  -- | A viewport scrolling handle for managing the scroll state of -- viewports.-data ViewportScroll =-    ViewportScroll { viewportName :: Name+data ViewportScroll n =+    ViewportScroll { viewportName :: n                    -- ^ The name of the viewport to be controlled by                    -- this scrolling handle.-                   , hScrollPage :: Direction -> EventM ()+                   , hScrollPage :: forall s. Direction -> EventM n s ()                    -- ^ Scroll the viewport horizontally by one page in                    -- the specified direction.-                   , hScrollBy :: Int -> EventM ()+                   , 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 ()+                   , hScrollToBeginning :: forall s. EventM n s ()                    -- ^ Scroll horizontally to the beginning of the                    -- viewport.-                   , hScrollToEnd :: EventM ()+                   , hScrollToEnd :: forall s. EventM n s ()                    -- ^ Scroll horizontally to the end of the viewport.-                   , vScrollPage :: Direction -> EventM ()+                   , vScrollPage :: forall s. Direction -> EventM n s ()                    -- ^ Scroll the viewport vertically by one page in                    -- the specified direction.-                   , vScrollBy :: Int -> EventM ()+                   , 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 ()+                   , vScrollToBeginning :: forall s. EventM n s ()                    -- ^ Scroll vertically to the beginning of the viewport.-                   , vScrollToEnd :: EventM ()+                   , vScrollToEnd :: forall s. EventM n s ()                    -- ^ Scroll vertically to the end of the viewport.+                   , setTop :: forall s. Int -> EventM n s ()+                   -- ^ Set the top row offset of the viewport.+                   , setLeft :: forall s. Int -> EventM n s ()+                   -- ^ Set the left column offset of the viewport.                    } +addScrollRequest :: (n, ScrollRequest) -> EventM n s ()+addScrollRequest req = EventM $ do+    lift $ lift $ modify (\s -> s { esScrollRequests = req : esScrollRequests s })+ -- | Build a viewport scroller for the viewport with the specified name.-viewportScroll :: Name -> ViewportScroll+viewportScroll :: n -> ViewportScroll n viewportScroll n =-    ViewportScroll { viewportName = n-                   , hScrollPage = \dir -> lift $ modify ((n, HScrollPage dir) :)-                   , hScrollBy = \i -> lift $ modify ((n, HScrollBy i) :)-                   , hScrollToBeginning = lift $ modify ((n, HScrollToBeginning) :)-                   , hScrollToEnd = lift $ modify ((n, HScrollToEnd) :)-                   , vScrollPage = \dir -> lift $ modify ((n, VScrollPage dir) :)-                   , vScrollBy = \i -> lift $ modify ((n, VScrollBy i) :)-                   , vScrollToBeginning = lift $ modify ((n, VScrollToBeginning) :)-                   , vScrollToEnd = lift $ modify ((n, VScrollToEnd) :)+    ViewportScroll { viewportName       = n+                   , hScrollPage        = \dir -> addScrollRequest (n, HScrollPage dir)+                   , hScrollBy          = \i ->   addScrollRequest (n, HScrollBy i)+                   , hScrollToBeginning =         addScrollRequest (n, HScrollToBeginning)+                   , hScrollToEnd       =         addScrollRequest (n, HScrollToEnd)+                   , vScrollPage        = \dir -> addScrollRequest (n, VScrollPage dir)+                   , vScrollBy          = \i ->   addScrollRequest (n, VScrollBy i)+                   , vScrollToBeginning =         addScrollRequest (n, VScrollToBeginning)+                   , vScrollToEnd       =         addScrollRequest (n, VScrollToEnd)+                   , setTop             = \i ->   addScrollRequest (n, SetTop i)+                   , setLeft            = \i ->   addScrollRequest (n, SetLeft i)                    }  -- | Continue running the event loop with the specified application--- state.-continue :: s -> EventM (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 (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 (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,54 +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 Control.Lens ((.~), (&), (^.))-import Control.Monad (forM)-import qualified Data.Text as T-import Data.Text.Markup-import Data.Default (def)--import Graphics.Vty (Attr, 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 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-markup m =-    Widget Fixed Fixed $ do-      let pairs = markupToList m-      imgs <- forM pairs $ \(t, aSrc) -> do-          a <- getAttr aSrc-          return $ string a $ T.unpack t-      return $ def & imageL .~ horizCat imgs
+ src/Brick/Themes.hs view
@@ -0,0 +1,410 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}+-- | Support for representing attribute themes and loading and saving+-- theme customizations in INI-style files.+--+-- Customization files are INI-style files with two sections, both+-- optional: @"default"@ and @"other"@.+--+-- The @"default"@ section specifies three optional fields:+--+--  * @"default.fg"@ - a color specification+--  * @"default.bg"@ - a color specification+--  * @"default.style"@ - a style specification+--+-- A color specification can be any of the strings @black@, @red@,+-- @green@, @yellow@, @blue@, @magenta@, @cyan@, @white@, @brightBlack@,+-- @brightRed@, @brightGreen@, @brightYellow@, @brightBlue@,+-- @brightMagenta@, @brightCyan@, @brightWhite@, or @default@.+--+-- We also support color specifications in the common hex format @#RRGGBB@, but+-- note that this specification is lossy: terminals can only display 256 colors,+-- but hex codes can specify @256^3 = 16777216@ colors.+--+-- A style specification can be either one of the following values+-- (without quotes) or a comma-delimited list of one or more of the+-- following values (e.g. @"[bold,underline]"@) indicating that all+-- of the specified styles be used. Valid styles are @standout@,+-- @underline@, @reverseVideo@, @blink@, @dim@, @italic@,+-- @strikethrough@, and @bold@.+--+-- The @other@ section specifies for each attribute name in the theme+-- the same @fg@, @bg@, and @style@ settings as for the default+-- attribute. Furthermore, if an attribute name has multiple components,+-- the fields in the INI file should use periods as delimiters. For+-- example, if a theme has an attribute name (@attrName "foo" <> attrName "bar"@), then+-- the file may specify three fields:+--+--  * @foo.bar.fg@ - a color specification+--  * @foo.bar.bg@ - a color specification+--  * @foo.bar.style@ - a style specification+--+-- Any color or style specifications omitted from the file mean that+-- those attribute or style settings will use the theme's default value+-- instead.+--+-- Attribute names with multiple components (e.g. @attr1 <> attr2@) can+-- be referenced in customization files by separating the names with+-- a dot. For example, the attribute name @attrName "list" <> attrName "selected"@ can be+-- referenced by using the string "list.selected".+module Brick.Themes+  ( CustomAttr(..)+  , customFgL+  , customBgL+  , customStyleL++  , Theme(..)+  , newTheme+  , themeDefaultAttrL+  , themeDefaultMappingL+  , themeCustomMappingL+  , themeCustomDefaultAttrL++  , ThemeDocumentation(..)+  , themeDescriptionsL++  , themeToAttrMap+  , applyCustomizations+  , loadCustomizations+  , saveCustomizations+  , saveTheme+  )+where++import GHC.Generics (Generic)+import Graphics.Vty hiding ((<|>))+import Control.DeepSeq+import Control.Monad (forM, join)+import Control.Applicative ((<|>))+import qualified Data.Text as T+import qualified Data.Text.Read as T+import qualified Data.Text.IO as T+import qualified Data.Map as M+import qualified Data.Semigroup as Sem+import Data.Tuple (swap)+import Data.List (intercalate)+import Data.Bits ((.|.), (.&.))+import Data.Maybe (fromMaybe, isNothing, catMaybes, mapMaybe)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Foldable as F++import Data.Ini.Config++import Brick.AttrMap (AttrMap, AttrName, attrMap, attrNameComponents)+import Brick.Types.TH (suffixLenses)++import Text.Printf++-- | An attribute customization can specify which aspects of an+-- attribute to customize.+data CustomAttr =+    CustomAttr { customFg    :: Maybe (MaybeDefault Color)+               -- ^ The customized foreground, if any.+               , customBg    :: Maybe (MaybeDefault Color)+               -- ^ The customized background, if any.+               , customStyle :: Maybe Style+               -- ^ The customized style, if any.+               }+               deriving (Eq, Read, Show, Generic, NFData)++instance Sem.Semigroup CustomAttr where+    a <> b =+        CustomAttr { customFg    = customFg a    <|> customFg b+                   , customBg    = customBg a    <|> customBg b+                   , customStyle = customStyle a <|> customStyle b+                   }++instance Monoid CustomAttr where+    mempty = CustomAttr Nothing Nothing Nothing+    mappend = (Sem.<>)++-- | Documentation for a theme's attributes.+data ThemeDocumentation =+    ThemeDocumentation { themeDescriptions :: M.Map AttrName T.Text+                       -- ^ The per-attribute documentation for a theme+                       -- so e.g. documentation for theme customization+                       -- can be generated mechanically.+                       }+                       deriving (Eq, Read, Show, Generic, NFData)++-- | A theme provides a set of default attribute mappings, a default+-- attribute, and a set of customizations for the default mapping+-- and default attribute. The idea here is that the application will+-- always need to provide a complete specification of its attribute+-- mapping, but if the user wants to customize any aspect of that+-- default mapping, it can be contained here and then built into an+-- 'AttrMap' (see 'themeToAttrMap'). We keep the defaults separate+-- from customizations to permit users to serialize themes and their+-- customizations to, say, disk files.+data Theme =+    Theme { themeDefaultAttr :: Attr+          -- ^ The default attribute to use.+          , themeDefaultMapping :: M.Map AttrName Attr+          -- ^ The default attribute mapping to use.+          , themeCustomDefaultAttr :: Maybe CustomAttr+          -- ^ Customization for the theme's default attribute.+          , themeCustomMapping :: M.Map AttrName CustomAttr+          -- ^ Customizations for individual entries of the default+          -- mapping. Note that this will only affect entries in the+          -- default mapping; any attributes named here that are not+          -- present in the default mapping will not be considered.+          }+          deriving (Eq, Read, Show, Generic, NFData)++suffixLenses ''CustomAttr+suffixLenses ''Theme+suffixLenses ''ThemeDocumentation++defaultSectionName :: T.Text+defaultSectionName = "default"++otherSectionName :: T.Text+otherSectionName = "other"++-- | Create a new theme with the specified default attribute and+-- attribute mapping. The theme will have no customizations.+newTheme :: Attr -> [(AttrName, Attr)] -> Theme+newTheme def mapping =+    Theme { themeDefaultAttr       = def+          , themeDefaultMapping    = M.fromList mapping+          , themeCustomDefaultAttr = Nothing+          , themeCustomMapping     = mempty+          }++-- | Build an 'AttrMap' from a 'Theme'. This applies all customizations+-- in the returned 'AttrMap'.+themeToAttrMap :: Theme -> AttrMap+themeToAttrMap t =+    attrMap (customizeAttr (themeCustomDefaultAttr t) (themeDefaultAttr t)) customMap+    where+        customMap = F.foldr f [] (M.toList $ themeDefaultMapping t)+        f (aName, attr) mapping =+            let a' = customizeAttr (M.lookup aName (themeCustomMapping t)) attr+            in (aName, a'):mapping++customizeAttr :: Maybe CustomAttr -> Attr -> Attr+customizeAttr Nothing a = a+customizeAttr (Just c) a =+    let fg = fromMaybe (attrForeColor a) (customFg c)+        bg = fromMaybe (attrBackColor a) (customBg c)+        sty = maybe (attrStyle a) SetTo (customStyle c)+    in a { attrForeColor = fg+         , attrBackColor = bg+         , attrStyle = sty+         }++isNullCustomization :: CustomAttr -> Bool+isNullCustomization c =+    isNothing (customFg c) &&+    isNothing (customBg c) &&+    isNothing (customStyle c)++-- |  This function is lossy in the sense that we only internally support 240 colors but+-- the #RRGGBB format supports 16^3 colors.+parseColor :: T.Text -> Either String (MaybeDefault Color)+parseColor s =+    let stripped = T.strip $ T.toLower s+        normalize (t, c) = (T.toLower t, c)+    in if stripped == "default"+          then Right Default+          else case parseRGB stripped of+              Just c  -> Right (SetTo c)+              Nothing -> maybe (Left $ "Invalid color: " <> show stripped) (Right . SetTo) $+                             lookup stripped (normalize <$> swap <$> allColors)+  where+    parseRGB t = if T.head t /= '#'+                    then Nothing+                    else case mapMaybe readHex (T.chunksOf 2 (T.tail t)) of+                            [r,g,b] -> Just (rgbColor r g b)+                            _ -> Nothing++    readHex :: T.Text -> Maybe Int+    readHex t = either (const Nothing) (Just . fst) (T.hexadecimal t)++allColors :: [(Color, T.Text)]+allColors =+    [ (black, "black")+    , (red, "red")+    , (green, "green")+    , (yellow, "yellow")+    , (blue, "blue")+    , (magenta, "magenta")+    , (cyan, "cyan")+    , (white, "white")+    , (brightBlack, "brightBlack")+    , (brightRed, "brightRed")+    , (brightGreen, "brightGreen")+    , (brightYellow, "brightYellow")+    , (brightBlue, "brightBlue")+    , (brightMagenta, "brightMagenta")+    , (brightCyan, "brightCyan")+    , (brightWhite, "brightWhite")+    ]++allStyles :: [(T.Text, Style)]+allStyles =+    [ ("standout", standout)+    , ("underline", underline)+    , ("strikethrough", strikethrough)+    , ("reversevideo", reverseVideo)+    , ("blink", blink)+    , ("dim", dim)+    , ("bold", bold)+    , ("italic", italic)+    ]++parseStyle :: T.Text -> Either String Style+parseStyle s =+    let lookupStyle "" = Right Nothing+        lookupStyle n = case lookup n normalizedStyles of+            Just sty -> Right $ Just sty+            Nothing  -> Left $ T.unpack $ "Invalid style: " <> n+        stripped = T.strip $ T.toLower s+        normalize (n, a) = (T.toLower n, a)+        normalizedStyles = normalize <$> allStyles+        bracketed = "[" `T.isPrefixOf` stripped &&+                    "]" `T.isSuffixOf` stripped+        unbracketed = T.tail $ T.init stripped+        parseStyleList = do+            ss <- mapM lookupStyle $ T.strip <$> T.splitOn "," unbracketed+            return $ foldr (.|.) 0 $ catMaybes ss++    in if bracketed+       then parseStyleList+       else do+           result <- lookupStyle stripped+           case result of+               Nothing -> Left $ "Invalid style: " <> show stripped+               Just sty -> Right sty++themeParser :: Theme -> IniParser (Maybe CustomAttr, M.Map AttrName CustomAttr)+themeParser t = do+    let parseCustomAttr basename = do+          c <- CustomAttr <$> fieldMbOf (basename <> ".fg")    parseColor+                          <*> fieldMbOf (basename <> ".bg")    parseColor+                          <*> fieldMbOf (basename <> ".style") parseStyle+          return $ if isNullCustomization c then Nothing else Just c++    defCustom <- sectionMb defaultSectionName $ do+        parseCustomAttr "default"++    customMap <- sectionMb otherSectionName $ do+        catMaybes <$> (forM (M.keys $ themeDefaultMapping t) $ \an ->+            (fmap (an,)) <$> parseCustomAttr (makeFieldName $ attrNameComponents an)+            )++    return (join defCustom, M.fromList $ fromMaybe [] customMap)++-- | Apply customizations using a custom lookup function. Customizations+-- are obtained for each attribute name in the theme. Any customizations+-- already set are lost.+applyCustomizations :: Maybe CustomAttr+                    -- ^ An optional customization for the theme's+                    -- default attribute.+                    -> (AttrName -> Maybe CustomAttr)+                    -- ^ A function to obtain a customization for the+                    -- specified attribute.+                    -> Theme+                    -- ^ The theme to customize.+                    -> Theme+applyCustomizations customDefAttr lookupAttr t =+    let customMap = foldr nextAttr mempty (M.keys $ themeDefaultMapping t)+        nextAttr an m = case lookupAttr an of+            Nothing     -> m+            Just custom -> M.insert an custom m+    in t { themeCustomDefaultAttr = customDefAttr+         , themeCustomMapping = customMap+         }++-- | Load an INI file containing theme customizations. Use the specified+-- theme to determine which customizations to load. Return the specified+-- theme with customizations set. See the module documentation for the+-- theme file format.+loadCustomizations :: FilePath -> Theme -> IO (Either String Theme)+loadCustomizations path t = do+    content <- T.readFile path+    case parseIniFile content (themeParser t) of+        Left e -> return $ Left e+        Right (customDef, customMap) ->+            return $ Right $ applyCustomizations customDef (flip M.lookup customMap) t++vtyColorName :: Color -> T.Text+vtyColorName c@(Color240 n) = case color240CodeToRGB (fromIntegral n) of+    Just (r,g,b) -> T.pack (printf "#%02x%02x%02x" r g b)+    Nothing -> (error $ "Invalid color: " <> show c)+vtyColorName c =+    fromMaybe (error $ "Invalid color: " <> show c)+              (lookup c allColors)++makeFieldName :: [String] -> T.Text+makeFieldName cs = T.pack $ intercalate "." cs++serializeCustomColor :: [String] -> MaybeDefault Color -> T.Text+serializeCustomColor cs cc =+    let cName = case cc of+          Default -> "default"+          SetTo c -> vtyColorName c+          KeepCurrent -> error "serializeCustomColor does not support KeepCurrent"+    in makeFieldName cs <> " = " <> cName++serializeCustomStyle :: [String] -> Style -> T.Text+serializeCustomStyle cs s =+    let activeStyles = filter (\(_, a) -> a .&. s == a) allStyles+        styleStr = case activeStyles of+            [(single, _)] -> single+            many -> "[" <> (T.intercalate ", " $ fst <$> many) <> "]"+    in makeFieldName cs <> " = " <> styleStr++serializeCustomAttr :: [String] -> CustomAttr -> [T.Text]+serializeCustomAttr cs c =+    catMaybes [ serializeCustomColor (cs <> ["fg"]) <$> customFg c+              , serializeCustomColor (cs <> ["bg"]) <$> customBg c+              , serializeCustomStyle (cs <> ["style"]) <$> customStyle c+              ]++emitSection :: T.Text -> [T.Text] -> [T.Text]+emitSection _ [] = []+emitSection secName ls = ("[" <> secName <> "]") : ls++-- | Save an INI file containing theme customizations. Use the specified+-- theme to determine which customizations to save. See the module+-- documentation for the theme file format.+saveCustomizations :: FilePath -> Theme -> IO ()+saveCustomizations path t = do+    let defSection = fromMaybe [] $+                     serializeCustomAttr ["default"] <$> themeCustomDefaultAttr t+        mapSection = concat $ flip map (M.keys $ themeDefaultMapping t) $ \an ->+            maybe [] (serializeCustomAttr (attrNameComponents an)) $+                     M.lookup an $ themeCustomMapping t+        content = T.unlines $ (emitSection defaultSectionName defSection) <>+                              (emitSection otherSectionName mapSection)+    T.writeFile path content++-- | Save an INI file containing all attributes from the specified+-- theme. Customized attributes are saved, but if an attribute is not+-- customized, its default is saved instead. The file can later be+-- re-loaded as a customization file.+saveTheme :: FilePath -> Theme -> IO ()+saveTheme path t = do+    let defSection = serializeCustomAttr ["default"] $+                     fromMaybe (attrToCustom $ themeDefaultAttr t) (themeCustomDefaultAttr t)+        mapSection = concat $ flip map (M.toList $ themeDefaultMapping t) $ \(an, def) ->+            serializeCustomAttr (attrNameComponents an) $+                fromMaybe (attrToCustom def) (M.lookup an $ themeCustomMapping t)+        content = T.unlines $ (emitSection defaultSectionName defSection) <>+                              (emitSection otherSectionName mapSection)+    T.writeFile path content++attrToCustom :: Attr -> CustomAttr+attrToCustom a =+    CustomAttr { customFg    = Just $ attrForeColor a+               , customBg    = Just $ attrBackColor a+               , customStyle = case attrStyle a of+                   SetTo s -> Just s+                   _       -> Nothing+               }
src/Brick/Types.hs view
@@ -1,5 +1,4 @@ -- | Basic types used by this library.-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Brick.Types@@ -20,34 +19,50 @@   , vpSize   , vpTop   , vpLeft+  , vpContentSize+  , VScrollBarOrientation(..)+  , HScrollBarOrientation(..)+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , ClickableScrollbarElement(..) -  -- * Event-handling types+  -- * Event-handling types and functions   , EventM-  , Next-  , HandleEvent(..)-  , handleEventLensed+  , BrickEvent(..)+  , nestEventM+  , nestEventM'    -- * Rendering infrastructure   , RenderM   , getContext    -- ** The rendering context-  , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap)+  , Context(ctxAttrName, availWidth, availHeight, windowWidth, windowHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)   , attrL   , availWidthL   , availHeightL+  , windowWidthL+  , windowHeightL+  , ctxVScrollBarOrientationL+  , ctxVScrollBarRendererL+  , ctxHScrollBarOrientationL+  , ctxHScrollBarRendererL   , ctxAttrMapL   , ctxAttrNameL   , ctxBorderStyleL+  , ctxDynBordersL    -- ** Rendering results   , Result(..)+  , emptyResult   , lookupAttrName+  , Extent(..)    -- ** Rendering result lenses   , imageL   , cursorsL   , visibilityRequestsL+  , extentsL    -- ** Visibility requests   , VisibilityRequest(..)@@ -56,127 +71,99 @@    -- * Making lenses   , suffixLenses+  , suffixLensesWith +  -- * Dynamic borders+  , bordersL+  , DynBorder(..)+  , dbStyleL, dbAttrL, dbSegmentsL+  , BorderSegment(..)+  , bsAcceptL, bsOfferL, bsDrawL+  , Edges(..)+  , eTopL, eBottomL, eRightL, eLeftL+   -- * Miscellaneous   , Size(..)-  , Padding(..)   , Direction(..)-  , Name(..) +  -- * Renderer internals (for benchmarking)+  , RenderState++  -- * Re-exports for convenience+  , get+  , gets+  , put+  , modify+  , zoom   ) where -import Control.Lens (_1, _2, to, (^.), (&), (.~), Lens')-import Data.Monoid (Monoid(..))-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader-import Graphics.Vty (Event, Image, emptyImage, Attr)-import Data.Default (Default(..))-import Data.Functor.Contravariant-import qualified Data.Map as M+import Lens.Micro (_1, _2, to, (^.))+import Lens.Micro.Type (Getting)+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 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.---- | The class of types that provide some basic event-handling.-class HandleEvent a where-    -- | Handle a Vty event-    handleEvent :: Event -> a -> EventM a---- | 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 :: (HandleEvent b)-                  => a-                  -- ^ The state value.-                  -> Lens' a b-                  -- ^ The lens to use to extract and store the target-                  -- of the event.-                  -> Event-                  -- ^ The event to handle.-                  -> EventM a-handleEventLensed v target 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'.-type EventM a = ReaderT (M.Map Name Viewport) (StateT EventState IO) a---- | 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 =-    Widget { hSize :: Size-           -- ^ This widget's horizontal growth policy-           , vSize :: Size-           -- ^ This widget's vertical growth policy-           , render :: RenderM Result-           -- ^ 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 a = ReaderT Context (State RenderState) a---- | 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 =-    Result { image :: Image-           -- ^ The final rendered image for a widget-           , cursors :: [CursorLocation]-           -- ^ The list of reported cursor positions for the-           -- application to choose from-           , visibilityRequests :: [VisibilityRequest]-           -- ^ The list of visibility requests made by widgets rendered-           -- while rendering this one (used by viewports)-           }-           deriving Show--instance Default Result where-    def = Result emptyImage [] []+-- | 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 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-suffixLenses ''Result+    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 :: (Contravariant f, Functor f) => (Attr -> f Attr) -> Context -> f Context+attrL :: forall r n. Getting r (Context n) Attr attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL)) -instance TerminalLocation CursorLocation where-    columnL = cursorLocationL._1-    column = column . cursorLocation-    rowL = cursorLocationL._2-    row = row . cursorLocation+instance TerminalLocation (CursorLocation n) where+    locationColumnL = cursorLocationL._1+    locationColumn = locationColumn . cursorLocation+    locationRowL = cursorLocationL._2+    locationRow = locationRow . cursorLocation  -- | Given an attribute name, obtain the attribute for the attribute -- name by consulting the context's attribute map.-lookupAttrName :: AttrName -> RenderM Attr+lookupAttrName :: AttrName -> RenderM n Attr lookupAttrName n = do     c <- getContext     return $ attrMapLookup n (c^.ctxAttrMapL)
+ src/Brick/Types/Common.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE CPP #-}+module Brick.Types.Common+  ( Location(..)+  , locL+  , origin+  , Edges(..)+  , eTopL, eBottomL, eRightL, eLeftL+  ) where++import Brick.Types.TH (suffixLenses)+import qualified Data.Semigroup as Sem+import GHC.Generics+import Control.DeepSeq+import Lens.Micro (_1, _2)+#if MIN_VERSION_microlens(0,5,0)+import Lens.Micro.FieldN (Field1, Field2)+#else+import Lens.Micro.Internal (Field1, Field2)+#endif++-- | A terminal screen location.+data Location = Location { loc :: !(Int, Int)+                         -- ^ (Column, Row)+                         }+                deriving (Show, Eq, Ord, Read, Generic, NFData)++suffixLenses ''Location++instance Field1 Location Location Int Int where+    _1 = locL._1++instance Field2 Location Location Int Int where+    _2 = locL._2++-- | The origin (upper-left corner).+origin :: Location+origin = Location (0, 0)++instance Sem.Semigroup Location where+    (Location (w1, h1)) <> (Location (w2, h2)) = Location (w1+w2, h1+h2)++instance Monoid Location where+    mempty = origin+    mappend = (Sem.<>)++data Edges a = Edges { eTop, eBottom, eLeft, eRight :: !a }+    deriving (Eq, Ord, Read, Show, Functor, Generic, NFData)++suffixLenses ''Edges++instance Applicative Edges where+    pure a = Edges a a a a+    Edges ft fb fl fr <*> Edges vt vb vl vr =+        Edges (ft vt) (fb vb) (fl vl) (fr vr)++instance Monad Edges where+    Edges vt vb vl vr >>= f = Edges+        (eTop    (f vt))+        (eBottom (f vb))+        (eLeft   (f vl))+        (eRight  (f vr))
+ src/Brick/Types/EventM.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Brick.Types.EventM+  ( EventM(..)+  , getVtyContext+  )+where++import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif+import Control.Monad.Reader+import Control.Monad.State.Strict+import Lens.Micro.Mtl+import Lens.Micro.Mtl.Internal++import Brick.Types.Internal++-- | The monad in which event handlers run.+newtype EventM n s a =+    EventM { runEventM :: ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a+           }+           deriving ( Functor, Applicative, Monad, MonadIO+                    , MonadThrow, MonadCatch, MonadMask+#if !MIN_VERSION_base(4,13,0)+                    , MonadFail+#endif+                    )++instance MonadState s (EventM n s) where+    get = EventM $ lift get+    put = EventM . lift . put++getVtyContext :: EventM n s VtyContext+getVtyContext = EventM $ lift $ lift $ gets vtyContext++type instance Zoomed (EventM n s) = Zoomed (StateT s (StateT (EventState n) IO))++instance Zoom (EventM n s) (EventM n t) s t where+    zoom l (EventM m) = EventM (zoom l m)
src/Brick/Types/Internal.hs view
@@ -1,11 +1,13 @@+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Brick.Types.Internal   ( ScrollRequest(..)   , VisibilityRequest(..)   , vrPositionL   , vrSizeL-  , Name(..)   , Location(..)   , locL   , origin@@ -17,150 +19,447 @@   , CursorLocation(..)   , cursorLocationL   , cursorLocationNameL+  , cursorLocationVisibleL+  , VScrollBarOrientation(..)+  , HScrollBarOrientation(..)+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , ClickableScrollbarElement(..)   , Context(..)-  , EventState-  , Next(..)+  , ctxAttrMapL+  , ctxAttrNameL+  , ctxBorderStyleL+  , ctxDynBordersL+  , ctxVScrollBarOrientationL+  , ctxVScrollBarRendererL+  , ctxHScrollBarOrientationL+  , ctxHScrollBarRendererL+  , ctxVScrollBarShowHandlesL+  , ctxHScrollBarShowHandlesL+  , ctxVScrollBarClickableConstrL+  , ctxHScrollBarClickableConstrL+  , availWidthL+  , availHeightL+  , windowWidthL+  , windowHeightL -  , scrollRequestsL+  , Size(..)++  , EventState(..)+  , VtyContext(..)+  , EventRO(..)+  , NextAction(..)+  , Result(..)+  , Extent(..)+  , Edges(..)+  , eTopL, eBottomL, eRightL, eLeftL+  , BorderSegment(..)+  , bsAcceptL, bsOfferL, bsDrawL+  , DynBorder(..)+  , dbStyleL, dbAttrL, dbSegmentsL+  , CacheInvalidateRequest(..)+  , BrickEvent(..)+  , RenderM+  , getContext+  , lookupReportedExtent+  , Widget(..)++  , rsScrollRequestsL   , viewportMapL+  , clickableNamesL+  , reportedExtentsL+  , renderCacheL+  , observedNamesL+  , requestedVisibleNames_L   , vpSize   , vpLeft   , vpTop+  , vpContentSize+  , imageL+  , cursorsL+  , extentsL+  , bordersL+  , visibilityRequestsL+  , emptyResult   ) where -import Control.Lens (Field1, Field2, _1, _2, Lens', makeLenses)-import Data.String-import Data.Monoid+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 (DisplayRegion)+import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, Attr, emptyImage)+import GHC.Generics+import Control.DeepSeq (NFData) +import Brick.BorderMap (BorderMap)+import qualified Brick.BorderMap as BM+import Brick.Types.Common import Brick.Types.TH import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) --- | Names of things. Used to name cursor locations, widgets, and--- viewports.-newtype Name = Name String-             deriving (Eq, Show, Ord)--instance IsString Name where-    fromString = Name--data RenderState =-    RS { viewportMap :: M.Map Name Viewport-       , scrollRequests :: [(Name, ScrollRequest)]-       }--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+                   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+       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+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) -type EventState = [(Name, ScrollRequest)]+data CacheInvalidateRequest n =+    InvalidateSingle n+    | InvalidateEntire+    deriving (Ord, Eq) +data EventState n =+    ES { esScrollRequests :: ![(n, ScrollRequest)]+       , cacheInvalidateRequests :: !(S.Set (CacheInvalidateRequest n))+       , requestedVisibleNames :: !(S.Set n)+       , 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)+                       }+                       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+data NextAction =+    Continue+    | ContinueWithoutRedraw+    | Halt  -- | Scrolling direction. data Direction = Up                -- ^ Up/left                | Down                -- ^ Down/right---- | A terminal screen location.-data Location = Location { loc :: (Int, Int)-                         -- ^ (Column, Row)-                         }-                deriving Show--suffixLenses ''Location--instance Field1 Location Location Int Int where-    _1 = locL._1--instance Field2 Location Location Int Int where-    _2 = locL._2+               deriving (Show, Eq, Read, Generic, NFData)  -- | The class of types that behave like terminal locations. class TerminalLocation a where     -- | Get the column out of the value-    columnL :: Lens' a Int-    column :: a -> Int+    locationColumnL :: Lens' a Int+    locationColumn :: a -> Int+     -- | Get the row out of the value-    rowL :: Lens' a Int-    row :: a -> Int+    locationRowL :: Lens' a Int+    locationRow :: a -> Int  instance TerminalLocation Location where-    columnL = _1-    column (Location t) = fst t-    rowL = _2-    row (Location t) = snd t---- | The origin (upper-left corner).-origin :: Location-origin = Location (0, 0)--instance Monoid Location where-    mempty = origin-    mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)+    locationColumnL = _1+    locationColumn (Location t) = fst t+    locationRowL = _2+    locationRow (Location t) = snd t  -- | A cursor location.  These are returned by the rendering process.-data CursorLocation =+data CursorLocation n =     CursorLocation { cursorLocation :: !Location                    -- ^ The location-                   , cursorLocationName :: !(Maybe Name)+                   , cursorLocationName :: !(Maybe n)                    -- ^ The name of the widget associated with the location+                   , cursorLocationVisible :: !Bool+                   -- ^ Whether the cursor should actually be visible                    }-                   deriving Show+                   deriving (Read, Show, Generic, NFData) +-- | A border character has four segments, one extending in each direction+-- (horizontally and vertically) from the center of the character.+data BorderSegment = BorderSegment+    { bsAccept :: !Bool+    -- ^ Would this segment be willing to be drawn if a neighbor wanted to+    -- connect to it?+    , bsOffer :: !Bool+    -- ^ Does this segment want to connect to its neighbor?+    , bsDraw :: !Bool+    -- ^ Should this segment be represented visually?+    } deriving (Eq, Ord, Read, Show, Generic, NFData)++-- | Information about how to redraw a dynamic border character when it abuts+-- another dynamic border character.+data DynBorder = DynBorder+    { dbStyle :: !BorderStyle+    -- ^ The 'Char's to use when redrawing the border. Also used to filter+    -- connections: only dynamic borders with equal 'BorderStyle's will connect+    -- to each other.+    , dbAttr :: !Attr+    -- ^ What 'Attr' to use to redraw the border character. Also used to filter+    -- connections: only dynamic borders with equal 'Attr's will connect to+    -- each other.+    , dbSegments :: !(Edges BorderSegment)+    } deriving (Eq, Read, Show, Generic, NFData)++-- | The type of result returned by a widget's rendering function. The+-- result provides the image, cursor positions, and visibility requests+-- that resulted from the rendering process.+data Result n =+    Result { image :: !Image+           -- ^ The final rendered image for a widget+           , cursors :: ![CursorLocation n]+           -- ^ The list of reported cursor positions for the+           -- application to choose from+           , visibilityRequests :: ![VisibilityRequest]+           -- ^ The list of visibility requests made by widgets rendered+           -- while rendering this one (used by viewports)+           , extents :: ![Extent n]+           -- Programmer's note: we don't try to maintain the invariant that+           -- the size of the borders closely matches the size of the 'image'+           -- field. Most widgets don't need to care about borders, and so they+           -- use the empty 'BorderMap' that has a degenerate rectangle. Only+           -- border-drawing widgets and the hbox/vbox stuff try to set this+           -- carefully. Even then, in the boxes, we only make sure that the+           -- 'BorderMap' is no larger than the entire concatenation of boxes,+           -- and it's certainly possible for it to be smaller. (Resizing+           -- 'BorderMap's is lossy, so we try to do it as little as possible.)+           -- If you're writing a widget, this should make it easier for you to+           -- do so; but beware this lack of invariant if you are consuming+           -- widgets.+           , borders :: !(BorderMap DynBorder)+           -- ^ Places where we may rewrite the edge of the image when+           -- placing this widget next to another one.+           }+           deriving (Show, Read, Generic, NFData)++emptyResult :: Result n+emptyResult =+    Result { image = emptyImage+           , cursors = []+           , visibilityRequests = []+           , extents = []+           , borders = BM.empty+           }++-- | The type of events.+data BrickEvent n e = VtyEvent !Event+                    -- ^ The event was a Vty event.+                    | AppEvent !e+                    -- ^ The event was an application event.+                    | 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+                    -- ^ 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 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 bordring style should be used, and the attribute map+-- to render, which bordering style should be used, and the attribute map -- available for rendering.-data Context =-    Context { ctxAttrName :: AttrName-            , availWidth :: Int-            , availHeight :: Int-            , ctxBorderStyle :: BorderStyle-            , ctxAttrMap :: AttrMap+data Context n =+    Context { ctxAttrName :: !AttrName+            , availWidth :: !Int+            , availHeight :: !Int+            , windowWidth :: !Int+            , windowHeight :: !Int+            , ctxBorderStyle :: !BorderStyle+            , ctxAttrMap :: !AttrMap+            , ctxDynBorders :: !Bool+            , ctxVScrollBarOrientation :: !(Maybe VScrollBarOrientation)+            , ctxVScrollBarRenderer :: !(Maybe (VScrollbarRenderer n))+            , ctxHScrollBarOrientation :: !(Maybe HScrollBarOrientation)+            , ctxHScrollBarRenderer :: !(Maybe (HScrollbarRenderer n))+            , ctxVScrollBarShowHandles :: !Bool+            , ctxHScrollBarShowHandles :: !Bool+            , ctxVScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n))+            , ctxHScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n))             }  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,18 +1,25 @@ module Brick.Types.TH   ( suffixLenses+  , suffixLensesWith   ) where  import qualified Language.Haskell.TH.Syntax as TH import qualified Language.Haskell.TH.Lib as TH -import Control.Lens (DefName(..), makeLensesWith, lensRules, (&), (.~), lensField)+import Lens.Micro ((&), (.~))+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 Control.Lens ((&), (%~))+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,10 +53,15 @@ 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 -> Location -> CursorLocation+clOffset :: CursorLocation n -> Location -> CursorLocation n clOffset cl off = cl & cursorLocationL %~ (<> off)
src/Brick/Widgets/Border.hs view
@@ -18,98 +18,89 @@   -- * Drawing single border elements   , borderElem -  -- * Border attribute names+  -- * Attribute names   , borderAttr-  , vBorderAttr   , hBorderAttr-  , hBorderLabelAttr-  , tlCornerAttr-  , trCornerAttr-  , blCornerAttr-  , brCornerAttr+  , vBorderAttr++  -- * Utility+  , joinableBorder   ) where -import Control.Applicative ((<$>))-import Control.Lens ((^.), to)+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))+#endif+import Lens.Micro ((^.), (&), (.~), to) import Graphics.Vty (imageHeight, imageWidth)  import Brick.AttrMap import Brick.Types import Brick.Widgets.Core-import Brick.Widgets.Center (hCenterWith) import Brick.Widgets.Border.Style (BorderStyle(..))+import Brick.Widgets.Internal (renderDynBorder)+import Data.IMap (Run(..))+import qualified Brick.BorderMap as BM  -- | The top-level border attribute name. borderAttr :: AttrName-borderAttr = "border"---- | The vertical border attribute name.-vBorderAttr :: AttrName-vBorderAttr = borderAttr <> "vertical"+borderAttr = attrName "border" --- | The horizontal border attribute name.+-- | The horizontal border attribute name. Inherits from 'borderAttr'. hBorderAttr :: AttrName-hBorderAttr = borderAttr <> "horizontal"---- | The attribute used for horizontal border labels.-hBorderLabelAttr :: AttrName-hBorderLabelAttr = hBorderAttr <> "label"---- | The attribute used for border box top-left corners.-tlCornerAttr :: AttrName-tlCornerAttr = borderAttr <> "corner" <> "tl"---- | The attribute used for border box top-right corners.-trCornerAttr :: AttrName-trCornerAttr = borderAttr <> "corner" <> "tr"---- | The attribute used for border box bottom-left corners.-blCornerAttr :: AttrName-blCornerAttr = borderAttr <> "corner" <> "bl"+hBorderAttr = borderAttr <> attrName "horizontal" --- | The attribute used for border box bottom-right corners.-brCornerAttr :: AttrName-brCornerAttr = borderAttr <> "corner" <> "br"+-- | The vertical border attribute name. Inherits from 'borderAttr'.+vBorderAttr :: AttrName+vBorderAttr = borderAttr <> attrName "vertical"  -- | Draw the specified border element using the active border style -- using 'borderAttr'.-borderElem :: (BorderStyle -> Char) -> Widget+--+-- Does not participate in dynamic borders (due to the difficulty of+-- introspecting on the first argument); consider using 'joinableBorder'+-- instead.+borderElem :: (BorderStyle -> Char) -> Widget n borderElem f =     Widget Fixed Fixed $ do       bs <- ctxBorderStyle <$> getContext       render $ withAttr borderAttr $ str [f bs]  -- | Put a border around the specified widget.-border :: Widget -> Widget+border :: Widget n -> Widget n border = border_ Nothing  -- | Put a border around the specified widget with the specified label -- widget placed in the middle of the top horizontal border.-borderWithLabel :: Widget+--+-- Note that a border will wrap its child widget as tightly as possible,+-- which means that if the child widget is narrower than the label+-- widget, the label widget will be truncated. If you want to avoid+-- this behavior, add a 'fill' or other space-filling wrapper to the+-- bordered widget so that it takes up enough room to make the border+-- horizontally able to avoid truncating the label.+borderWithLabel :: Widget n                 -- ^ The label widget-                -> Widget+                -> Widget n                 -- ^ The widget to put a border around-                -> Widget+                -> Widget n borderWithLabel label = border_ (Just label) -border_ :: Maybe Widget -> Widget -> Widget+border_ :: Maybe (Widget n) -> Widget n -> Widget n border_ label wrapped =     Widget (hSize wrapped) (vSize wrapped) $ do-      bs <- ctxBorderStyle <$> getContext       c <- getContext        middleResult <- render $ hLimit (c^.availWidthL - 2)                              $ vLimit (c^.availHeightL - 2)                              $ wrapped -      let top = (withAttr tlCornerAttr $ str [bsCornerTL bs])-                <+> hBorder_ label <+>-                (withAttr trCornerAttr $ str [bsCornerTR bs])-          bottom = (withAttr blCornerAttr $ str [bsCornerBL bs])-                   <+> hBorder <+>-                   (withAttr brCornerAttr $ str [bsCornerBR bs])+      let tl = joinableBorder (Edges False True False True)+          tr = joinableBorder (Edges False True True False)+          bl = joinableBorder (Edges True False False True)+          br = joinableBorder (Edges True False True False)+          top = tl <+> maybe hBorder hBorderWithLabel label <+> tr+          bottom = bl <+> hBorder <+> br           middle = vBorder <+> (Widget Fixed Fixed $ return middleResult) <+> vBorder           total = top <=> middle <=> bottom @@ -117,27 +108,76 @@              $ vLimit (middleResult^.imageL.to imageHeight + 2)              $ total --- | A horizontal border.  Fills all horizontal space.-hBorder :: Widget-hBorder = hBorder_ Nothing+-- | A horizontal border. Fills all horizontal space. Draws using+-- 'hBorderAttr'.+hBorder :: Widget n+hBorder =+    withAttr borderAttr $ Widget Greedy Fixed $ do+      ctx <- getContext+      let bs = ctxBorderStyle ctx+          w = availWidth ctx+      db <- dynBorderFromDirections (Edges False False True True)+      let dynBorders = BM.insertH mempty (Run w db)+                     $ BM.emptyCoordinates (Edges 0 0 0 (w-1))+      setDynBorders dynBorders $ render $ withAttr hBorderAttr+                               $ vLimit 1 $ fill (bsHorizontal bs)  -- | A horizontal border with a label placed in the center of the -- border. Fills all horizontal space.-hBorderWithLabel :: Widget+hBorderWithLabel :: Widget n                  -- ^ The label widget-                 -> Widget-hBorderWithLabel label = hBorder_ (Just label)--hBorder_ :: Maybe Widget -> Widget-hBorder_ label =+                 -> Widget n+hBorderWithLabel label =     Widget Greedy Fixed $ do-      bs <- ctxBorderStyle <$> getContext-      let msg = maybe (str [bsHorizontal bs]) (withAttr hBorderLabelAttr) label-      render $ vLimit 1 $ withAttr hBorderAttr $ hCenterWith (Just $ bsHorizontal bs) msg+      res <- render $ vLimit 1 label+      render $ hBox [hBorder, Widget Fixed Fixed (return res), hBorder] --- | A vertical border.  Fills all vertical space.-vBorder :: Widget+-- | A vertical border. Fills all vertical space. Draws using+-- 'vBorderAttr'.+vBorder :: Widget n vBorder =-    Widget Fixed Greedy $ do-      bs <- ctxBorderStyle <$> getContext-      render $ hLimit 1 $ withAttr vBorderAttr $ fill (bsVertical bs)+    withAttr borderAttr $ Widget Fixed Greedy $ do+      ctx <- getContext+      let bs = ctxBorderStyle ctx+          h = availHeight ctx+      db <- dynBorderFromDirections (Edges True True False False)+      let dynBorders = BM.insertV mempty (Run h db)+                     $ BM.emptyCoordinates (Edges 0 (h-1) 0 0)+      setDynBorders dynBorders $ render $ withAttr vBorderAttr+                               $ hLimit 1 $ fill (bsVertical bs)++-- | Initialize a 'DynBorder'. It will be 'bsDraw'n and 'bsOffer'ing+-- in the given directions to begin with, and accept join offers from+-- all directions. We consult the context to choose the 'dbStyle' and+-- 'dbAttr'.+--+-- This is likely to be useful only for custom widgets that need more+-- complicated dynamic border behavior than 'border', 'vBorder', or+-- 'hBorder' offer.+dynBorderFromDirections :: Edges Bool -> RenderM n DynBorder+dynBorderFromDirections dirs = do+    ctx <- getContext+    return DynBorder+        { dbStyle = ctxBorderStyle ctx+        , dbAttr = attrMapLookup (ctxAttrName ctx) (ctxAttrMap ctx)+        , dbSegments = (\draw -> BorderSegment True draw draw) <$> dirs+        }++-- | Replace the 'Result'\'s dynamic borders with the given one,+-- provided the context says to use dynamic borders at all.+setDynBorders :: BM.BorderMap DynBorder -> RenderM n (Result n) -> RenderM n (Result n)+setDynBorders newBorders act = do+    dyn <- ctxDynBorders <$> getContext+    res <- act+    return $ if dyn+        then res & bordersL .~ newBorders+        else res++-- | A single-character dynamic border that will react to neighboring+-- borders, initially connecting in the given directions.+joinableBorder :: Edges Bool -> Widget n+joinableBorder dirs = withAttr borderAttr . Widget Fixed Fixed $ do+    db <- dynBorderFromDirections dirs+    setDynBorders+        (BM.singleton mempty db)+        (render (raw (renderDynBorder db)))
src/Brick/Widgets/Border/Style.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} -- | This module provides styles for borders as used in terminal -- applications. Your mileage may vary on some of the fancier styles -- due to varying support for some border characters in the fonts your@@ -8,8 +9,7 @@ -- -- To use these in your widgets, see -- 'Brick.Widgets.Core.withBorderStyle'. By default, widgets rendered--- without a specified border style use 'unicode' via the 'Default'--- instance provided by 'BorderStyle'.+-- without a specified border style use 'unicode' style. module Brick.Widgets.Border.Style   ( BorderStyle(..)   , borderStyleFromChar@@ -17,10 +17,12 @@   , unicode   , unicodeBold   , unicodeRounded+  , defaultBorderStyle   ) where -import Data.Default+import GHC.Generics+import Control.DeepSeq  -- | A border style for use in any widget that needs to render borders -- in a consistent style.@@ -48,10 +50,10 @@                 , bsVertical :: Char                 -- ^ Vertical border character                 }-                deriving (Show, Read)+                deriving (Show, Read, Eq, Generic, NFData) -instance Default BorderStyle where-    def = unicode+defaultBorderStyle :: BorderStyle+defaultBorderStyle = unicode  -- | Make a border style using the specified character everywhere. borderStyleFromChar :: Char -> BorderStyle
src/Brick/Widgets/Center.hs view
@@ -3,42 +3,66 @@   ( -- * Centering horizontally     hCenter   , hCenterWith+  , hCenterLayer   -- * Centering vertically   , vCenter   , vCenterWith+  , vCenterLayer   -- * Centering both horizontally and vertically   , center   , centerWith+  , centerLayer   -- * Centering about an arbitrary origin   , centerAbout   ) where -import Control.Lens ((^.), (&), (.~), to)-import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat)+import Lens.Micro ((^.), (&), (.~), to)+import Data.Maybe (fromMaybe)+import Graphics.Vty (imageWidth, imageHeight, horizCat, charFill, vertCat,+                    translateX, translateY)  import Brick.Types import Brick.Widgets.Core  -- | Center the specified widget horizontally. Consumes all available -- horizontal space.-hCenter :: Widget -> Widget+hCenter :: Widget n -> Widget n hCenter = hCenterWith Nothing +-- | Center the specified widget horizontally using a Vty image+-- translation. Consumes all available horizontal space. Unlike hCenter,+-- this does not fill the surrounding space so it is suitable for use+-- as a layer. Layers underneath this widget will be visible in regions+-- surrounding the centered widget.+hCenterLayer :: Widget n -> Widget n+hCenterLayer p =+    Widget Greedy (vSize p) $ do+        result <- render p+        c <- getContext+        let rWidth = result^.imageL.to imageWidth+            leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2+            paddedImage = translateX leftPaddingAmount $ result^.imageL+            off = Location (leftPaddingAmount, 0)+        if leftPaddingAmount == 0 then+            return result else+            return $ addResultOffset off+                   $ result & imageL .~ paddedImage+ -- | Center the specified widget horizontally. Consumes all available -- horizontal space. Uses the specified character to fill in the space -- to either side of the centered widget (defaults to space).-hCenterWith :: Maybe Char -> Widget -> Widget+hCenterWith :: Maybe Char -> Widget n -> Widget n hCenterWith mChar p =-    let ch = maybe ' ' id mChar+    let ch = fromMaybe ' ' mChar     in Widget Greedy (vSize p) $ do            result <- render p            c <- getContext            let rWidth = result^.imageL.to imageWidth                rHeight = result^.imageL.to imageHeight-               remainder = c^.availWidthL - (leftPaddingAmount * 2)-               leftPaddingAmount = (c^.availWidthL - rWidth) `div` 2-               rightPaddingAmount = leftPaddingAmount + remainder+               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                rightPadding = charFill (c^.attrL) ch rightPaddingAmount rHeight                paddedImage = horizCat [ leftPadding@@ -52,23 +76,42 @@                       $ result & imageL .~ paddedImage  -- | Center a widget vertically.  Consumes all vertical space.-vCenter :: Widget -> Widget+vCenter :: Widget n -> Widget n vCenter = vCenterWith Nothing +-- | Center the specified widget vertically using a Vty image+-- translation. Consumes all available vertical space. Unlike vCenter,+-- this does not fill the surrounding space so it is suitable for use+-- as a layer. Layers underneath this widget will be visible in regions+-- surrounding the centered widget.+vCenterLayer :: Widget n -> Widget n+vCenterLayer p =+    Widget (hSize p) Greedy $ do+        result <- render p+        c <- getContext+        let rHeight = result^.imageL.to imageHeight+            topPaddingAmount = max 0 $ (c^.availHeightL - rHeight) `div` 2+            paddedImage = translateY topPaddingAmount $ result^.imageL+            off = Location (0, topPaddingAmount)+        if topPaddingAmount == 0 then+            return result else+            return $ addResultOffset off+                   $ result & imageL .~ paddedImage+ -- | Center a widget vertically. Consumes all vertical space. Uses the -- specified character to fill in the space above and below the centered -- widget (defaults to space).-vCenterWith :: Maybe Char -> Widget -> Widget+vCenterWith :: Maybe Char -> Widget n -> Widget n vCenterWith mChar p =-    let ch = maybe ' ' id mChar+    let ch = fromMaybe ' ' mChar     in Widget (hSize p) Greedy $ do            result <- render p            c <- getContext            let rWidth = result^.imageL.to imageWidth                rHeight = result^.imageL.to imageHeight-               remainder = c^.availHeightL - (topPaddingAmount * 2)-               topPaddingAmount = (c^.availHeightL - rHeight) `div` 2-               bottomPaddingAmount = topPaddingAmount + remainder+               remainder = max 0 $ c^.availHeightL - (topPaddingAmount * 2)+               topPaddingAmount = max 0 $ (c^.availHeightL - rHeight) `div` 2+               bottomPaddingAmount = max 0 $ topPaddingAmount + remainder                topPadding = charFill (c^.attrL) ch rWidth topPaddingAmount                bottomPadding = charFill (c^.attrL) ch rWidth bottomPaddingAmount                paddedImage = vertCat [ topPadding@@ -83,18 +126,26 @@  -- | Center a widget both vertically and horizontally. Consumes all -- available vertical and horizontal space.-center :: Widget -> Widget+center :: Widget n -> Widget n center = centerWith Nothing  -- | Center a widget both vertically and horizontally. Consumes all -- available vertical and horizontal space. Uses the specified character -- to fill in the space around the centered widget (defaults to space).-centerWith :: Maybe Char -> Widget -> Widget+centerWith :: Maybe Char -> Widget n -> Widget n centerWith c = vCenterWith c . hCenterWith c +-- | Center a widget both vertically and horizontally using a Vty image+-- translation. Consumes all available vertical and horizontal space.+-- Unlike center, this does not fill in the surrounding space with a+-- character so it is usable as a layer. Any widget underneath this one+-- will be visible in the region surrounding the centered widget.+centerLayer :: Widget n -> Widget n+centerLayer = vCenterLayer . hCenterLayer+ -- | Center the widget horizontally and vertically about the specified -- origin.-centerAbout :: Location -> Widget -> Widget+centerAbout :: Location -> Widget n -> Widget n centerAbout l p =     Widget Greedy Greedy $ do       -- Compute translation offset so that loc is in the middle of the@@ -102,7 +153,16 @@       c <- getContext       let centerW = c^.availWidthL `div` 2           centerH = c^.availHeightL `div` 2-          off = Location ( centerW - l^.columnL-                         , centerH - l^.rowL+          off = Location ( centerW - l^.locationColumnL+                         , centerH - l^.locationRowL                          )-      render $ translateBy off p+      result <- render $ translateBy off p++      -- Pad the result so it consumes available space+      let rightPaddingAmt = max 0 $ c^.availWidthL - imageWidth (result^.imageL)+          bottomPaddingAmt = max 0 $ c^.availHeightL - imageHeight (result^.imageL)+          rightPadding = charFill (c^.attrL) ' ' rightPaddingAmt (imageHeight $ result^.imageL)+          bottomPadding = charFill (c^.attrL) ' ' (imageWidth $ result^.imageL) bottomPaddingAmt+          paddedImg = horizCat [vertCat [result^.imageL, bottomPadding], rightPadding]++      return $ result & imageL .~ paddedImg
src/Brick/Widgets/Core.hs view
@@ -1,741 +1,1986 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-}--- | 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-    emptyWidget-  , raw-  , txt-  , str-  , fill--  -- * Padding-  , padLeft-  , padRight-  , padTop-  , padBottom-  , padLeftRight-  , padTopBottom-  , padAll--  -- * Box layout-  , (<=>)-  , (<+>)-  , hBox-  , vBox--  -- * Limits-  , hLimit-  , vLimit--  -- * Attribute mangement-  , withDefAttr-  , withAttr-  , forceAttr-  , updateAttrMap--  -- * Border style management-  , withBorderStyle--  -- * Cursor placement-  , showCursor--  -- * Translation-  , translateBy--  -- * Cropping-  , cropLeftBy-  , cropRightBy-  , cropTopBy-  , cropBottomBy--  -- * Scrollable viewports-  , viewport-  , visible-  , visibleRegion--  -- ** Adding offsets to cursor positions and visibility requests-  , addResultOffset--  -- ** Cropping results-  , cropToContext-  )-where--import Control.Applicative-import Control.Lens ((^.), (.~), (&), (%~), to, _1, _2, each, to, ix)-import Control.Monad (when)-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Class (lift)-import qualified Data.Text as T-import Data.Default-import Data.Monoid ((<>), mempty)-import qualified Data.Map as M-import qualified Data.Function as DF-import Data.List (sortBy, partition)-import Control.Lens (Lens')-import qualified Graphics.Vty as V-import Control.DeepSeq--import Brick.Types-import Brick.Types.Internal-import Brick.Widgets.Border.Style-import Brick.Util (clOffset, clamp)-import Brick.AttrMap-import Brick.Widgets.Internal---- | When rendering the specified widget, use the specified border style--- for any border rendering.-withBorderStyle :: BorderStyle -> Widget -> Widget-withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p)---- | The empty widget.-emptyWidget :: Widget-emptyWidget = raw V.emptyImage---- | Add an offset to all cursor locations and visbility requests--- 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 -> Result-addResultOffset off = addCursorOffset off . addVisibilityOffset off--addVisibilityOffset :: Location -> Result -> Result-addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)--addCursorOffset :: Location -> Result -> Result-addCursorOffset off r =-    let onlyVisible = filter isVisible-        isVisible l = l^.columnL >= 0 && l^.rowL >= 0-    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)--unrestricted :: Int-unrestricted = 100000---- | Build a widget from a 'String'. Breaks newlines up and space-pads--- short lines out to the length of the longest line.-str :: String -> Widget-str s =-    Widget Fixed Fixed $ do-      c <- getContext-      let theLines = fixEmpty <$> (dropUnused . lines) s-          fixEmpty [] = " "-          fixEmpty l = l-          dropUnused l = take (availWidth c) <$> take (availHeight c) l-      case force theLines of-          [] -> return def-          [one] -> return $ def & imageL .~ (V.string (c^.attrL) one)-          multiple ->-              let maxLength = maximum $ length <$> multiple-                  lineImgs = lineImg <$> multiple-                  lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - length lStr) ' ')-              in return $ def & imageL .~ (V.vertCat lineImgs)---- | Build a widget from a one-line 'T.Text' value. Behaves the same as--- 'str'.-txt :: T.Text -> Widget-txt = str . T.unpack---- | Pad the specified widget on the left. If max padding is used, this--- grows greedily horizontally; otherwise it defers to the padded--- widget.-padLeft :: Padding -> Widget -> Widget-padLeft padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (hLimit i, hSize p)-    in Widget sz (vSize p) $ do-        result <- render 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 -> Widget-padRight padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (hLimit i, hSize p)-    in Widget sz (vSize p) $ do-        result <- render 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 -> Widget-padTop padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (vLimit i, vSize p)-    in Widget (hSize p) sz $ do-        result <- render 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 -> Widget-padBottom padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (vLimit i, vSize p)-    in Widget (hSize p) sz $ do-        result <- render 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 -> Widget-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 -> Widget-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 -> Widget-padAll v w = padLeftRight v $ padTopBottom v w---- | Fill all available space with the specified character. Grows both--- horizontally and vertically.-fill :: Char -> Widget-fill ch =-    Widget Greedy Greedy $ do-      c <- getContext-      return $ def & 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] -> Widget-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] -> Widget-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 =-    BoxRenderer { contextPrimary :: Lens' Context Int-                , contextSecondary :: Lens' Context Int-                , imagePrimary :: V.Image -> Int-                , imageSecondary :: V.Image -> Int-                , limitPrimary :: Int -> Widget -> Widget-                , limitSecondary :: Int -> Widget -> Widget-                , primaryWidgetSize :: Widget -> Size-                , concatenatePrimary :: [V.Image] -> V.Image-                , locationFromOffset :: Int -> Location-                , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image-                }--vBoxRenderer :: BoxRenderer-vBoxRenderer =-    BoxRenderer { contextPrimary = availHeightL-                , contextSecondary = availWidthL-                , imagePrimary = V.imageHeight-                , imageSecondary = V.imageWidth-                , limitPrimary = vLimit-                , limitSecondary = hLimit-                , primaryWidgetSize = vSize-                , concatenatePrimary = V.vertCat-                , locationFromOffset = Location . (0 ,)-                , padImageSecondary = \amt img a ->-                    let p = V.charFill a ' ' amt (V.imageHeight img)-                    in V.horizCat [img, p]-                }--hBoxRenderer :: BoxRenderer-hBoxRenderer =-    BoxRenderer { contextPrimary = availWidthL-                , contextSecondary = availHeightL-                , imagePrimary = V.imageWidth-                , imageSecondary = V.imageHeight-                , limitPrimary = hLimit-                , limitSecondary = vLimit-                , primaryWidgetSize = hSize-                , concatenatePrimary = V.horizCat-                , locationFromOffset = Location . (, 0)-                , padImageSecondary = \amt img a ->-                    let p = V.charFill a ' ' (V.imageWidth img) amt-                    in V.vertCat [img, p]-                }---- | Render a series of widgets in a box layout in the order given.------ The growth policy of a box layout is the most unrestricted of the--- growth policies of the widgets it contains, so to determine the hSize--- and vSize of the box we just take the maximum (using the Ord instance--- for Size) of all of the widgets to be rendered in the box.------ Then the box layout algorithm proceeds as follows. We'll use--- the vertical case to concretely describe the algorithm, but the--- horizontal case can be envisioned just by exchanging all--- "vertical"/"horizontal" and "rows"/"columns", etc., in the--- description.------ The growth policies of the child widgets determine the order in which--- they are rendered, i.e., the order in which space in the box is--- allocated to widgets as the algorithm proceeds. This is because order--- matters: if we render greedy widgets first, there will be no space--- left for non-greedy ones.------ So we render all widgets with size 'Fixed' in the vertical dimension--- first. Each is rendered with as much room as the overall box has, but--- we assume that they will not be greedy and use it all. If they do,--- maybe it's because the terminal is small and there just isn't enough--- room to render everything.------ Then the remaining height is distributed evenly amongst all remaining--- (greedy) widgets and they are rendered in sub-boxes that are as high--- as this even slice of rows and as wide as the box is permitted to be.--- We only do this step at all if rendering the non-greedy widgets left--- us any space, i.e., if there were any rows left.------ After rendering the non-greedy and then greedy widgets, their images--- are sorted so that they are stored in the order the original widgets--- were given. All cursor locations and visibility requests in each--- sub-widget are translated according to the position of the sub-widget--- in the box.------ All images are padded to be as wide as the widest sub-widget to--- prevent attribute over-runs. Without this step the attribute used by--- a sub-widget may continue on in an undesirable fashion until it hits--- something with a different attribute. To prevent this and to behave--- in the least surprising way, we pad the image on the right with--- whitespace using the context's current attribute.------ Finally, the padded images are concatenated together vertically and--- returned along with the translated cursor positions and visibility--- requests.-renderBox :: BoxRenderer -> [Widget] -> Widget-renderBox br ws = do-    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--      renderedHis <- mapM (\(i, prim) -> (i,) <$> render prim) his--      renderedLows <- case lows of-          [] -> return []-          ls -> do-              let remainingPrimary = c^.(contextPrimary br) - (sum $ (^._2.imageL.(to $ imagePrimary br)) <$> renderedHis)-                  primaryPerLow = remainingPrimary `div` length ls-                  padFirst = remainingPrimary - (primaryPerLow * length ls)-                  secondaryPerLow = c^.(contextSecondary br)-                  primaries = replicate (length ls) primaryPerLow & ix 0 %~ (+ padFirst)--              let renderLow ((i, prim), pri) =-                      (i,) <$> (render $ limitPrimary br pri-                                       $ limitSecondary br secondaryPerLow-                                       $ cropToContext prim)--              if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return []--      let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows-          allResults = snd <$> rendered-          allImages = (^.imageL) <$> allResults-          allPrimaries = imagePrimary br <$> allImages-          allTranslatedResults = (flip map) (zip [0..] allResults) $ \(i, result) ->-              let off = locationFromOffset br offPrimary-                  offPrimary = sum $ take i allPrimaries-              in addResultOffset off result-          -- Determine the secondary dimension value to pad to. In a-          -- vertical box we want all images to be the same width to-          -- avoid attribute over-runs or blank spaces with the wrong-          -- attribute. In a horizontal box we want all images to have-          -- the same height for the same reason.-          maxSecondary = maximum $ imageSecondary br <$> allImages-          padImage img = padImageSecondary br (maxSecondary - imageSecondary br img) img (c^.attrL)-          paddedImages = padImage <$> allImages--      cropResultToContext $ Result (concatenatePrimary br paddedImages)-                            (concat $ cursors <$> allTranslatedResults)-                            (concat $ visibilityRequests <$> allTranslatedResults)---- | 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 -> Widget-hLimit w p =-    Widget Fixed (vSize p) $ do-      withReaderT (& availWidthL .~ w) $ render $ cropToContext p---- | Limit the space available to the specified widget to the specified--- number of rows. This is important for constraining the vertical--- growth of otherwise-greedy widgets. This is non-greedy vertically and--- defers to the limited widget horizontally.-vLimit :: Int -> Widget -> Widget-vLimit h p =-    Widget (hSize p) Fixed $ do-      withReaderT (& availHeightL .~ h) $ render $ cropToContext p---- | When drawing the specified widget, set the current attribute used--- for drawing to the one with the specified name. Note that the widget--- may use further calls to 'withAttr' to override this; if you really--- want to prevent that, use 'forceAttr'. Attributes used this way still--- get merged hierarchically and still fall back to the attribute map's--- default attribute. If you want to change the default attribute, use--- 'withDefAttr'.-withAttr :: AttrName -> Widget -> Widget-withAttr an p =-    Widget (hSize p) (vSize p) $ do-      withReaderT (& ctxAttrNameL .~ an) (render p)---- | Update the attribute map while rendering the specified widget: set--- its new default attribute to the one that we get by looking up the--- specified attribute name in the map.-withDefAttr :: AttrName -> Widget -> Widget-withDefAttr an p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL %~ (setDefault (attrMapLookup an (c^.ctxAttrMapL)))) (render p)---- | When rendering the specified widget, update the attribute map with--- the specified transformation.-updateAttrMap :: (AttrMap -> AttrMap) -> Widget -> Widget-updateAttrMap f p =-    Widget (hSize p) (vSize p) $ do-        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 -> Widget-forceAttr an p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)---- | Build a widget directly from a raw Vty image.-raw :: V.Image -> Widget-raw img = Widget Fixed Fixed $ return $ def & imageL .~ img---- | Translate the specified widget by the specified offset amount.--- Defers to the translated width for growth policy.-translateBy :: Location -> Widget -> Widget-translateBy off p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ addResultOffset off-             $ result & imageL %~ (V.translate (off^.columnL) (off^.rowL))---- | Crop the specified widget on the left by the specified number of--- columns. Defers to the translated width for growth policy.-cropLeftBy :: Int -> Widget -> Widget-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 translated width for growth policy.-cropRightBy :: Int -> Widget -> Widget-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 translated width for growth policy.-cropTopBy :: Int -> Widget -> Widget-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 translated width for growth policy.-cropBottomBy :: Int -> Widget -> Widget-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 :: Name -> Location -> Widget -> Widget-showCursor n cloc p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ result & cursorsL %~ (CursorLocation cloc (Just n):)--hRelease :: Widget -> Maybe Widget-hRelease p =-    case hSize p of-        Fixed -> Just $ Widget Greedy (vSize p) $ withReaderT (& availWidthL .~ unrestricted) (render p)-        Greedy -> Nothing--vRelease :: Widget -> Maybe Widget-vRelease p =-    case vSize p of-        Fixed -> Just $ Widget (hSize p) Greedy $ withReaderT (& availHeightL .~ unrestricted) (render p)-        Greedy -> Nothing---- | 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, only the--- first is honored. 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 :: Name-         -- ^ The name of the viewport (must be unique and stable for-         -- reliable behavior)-         -> ViewportType-         -- ^ The type of viewport (indicates the permitted scrolling-         -- direction)-         -> Widget-         -- ^ The widget to be rendered in the scrollable viewport-         -> Widget-viewport vpname typ p =-    Widget Greedy Greedy $ do-      -- First, update the viewport size.-      c <- getContext-      let newVp = VP 0 0 newSize-          newSize = (c^.availWidthL, c^.availHeightL)-          doInsert (Just vp) = Just $ vp & vpSize .~ newSize-          doInsert Nothing = Just newVp--      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 Name vpn = vpname-          release = case typ of-            Vertical -> vRelease-            Horizontal -> hRelease-            Both -> \w -> vRelease w >>= 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 vpn)-                Horizontal -> error $ "tried to embed an infinite-width widget in horizontal viewport " <> (show vpn)-                Both -> error $ "tried to embed an infinite-width or infinite-height widget in 'Both' type viewport " <> (show vpn)--      initialResult <- render released--      -- If the rendering state includes any scrolling requests for this-      -- viewport, apply those-      reqs <- lift $ gets $ (^.scrollRequestsL)-      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 rq = head $ initialResult^.visibilityRequestsL-              updatedVp = 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 updatedVp))--      -- 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) -> return $ translated & imageL .~ (V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL))-                                        & visibilityRequestsL .~ mempty-          _ -> render $ cropToContext-                      $ padBottom Max-                      $ padRight Max-                      $ Widget Fixed Fixed $ return $ translated & visibilityRequestsL .~ mempty--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-            _ -> 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-            _ -> 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.rowL--        reqEnd = rq^.vrPositionL.rowL + rq^.vrSizeL._2-        newVStart :: Int-        newVStart = if reqStart < curStart-                   then reqStart-                   else if reqStart > curEnd || reqEnd > curEnd-                        then reqEnd - vp^.vpSize._2-                        else curStart-scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart-    where-        curStart = vp^.vpLeft-        curEnd = curStart + vp^.vpSize._1-        reqStart = rq^.vrPositionL.columnL--        reqEnd = rq^.vrPositionL.columnL + rq^.vrSizeL._1-        newHStart :: Int-        newHStart = if reqStart < curStart-                   then reqStart-                   else if reqStart > curEnd || reqEnd > curEnd-                        then reqEnd - vp^.vpSize._1-                        else curStart---- | 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 -> Widget-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 -> Widget-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-      -- ^ Left-      -> Widget-      -- ^ Right-      -> Widget-(<+>) 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-      -- ^ Top-      -> Widget-      -- ^ Bottom-      -> Widget-(<=>) a b = vBox [a, b]+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- | This module provides the core widget combinators and rendering+-- routines. Everything this library does is in terms of these basic+-- primitives.+module Brick.Widgets.Core+  ( -- * Basic rendering primitives+    TextWidth(..)+  , emptyWidget+  , raw+  , txt+  , txtWrap+  , txtWrapWith+  , str+  , strWrap+  , strWrapWith+  , fill+  , hyperlink++  -- * Padding+  , Padding(..)+  , padLeft+  , padRight+  , padTop+  , padBottom+  , padLeftRight+  , padTopBottom+  , padAll++  -- * Box layout+  , (<=>)+  , (<+>)+  , hBox+  , vBox++  -- * Limits+  , hLimit+  , hLimitPercent+  , vLimit+  , vLimitPercent+  , setAvailableSize++  -- * Attribute management+  , withDefAttr+  , modifyDefAttr+  , withAttr+  , forceAttr+  , forceAttrAllowStyle+  , overrideAttr+  , updateAttrMap++  -- * Border style management+  , withBorderStyle+  , joinBorders+  , separateBorders+  , freezeBorders++  -- * Cursor placement+  , showCursor+  , putCursor++  -- * Naming+  , Named(..)++  -- * Translation and positioning+  , translateBy+  , relativeTo++  -- * Cropping+  , cropLeftBy+  , cropRightBy+  , cropTopBy+  , cropBottomBy+  , cropLeftTo+  , cropRightTo+  , cropTopTo+  , cropBottomTo++  -- * Extent reporting+  , reportExtent+  , clickable++  -- * Scrollable viewports+  , viewport+  , visible+  , visibleRegion+  , unsafeLookupViewport+  , cached++  -- ** Viewport scroll bars+  , withVScrollBars+  , withHScrollBars+  , withClickableHScrollBars+  , withClickableVScrollBars+  , withVScrollBarHandles+  , withHScrollBarHandles+  , withVScrollBarRenderer+  , withHScrollBarRenderer+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , verticalScrollbarRenderer+  , horizontalScrollbarRenderer+  , scrollbarAttr+  , scrollbarTroughAttr+  , scrollbarHandleAttr+  , verticalScrollbar+  , horizontalScrollbar++  -- ** Adding offsets to cursor positions and visibility requests+  , addResultOffset++  -- ** Cropping results+  , cropToContext+  )+where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif++import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens')+import Lens.Micro.Mtl (use, (%=))+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader+import qualified Data.Foldable as F+import Data.Traversable (for)+import qualified Data.Text as T+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.IMap as I+import qualified Data.Function as DF+import Data.List (sortBy, partition)+import Data.Maybe (fromMaybe)+import qualified Graphics.Vty as V+import Control.DeepSeq++import Text.Wrap (wrapTextToLines, WrapSettings, defaultWrapSettings)++import Brick.Types+import Brick.Types.Internal+import Brick.Widgets.Border.Style+import Brick.Util (clOffset, clamp)+import Brick.AttrMap+import Brick.Widgets.Internal+import qualified Brick.BorderMap as BM++-- | The class of text types that have widths measured in terminal+-- columns. NEVER use 'length' etc. to measure the length of a string if+-- you need to compute how much screen space it will occupy; always use+-- 'textWidth'.+class TextWidth a where+    textWidth :: a -> Int++instance TextWidth T.Text where+    textWidth = V.wcswidth . T.unpack++instance (F.Foldable f) => TextWidth (f Char) where+    textWidth = V.wcswidth . F.toList++-- | The class of types that store interface element names.+class Named a n where+    -- | Get the name of the specified value.+    getName :: a -> n++-- | When rendering the specified widget, use the specified border style+-- for any border rendering.+withBorderStyle :: BorderStyle -> Widget n -> Widget n+withBorderStyle bs p = Widget (hSize p) (vSize p) $+    withReaderT (ctxBorderStyleL .~ bs) (render p)++-- | When rendering the specified widget, create borders that respond+-- dynamically to their neighbors to form seamless connections.+joinBorders :: Widget n -> Widget n+joinBorders p = Widget (hSize p) (vSize p) $+    withReaderT (ctxDynBordersL .~ True) (render p)++-- | When rendering the specified widget, use static borders. This+-- may be marginally faster, but will introduce a small gap between+-- neighboring orthogonal borders.+--+-- This is the default for backwards compatibility.+separateBorders :: Widget n -> Widget n+separateBorders p = Widget (hSize p) (vSize p) $+    withReaderT (ctxDynBordersL .~ False) (render p)++-- | After the specified widget has been rendered, freeze its borders. A+-- frozen border will not be affected by neighbors, nor will it affect+-- neighbors. Compared to 'separateBorders', 'freezeBorders' will not+-- affect whether borders connect internally to a widget (whereas+-- 'separateBorders' prevents them from connecting).+--+-- Frozen borders cannot be thawed.+freezeBorders :: Widget n -> Widget n+freezeBorders p = Widget (hSize p) (vSize p) $ (bordersL %~ BM.clear) <$> render p++-- | The empty widget.+emptyWidget :: Widget n+emptyWidget = raw V.emptyImage++-- | Add an offset to all cursor locations, visibility requests, and+-- extents in the specified rendering result. This function is critical+-- for maintaining correctness in the rendering results as they are+-- processed successively by box layouts and other wrapping combinators,+-- since calls to this function result in converting from widget-local+-- coordinates to (ultimately) terminal-global ones so they can be+-- used by other combinators. You should call this any time you render+-- something and then translate it or otherwise offset it from its+-- original origin.+addResultOffset :: Location -> Result n -> Result n+addResultOffset off = addCursorOffset off .+                      addVisibilityOffset off .+                      addExtentOffset off .+                      addDynBorderOffset off++addVisibilityOffset :: Location -> Result n -> Result n+addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)++addExtentOffset :: Location -> Result n -> Result n+addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz) -> Extent n (off <> l) sz)++addDynBorderOffset :: Location -> Result n -> Result n+addDynBorderOffset off r = r & bordersL %~ BM.translate off++-- | Render the specified widget and record its rendering extent using+-- the specified name (see also 'lookupExtent').+--+-- This function is the counterpart to 'makeVisible'; any visibility+-- requests made with 'makeVisible' must have a corresponding+-- 'reportExtent' in order to work. The 'clickable' function will also+-- work for this purpose to tell the renderer about the clickable+-- region.+reportExtent :: (Ord n) => n -> Widget n -> Widget n+reportExtent n p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let ext = Extent n (Location (0, 0)) sz+            sz = ( result^.imageL.to V.imageWidth+                 , result^.imageL.to V.imageHeight+                 )+        -- If the reported extent also has a visibility request+        -- from EventM via makeVisible, add a visibility request to+        -- the render state so this gets scrolled into view by any+        -- containing viewport.+        vReqs <- use requestedVisibleNames_L+        let addVisReq = if sz^._1 > 0 && sz^._2 > 0 && n `S.member` vReqs+                        then visibilityRequestsL %~ (VR (Location (0, 0)) sz :)+                        else id+        return $ addVisReq $ result & extentsL %~ (ext:)++-- | Request mouse click events on the specified widget.+--+-- Regions used with 'clickable' can be scrolled into view with+-- 'makeVisible'.+clickable :: (Ord n) => n -> Widget n -> Widget n+clickable n p =+    Widget (hSize p) (vSize p) $ do+        clickableNamesL %= (n:)+        render $ reportExtent n p++addCursorOffset :: Location -> Result n -> Result n+addCursorOffset off r =+    let onlyVisible = filter isVisible+        isVisible l = l^.locationColumnL >= 0 && l^.locationRowL >= 0+    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)++unrestricted :: Int+unrestricted = 100000++-- | Make a widget from a string, but wrap the words in the input's+-- lines at the available width using the default wrapping settings. The+-- input string should not contain escape sequences or carriage returns.+--+-- Unlike 'str', this is greedy horizontally.+strWrap :: String -> Widget n+strWrap = strWrapWith defaultWrapSettings++-- | Make a widget from a string, but wrap the words in the input's+-- lines at the available width using the specified wrapping settings.+-- The input string should not contain escape sequences or carriage+-- returns.+--+-- Unlike 'str', this is greedy horizontally.+strWrapWith :: WrapSettings -> String -> Widget n+strWrapWith settings t = txtWrapWith settings $ T.pack t++-- | Make a widget from text, but wrap the words in the input's lines at+-- the available width using the default wrapping settings. The input+-- text should not contain escape sequences or carriage returns.+--+-- Unlike 'txt', this is greedy horizontally.+txtWrap :: T.Text -> Widget n+txtWrap = txtWrapWith defaultWrapSettings++-- | Make a widget from text, but wrap the words in the input's lines at+-- the available width using the specified wrapping settings. The input+-- text should not contain escape sequences or carriage returns.+--+-- Unlike 'txt', this is greedy horizontally.+txtWrapWith :: WrapSettings -> T.Text -> Widget n+txtWrapWith settings s =+    Widget Greedy Fixed $ do+      c <- getContext+      let theLines = fixEmpty <$> wrapTextToLines settings (c^.availWidthL) s+          fixEmpty l | T.null l = " "+                     | otherwise = l+      case force theLines of+          [] -> return emptyResult+          multiple ->+              let maxLength = maximum $ textWidth <$> multiple+                  padding = V.charFill (c^.attrL) ' ' (c^.availWidthL - maxLength) (length lineImgs)+                  lineImgs = lineImg <$> multiple+                  lineImg lStr = V.text' (c^.attrL)+                                   (lStr <> T.replicate (maxLength - textWidth lStr) " ")+              in return $ emptyResult & imageL .~ (V.horizCat [V.vertCat lineImgs, padding])++-- | Build a widget from a 'String'. Behaves the same as 'txt' when the+-- input contains multiple lines.+--+-- The input string must not contain tab characters. If it does,+-- interface corruption will result since the terminal will likely+-- render it as taking up more than a single column. The caller should+-- replace tabs with the appropriate number of spaces as desired. The+-- input string should not contain escape sequences or carriage returns.+str :: String -> Widget n+str = txt . T.pack++-- | Build a widget from a 'T.Text' value. Breaks newlines up and+-- space-pads short lines out to the length of the longest line.+--+-- The input string must not contain tab characters. If it does,+-- interface corruption will result since the terminal will likely+-- render it as taking up more than a single column. The caller should+-- replace tabs with the appropriate number of spaces as desired. The+-- input text should not contain escape sequences or carriage returns.+txt :: T.Text -> Widget n+txt s =+    -- Although vty Image uses lazy Text internally, using lazy text at this+    -- level may not be an improvement.  Indeed it can be much worse, due+    -- the overhead of lazy Text being significant compared to the typically+    -- short string content used to compose UIs.+    Widget Fixed Fixed $ do+        c <- getContext+        let theLines = fixEmpty <$> (dropUnused . T.lines) s+            fixEmpty l = if T.null l then T.singleton ' ' else l+            dropUnused l = takeColumnsT (availWidth c) <$> take (availHeight c) l+        pure $ case theLines of+            [] -> emptyResult+            [one] -> emptyResult & imageL .~ (V.text' (c^.attrL) one)+            multiple ->+                let maxLength = maximum $ V.safeWctwidth <$> multiple+                    lineImgs = lineImg <$> multiple+                    lineImg lStr = V.text' (c^.attrL)+                        (lStr <> T.replicate (maxLength - V.safeWctwidth lStr) (T.singleton ' '))+                in emptyResult & imageL .~ (V.vertCat lineImgs)++-- | Take up to the given width, having regard to character width.+takeColumnsT :: Int -> T.Text -> T.Text+takeColumnsT w s = T.take (fst $ T.foldl' f (0,0) s) s+    where+    -- The accumulator value is (index in Text value, width of Text so far)+    f (i,z) c+        -- Width was previously exceeded; continue with same values.+        | z < 0                   = (i, z)+        -- Width exceeded.  Signal this with z = -1.  Index will no longer be+        -- incremented.+        --+        -- Why not short circuit (e.g. using foldlM construction)?+        -- Because in the typical case, the Either allocation costs exceed+        -- any benefits.  The pathological case, string length >> width, is+        -- probably rare.+        | z + V.safeWcwidth c > w = (i, -1)+        -- Width not yet exceeded.  Increment index and add character width.+        | otherwise               = (i + 1, z + V.safeWcwidth c)++-- | Hyperlink the given widget to the specified URL. Not all terminal+-- emulators support this. In those that don't, this should have no+-- discernible effect.+hyperlink :: T.Text -> Widget n -> Widget n+hyperlink url p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        let attr = (c^.attrL) `V.withURL` url+        withReaderT (ctxAttrMapL %~ setDefaultAttr attr) (render p)++-- | The type of padding.+data Padding = Pad Int+             -- ^ Pad by the specified number of rows or columns.+             | Max+             -- ^ Pad up to the number of available rows or columns.++-- | Pad the specified widget on the left. If max padding is used, this+-- grows greedily horizontally; otherwise it defers to the padded+-- widget.+padLeft :: Padding -> Widget n -> Widget n+padLeft padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (hLimit i, hSize p)+    in Widget sz (vSize p) $ do+        c <- getContext+        let lim = case padding of+              Max -> c^.availWidthL+              Pad i -> c^.availWidthL - i+        result <- render $ hLimit lim p+        render $ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') <+>+                 (Widget Fixed Fixed $ return result)++-- | Pad the specified widget on the right. If max padding is used,+-- this grows greedily horizontally; otherwise it defers to the padded+-- widget.+padRight :: Padding -> Widget n -> Widget n+padRight padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (hLimit i, hSize p)+    in Widget sz (vSize p) $ do+        c <- getContext+        let lim = case padding of+              Max -> c^.availWidthL+              Pad i -> c^.availWidthL - i+        result <- render $ hLimit lim p+        render $ (Widget Fixed Fixed $ return result) <+>+                 (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ')++-- | Pad the specified widget on the top. If max padding is used, this+-- grows greedily vertically; otherwise it defers to the padded widget.+padTop :: Padding -> Widget n -> Widget n+padTop padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (vLimit i, vSize p)+    in Widget (hSize p) sz $ do+        c <- getContext+        let lim = case padding of+              Max -> c^.availHeightL+              Pad i -> c^.availHeightL - i+        result <- render $ vLimit lim p+        render $ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') <=>+                 (Widget Fixed Fixed $ return result)++-- | Pad the specified widget on the bottom. If max padding is used,+-- this grows greedily vertically; otherwise it defers to the padded+-- widget.+padBottom :: Padding -> Widget n -> Widget n+padBottom padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (vLimit i, vSize p)+    in Widget (hSize p) sz $ do+        c <- getContext+        let lim = case padding of+              Max -> c^.availHeightL+              Pad i -> c^.availHeightL - i+        result <- render $ vLimit lim p+        render $ (Widget Fixed Fixed $ return result) <=>+                 (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ')++-- | Pad a widget on the left and right. Defers to the padded widget for+-- growth policy.+padLeftRight :: Int -> Widget n -> Widget n+padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w++-- | Pad a widget on the top and bottom. Defers to the padded widget for+-- growth policy.+padTopBottom :: Int -> Widget n -> Widget n+padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w++-- | Pad a widget on all sides. Defers to the padded widget for growth+-- policy.+padAll :: Int -> Widget n -> Widget n+padAll v w = padLeftRight v $ padTopBottom v w++-- | Fill all available space with the specified character. Grows both+-- horizontally and vertically.+fill :: Char -> Widget n+fill ch =+    Widget Greedy Greedy $ do+      c <- getContext+      return $ emptyResult & imageL .~ (V.charFill (c^.attrL) ch (c^.availWidthL) (c^.availHeightL))++-- | Vertical box layout: put the specified widgets one above the other+-- in the specified order (uppermost first). Defers growth policies to+-- the growth policies of the contained widgets (if any are greedy, so+-- is the box).+--+-- Allocates space to 'Fixed' elements first and 'Greedy' elements+-- second. For example, if a 'vBox' contains three elements @A@, @B@,+-- and @C@, and if @A@ and @B@ are 'Fixed', then 'vBox' first renders+-- @A@ and @B@. Suppose those two take up 10 rows total, and the 'vBox'+-- was given 50 rows. This means 'vBox' then allocates the remaining+-- 40 rows to @C@. If, on the other hand, @A@ and @B@ take up 50 rows+-- together, @C@ will not be rendered at all.+--+-- If all elements are 'Greedy', 'vBox' allocates the available height+-- evenly among the elements. So, for example, if a 'vBox' is rendered+-- in 90 rows and has three 'Greedy' elements, each element will be+-- allocated 30 rows.+{-# NOINLINE vBox #-}+vBox :: [Widget n] -> Widget n+vBox [] = emptyWidget+vBox [a] = a+vBox pairs = renderBox vBoxRenderer pairs++-- | Horizontal box layout: put the specified widgets next to each other+-- in the specified order (leftmost first). Defers growth policies to+-- the growth policies of the contained widgets (if any are greedy, so+-- is the box).+--+-- Allocates space to 'Fixed' elements first and 'Greedy' elements+-- second. For example, if an 'hBox' contains three elements @A@, @B@,+-- and @C@, and if @A@ and @B@ are 'Fixed', then 'hBox' first renders+-- @A@ and @B@. Suppose those two take up 10 columns total, and the+-- 'hBox' was given 50 columns. This means 'hBox' then allocates the+-- remaining 40 columns to @C@. If, on the other hand, @A@ and @B@ take+-- up 50 columns together, @C@ will not be rendered at all.+--+-- If all elements are 'Greedy', 'hBox' allocates the available width+-- evenly among the elements. So, for example, if an 'hBox' is rendered+-- in 90 columns and has three 'Greedy' elements, each element will be+-- allocated 30 columns.+{-# NOINLINE hBox #-}+hBox :: [Widget n] -> Widget n+hBox [] = emptyWidget+hBox [a] = a+hBox pairs = renderBox hBoxRenderer pairs++-- | The process of rendering widgets in a box layout is exactly the+-- same except for the dimension under consideration (width vs. height),+-- in which case all of the same operations that consider one dimension+-- in the layout algorithm need to be switched to consider the other.+-- Because of this we fill a BoxRenderer with all of the functions+-- needed to consider the "primary" dimension (e.g. vertical if the+-- box layout is vertical) as well as the "secondary" dimension (e.g.+-- horizontal if the box layout is vertical). Doing this permits us to+-- have one implementation for box layout and parameterizing on the+-- orientation of all of the operations.+data BoxRenderer n =+    BoxRenderer { contextPrimary :: Lens' (Context n) Int+                , contextSecondary :: Lens' (Context n) Int+                , imagePrimary :: V.Image -> Int+                , imageSecondary :: V.Image -> Int+                , limitPrimary :: Int -> Widget n -> Widget n+                , primaryWidgetSize :: Widget n -> Size+                , concatenatePrimary :: [V.Image] -> V.Image+                , concatenateSecondary :: [V.Image] -> V.Image+                , locationFromOffset :: Int -> Location+                , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image+                , loPrimary :: forall a. Lens' (Edges a) a -- lo: towards smaller coordinates in that dimension+                , hiPrimary :: forall a. Lens' (Edges a) a -- hi: towards larger  coordinates in that dimension+                , loSecondary :: forall a. Lens' (Edges a) a+                , hiSecondary :: forall a. Lens' (Edges a) a+                , locationFromPrimarySecondary :: Int -> Int -> Location+                , splitLoPrimary :: Int -> V.Image -> V.Image+                , splitHiPrimary :: Int -> V.Image -> V.Image+                , splitLoSecondary :: Int -> V.Image -> V.Image+                , splitHiSecondary :: Int -> V.Image -> V.Image+                , lookupPrimary :: Int -> BM.BorderMap DynBorder -> I.IMap DynBorder+                , insertSecondary :: Location -> I.Run DynBorder -> BM.BorderMap DynBorder -> BM.BorderMap DynBorder+                }++vBoxRenderer :: BoxRenderer n+vBoxRenderer =+    BoxRenderer { contextPrimary = availHeightL+                , contextSecondary = availWidthL+                , imagePrimary = V.imageHeight+                , imageSecondary = V.imageWidth+                , limitPrimary = vLimit+                , primaryWidgetSize = vSize+                , concatenatePrimary = V.vertCat+                , concatenateSecondary = V.horizCat+                , locationFromOffset = Location . (0 ,)+                , padImageSecondary = \amt img a ->+                    let p = V.charFill a ' ' amt (V.imageHeight img)+                    in V.horizCat [img, p]+                , loPrimary = eTopL+                , hiPrimary = eBottomL+                , loSecondary = eLeftL+                , hiSecondary = eRightL+                , locationFromPrimarySecondary = \r c -> Location (c, r)+                , splitLoPrimary = V.cropBottom+                , splitHiPrimary = \n img -> V.cropTop (V.imageHeight img-n) img+                , splitLoSecondary = V.cropRight+                , splitHiSecondary = \n img -> V.cropLeft (V.imageWidth img-n) img+                , lookupPrimary = BM.lookupRow+                , insertSecondary = BM.insertH+                }++hBoxRenderer :: BoxRenderer n+hBoxRenderer =+    BoxRenderer { contextPrimary = availWidthL+                , contextSecondary = availHeightL+                , imagePrimary = V.imageWidth+                , imageSecondary = V.imageHeight+                , limitPrimary = hLimit+                , primaryWidgetSize = hSize+                , concatenatePrimary = V.horizCat+                , concatenateSecondary = V.vertCat+                , locationFromOffset = Location . (, 0)+                , padImageSecondary = \amt img a ->+                    let p = V.charFill a ' ' (V.imageWidth img) amt+                    in V.vertCat [img, p]+                , loPrimary = eLeftL+                , hiPrimary = eRightL+                , loSecondary = eTopL+                , hiSecondary = eBottomL+                , locationFromPrimarySecondary = \c r -> Location (c, r)+                , splitLoPrimary = V.cropRight+                , splitHiPrimary = \n img -> V.cropLeft (V.imageWidth img-n) img+                , splitLoSecondary = V.cropBottom+                , splitHiSecondary = \n img -> V.cropTop (V.imageHeight img-n) img+                , lookupPrimary = BM.lookupCol+                , insertSecondary = BM.insertV+                }++-- | Render a series of widgets in a box layout in the order given.+--+-- The growth policy of a box layout is the most unrestricted of the+-- growth policies of the widgets it contains, so to determine the hSize+-- and vSize of the box we just take the maximum (using the Ord instance+-- for Size) of all of the widgets to be rendered in the box.+--+-- Then the box layout algorithm proceeds as follows. We'll use+-- the vertical case to concretely describe the algorithm, but the+-- horizontal case can be envisioned just by exchanging all+-- "vertical"/"horizontal" and "rows"/"columns", etc., in the+-- description.+--+-- The growth policies of the child widgets determine the order in which+-- they are rendered, i.e., the order in which space in the box is+-- allocated to widgets as the algorithm proceeds. This is because order+-- matters: if we render greedy widgets first, there will be no space+-- left for non-greedy ones.+--+-- So we render all widgets with size 'Fixed' in the vertical dimension+-- first. Each is rendered with as much room as the overall box has, but+-- we assume that they will not be greedy and use it all. If they do,+-- maybe it's because the terminal is small and there just isn't enough+-- room to render everything.+--+-- Then the remaining height is distributed evenly amongst all remaining+-- (greedy) widgets and they are rendered in sub-boxes that are as high+-- as this even slice of rows and as wide as the box is permitted to be.+-- We only do this step at all if rendering the non-greedy widgets left+-- us any space, i.e., if there were any rows left.+--+-- After rendering the non-greedy and then greedy widgets, their images+-- are sorted so that they are stored in the order the original widgets+-- were given. All cursor locations and visibility requests in each+-- sub-widget are translated according to the position of the sub-widget+-- in the box.+--+-- All images are padded to be as wide as the widest sub-widget to+-- prevent attribute over-runs. Without this step the attribute used by+-- a sub-widget may continue on in an undesirable fashion until it hits+-- something with a different attribute. To prevent this and to behave+-- in the least surprising way, we pad the image on the right with+-- whitespace using the context's current attribute.+--+-- Finally, the padded images are concatenated together vertically and+-- returned along with the translated cursor positions and visibility+-- requests.+renderBox :: BoxRenderer n -> [Widget n] -> Widget n+renderBox br ws =+    Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do+      c <- getContext++      let pairsIndexed = zip [(0::Int)..] ws+          (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed)+                        pairsIndexed++          renderHi prim = do+            remainingPrimary <- get+            result <- lift $ render $ limitPrimary br remainingPrimary prim+            result <$ (put $! remainingPrimary - (result^.imageL.(to $ imagePrimary br)))++      (renderedHis, remainingPrimary) <-+        runStateT (traverse (traverse renderHi) his) (c ^. contextPrimary br)++      renderedLows <- case lows of+          [] -> return []+          ls -> do+              let primaryPerLow = remainingPrimary `div` length ls+                  rest = remainingPrimary - (primaryPerLow * length ls)+                  primaries = replicate rest (primaryPerLow + 1) <>+                              replicate (length ls - rest) primaryPerLow++              let renderLow ((i, prim), pri) = (i,) <$> render (limitPrimary br pri prim)++              if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return []++      let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows+          allResults = snd <$> rendered+          allImages = (^.imageL) <$> allResults+          allTranslatedResults = flip evalState 0 $ for allResults $ \result -> do+              offPrimary <- get+              put $ offPrimary + (result ^. imageL . to (imagePrimary br))+              pure $ addResultOffset (locationFromOffset br offPrimary) result+          -- Determine the secondary dimension value to pad to. In a+          -- vertical box we want all images to be the same width to+          -- avoid attribute over-runs or blank spaces with the wrong+          -- attribute. In a horizontal box we want all images to have+          -- the same height for the same reason.+          maxSecondary = maximum $ imageSecondary br <$> allImages+          padImage img = padImageSecondary br (maxSecondary - imageSecondary br img)+                         img (c^.attrL)+          (imageRewrites, newBorders) = catAllBorders br (borders <$> allTranslatedResults)+          rewrittenImages = zipWith (rewriteImage br) imageRewrites allImages+          paddedImages = padImage <$> rewrittenImages++      cropResultToContext $ Result (concatenatePrimary br paddedImages)+                            (concatMap cursors allTranslatedResults)+                            (concatMap visibilityRequests allTranslatedResults)+                            (concatMap extents allTranslatedResults)+                            newBorders++catDynBorder :: Lens' (Edges BorderSegment) BorderSegment+             -> Lens' (Edges BorderSegment) BorderSegment+             -> DynBorder+             -> DynBorder+             -> Maybe DynBorder+catDynBorder towardsA towardsB a b+    -- Currently, we check if the 'BorderStyle's are exactly the same. In the+    -- future, it might be nice to relax this restriction. For example, if a+    -- horizontal border is being rewritten to accommodate a neighboring+    -- vertical border, all we care about is that the two 'bsVertical's line up+    -- sanely. After all, if the horizontal border's 'bsVertical' is the same+    -- as the vertical one's, and the horizontal border's 'BorderStyle' is+    -- self-consistent, then it will look "right" to rewrite according to the+    -- horizontal border's 'BorderStyle'.+    |  dbStyle a == dbStyle b+    && dbAttr  a == dbAttr  b+    && a ^. dbSegmentsL.towardsB.bsAcceptL+    && b ^. dbSegmentsL.towardsA.bsOfferL+    && not (a ^. dbSegmentsL.towardsB.bsDrawL) -- don't bother doing an update if we don't need to+    = Just (a & dbSegmentsL.towardsB.bsDrawL .~ True)+    | otherwise = Nothing++catDynBorders :: Lens' (Edges BorderSegment) BorderSegment+              -> Lens' (Edges BorderSegment) BorderSegment+              -> I.IMap DynBorder+              -> I.IMap DynBorder+              -> I.IMap DynBorder+catDynBorders towardsA towardsB am bm = I.mapMaybe id+    $ I.intersectionWith (catDynBorder towardsA towardsB) am bm++-- | Given borders that should be placed next to each other (the first argument+-- on the right or bottom, and the second argument on the left or top), compute+-- new borders and the rewrites that should be done along the edges of the two+-- images to keep the image in sync with the border information.+--+-- The input borders are assumed to be disjoint. This property is not checked.+catBorders :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)+           => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)+catBorders br r l = if lCoord + 1 == rCoord+    then ((lRe, rRe), lr')+    else ((I.empty, I.empty), lr)+    where+    lr     = BM.expand (BM.coordinates r) l `BM.unsafeUnion`+             BM.expand (BM.coordinates l) r+    lr'    = id+           . mergeIMap lCoord lIMap'+           . mergeIMap rCoord rIMap'+           $ lr+    lCoord = BM.coordinates l ^. hiPrimary br+    rCoord = BM.coordinates r ^. loPrimary br+    lIMap  = lookupPrimary br lCoord l+    rIMap  = lookupPrimary br rCoord r+    lIMap' = catDynBorders (loPrimary br) (hiPrimary br) lIMap rIMap+    rIMap' = catDynBorders (hiPrimary br) (loPrimary br) rIMap lIMap+    lRe    = renderDynBorder <$> lIMap'+    rRe    = renderDynBorder <$> rIMap'+    mergeIMap p imap bm = F.foldl'+        (\bm' (s,v) -> insertSecondary br (locationFromPrimarySecondary br p s) v bm')+        bm+        (I.unsafeToAscList imap)++-- | Given a direction to concatenate borders in, and the border information+-- itself (which list is assumed to be already shifted so that borders do not+-- overlap and are strictly increasing in the primary direction), produce: a+-- list of rewrites for the lo and hi directions of each border, respectively,+-- and the borders describing the fully concatenated object.+catAllBorders :: BoxRenderer n+              -> [BM.BorderMap DynBorder]+              -> ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder)+catAllBorders _ [] = ([], BM.empty)+catAllBorders br (bm:bms) = (zip ([I.empty]++los) (his++[I.empty]), bm') where+    (rewrites, bm') = runState (traverse (state . catBorders br) bms) bm+    (his, los) = unzip rewrites++rewriteEdge :: (Int -> V.Image -> V.Image)+            -> (Int -> V.Image -> V.Image)+            -> ([V.Image] -> V.Image)+            -> I.IMap V.Image+            -> V.Image+            -> V.Image+rewriteEdge splitLo splitHi combine = (combine .) . go . offsets 0 . I.unsafeToAscList where++    -- convert absolute positions into relative ones+    offsets _ [] = []+    offsets n ((n', r):nrs) = (n'-n, r) : offsets (n'+I.len r) nrs++    go [] old = [old]+    -- TODO: might be nice to construct this image with fill rather than+    -- replicate+char+    go ((lo, I.Run len new):nrs) old+        =  [splitLo lo old]+        ++ replicate len new+        ++ go nrs (splitHi (lo+len) old)++rewriteImage :: BoxRenderer n -> (I.IMap V.Image, I.IMap V.Image) -> V.Image -> V.Image+rewriteImage br (loRewrite, hiRewrite) old = rewriteHi . rewriteLo $ old where+    size = imagePrimary br old+    go = rewriteEdge (splitLoSecondary br) (splitHiSecondary br) (concatenateSecondary br)+    rewriteLo img+        | I.null loRewrite || size == 0 = img+        | otherwise = concatenatePrimary br+            [ go loRewrite (splitLoPrimary br 1 img)+            , splitHiPrimary br 1 img+            ]+    rewriteHi img+        | I.null hiRewrite || size == 0 = img+        | otherwise = concatenatePrimary br+            [ splitLoPrimary br (size-1) img+            , go hiRewrite (splitHiPrimary br (size-1) img)+            ]++-- | Limit the space available to the specified widget to the specified+-- number of columns. This is important for constraining the horizontal+-- growth of otherwise-greedy widgets. This is non-greedy horizontally+-- and defers to the limited widget vertically.+hLimit :: Int -> Widget n -> Widget n+hLimit w p+    | w <= 0 = emptyWidget+    | otherwise =+        Widget Fixed (vSize p) $+          withReaderT (availWidthL %~ (min w)) $ render $ cropToContext p++-- | Limit the space available to the specified widget to the specified+-- percentage of available width, as a value between 0 and 100+-- inclusive. Values outside the valid range will be clamped to the+-- range endpoints. This is important for constraining the horizontal+-- growth of otherwise-greedy widgets. This is non-greedy horizontally+-- and defers to the limited widget vertically.+hLimitPercent :: Int -> Widget n -> Widget n+hLimitPercent w' p+    | w' <= 0 = emptyWidget+    | otherwise =+        Widget Fixed (vSize p) $ do+          let w = clamp 0 100 w'+          ctx <- getContext+          let usableWidth = ctx^.availWidthL+              widgetWidth = round (toRational usableWidth * (toRational w / 100))+          withReaderT (availWidthL %~ (min widgetWidth)) $ render $ cropToContext p++-- | Limit the space available to the specified widget to the specified+-- number of rows. This is important for constraining the vertical+-- growth of otherwise-greedy widgets. This is non-greedy vertically and+-- defers to the limited widget horizontally.+vLimit :: Int -> Widget n -> Widget n+vLimit h p+    | h <= 0 = emptyWidget+    | otherwise =+        Widget (hSize p) Fixed $+          withReaderT (availHeightL %~ (min h)) $ render $ cropToContext p++-- | Limit the space available to the specified widget to the specified+-- percentage of available height, as a value between 0 and 100+-- inclusive. Values outside the valid range will be clamped to the+-- range endpoints. This is important for constraining the vertical+-- growth of otherwise-greedy widgets. This is non-greedy vertically and+-- defers to the limited widget horizontally.+vLimitPercent :: Int -> Widget n -> Widget n+vLimitPercent h' p+    | h' <= 0 = emptyWidget+    | otherwise =+        Widget (hSize p) Fixed $ do+          let h = clamp 0 100 h'+          ctx <- getContext+          let usableHeight = ctx^.availHeightL+              widgetHeight = round (toRational usableHeight * (toRational h / 100))+          withReaderT (availHeightL %~ (min widgetHeight)) $ render $ cropToContext p++-- | Set the rendering context height and width for this widget. This+-- is useful for relaxing the rendering size constraints on e.g. layer+-- widgets where cropping to the screen size is undesirable.+setAvailableSize :: (Int, Int) -> Widget n -> Widget n+setAvailableSize (w, h) p+    | w <= 0 || h <= 0 = emptyWidget+    | otherwise =+        Widget Fixed Fixed $+          withReaderT (\c -> c & availHeightL .~ h & availWidthL .~ w) $+            render $ cropToContext p++-- | When drawing the specified widget, set the attribute used for+-- drawing to the one with the specified name. Note that the widget may+-- make further changes to the active drawing attribute, so this only+-- takes effect if nothing in the specified widget invokes 'withAttr'+-- or otherwise changes the rendering context's attribute setup. If you+-- want to prevent that, use 'forceAttr'. Attributes used this way still+-- get merged hierarchically and still fall back to the attribute map's+-- default attribute. If you want to change the default attribute, use+-- 'withDefAttr'.+--+-- For example:+--+-- @+--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)+--                                           , ("warning", bg magenta)+--                                           ]+--+--    renderA :: (String, String) -> [Widget n]+--    renderA (a,b) = hBox [ str a+--                         , str " is "+--                         , withAttr "highlight" (str b)+--                         ]+--+--    render1 = renderA (\"Brick\", "fun")+--    render2 = withAttr "warning" render1+-- @+--+-- In the example above, @render1@ will show @Brick is fun@ where the+-- first two words are white on a blue background and the last word+-- is yellow on a blue background. However, @render2@ will show the+-- first two words in white on magenta although the last word is still+-- rendered in yellow on blue.+withAttr :: AttrName -> Widget n -> Widget n+withAttr an p =+    Widget (hSize p) (vSize p) $+      withReaderT (ctxAttrNameL .~ an) (render p)++-- | Update the attribute map while rendering the specified widget: set+-- the map's default attribute to the one that we get by applying the+-- specified function to the current map's default attribute. This is a+-- variant of 'withDefAttr'; see the latter for more information.+modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n+modifyDefAttr f p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        withReaderT (ctxAttrMapL %~ (setDefaultAttr (f $ getDefaultAttr (c^.ctxAttrMapL)))) (render p)++-- | Update the attribute map used while rendering the specified+-- widget (and any sub-widgets): set its new *default* attribute+-- (i.e. the attribute components that will be applied if not+-- overridden by any more specific attributes) to the one that we get+-- by looking up the specified attribute name in the map.+--+-- For example:+--+-- @+--    ...+--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)+--                                           , ("warning", bg magenta)+--                                           , ("good", white `on` green) ]+--    ...+--+--    renderA :: (String, String) -> [Widget n]+--    renderA (a,b) = hBox [ withAttr "good" (str a)+--                         , str " is "+--                         , withAttr "highlight" (str b) ]+--+--    render1 = renderA (\"Brick\", "fun")+--    render2 = withDefAttr "warning" render1+-- @+--+-- In the above, render1 will show "Brick is fun" where the first word+-- is white on a green background, the middle word is white on a blue+-- background, and the last word is yellow on a blue background.+-- However, render2 will show the first word in the same colors but+-- the middle word will be shown in whatever the terminal's normal+-- foreground is on a magenta background, and the third word will be+-- yellow on a magenta background.+withDefAttr :: AttrName -> Widget n -> Widget n+withDefAttr an p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        withReaderT (ctxAttrMapL %~ (setDefaultAttr (attrMapLookup an (c^.ctxAttrMapL)))) (render p)++-- | While rendering the specified widget, use a transformed version+-- of the current attribute map. This is a very general function with+-- broad capabilities: you probably want a more specific function such+-- as 'withDefAttr' or 'withAttr'.+updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n+updateAttrMap f p =+    Widget (hSize p) (vSize p) $+        withReaderT (ctxAttrMapL %~ f) (render p)++-- | When rendering the specified widget, force all attribute lookups+-- in the attribute map to use the value currently assigned to the+-- specified attribute name. This means that the attribute lookups will+-- behave as if they all used the name specified here. That further+-- means that the resolved attribute will still inherit from its parent+-- entry in the attribute map as would normally be the case. If you+-- want to have more control over the resulting attribute, consider+-- 'modifyDefAttr'.+--+-- For example:+--+-- @+--    ...+--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)+--                                           , ("notice", fg red) ]+--    ...+--+--    renderA :: (String, String) -> [Widget n]+--    renderA (a,b) = hBox [ withAttr "highlight" (str a)+--                         , str " is "+--                         , withAttr "highlight" (str b)+--                         ]+--+--    render1 = renderA ("Brick", "fun")+--    render2 = forceAttr "notice" render1+-- @+--+-- In the above, render1 will show "Brick is fun" where the first and+-- last words are yellow on a blue background and the middle word is+-- white on a blue background.  However, render2 will show all words+-- in red on a blue background.  In both versions, the middle word+-- will be in white on a blue background.+forceAttr :: AttrName -> Widget n -> Widget n+forceAttr an p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        withReaderT (ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)++-- | Like 'forceAttr', except that the style of attribute lookups in the+-- attribute map is preserved and merged with the forced attribute. This+-- allows for situations where 'forceAttr' would otherwise ignore style+-- information that is important to preserve.+forceAttrAllowStyle :: AttrName -> Widget n -> Widget n+forceAttrAllowStyle an p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        let m = c^.ctxAttrMapL+        withReaderT (ctxAttrMapL .~ (forceAttrMapAllowStyle (attrMapLookup an m) m)) (render p)++-- | Override the lookup of the attribute name 'targetName' to return+-- the attribute value associated with 'fromName' when rendering the+-- specified widget.+--+-- For example:+--+-- @+--    appAttrMap = attrMap (white `on` blue) [ ("highlight", fg yellow)+--                                           , ("notice", fg red)+--                                           ]+--+--    renderA :: (String, String) -> [Widget n]+--    renderA (a, b) = str a <+> str " is " <+> withAttr "highlight" (str b)+--+--    render1 = withAttr "notice" $ renderA ("Brick", "fun")+--    render2 = overrideAttr "highlight" "notice" render1+-- @+--+-- In the example above, @render1@ will show @Brick is fun@ where the+-- first two words are red on a blue background, but @fun@ is yellow on+-- a blue background. However, @render2@ will show all three words in+-- red on a blue background.+overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n+overrideAttr targetName fromName =+    updateAttrMap (mapAttrName fromName targetName)++-- | Build a widget directly from a raw Vty image.+raw :: V.Image -> Widget n+raw img = Widget Fixed Fixed $ return $ emptyResult & imageL .~ img++-- | Translate the specified widget by the specified offset amount.+-- Defers to the translated widget for growth policy.+translateBy :: Location -> Widget n -> Widget n+translateBy off p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      return $ addResultOffset off+             $ result & imageL %~ (V.translate (off^.locationColumnL) (off^.locationRowL))++-- | Given a widget, translate it to position it relative to the+-- upper-left coordinates of a reported extent with the specified+-- positioning offset. If the specified name has no reported extent,+-- this draws nothing on the basis that it only makes sense to draw what+-- was requested when the relative position can be known.+--+-- This is only useful for positioning something in a higher layer+-- relative to a reported extent in a lower layer. Any other use is+-- likely to result in the specified widget not being rendered. This+-- is because this function relies on information about lower layer+-- renderings in order to work; using it with a resource name that+-- wasn't rendered in a lower layer will result in this being equivalent+-- to @emptyWidget@.+--+-- For example, if you have two layers @topLayer@ and @bottomLayer@,+-- then a widget drawn in @bottomLayer@ with @reportExtent Foo@ can be+-- used to relatively position a widget in @topLayer@ with @topLayer =+-- relativeTo Foo ...@.+relativeTo :: (Ord n) => n -> Location -> Widget n -> Widget n+relativeTo n off w =+    Widget (hSize w) (vSize w) $ do+        mExt <- lookupReportedExtent n+        case mExt of+            Nothing -> render emptyWidget+            Just ext -> render $ translateBy (extentUpperLeft ext <> off) w++-- | Crop the specified widget on the left by the specified number of+-- columns. Defers to the cropped widget for growth policy.+cropLeftBy :: Int -> Widget n -> Widget n+cropLeftBy cols p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageWidth (result^.imageL) - cols+          cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img+      render $ Widget (hSize p) (vSize p) $+               withReaderT (availWidthL .~ amt) $+                   cropResultToContext $+                       addResultOffset (Location (-1 * cols, 0)) $+                           result & imageL %~ cropped++-- | Crop the specified widget to the specified size from the left.+-- Defers to the cropped widget for growth policy.+cropLeftTo :: Int -> Widget n -> Widget n+cropLeftTo cols p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let w = V.imageWidth $ result^.imageL+            amt = w - cols+        if w <= cols+           then return result+           else render $ cropLeftBy amt $ Widget Fixed Fixed $ return result++-- | Crop the specified widget on the right by the specified number of+-- columns. Defers to the cropped widget for growth policy.+cropRightBy :: Int -> Widget n -> Widget n+cropRightBy cols p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageWidth (result^.imageL) - cols+          cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img+      withReaderT (availWidthL .~ amt) $+          cropResultToContext $ result & imageL %~ cropped++-- | Crop the specified widget to the specified size from the right.+-- Defers to the cropped widget for growth policy.+cropRightTo :: Int -> Widget n -> Widget n+cropRightTo cols p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let w = V.imageWidth $ result^.imageL+            amt = w - cols+        if w <= cols+           then return result+           else render $ cropRightBy amt $ Widget Fixed Fixed $ return result++-- | Crop the specified widget on the top by the specified number of+-- rows. Defers to the cropped widget for growth policy.+cropTopBy :: Int -> Widget n -> Widget n+cropTopBy rows p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageHeight (result^.imageL) - rows+          cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img+      render $ Widget (hSize p) (vSize p) $+               withReaderT (availHeightL .~ amt) $+                   cropResultToContext $+                       addResultOffset (Location (0, -1 * rows)) $+                           result & imageL %~ cropped++-- | Crop the specified widget to the specified size from the top.+-- Defers to the cropped widget for growth policy.+cropTopTo :: Int -> Widget n -> Widget n+cropTopTo rows p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let h = V.imageHeight $ result^.imageL+            amt = h - rows+        if h <= rows+           then return result+           else render $ cropTopBy amt $ Widget Fixed Fixed $ return result++-- | Crop the specified widget on the bottom by the specified number of+-- rows. Defers to the cropped widget for growth policy.+cropBottomBy :: Int -> Widget n -> Widget n+cropBottomBy rows p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageHeight (result^.imageL) - rows+          cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img+      withReaderT (availHeightL .~ amt) $+          cropResultToContext $ result & imageL %~ cropped++-- | Crop the specified widget to the specified size from the bottom.+-- Defers to the cropped widget for growth policy.+cropBottomTo :: Int -> Widget n -> Widget n+cropBottomTo rows p =+    Widget (hSize p) (vSize p) $ do+        result <- render p+        let h = V.imageHeight $ result^.imageL+            amt = h - rows+        if h <= rows+           then return result+           else render $ cropBottomBy amt $ Widget Fixed Fixed $ return result++-- | When rendering the specified widget, also register a cursor+-- positioning request using the specified name and location.+showCursor :: n -> Location -> Widget n -> Widget n+showCursor n cloc p = Widget (hSize p) (vSize p) $+    (cursorsL %~ (CursorLocation cloc (Just n) True:)) <$> (render p)++-- | When rendering the specified widget, also register a cursor+-- positioning request using the specified name and location.+-- The cursor will only be positioned but not made visible.+putCursor :: n -> Location -> Widget n -> Widget n+putCursor n cloc p = Widget (hSize p) (vSize p) $+    (cursorsL %~ (CursorLocation cloc (Just n) False:)) <$> (render p)++hRelease :: Widget n -> Maybe (Widget n)+hRelease p =+    case hSize p of+        Fixed -> Just $ Widget Greedy (vSize p) $+                        withReaderT (availWidthL .~ unrestricted) (render p)+        Greedy -> Nothing++vRelease :: Widget n -> Maybe (Widget n)+vRelease p =+    case vSize p of+        Fixed -> Just $ Widget (hSize p) Greedy $+                        withReaderT (availHeightL .~ unrestricted) (render p)+        Greedy -> Nothing++-- | If the specified resource name has an entry in the rendering cache,+-- use the rendered version from the cache. If not, render the specified+-- widget and update the cache with the result.+--+-- To ensure that mouse events are emitted correctly for cached widgets,+-- in addition to the rendered widget, we also cache (the names of) any+-- clickable extents that were rendered and restore that when utilizing+-- the cache.+--+-- See also 'invalidateCacheEntry'.+cached :: (Ord n) => n -> Widget n -> Widget n+cached n w =+    Widget (hSize w) (vSize w) $ do+        result <- cacheLookup n+        case result of+            Just (clickables, prevResult) -> do+                clickableNamesL %= (clickables ++)+                return prevResult+            Nothing  -> do+                wResult <- render w+                clickables <- renderedClickables wResult+                cacheUpdate n (clickables, wResult & visibilityRequestsL .~ mempty)+                return wResult+    where+        -- Given the rendered result of a Widget, collect the list of "clickable" names+        -- from the extents that were in the result.+        renderedClickables :: (Ord n) => Result n -> RenderM n [n]+        renderedClickables renderResult = do+            allClickables <- use clickableNamesL+            return [extentName e | e <- renderResult^.extentsL, extentName e `elem` allClickables]++cacheLookup :: (Ord n) => n -> RenderM n (Maybe ([n], Result n))+cacheLookup n = do+    cache <- lift $ gets (^.renderCacheL)+    return $ M.lookup n cache++cacheUpdate :: Ord n => n -> ([n], Result n) -> RenderM n ()+cacheUpdate n r = lift $ modify (renderCacheL %~ M.insert n r)++-- | Enable vertical scroll bars on all viewports in the specified+-- widget and draw them with the specified orientation.+withVScrollBars :: VScrollBarOrientation -> Widget n -> Widget n+withVScrollBars orientation w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxVScrollBarOrientationL .~ Just orientation) (render w)++-- | Enable scroll bar handles on all vertical scroll bars in the+-- specified widget. Handles appear at the ends of the scroll bar,+-- representing the "handles" that are typically clickable in+-- graphical UIs to move the scroll bar incrementally. Vertical+-- scroll bars are also clickable if mouse mode is enabled and if+-- 'withClickableVScrollBars' is used.+--+-- This will only have an effect if 'withVScrollBars' is also called.+withVScrollBarHandles :: Widget n -> Widget n+withVScrollBarHandles w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxVScrollBarShowHandlesL .~ True) (render w)++-- | Render vertical viewport scroll bars in the specified widget with+-- the specified renderer. This is only needed if you want to override+-- the use of the default renderer, 'verticalScrollbarRenderer'.+withVScrollBarRenderer :: VScrollbarRenderer n -> Widget n -> Widget n+withVScrollBarRenderer r w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxVScrollBarRendererL .~ Just r) (render w)++-- | The default renderer for vertical viewport scroll bars. Override+-- with 'withVScrollBarRenderer'.+verticalScrollbarRenderer :: VScrollbarRenderer n+verticalScrollbarRenderer =+    VScrollbarRenderer { renderVScrollbar = fill '█'+                       , renderVScrollbarTrough = fill ' '+                       , renderVScrollbarHandleBefore = str "^"+                       , renderVScrollbarHandleAfter = str "v"+                       , scrollbarWidthAllocation = 1+                       }++-- | Enable horizontal scroll bars on all viewports in the specified+-- widget and draw them with the specified orientation.+withHScrollBars :: HScrollBarOrientation -> Widget n -> Widget n+withHScrollBars orientation w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxHScrollBarOrientationL .~ Just orientation) (render w)++-- | Enable mouse click reporting on horizontal scroll bars in the+-- specified widget. This must be used with 'withHScrollBars'. The+-- provided function is used to build a resource name containing the+-- scroll bar element clicked and the viewport name associated with the+-- scroll bar. It is usually a data constructor of the @n@ type.+withClickableHScrollBars :: (ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n+withClickableHScrollBars f w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxHScrollBarClickableConstrL .~ Just f) (render w)++-- | Enable mouse click reporting on vertical scroll bars in the+-- specified widget. This must be used with 'withVScrollBars'. The+-- provided function is used to build a resource name containing the+-- scroll bar element clicked and the viewport name associated with the+-- scroll bar. It is usually a data constructor of the @n@ type.+withClickableVScrollBars :: (ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n+withClickableVScrollBars f w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxVScrollBarClickableConstrL .~ Just f) (render w)++-- | Enable scroll bar handles on all horizontal scroll bars in+-- the specified widget. Handles appear at the ends of the scroll+-- bar, representing the "handles" that are typically clickable in+-- graphical UIs to move the scroll bar incrementally. Horizontal+-- scroll bars are also clickable if mouse mode is enabled and if+-- 'withClickableHScrollBars' is used.+--+-- This will only have an effect if 'withHScrollBars' is also called.+withHScrollBarHandles :: Widget n -> Widget n+withHScrollBarHandles w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxHScrollBarShowHandlesL .~ True) (render w)++-- | Render horizontal viewport scroll bars in the specified widget with+-- the specified renderer. This is only needed if you want to override+-- the use of the default renderer, 'horizontalScrollbarRenderer'.+withHScrollBarRenderer :: HScrollbarRenderer n -> Widget n -> Widget n+withHScrollBarRenderer r w =+    Widget (hSize w) (vSize w) $+        withReaderT (ctxHScrollBarRendererL .~ Just r) (render w)++-- | The default renderer for horizontal viewport scroll bars. Override+-- with 'withHScrollBarRenderer'.+horizontalScrollbarRenderer :: HScrollbarRenderer n+horizontalScrollbarRenderer =+    HScrollbarRenderer { renderHScrollbar = fill '█'+                       , renderHScrollbarTrough = fill ' '+                       , renderHScrollbarHandleBefore = str "<"+                       , renderHScrollbarHandleAfter = str ">"+                       , scrollbarHeightAllocation = 1+                       }++-- | Render the specified widget in a named viewport with the+-- specified type. This permits widgets to be scrolled without being+-- scrolling-aware. To make the most use of viewports, the specified+-- widget should use the 'visible' combinator to make a "visibility+-- request". This viewport combinator will then translate the resulting+-- rendering to make the requested region visible. In addition, the+-- 'Brick.Main.EventM' monad provides primitives to scroll viewports+-- created by this function if 'visible' is not what you want.+--+-- This function can automatically render vertical and horizontal scroll+-- bars if desired. To enable scroll bars, wrap your call to 'viewport'+-- with a call to 'withVScrollBars' and/or 'withHScrollBars'. If you+-- don't like the appearance of the resulting scroll bars (defaults:+-- 'verticalScrollbarRenderer' and 'horizontalScrollbarRenderer'),+-- you can customize how they are drawn by making your own+-- 'VScrollbarRenderer' or 'HScrollbarRenderer' and using+-- 'withVScrollBarRenderer' and/or 'withHScrollBarRenderer'. Note that+-- when you enable scrollbars, the content of your viewport will lose+-- one column of available space if vertical scroll bars are enabled and+-- one row of available space if horizontal scroll bars are enabled.+--+-- If a viewport receives more than one visibility request, then the+-- visibility requests are merged with the inner visibility request+-- taking preference. If a viewport receives more than one scrolling+-- request from 'Brick.Main.EventM', all are honored in the order in+-- which they are received.+--+-- Some caution should be advised when using this function. The viewport+-- renders its contents anew each time the viewport is drawn; in many+-- cases this is prohibitively expensive, and viewports should not be+-- used to display large contents for scrolling. This function is best+-- used when the contents are not too large OR when the contents are+-- large and render-cacheable.+--+-- Also, be aware that there is a rich API for accessing viewport+-- information from within the 'EventM' monad; check the docs for+-- @Brick.Main@ to learn more about ways to get information about+-- viewports after they're drawn.+viewport :: (Ord n, Show n)+         => n+         -- ^ The name of the viewport (must be unique and stable for+         -- reliable behavior)+         -> ViewportType+         -- ^ The type of viewport (indicates the permitted scrolling+         -- direction)+         -> Widget n+         -- ^ The widget to be rendered in the scrollable viewport+         -> Widget n+viewport vpname typ p =+    clickable vpname $ Widget Greedy Greedy $ do+      -- Obtain the scroll bar configuration.+      c <- getContext+      let vsOrientation = ctxVScrollBarOrientation c+          hsOrientation = ctxHScrollBarOrientation c+          vsRenderer = fromMaybe verticalScrollbarRenderer (ctxVScrollBarRenderer c)+          hsRenderer = fromMaybe horizontalScrollbarRenderer (ctxHScrollBarRenderer c)+          showVHandles = ctxVScrollBarShowHandles c+          showHHandles = ctxHScrollBarShowHandles c+          vsbClickableConstr = ctxVScrollBarClickableConstr c+          hsbClickableConstr = ctxHScrollBarClickableConstr c++      -- Observe the viewport name so we can detect multiple uses of the+      -- name.+      let observeName :: (Ord n, Show n) => n -> RenderM n ()+          observeName n = do+              observed <- use observedNamesL+              case S.member n observed of+                  False -> observedNamesL %= S.insert n+                  True ->+                      error $ "Error: while rendering the interface, the name " <> show n <>+                              " was seen more than once. You should ensure that all of the widgets " <>+                              "in each interface have unique name values. This means either " <>+                              "using a different name type or adding constructors to your " <>+                              "existing one and using those to name your widgets.  For more " <>+                              "information, see the \"Resource Names\" section of the Brick User Guide."++      observeName vpname++      -- Update the viewport size.+      let newVp = VP 0 0 newSize (0, 0)+          newSize = (newWidth, newHeight)+          newWidth = c^.availWidthL - vSBWidth+          newHeight = c^.availHeightL - hSBHeight+          vSBWidth = maybe 0 (const $ scrollbarWidthAllocation vsRenderer) vsOrientation+          hSBHeight = maybe 0 (const $ scrollbarHeightAllocation hsRenderer) hsOrientation+          doInsert (Just vp) = Just $ vp & vpSize .~ newSize+          doInsert Nothing = Just newVp++      lift $ modify (viewportMapL %~ (M.alter doInsert vpname))++      -- Then render the viewport content widget with the rendering+      -- layout constraint released (but raise an exception if we are+      -- asked to render an infinitely-sized widget in the viewport's+      -- scrolling dimension). Also note that for viewports that+      -- only scroll in one direction, we apply a constraint in the+      -- non-scrolling direction in case a scroll bar is present.+      let release = case typ of+            Vertical -> vRelease . hLimit newWidth+            Horizontal -> hRelease . vLimit newHeight+            Both -> vRelease >=> hRelease+          released = case release p of+            Just w -> w+            Nothing -> case typ of+                Vertical -> error $ "tried to embed an infinite-height " <>+                                    "widget in vertical viewport " <> (show vpname)+                Horizontal -> error $ "tried to embed an infinite-width " <>+                                      "widget in horizontal viewport " <> (show vpname)+                Both -> error $ "tried to embed an infinite-width or " <>+                                "infinite-height widget in 'Both' type " <>+                                "viewport " <> (show vpname)++      initialResult <- render released++      -- If the rendering state includes any scrolling requests for this+      -- viewport, apply those+      reqs <- lift $ gets (^.rsScrollRequestsL)+      let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs+      when (not $ null relevantRequests) $ do+          mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname))+          case mVp of+              Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+              Just vp -> do+                  let updatedVp = applyRequests relevantRequests vp+                      applyRequests [] v = v+                      applyRequests (rq:rqs) v =+                          case typ of+                              Horizontal -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v+                              Vertical -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v+                              Both -> scrollTo Horizontal rq (initialResult^.imageL) $+                                      scrollTo Vertical rq (initialResult^.imageL) $+                                      applyRequests rqs v+                  lift $ modify (viewportMapL %~ (M.insert vpname updatedVp))++      -- If the sub-rendering requested visibility, update the scroll+      -- state accordingly+      when (not $ null $ initialResult^.visibilityRequestsL) $ do+          mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname))+          case mVp of+              Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+              Just vp -> do+                  let rqs = initialResult^.visibilityRequestsL+                      updateVp vp' rq = case typ of+                          Both -> scrollToView Horizontal rq $ scrollToView Vertical rq vp'+                          Horizontal -> scrollToView typ rq vp'+                          Vertical -> scrollToView typ rq vp'+                  lift $ modify (viewportMapL %~ (M.insert vpname $ foldl updateVp vp rqs))++      -- If the size of the rendering changes enough to make the+      -- viewport offsets invalid, reset them+      mVp <- lift $ gets (^.viewportMapL.to (M.lookup vpname))+      vp <- case mVp of+          Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+          Just v -> return v++      let img = initialResult^.imageL+          fixTop v = if V.imageHeight img < v^.vpSize._2+                   then v & vpTop .~ 0+                   else v+          fixLeft v = if V.imageWidth img < v^.vpSize._1+                   then v & vpLeft .~ 0+                   else v+          updateContentSize v = v & vpContentSize .~ (V.imageWidth img, V.imageHeight img)+          updateVp = updateContentSize . case typ of+              Both -> fixLeft . fixTop+              Horizontal -> fixLeft+              Vertical -> fixTop+      lift $ modify (viewportMapL %~ (M.insert vpname (updateVp vp)))++      -- Get the viewport state now that it has been updated.+      mVpFinal <- lift $ gets (M.lookup vpname . (^.viewportMapL))+      vpFinal <- case mVpFinal of+          Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+          Just v -> return v++      -- Then perform a translation of the sub-rendering to fit into the+      -- viewport+      translated <- render $ translateBy (Location (-1 * vpFinal^.vpLeft, -1 * vpFinal^.vpTop))+                           $ Widget Fixed Fixed $ return initialResult++      -- If the vertical scroll bar is enabled, render the scroll bar+      -- area.+      let addVScrollbar = case vsOrientation of+              Nothing -> id+              Just orientation ->+                  let sb = verticalScrollbar vsRenderer orientation+                                                        vpname+                                                        vsbClickableConstr+                                                        showVHandles+                                                        (vpFinal^.vpSize._2)+                                                        (vpFinal^.vpTop)+                                                        (vpFinal^.vpContentSize._2)+                      combine = case orientation of+                          OnLeft -> (<+>)+                          OnRight -> flip (<+>)+                  in combine sb+          addHScrollbar = case hsOrientation of+              Nothing -> id+              Just orientation ->+                  let sb = horizontalScrollbar hsRenderer orientation+                                                          vpname+                                                          hsbClickableConstr+                                                          showHHandles+                                                          (vpFinal^.vpSize._1)+                                                          (vpFinal^.vpLeft)+                                                          (vpFinal^.vpContentSize._1)+                      combine = case orientation of+                          OnTop -> (<=>)+                          OnBottom -> flip (<=>)+                  in combine sb++      -- Return the translated result with the visibility requests+      -- discarded+      let translatedSize = ( translated^.imageL.to V.imageWidth+                           , translated^.imageL.to V.imageHeight+                           )+      case translatedSize of+          (0, 0) -> do+              let spaceFill = V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL)+              return $ translated & imageL .~ spaceFill+                                  & visibilityRequestsL .~ mempty+                                  & extentsL .~ mempty+          _ -> render $ addVScrollbar+                      $ addHScrollbar+                      $ vLimit (vpFinal^.vpSize._2)+                      $ hLimit (vpFinal^.vpSize._1)+                      $ padBottom Max+                      $ padRight Max+                      $ Widget Fixed Fixed+                      $ return $ translated & visibilityRequestsL .~ mempty++-- | The base attribute for scroll bars.+scrollbarAttr :: AttrName+scrollbarAttr = attrName "scrollbar"++-- | The attribute for scroll bar troughs. This attribute is a+-- specialization of @scrollbarAttr@.+scrollbarTroughAttr :: AttrName+scrollbarTroughAttr = scrollbarAttr <> attrName "trough"++-- | The attribute for scroll bar handles. This attribute is a+-- specialization of @scrollbarAttr@.+scrollbarHandleAttr :: AttrName+scrollbarHandleAttr = scrollbarAttr <> attrName "handle"++maybeClick :: (Ord n)+           => n+           -> Maybe (ClickableScrollbarElement -> n -> n)+           -> ClickableScrollbarElement+           -> Widget n+           -> Widget n+maybeClick _ Nothing _ w = w+maybeClick n (Just f) el w = clickable (f el n) w++-- | Build a vertical scroll bar using the specified renderer and+-- settings.+--+-- You probably don't want to use this directly; instead,+-- use @viewport@, @withVScrollBars@, and, if needed,+-- @withVScrollBarRenderer@. This is exposed so that if you want to+-- render a scroll bar of your own, you can do so outside the @viewport@+-- context.+verticalScrollbar :: (Ord n)+                  => VScrollbarRenderer n+                  -- ^ The renderer to use.+                  -> VScrollBarOrientation+                  -- ^ The scroll bar orientation. The orientation+                  -- governs how additional padding is added to+                  -- the scroll bar if it is smaller than it space+                  -- allocation according to 'scrollbarWidthAllocation'.+                  -> n+                  -- ^ The viewport name associated with this scroll+                  -- bar.+                  -> Maybe (ClickableScrollbarElement -> n -> n)+                  -- ^ Constructor for clickable scroll bar element names.+                  -> Bool+                  -- ^ Whether to display handles.+                  -> Int+                  -- ^ The total viewport height in effect.+                  -> Int+                  -- ^ The viewport vertical scrolling offset in effect.+                  -> Int+                  -- ^ The total viewport content height.+                  -> Widget n+verticalScrollbar vsRenderer o n constr showHandles vpHeight vOffset contentHeight =+    hLimit (scrollbarWidthAllocation vsRenderer) $+    applyPadding $+    if showHandles+       then vBox [ vLimit 1 $+                   maybeClick n constr SBHandleBefore $+                   withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleBefore vsRenderer+                 , sbBody+                 , vLimit 1 $+                   maybeClick n constr SBHandleAfter $+                   withDefAttr scrollbarHandleAttr $ renderVScrollbarHandleAfter vsRenderer+                 ]+       else sbBody+    where+        sbBody = verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight+        applyPadding = case o of+            OnLeft -> padRight Max+            OnRight -> padLeft Max++verticalScrollbar' :: (Ord n)+                   => VScrollbarRenderer n+                   -- ^ The renderer to use.+                   -> n+                   -- ^ The viewport name associated with this scroll+                   -- bar.+                   -> Maybe (ClickableScrollbarElement -> n -> n)+                   -- ^ Constructor for clickable scroll bar element+                   -- names. Will be given the element name and the+                   -- viewport name.+                   -> Int+                   -- ^ The total viewport height in effect.+                   -> Int+                   -- ^ The viewport vertical scrolling offset in effect.+                   -> Int+                   -- ^ The total viewport content height.+                   -> Widget n+verticalScrollbar' vsRenderer _ _ vpHeight _ 0 =+    vLimit vpHeight $ renderVScrollbarTrough vsRenderer+verticalScrollbar' vsRenderer n constr vpHeight vOffset contentHeight =+    Widget Fixed Greedy $ do+        c <- getContext++        -- Get the proportion of the total content that is visible+        let visibleContentPercent :: Double+            visibleContentPercent = fromIntegral vpHeight /+                                    fromIntegral contentHeight++            ctxHeight = c^.availHeightL++            -- Then get the proportion of the scroll bar that+            -- should be filled in+            sbSize = min ctxHeight $+                     max 1 $+                     round $ visibleContentPercent * (fromIntegral ctxHeight)++            -- Then get the vertical offset of the scroll bar+            -- itself+            sbOffset = if vOffset == 0+                       then 0+                       else if vOffset == contentHeight - vpHeight+                            then ctxHeight - sbSize+                            else min (ctxHeight - sbSize - 1) $+                                 max 1 $+                                 round $ fromIntegral ctxHeight *+                                         (fromIntegral vOffset /+                                          fromIntegral contentHeight::Double)++            sbAbove = maybeClick n constr SBTroughBefore $+                      withDefAttr scrollbarTroughAttr $ vLimit sbOffset $+                      renderVScrollbarTrough vsRenderer+            sbBelow = maybeClick n constr SBTroughAfter $+                      withDefAttr scrollbarTroughAttr $ vLimit (ctxHeight - (sbOffset + sbSize)) $+                      renderVScrollbarTrough vsRenderer+            sbMiddle = maybeClick n constr SBBar $+                       withDefAttr scrollbarAttr $ vLimit sbSize $ renderVScrollbar vsRenderer++            sb = if sbSize == ctxHeight+                 then vLimit sbSize $+                      renderVScrollbarTrough vsRenderer+                 else vBox [sbAbove, sbMiddle, sbBelow]++        render sb++-- | Build a horizontal scroll bar using the specified renderer and+-- settings.+--+-- You probably don't want to use this directly; instead, use+-- @viewport@, @withHScrollBars@, and, if needed,+-- @withHScrollBarRenderer@. This is exposed so that if you want to+-- render a scroll bar of your own, you can do so outside the @viewport@+-- context.+horizontalScrollbar :: (Ord n)+                    => HScrollbarRenderer n+                    -- ^ The renderer to use.+                    -> HScrollBarOrientation+                    -- ^ The scroll bar orientation. The orientation+                    -- governs how additional padding is added+                    -- to the scroll bar if it is smaller+                    -- than it space allocation according to+                    -- 'scrollbarHeightAllocation'.+                    -> n+                    -- ^ The viewport name associated with this scroll+                    -- bar.+                    -> Maybe (ClickableScrollbarElement -> n -> n)+                    -- ^ Constructor for clickable scroll bar element+                    -- names. Will be given the element name and the+                    -- viewport name.+                    -> Bool+                    -- ^ Whether to show handles.+                    -> Int+                    -- ^ The total viewport width in effect.+                    -> Int+                    -- ^ The viewport horizontal scrolling offset in effect.+                    -> Int+                    -- ^ The total viewport content width.+                    -> Widget n+horizontalScrollbar hsRenderer o n constr showHandles vpWidth hOffset contentWidth =+    vLimit (scrollbarHeightAllocation hsRenderer) $+    applyPadding $+    if showHandles+       then hBox [ hLimit 1 $+                   maybeClick n constr SBHandleBefore $+                   withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleBefore hsRenderer+                 , sbBody+                 , hLimit 1 $+                   maybeClick n constr SBHandleAfter $+                   withDefAttr scrollbarHandleAttr $ renderHScrollbarHandleAfter hsRenderer+                 ]+       else sbBody+    where+        sbBody = horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth+        applyPadding = case o of+            OnTop -> padBottom Max+            OnBottom -> padTop Max++horizontalScrollbar' :: (Ord n)+                     => HScrollbarRenderer n+                     -- ^ The renderer to use.+                     -> n+                     -- ^ The viewport name associated with this scroll+                     -- bar.+                     -> Maybe (ClickableScrollbarElement -> n -> n)+                     -- ^ Constructor for clickable scroll bar element+                     -- names.+                     -> Int+                     -- ^ The total viewport width in effect.+                     -> Int+                     -- ^ The viewport horizontal scrolling offset in effect.+                     -> Int+                     -- ^ The total viewport content width.+                     -> Widget n+horizontalScrollbar' hsRenderer _ _ vpWidth _ 0 =+    hLimit vpWidth $ renderHScrollbarTrough hsRenderer+horizontalScrollbar' hsRenderer n constr vpWidth hOffset contentWidth =+    Widget Greedy Fixed $ do+        c <- getContext++        -- Get the proportion of the total content that is visible+        let visibleContentPercent :: Double+            visibleContentPercent = fromIntegral vpWidth /+                                    fromIntegral contentWidth++            ctxWidth = c^.availWidthL++            -- Then get the proportion of the scroll bar that+            -- should be filled in+            sbSize = min ctxWidth $+                     max 1 $+                     round $ visibleContentPercent * (fromIntegral ctxWidth)++            -- Then get the horizontal offset of the scroll bar itself+            sbOffset = if hOffset == 0+                       then 0+                       else if hOffset == contentWidth - vpWidth+                            then ctxWidth - sbSize+                            else min (ctxWidth - sbSize - 1) $+                                 max 1 $+                                 round $ fromIntegral ctxWidth *+                                         (fromIntegral hOffset /+                                          fromIntegral contentWidth::Double)++            sbLeft = maybeClick n constr SBTroughBefore $+                     withDefAttr scrollbarTroughAttr $ hLimit sbOffset $+                     renderHScrollbarTrough hsRenderer+            sbRight = maybeClick n constr SBTroughAfter $+                      withDefAttr scrollbarTroughAttr $ hLimit (ctxWidth - (sbOffset + sbSize)) $+                      renderHScrollbarTrough hsRenderer+            sbMiddle = maybeClick n constr SBBar $+                       withDefAttr scrollbarAttr $ hLimit sbSize $ renderHScrollbar hsRenderer++            sb = if sbSize == ctxWidth+                 then hLimit sbSize $+                      renderHScrollbarTrough hsRenderer+                 else hBox [sbLeft, sbMiddle, sbRight]++        render sb++-- | Given a name, obtain the viewport for that name by consulting the+-- viewport map in the rendering monad. NOTE! Some care must be taken+-- when calling this function, since it only returns useful values+-- after the viewport in question has been rendered. If you call this+-- function during rendering before a viewport has been rendered, you+-- may get nothing or you may get a stale version of the viewport. This+-- is because viewports are updated during rendering and the one you are+-- interested in may not have been rendered yet. So if you want to use+-- this, be sure you know what you are doing.+unsafeLookupViewport :: (Ord n) => n -> RenderM n (Maybe Viewport)+unsafeLookupViewport name = lift $ gets (M.lookup name . (^.viewportMapL))++scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport+scrollTo Both _ _ _ = error "BUG: called scrollTo on viewport type 'Both'"+scrollTo Vertical req img vp = vp & vpTop .~ newVStart+    where+        newVStart = clamp 0 (V.imageHeight img - vp^.vpSize._2) adjustedAmt+        adjustedAmt = case req of+            VScrollBy amt -> vp^.vpTop + amt+            VScrollPage Up -> vp^.vpTop - vp^.vpSize._2+            VScrollPage Down -> vp^.vpTop + vp^.vpSize._2+            VScrollToBeginning -> 0+            VScrollToEnd -> V.imageHeight img - vp^.vpSize._2+            SetTop i -> i+            _ -> vp^.vpTop+scrollTo Horizontal req img vp = vp & vpLeft .~ newHStart+    where+        newHStart = clamp 0 (V.imageWidth img - vp^.vpSize._1) adjustedAmt+        adjustedAmt = case req of+            HScrollBy amt -> vp^.vpLeft + amt+            HScrollPage Up -> vp^.vpLeft - vp^.vpSize._1+            HScrollPage Down -> vp^.vpLeft + vp^.vpSize._1+            HScrollToBeginning -> 0+            HScrollToEnd -> V.imageWidth img - vp^.vpSize._1+            SetLeft i -> i+            _ -> vp^.vpLeft++scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport+scrollToView Both _ _ = error "BUG: called scrollToView on 'Both' type viewport"+scrollToView Vertical rq vp = vp & vpTop .~ newVStart+    where+        curStart = vp^.vpTop+        curEnd = curStart + vp^.vpSize._2+        reqStart = rq^.vrPositionL.locationRowL++        reqEnd = rq^.vrPositionL.locationRowL + rq^.vrSizeL._2+        newVStart :: Int+        newVStart = if reqStart < vStartEndVisible+                   then reqStart+                   else vStartEndVisible+        vStartEndVisible = if reqEnd < curEnd+                           then curStart+                           else curStart + (reqEnd - curEnd)+scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart+    where+        curStart = vp^.vpLeft+        curEnd = curStart + vp^.vpSize._1+        reqStart = rq^.vrPositionL.locationColumnL++        reqEnd = rq^.vrPositionL.locationColumnL + rq^.vrSizeL._1+        newHStart :: Int+        newHStart = if reqStart < hStartEndVisible+                   then reqStart+                   else hStartEndVisible+        hStartEndVisible = if reqEnd < curEnd+                           then curStart+                           else curStart + (reqEnd - curEnd)++-- | Request that the specified widget be made visible when it is+-- rendered inside a viewport. This permits widgets (whose sizes and+-- positions cannot be known due to being embedded in arbitrary layouts)+-- to make a request for a parent viewport to locate them and scroll+-- enough to put them in view. This, together with 'viewport', is what+-- makes the text editor and list widgets possible without making them+-- deal with the details of scrolling state management.+--+-- This does nothing if not rendered in a viewport.+visible :: Widget n -> Widget n+visible p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let imageSize = ( result^.imageL.to V.imageWidth+                      , result^.imageL.to V.imageHeight+                      )+      -- The size of the image to be made visible in a viewport must have+      -- non-zero size in both dimensions.+      return $ if imageSize^._1 > 0 && imageSize^._2 > 0+               then result & visibilityRequestsL %~ (VR (Location (0, 0)) imageSize :)+               else result++-- | Similar to 'visible', request that a region (with the specified+-- 'Location' as its origin and 'V.DisplayRegion' as its size) be made+-- visible when it is rendered inside a viewport. The 'Location' is+-- relative to the specified widget's upper-left corner of (0, 0).+--+-- This does nothing if not rendered in a viewport.+visibleRegion :: Location -> V.DisplayRegion -> Widget n -> Widget n+visibleRegion vrloc sz p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      -- The size of the image to be made visible in a viewport must have+      -- non-zero size in both dimensions.+      return $ if sz^._1 > 0 && sz^._2 > 0+               then result & visibilityRequestsL %~ (VR vrloc sz :)+               else result++-- | Horizontal box layout: put the specified widgets next to each other+-- in the specified order. Defers growth policies to the growth policies+-- of both widgets.  This operator is a binary version of 'hBox'.+{-# NOINLINE (<+>) #-}+(<+>) :: Widget n+      -- ^ Left+      -> Widget n+      -- ^ Right+      -> Widget n+(<+>) a b = hBox [a, b]++-- | Vertical box layout: put the specified widgets one above the other+-- in the specified order. Defers growth policies to the growth policies+-- of both widgets.  This operator is a binary version of 'vBox'.+{-# NOINLINE (<=>) #-}+(<=>) :: Widget n+      -- ^ Top+      -> Widget n+      -- ^ Bottom+      -> Widget n+(<=>) a b = vBox [a, b]++{-# RULES+"baseHbox" forall a b   . a <+> b                 = hBox [a, b]+"hBox2"    forall as bs . hBox [hBox as, hBox bs] = hBox (as ++ bs)+"hboxL"    forall as b  . hBox [hBox as, b]       = hBox (as ++ [b])+"hboxR"    forall a bs  . hBox [a, hBox bs]       = hBox (a : bs)+"baseVbox" forall a b   . a <=> b                 = vBox [a, b]+"vBox2"    forall as bs . vBox [vBox as, vBox bs] = vBox (as ++ bs)+"vboxL"    forall as b  . vBox [vBox as, b]       = vBox (as ++ [b])+"vboxR"    forall a bs  . vBox [a, vBox bs]       = vBox (a : bs)+  #-}
src/Brick/Widgets/Dialog.hs view
@@ -1,17 +1,31 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- | This module provides a simple dialog widget. You get to pick the -- dialog title, if any, as well as its body and buttons.+--+-- Note that this dialog is really for simple use cases where you want+-- to get the user's answer to a question, such as "Would you like to+-- save changes before quitting?" As is typical in such cases, we assume+-- that this dialog box is used modally, meaning that while it is open+-- it is has exclusive input focus until it is closed.+--+-- If you require something more sophisticated, you'll need to build it+-- yourself. You might also consider seeing the 'Brick.Forms' module for+-- help with input management and see the implementation of this module+-- to see how to reproduce a dialog-style UI. module Brick.Widgets.Dialog   ( Dialog   , dialogTitle-  , dialogName   , dialogButtons-  , dialogSelectedIndex   , dialogWidth   -- * Construction and rendering   , dialog   , renderDialog+  , getDialogFocus+  , setDialogFocus+  -- * Handling events+  , handleDialogEvent   -- * Getting a dialog's current value   , dialogSelection   -- * Attributes@@ -19,21 +33,21 @@   , buttonAttr   , buttonSelectedAttr   -- * Lenses-  , dialogNameL   , dialogButtonsL-  , dialogSelectedIndexL   , dialogWidthL   , dialogTitleL   ) where -import Control.Lens-import Control.Applicative+import Lens.Micro+import Lens.Micro.Mtl ((%=))+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid-import Data.List (intersperse)+#endif+import Data.List (intersperse, find) import Graphics.Vty.Input (Event(..), Key(..)) -import Brick.Util (clamp)+import Brick.Focus import Brick.Types import Brick.Widgets.Core import Brick.Widgets.Center@@ -41,81 +55,100 @@ import Brick.AttrMap  -- | Dialogs present a window with a title (optional), a body, and--- buttons (optional). They provide a 'HandleEvent' instance that knows--- about Tab and Shift-Tab for changing which button is active. Dialog--- buttons are labeled with strings and map to values of type 'a', which--- you choose.+-- buttons (optional). Dialog buttons are labeled with strings and map+-- to values of type 'a', which you choose. ----- Dialogs handle the following events by default:+-- Dialogs handle the following events by default with+-- handleDialogEvent: ----- * Tab: selecte the next button--- * Shift-tab: select the previous button-data Dialog a =-    Dialog { dialogName :: Name-           -- ^ The dialog name-           , dialogTitle :: Maybe String+-- * Tab or Right Arrow: select the next button+-- * Shift-tab or Left Arrow: select the previous button+data Dialog a n =+    Dialog { dialogTitle :: Maybe (Widget n)            -- ^ The dialog title-           , dialogButtons :: [(String, a)]-           -- ^ The dialog button labels and values-           , dialogSelectedIndex :: Maybe Int-           -- ^ The currently selected dialog button index (if any)+           , dialogButtons :: [(String, n, a)]+           -- ^ The dialog buttons' labels, resource names, and values            , dialogWidth :: Int            -- ^ The maximum width of the dialog+           , dialogFocus :: FocusRing n+           -- ^ The focus ring for the dialog's buttons            }  suffixLenses ''Dialog -instance HandleEvent (Dialog a) where-    handleEvent ev d =-        case ev of-            EvKey (KChar '\t') [] -> return $ nextButtonBy 1 d-            EvKey KBackTab [] -> return $ nextButtonBy (-1) d-            _ -> return 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 :: Name-       -- ^ The dialog name, provided so that you can use this as a-       -- basis for viewport names in the dialog if desired-       -> 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 name 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 name title buttons idx w+       -> Dialog a n+dialog title buttonData 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.-renderDialog :: Dialog a -> Widget -> Widget+-- | 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 :: (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)-    in center $+        doBorder = maybe border borderWithLabel (d^.dialogTitleL)+    in centerLayer $        withDefAttr dialogAttr $        hLimit (d^.dialogWidthL) $        doBorder $@@ -123,19 +156,12 @@             , hCenter buttons             ] -nextButtonBy :: Int -> Dialog a -> Dialog a-nextButtonBy amt d =-    let numButtons = length $ d^.dialogButtonsL-    in if numButtons == 0 then d-       else case d^.dialogSelectedIndexL of-           Nothing -> d & dialogSelectedIndexL .~ (Just 0)-           Just i -> d & dialogSelectedIndexL .~ (Just $ (i + amt) `mod` numButtons)---- | Obtain the value associated with the dialog's currently-selected--- button, if any. This function is probably what you want when someone--- presses 'Enter' in a dialog.-dialogSelection :: Dialog a -> Maybe a-dialogSelection d =-    case d^.dialogSelectedIndexL of-        Nothing -> Nothing-        Just i -> Just $ ((d^.dialogButtonsL) !! i)^._2+-- | Obtain the resource name and value associated with the dialog's+-- currently-selected button, if any. The result of this function is+-- probably what you want when someone presses 'Enter' in a dialog.+dialogSelection :: (Eq n) => Dialog a n -> Maybe (n, a)+dialogSelection d = do+    n' <- focusGetCurrent $ dialogFocus d+    let matches (_, n, _) = n == n'+    (_, n, a) <- find matches (d^.dialogButtonsL)+    return (n, a)
src/Brick/Widgets/Edit.hs view
@@ -1,36 +1,60 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE CPP #-} -- | This module provides a basic text editor widget. You'll need to -- embed an 'Editor' in your application state and transform it with--- 'handleEvent' when relevant events arrive. To get the contents+-- 'handleEditorEvent' when relevant events arrive. To get the contents -- of the editor, just use 'getEditContents'. To modify it, use the -- 'Z.TextZipper' interface with 'applyEdit'. ----- The editor's 'HandleEvent' instance handles a set of basic input--- events that should suffice for most purposes; see the source for a--- complete list.+-- The editor's 'handleEditorEvent' function handles a set of basic+-- input events that should suffice for most purposes; see the source+-- for a complete list.+--+-- Bear in mind that the editor provided by this module is intended to+-- provide basic input support for brick applications but it is not+-- intended to be a replacement for your favorite editor such as Vim or+-- Emacs. It is also not suitable for building sophisticated editors. If+-- you want to build your own editor, I suggest starting from scratch. module Brick.Widgets.Edit-  ( Editor(editContents, editorName, editDrawContents)+  ( Editor(editContents, editorName)   -- * Constructing an editor   , editor+  , editorText   -- * Reading editor contents   , getEditContents+  , getCursorPosition+  -- * Handling events+  , handleEditorEvent   -- * Editing text   , applyEdit   -- * Lenses for working with editors   , editContentsL-  , editDrawContentsL   -- * Rendering editors   , renderEditor   -- * Attributes   , editAttr+  , editFocusedAttr+  -- * UTF-8 decoding of editor pastes+  , DecodeUtf8(..)   ) where -import Control.Lens+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import Lens.Micro import Graphics.Vty (Event(..), Key(..), Modifier(..)) -import qualified Data.Text.Zipper as Z+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@@ -38,85 +62,189 @@  -- | 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-data Editor =-    Editor { editContents :: Z.TextZipper String+-- * Paste: Bracketed Pastes from the terminal will be pasted, provided+--   the incoming data is UTF-8-encoded.+data Editor t n =+    Editor { editContents :: Z.TextZipper t            -- ^ The contents of the editor-           , editDrawContents :: [String] -> Widget-           -- ^ The function the editor uses to draw its contents-           , editorName :: Name+           , editorName :: n            -- ^ The name of the editor            }  suffixLenses ''Editor -instance HandleEvent Editor where-    handleEvent 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 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+instance (Show t, Show n) => Show (Editor t n) where+    show e =+        concat [ "Editor { "+               , "editContents = " <> show (editContents e)+               , ", editorName = " <> show (editorName e)+               , "}"+               ] --- | Construct an editor.-editor :: Name+instance Named (Editor t n) n where+    getName = editorName++-- | 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+editorText = editor++-- | Construct an editor over generic text values+editor :: Z.GenericTextZipper a+       => n        -- ^ The editor's name (must be unique)-       -> ([String] -> Widget)-       -- ^ The content rendering function        -> Maybe Int        -- ^ The limit on the number of lines in the editor ('Nothing'        -- means no limit)-       -> String+       -> a        -- ^ The initial content-       -> Editor-editor name draw limit s = Editor (Z.stringZipper [s] limit) draw name+       -> 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.-applyEdit :: (Z.TextZipper String -> Z.TextZipper String)-          -- ^ The 'Data.Text.Zipper' editing transformation to apply-          -> Editor-          -> Editor+-- | 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 'Z.TextZipper' editing transformation to apply+          -> Editor t n+          -> Editor t n applyEdit f e = e & editContentsL %~ f --- | The attribute assigned to the editor+-- | 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 <> attrName "focused"+ -- | Get the contents of the editor.-getEditContents :: Editor -> [String]+getEditContents :: Monoid t => Editor t n -> [t] getEditContents e = Z.getText $ e^.editContentsL --- | Turn an editor state value into a widget-renderEditor :: Editor -> Widget-renderEditor e =-    let cp = Z.cursorPosition $ e^.editContentsL-        cursorLoc = Location (cp^._2, cp^._1)+-- | Get the cursor position of the editor (row, column).+getCursorPosition :: Editor t n -> (Int, Int)+getCursorPosition e = Z.cursorPosition $ e^.editContentsL++-- | Turn an editor state value into a widget. This uses the editor's+-- name for its scrollable viewport handle and the name is also used to+-- report mouse events.+renderEditor :: (Ord n, Show n, Monoid t, TextWidth t, Z.GenericTextZipper t)+             => ([t] -> Widget n)+             -- ^ The content drawing function+             -> Bool+             -- ^ Whether the editor has focus. It will report a cursor+             -- position if and only if it has focus.+             -> Editor t n+             -- ^ The editor.+             -> Widget n+renderEditor draw foc e =+    let cp = Z.cursorPosition z+        z = e^.editContentsL+        toLeft = Z.take (cp^._2) (Z.currentLine z)+        cursorLoc = Location (textWidth toLeft, cp^._1)         limit = case e^.editContentsL.to Z.getLineLimit of             Nothing -> id             Just lim -> vLimit lim-    in withAttr editAttr $+        atChar = charAtCursor $ e^.editContentsL+        atCharWidth = maybe 1 textWidth atChar+    in withAttr (if foc then editFocusedAttr else editAttr) $        limit $        viewport (e^.editorNameL) Both $-       showCursor (e^.editorNameL) cursorLoc $-       visibleRegion cursorLoc (1, 1) $-       e^.editDrawContentsL $+       (if foc then showCursor (e^.editorNameL) cursorLoc else id) $+       visibleRegion cursorLoc (atCharWidth, 1) $+       draw $        getEditContents e++charAtCursor :: (Z.GenericTextZipper t) => Z.TextZipper t -> Maybe t+charAtCursor z =+    let col = snd $ Z.cursorPosition z+        curLine = Z.currentLine z+        toRight = Z.drop col curLine+    in if Z.length toRight > 0+       then Just $ Z.take 1 toRight+       else Nothing
+ src/Brick/Widgets/FileBrowser.hs view
@@ -0,0 +1,948 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- | This module provides a file browser widget that allows users to+-- navigate directory trees, search for files and directories, and+-- select entries of interest. For a complete working demonstration of+-- this module, see @programs/FileBrowserDemo.hs@.+--+-- To use this module:+--+-- * Embed a 'FileBrowser' in your application state.+-- * Dispatch events to it in your event handler with+--   'handleFileBrowserEvent'.+-- * Get the entry under the browser's cursor with 'fileBrowserCursor'+--   and get the entries selected by the user with 'Enter' or 'Space'+--   using 'fileBrowserSelection'.+-- * Inspect 'fileBrowserException' to determine whether the+--   file browser encountered an error when reading a directory in+--   'setWorkingDirectory' or when changing directories in the event+--   handler.+--+-- File browsers have a built-in user-configurable function to limit the+-- entries displayed that defaults to showing all files. For example,+-- an application might want to limit the browser to just directories+-- and XML files. That is accomplished by setting the filter with+-- 'setFileBrowserEntryFilter' and some examples are provided in this+-- module: 'fileTypeMatch' and 'fileExtensionMatch'.+--+-- File browsers are styled using the provided collection of attribute+-- names, so add those to your attribute map to get the appearance you+-- want. File browsers also make use of a 'List' internally, so the+-- 'List' attributes will affect how the list appears.+--+-- File browsers catch 'IOException's when changing directories. If a+-- call to 'setWorkingDirectory' triggers an 'IOException' while reading+-- the working directory, the resulting 'IOException' is stored in the+-- file browser and is accessible with 'fileBrowserException'. The+-- 'setWorkingDirectory' function clears the exception field if the+-- working directory is read successfully. The caller is responsible for+-- deciding when and whether to display the exception to the user. In+-- the event that an 'IOException' is raised as described here, the file+-- browser will always present @..@ as a navigation option to allow the+-- user to continue navigating up the directory tree. It does this even+-- if the current or parent directory does not exist or cannot be read,+-- so it is always safe to present a file browser for any working+-- directory. Bear in mind that the @..@ entry is always subjected to+-- filtering and searching.+module Brick.Widgets.FileBrowser+  ( -- * Types+    FileBrowser+  , FileInfo(..)+  , FileStatus(..)+  , FileType(..)++  -- * Making a new file browser+  , newFileBrowser+  , selectNonDirectories+  , selectDirectories++  -- * Manipulating a file browser's state+  , setWorkingDirectory+  , getWorkingDirectory+  , updateFileBrowserSearch+  , setFileBrowserEntryFilter++  -- * Actions+  , actionFileBrowserBeginSearch+  , actionFileBrowserSelectEnter+  , actionFileBrowserSelectCurrent+  , actionFileBrowserToggleCurrent+  , actionFileBrowserListPageUp+  , actionFileBrowserListPageDown+  , actionFileBrowserListHalfPageUp+  , actionFileBrowserListHalfPageDown+  , actionFileBrowserListTop+  , actionFileBrowserListBottom+  , actionFileBrowserListNext+  , actionFileBrowserListPrev++  -- * Handling events+  , handleFileBrowserEvent+  , maybeSelectCurrentEntry++  -- * Rendering+  , renderFileBrowser++  -- * Getting information+  , fileBrowserCursor+  , fileBrowserIsSearching+  , fileBrowserSelection+  , fileBrowserException+  , fileBrowserSelectable+  , fileInfoFileType++  -- * Attributes+  , fileBrowserAttr+  , fileBrowserCurrentDirectoryAttr+  , fileBrowserSelectionInfoAttr+  , fileBrowserSelectedAttr+  , fileBrowserDirectoryAttr+  , fileBrowserBlockDeviceAttr+  , fileBrowserRegularFileAttr+  , fileBrowserCharacterDeviceAttr+  , fileBrowserNamedPipeAttr+  , fileBrowserSymbolicLinkAttr+  , fileBrowserUnixSocketAttr++  -- * Example browser entry filters+  , fileTypeMatch+  , fileExtensionMatch++  -- * Lenses+  , fileBrowserSelectableL+  , fileInfoFilenameL+  , fileInfoSanitizedFilenameL+  , fileInfoFilePathL+  , fileInfoFileStatusL+  , fileInfoLinkTargetTypeL+  , fileStatusSizeL+  , fileStatusFileTypeL++  -- * Getters+  , fileBrowserEntryFilterG+  , fileBrowserWorkingDirectoryG+  , fileBrowserEntriesG+  , fileBrowserLatestResultsG+  , fileBrowserSelectedFilesG+  , fileBrowserNameG+  , fileBrowserSearchStringG+  , fileBrowserExceptionG+  , fileBrowserSelectableG++  -- * Miscellaneous+  , prettyFileSize++  -- * Utilities+  , entriesForDirectory+  , getFileInfo+  )+where++import qualified Control.Exception as E+import Control.Monad (forM, when)+import Control.Monad.IO.Class (liftIO)+import Data.Char (toLower, isPrint)+import Data.Foldable (for_)+import Data.Maybe (fromMaybe, isJust, fromJust)+import qualified Data.Foldable as F+import qualified Data.Text as T+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import Data.Int (Int64)+import Data.List (sortBy, isSuffixOf, dropWhileEnd)+import qualified Data.Set as Set+import qualified Data.Vector as V+import Lens.Micro+import Lens.Micro.Mtl ((%=), use)+import Lens.Micro.TH (lensRules, generateUpdateableOptics)+import qualified Graphics.Vty as Vty+import qualified System.Directory as D+import qualified System.PosixCompat.Files as U+import qualified System.PosixCompat.Types as U+import qualified System.FilePath as FP+import Text.Printf (printf)++import Brick.Types+import Brick.AttrMap (AttrName, attrName)+import Brick.Widgets.Core+import Brick.Widgets.List++-- | A file browser's state. Embed this in your application state and+-- transform it with 'handleFileBrowserEvent' and the functions included+-- in this module.+data FileBrowser n =+    FileBrowser { fileBrowserWorkingDirectory :: FilePath+                , fileBrowserEntries :: List n FileInfo+                , fileBrowserLatestResults :: [FileInfo]+                , fileBrowserSelectedFiles :: Set.Set String+                , fileBrowserName :: n+                , fileBrowserEntryFilter :: Maybe (FileInfo -> Bool)+                , fileBrowserSearchString :: Maybe T.Text+                , fileBrowserException :: Maybe E.IOException+                -- ^ The exception status of the latest directory+                -- change. If 'Nothing', the latest directory change+                -- was successful and all entries were read. Otherwise,+                -- this contains the exception raised by the latest+                -- directory change in case the calling application+                -- needs to inspect or present the error to the user.+                , fileBrowserSelectable :: FileInfo -> Bool+                -- ^ The function that determines what kinds of entries+                -- are selectable with in the event handler. Note that+                -- if this returns 'True' for an entry, an @Enter@ or+                -- @Space@ keypress selects that entry rather than doing+                -- anything else; directory changes can only occur if+                -- this returns 'False' for directories.+                --+                -- Note that this is a record field so it can be used to+                -- change the selection function.+                }++instance Named (FileBrowser n) n where+    getName = getName . fileBrowserEntries++-- | File status information.+data FileStatus =+    FileStatus { fileStatusSize :: Int64+               -- ^ The size, in bytes, of this entry's file.+               , fileStatusFileType :: Maybe FileType+               -- ^ The type of this entry's file, if it could be+               -- determined.+               }+               deriving (Show, Eq)++-- | Information about a file entry in the browser.+data FileInfo =+    FileInfo { fileInfoFilename :: String+             -- ^ The filename of this entry, without its path.+             -- This is not for display purposes; for that, use+             -- 'fileInfoSanitizedFilename'.+             , fileInfoSanitizedFilename :: String+             -- ^ The filename of this entry with out its path,+             -- sanitized of non-printable characters (replaced with+             -- '?'). This is for display purposes only.+             , fileInfoFilePath :: FilePath+             -- ^ The full path to this entry's file.+             , fileInfoFileStatus :: Either E.IOException FileStatus+             -- ^ The file status if it could be obtained, or the+             -- exception that was caught when attempting to read the+             -- file's status.+             , fileInfoLinkTargetType :: Maybe FileType+             -- ^ If this entry is a symlink, this indicates the type of+             -- file the symlink points to, if it could be obtained.+             }+             deriving (Show, Eq)++-- | The type of file entries in the browser.+data FileType =+    RegularFile+    -- ^ A regular disk file.+    | BlockDevice+    -- ^ A block device.+    | CharacterDevice+    -- ^ A character device.+    | NamedPipe+    -- ^ A named pipe.+    | Directory+    -- ^ A directory.+    | SymbolicLink+    -- ^ A symbolic link.+    | UnixSocket+    -- ^ A Unix socket.+    deriving (Read, Show, Eq)++suffixLenses ''FileBrowser+suffixLensesWith "G" (lensRules & generateUpdateableOptics .~ False) ''FileBrowser+suffixLenses ''FileInfo+suffixLenses ''FileStatus++-- | Make a new file browser state. The provided resource name will be+-- used to render the 'List' viewport of the browser.+--+-- By default, the browser will show all files and directories+-- in its working directory. To change that behavior, see+-- 'setFileBrowserEntryFilter'.+newFileBrowser :: (FileInfo -> Bool)+               -- ^ The function used to determine what kinds of entries+               -- can be selected (see 'handleFileBrowserEvent'). A+               -- good default is 'selectNonDirectories'. This can be+               -- changed at 'any time with 'fileBrowserSelectable' or+               -- its 'corresponding lens.+               -> n+               -- ^ The resource name associated with the browser's+               -- entry listing.+               -> Maybe FilePath+               -- ^ The initial working directory that the browser+               -- displays. If not provided, this defaults to the+               -- executable's current working directory.+               -> IO (FileBrowser n)+newFileBrowser selPredicate name mCwd = do+    initialCwd <- FP.normalise <$> case mCwd of+        Just path -> return $ removeTrailingSlash path+        Nothing -> D.getCurrentDirectory++    let b = FileBrowser { fileBrowserWorkingDirectory = initialCwd+                        , fileBrowserEntries = list name mempty 1+                        , fileBrowserLatestResults = mempty+                        , fileBrowserSelectedFiles = mempty+                        , fileBrowserName = name+                        , fileBrowserEntryFilter = Nothing+                        , fileBrowserSearchString = Nothing+                        , fileBrowserException = Nothing+                        , fileBrowserSelectable = selPredicate+                        }++    setWorkingDirectory initialCwd b++-- | Removes any trailing slash(es) from the supplied FilePath (which should+-- indicate a directory).  This does not remove a sole slash indicating the root+-- directory.+--+-- This is done because if the FileBrowser is initialized with an initial working+-- directory that ends in a slash, then selecting the "../" entry to move to the+-- parent directory will cause the removal of the trailing slash, but it will not+-- otherwise cause any change, misleading the user into thinking no action was+-- taken (the disappearance of the trailing slash is unlikely to be noticed).+-- All subsequent parent directory selection operations are processed normally,+-- and the 'fileBrowserWorkingDirectory' never ends in a trailing slash+-- thereafter (except at the root directory).+removeTrailingSlash :: FilePath -> FilePath+removeTrailingSlash "/" = "/"+removeTrailingSlash d = dropWhileEnd (== '/') d++-- | A file entry selector that permits selection of all file entries+-- except directories. Use this if you want users to be able to navigate+-- directories in the browser. If you want users to be able to select+-- only directories, use 'selectDirectories'.+selectNonDirectories :: FileInfo -> Bool+selectNonDirectories i =+    case fileInfoFileType i of+        Just Directory -> False+        Just SymbolicLink ->+            case fileInfoLinkTargetType i of+                Just Directory -> False+                _ -> True+        _ -> True++-- | A file entry selector that permits selection of directories+-- only. This prevents directory navigation and only supports directory+-- selection.+selectDirectories :: FileInfo -> Bool+selectDirectories i =+    case fileInfoFileType i of+        Just Directory -> True+        Just SymbolicLink -> fileInfoLinkTargetType i == Just Directory+        _ -> False++-- | Set the filtering function used to determine which entries in+-- the browser's current directory appear in the browser. 'Nothing'+-- indicates no filtering, meaning all entries will be shown. 'Just'+-- indicates a function that should return 'True' for entries that+-- should be permitted to appear.+--+-- Note that this applies the filter after setting it by updating the+-- listed entries to reflect the result of the filter. That is unlike+-- setting the filter with the 'fileBrowserEntryFilterL' lens directly,+-- which just sets the filter but does not (and cannot) update the+-- listed entries.+setFileBrowserEntryFilter :: Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n+setFileBrowserEntryFilter f b =+    applyFilterAndSearch $ b & fileBrowserEntryFilterL .~ f++-- | Set the working directory of the file browser. This scans the new+-- directory and repopulates the browser while maintaining any active+-- search string and/or entry filtering.+--+-- If the directory scan raises an 'IOException', the exception is+-- stored in the browser and is accessible with 'fileBrowserException'. If+-- no exception is raised, the exception field is cleared. Regardless of+-- whether an exception is raised, @..@ is always presented as a valid+-- option in the browser.+setWorkingDirectory :: FilePath -> FileBrowser n -> IO (FileBrowser n)+setWorkingDirectory path b = do+    entriesResult <- E.try $ entriesForDirectory path++    let (entries, exc) = case entriesResult of+            Left (e::E.IOException) -> ([], Just e)+            Right es -> (es, Nothing)++    allEntries <- if path == "/" then return entries else do+        parentResult <- E.try $ parentOf path+        return $ case parentResult of+            Left (_::E.IOException) -> entries+            Right parent -> parent : entries++    return $ setEntries allEntries b+                 & fileBrowserWorkingDirectoryL .~ path+                 & fileBrowserExceptionL .~ exc+                 & fileBrowserSelectedFilesL .~ mempty++parentOf :: FilePath -> IO FileInfo+parentOf path = getFileInfo ".." $ FP.takeDirectory path++-- | Build a 'FileInfo' for the specified file and path. If an+-- 'IOException' is raised while attempting to get the file information,+-- the 'fileInfoFileStatus' field is populated with the exception.+-- Otherwise it is populated with the 'FileStatus' for the file.+getFileInfo :: String+            -- ^ The name of the file to inspect. This filename is only+            -- used to set the 'fileInfoFilename' and sanitized filename+            -- fields; the actual file to be inspected is referred+            -- to by the second argument. This is decomposed so that+            -- 'FileInfo's can be used to represent information about+            -- entries like @..@, whose display names differ from their+            -- physical paths.+            -> FilePath+            -- ^ The actual full path to the file or directory to+            -- inspect.+            -> IO FileInfo+getFileInfo name = go []+    where+        go history fullPath = do+            filePath <- D.makeAbsolute fullPath+            statusResult <- E.try $ U.getSymbolicLinkStatus filePath++            let stat = do+                  status <- statusResult+                  let U.COff sz = U.fileSize status+                  return FileStatus { fileStatusFileType = fileTypeFromStatus status+                                    , fileStatusSize = sz+                                    }++            targetTy <- case fileStatusFileType <$> stat of+                Right (Just SymbolicLink) -> do+                    targetPathResult <- E.try $ U.readSymbolicLink filePath+                    case targetPathResult of+                        Left (_::E.SomeException) -> return Nothing+                        Right targetPath ->+                            -- Watch out for recursive symlink chains:+                            -- if history starts repeating, abort the+                            -- symlink following process.+                            --+                            -- Examples:+                            --   $ ln -s foo foo+                            --+                            --   $ ln -s foo bar+                            --   $ ln -s bar foo+                            if targetPath `elem` history+                            then return Nothing+                            else do+                                targetInfo <- liftIO $ go (fullPath : history) targetPath+                                case fileInfoFileStatus targetInfo of+                                    Right (FileStatus _ targetTy) -> return targetTy+                                    _ -> return Nothing+                _ -> return Nothing++            return FileInfo { fileInfoFilename = name+                            , fileInfoFilePath = filePath+                            , fileInfoSanitizedFilename = sanitizeFilename name+                            , fileInfoFileStatus = stat+                            , fileInfoLinkTargetType = targetTy+                            }++-- | Get the file type for this file info entry. If the file type could+-- not be obtained due to an 'IOException', return 'Nothing'.+fileInfoFileType :: FileInfo -> Maybe FileType+fileInfoFileType i =+    case fileInfoFileStatus i of+        Left _ -> Nothing+        Right stat -> fileStatusFileType stat++-- | Get the working directory of the file browser.+getWorkingDirectory :: FileBrowser n -> FilePath+getWorkingDirectory = fileBrowserWorkingDirectory++setEntries :: [FileInfo] -> FileBrowser n -> FileBrowser n+setEntries es b =+    applyFilterAndSearch $ b & fileBrowserLatestResultsL .~ es++-- | Returns whether the file browser is in search mode, i.e., the mode+-- in which user input affects the browser's active search string and+-- displayed entries. This is used to aid in event dispatching in the+-- calling program.+fileBrowserIsSearching :: FileBrowser n -> Bool+fileBrowserIsSearching b = isJust $ b^.fileBrowserSearchStringL++-- | Get the entries chosen by the user, if any. Entries are chosen by+-- an 'Enter' or 'Space' keypress; if you want the entry under the+-- cursor, use 'fileBrowserCursor'.+fileBrowserSelection :: FileBrowser n -> [FileInfo]+fileBrowserSelection b =+    let getEntry filename = fromJust $ F.find ((== filename) . fileInfoFilename) $ b^.fileBrowserLatestResultsL+    in fmap getEntry $ F.toList $ b^.fileBrowserSelectedFilesL++-- | Modify the file browser's active search string. This causes the+-- browser's displayed entries to change to those in its current+-- directory that match the search string, if any. If a search string+-- is provided, it is matched case-insensitively anywhere in file or+-- directory names.+updateFileBrowserSearch :: (Maybe T.Text -> Maybe T.Text)+                        -- ^ The search transformation. 'Nothing'+                        -- indicates that search mode should be off;+                        -- 'Just' indicates that it should be on and+                        -- that the provided search string should be+                        -- used.+                        -> FileBrowser n+                        -- ^ The browser to modify.+                        -> FileBrowser n+updateFileBrowserSearch f b =+    let old = b^.fileBrowserSearchStringL+        new = f $ b^.fileBrowserSearchStringL+        oldLen = maybe 0 T.length old+        newLen = maybe 0 T.length new+    in if old == new+       then b+       else if oldLen == newLen+            -- This case avoids a list rebuild and cursor position reset+            -- when the search state isn't *really* changing.+            then b & fileBrowserSearchStringL .~ new+            else applyFilterAndSearch $ b & fileBrowserSearchStringL .~ new++applyFilterAndSearch :: FileBrowser n -> FileBrowser n+applyFilterAndSearch b =+    let filterMatch = fromMaybe (const True) (b^.fileBrowserEntryFilterL)+        searchMatch = maybe (const True)+                            (\search i -> T.toLower search `T.isInfixOf` T.pack (toLower <$> fileInfoSanitizedFilename i))+                            (b^.fileBrowserSearchStringL)+        match i = filterMatch i && searchMatch i+        matching = filter match $ b^.fileBrowserLatestResultsL+    in b { fileBrowserEntries = list (b^.fileBrowserNameL) (V.fromList matching) 1 }++-- | Generate a textual abbreviation of a file size, e.g. "10.2M" or "12+-- bytes".+prettyFileSize :: Int64+               -- ^ A file size in bytes.+               -> T.Text+prettyFileSize i+    | i >= 2 ^ (40::Int64) = T.pack $ format (i `divBy` (2 ** 40)) <> "T"+    | i >= 2 ^ (30::Int64) = T.pack $ format (i `divBy` (2 ** 30)) <> "G"+    | i >= 2 ^ (20::Int64) = T.pack $ format (i `divBy` (2 ** 20)) <> "M"+    | i >= 2 ^ (10::Int64) = T.pack $ format (i `divBy` (2 ** 10)) <> "K"+    | otherwise    = T.pack $ show i <> " bytes"+    where+        format = printf "%0.1f"+        divBy :: Int64 -> Double -> Double+        divBy a b = ((fromIntegral a) :: Double) / b++-- | Build a list of file info entries for the specified directory. This+-- function does not catch any exceptions raised by calling+-- 'makeAbsolute' or 'listDirectory', but it does catch exceptions on+-- a per-file basis. Any exceptions caught when inspecting individual+-- files are stored in the 'fileInfoFileStatus' field of each+-- 'FileInfo'.+--+-- The entries returned are all entries in the specified directory+-- except for @.@ and @..@. Directories are always given first. Entries+-- are sorted in case-insensitive lexicographic order.+--+-- This function is exported for those who want to implement their own+-- file browser using the types in this module.+entriesForDirectory :: FilePath -> IO [FileInfo]+entriesForDirectory rawPath = do+    path <- D.makeAbsolute rawPath++    -- Get all entries except "." and "..", then sort them+    dirContents <- D.listDirectory path++    infos <- forM dirContents $ \f -> do+        getFileInfo f (path FP.</> f)++    let dirsFirst a b = if fileInfoFileType a == Just Directory &&+                           fileInfoFileType b == Just Directory+                        then compare (toLower <$> fileInfoFilename a)+                                     (toLower <$> fileInfoFilename b)+                        else if fileInfoFileType a == Just Directory &&+                                fileInfoFileType b /= Just Directory+                             then LT+                             else if fileInfoFileType b == Just Directory &&+                                     fileInfoFileType a /= Just Directory+                                  then GT+                                  else compare (toLower <$> fileInfoFilename a)+                                               (toLower <$> fileInfoFilename b)++        allEntries = sortBy dirsFirst infos++    return allEntries++fileTypeFromStatus :: U.FileStatus -> Maybe FileType+fileTypeFromStatus s =+    if | U.isBlockDevice s     -> Just BlockDevice+       | U.isCharacterDevice s -> Just CharacterDevice+       | U.isNamedPipe s       -> Just NamedPipe+       | U.isRegularFile s     -> Just RegularFile+       | U.isDirectory s       -> Just Directory+       | U.isSocket s          -> Just UnixSocket+       | U.isSymbolicLink s    -> Just SymbolicLink+       | otherwise             -> Nothing++-- | Get the file information for the file under the cursor, if any.+fileBrowserCursor :: FileBrowser n -> Maybe FileInfo+fileBrowserCursor b = snd <$> listSelectedElement (b^.fileBrowserEntriesL)++-- | Handle a Vty input event. Note that event handling can+-- cause a directory change so the caller should be aware that+-- 'fileBrowserException' may need to be checked after handling an+-- event in case an exception was triggered while scanning the working+-- directory.+--+-- Events handled regardless of mode:+--+-- * @Ctrl-b@: 'actionFileBrowserListPageUp'+-- * @Ctrl-f@: 'actionFileBrowserListPageDown'+-- * @Ctrl-d@: 'actionFileBrowserListHalfPageDown'+-- * @Ctrl-u@: 'actionFileBrowserListHalfPageUp'+-- * @Ctrl-n@: 'actionFileBrowserListNext'+-- * @Ctrl-p@: 'actionFileBrowserListPrev'+--+-- Events handled only in normal mode:+--+-- * @/@: 'actionFileBrowserBeginSearch'+-- * @Enter@: 'actionFileBrowserSelectEnter'+-- * @Space@: 'actionFileBrowserToggleCurrent'+-- * @g@: 'actionFileBrowserListTop'+-- * @G@: 'actionFileBrowserListBottom'+-- * @j@: 'actionFileBrowserListNext'+-- * @k@: 'actionFileBrowserListPrev'+--+-- Events handled only in search mode:+--+-- * @Esc@, @Ctrl-C@: cancel search mode+-- * Text input: update search string++actionFileBrowserBeginSearch :: EventM n (FileBrowser n) ()+actionFileBrowserBeginSearch =+    modify $ updateFileBrowserSearch (const $ Just "")++actionFileBrowserSelectEnter :: EventM n (FileBrowser n) ()+actionFileBrowserSelectEnter =+    maybeSelectCurrentEntry++actionFileBrowserSelectCurrent :: EventM n (FileBrowser n) ()+actionFileBrowserSelectCurrent =+    selectCurrentEntry++actionFileBrowserToggleCurrent :: EventM n (FileBrowser n) ()+actionFileBrowserToggleCurrent =+    toggleCurrentEntrySelected++actionFileBrowserListPageUp :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPageUp =+    zoom fileBrowserEntriesL listMovePageUp++actionFileBrowserListPageDown :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPageDown =+    zoom fileBrowserEntriesL listMovePageDown++actionFileBrowserListHalfPageUp :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListHalfPageUp =+    zoom fileBrowserEntriesL (listMoveByPages (-0.5::Double))++actionFileBrowserListHalfPageDown :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListHalfPageDown =+    zoom fileBrowserEntriesL (listMoveByPages (0.5::Double))++actionFileBrowserListTop :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListTop =+    fileBrowserEntriesL %= listMoveTo 0++actionFileBrowserListBottom :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListBottom = do+    b <- get+    let sz = length (listElements $ b^.fileBrowserEntriesL)+    fileBrowserEntriesL %= listMoveTo (sz - 1)++actionFileBrowserListNext :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListNext =+    fileBrowserEntriesL %= listMoveBy 1++actionFileBrowserListPrev :: Ord n => EventM n (FileBrowser n) ()+actionFileBrowserListPrev =+    fileBrowserEntriesL %= listMoveBy (-1)++handleFileBrowserEvent :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEvent e = do+    b <- get+    if fileBrowserIsSearching b+        then handleFileBrowserEventSearching e+        else handleFileBrowserEventNormal e++safeInit :: T.Text -> T.Text+safeInit t | T.length t == 0 = t+           | otherwise = T.init t++handleFileBrowserEventSearching :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventSearching e =+    case e of+        Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl] ->+            modify $ updateFileBrowserSearch (const Nothing)+        Vty.EvKey Vty.KEsc [] ->+            modify $ updateFileBrowserSearch (const Nothing)+        Vty.EvKey Vty.KBS [] ->+            modify $ updateFileBrowserSearch (fmap safeInit)+        Vty.EvKey Vty.KEnter [] -> do+            maybeSelectCurrentEntry+            modify $ updateFileBrowserSearch (const Nothing)+        Vty.EvKey (Vty.KChar c) [] ->+            modify $ updateFileBrowserSearch (fmap (flip T.snoc c))+        _ ->+            handleFileBrowserEventCommon e++handleFileBrowserEventNormal :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventNormal e =+    case e of+        Vty.EvKey (Vty.KChar '/') [] ->+            -- Begin file search+            actionFileBrowserBeginSearch+        Vty.EvKey Vty.KEnter [] ->+            -- Select file or enter directory+            actionFileBrowserSelectEnter+        Vty.EvKey (Vty.KChar ' ') [] ->+            -- Toggle selected status of current entry+            actionFileBrowserToggleCurrent+        _ ->+            handleFileBrowserEventCommon e++handleFileBrowserEventCommon :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventCommon e =+    case e of+        Vty.EvKey (Vty.KChar 'b') [Vty.MCtrl] ->+            actionFileBrowserListPageUp+        Vty.EvKey (Vty.KChar 'f') [Vty.MCtrl] ->+            actionFileBrowserListPageDown+        Vty.EvKey (Vty.KChar 'd') [Vty.MCtrl] ->+            actionFileBrowserListHalfPageDown+        Vty.EvKey (Vty.KChar 'u') [Vty.MCtrl] ->+            actionFileBrowserListHalfPageUp+        Vty.EvKey (Vty.KChar 'g') [] ->+            actionFileBrowserListTop+        Vty.EvKey (Vty.KChar 'G') [] ->+            actionFileBrowserListBottom+        Vty.EvKey (Vty.KChar 'j') [] ->+            actionFileBrowserListNext+        Vty.EvKey (Vty.KChar 'k') [] ->+            actionFileBrowserListPrev+        Vty.EvKey (Vty.KChar 'n') [Vty.MCtrl] ->+            actionFileBrowserListNext+        Vty.EvKey (Vty.KChar 'p') [Vty.MCtrl] ->+            actionFileBrowserListPrev+        _ ->+            zoom fileBrowserEntriesL $ handleListEvent e++toggleSelected :: FileInfo -> EventM n (FileBrowser n) ()+toggleSelected e = do+    sel <- fileBrowserIsSelected e+    if sel+       then fileBrowserRemoveSelected e+       else fileBrowserAddSelected e++fileBrowserIsSelected :: FileInfo -> EventM n (FileBrowser n) Bool+fileBrowserIsSelected e = do+    fs <- use fileBrowserSelectedFilesL+    let fName = fileInfoFilename e+    return $ Set.member fName fs++fileBrowserAddSelected :: FileInfo -> EventM n (FileBrowser n) ()+fileBrowserAddSelected e = do+    let fName = fileInfoFilename e+    fileBrowserSelectedFilesL %= Set.insert fName++fileBrowserRemoveSelected :: FileInfo -> EventM n (FileBrowser n) ()+fileBrowserRemoveSelected e = do+    let fName = fileInfoFilename e+    fileBrowserSelectedFilesL %= Set.delete fName++-- | If the browser's current entry is selectable according to+-- @fileBrowserSelectable@, add it to the selection set and return.+-- If not, and if the entry is a directory or a symlink targeting a+-- directory, set the browser's current path to the selected directory.+--+-- Otherwise, return the browser state unchanged.+maybeSelectCurrentEntry :: EventM n (FileBrowser n) ()+maybeSelectCurrentEntry = do+    b <- get+    for_ (fileBrowserCursor b) $ \entry ->+        if fileBrowserSelectable b entry+        then fileBrowserAddSelected entry+        else when (selectDirectories entry) $+            put =<< liftIO (setWorkingDirectory (fileInfoFilePath entry) b)++selectCurrentEntry :: EventM n (FileBrowser n) ()+selectCurrentEntry = do+    b <- get+    for_ (fileBrowserCursor b) $ \entry ->+        when (fileBrowserSelectable b entry) $+            fileBrowserAddSelected entry++toggleCurrentEntrySelected :: EventM n (FileBrowser n) ()+toggleCurrentEntrySelected = do+    b <- get+    for_ (fileBrowserCursor b) $ \entry ->+        when (fileBrowserSelectable b entry) $+            toggleSelected entry++-- | Render a file browser. This renders a list of entries in the+-- working directory, a cursor to select from among the entries, a+-- header displaying the working directory, and a footer displaying+-- information about the selected entry.+--+-- Note that if the most recent file browser operation produced an+-- exception in 'fileBrowserException', that exception is not rendered+-- by this function. That exception needs to be rendered (if at all) by+-- the calling application.+--+-- The file browser is greedy in both dimensions.+renderFileBrowser :: (Show n, Ord n)+                  => Bool+                  -- ^ Whether the file browser has input focus.+                  -> FileBrowser n+                  -- ^ The browser to render.+                  -> Widget n+renderFileBrowser foc b =+    let maxFilenameLength = maximum $ length . fileInfoFilename <$> (b^.fileBrowserEntriesL)+        cwdHeader = padRight Max $+                    str $ sanitizeFilename $ fileBrowserWorkingDirectory b+        selInfo = case listSelectedElement (b^.fileBrowserEntriesL) of+            Nothing -> vLimit 1 $ fill ' '+            Just (_, i) -> padRight Max $ selInfoFor i+        fileTypeLabel Nothing = "unknown"+        fileTypeLabel (Just t) =+            case t of+                RegularFile -> "file"+                BlockDevice -> "block device"+                CharacterDevice -> "character device"+                NamedPipe -> "pipe"+                Directory -> "directory"+                SymbolicLink -> "symbolic link"+                UnixSocket -> "socket"+        selInfoFor i =+            let label = case fileInfoFileStatus i of+                    Left _ -> "unknown"+                    Right stat ->+                        let maybeSize = if fileStatusFileType stat == Just RegularFile+                                        then ", " <> prettyFileSize (fileStatusSize stat)+                                        else ""+                        in fileTypeLabel (fileStatusFileType stat) <> maybeSize+            in txt $ T.pack (fileInfoSanitizedFilename i) <> ": " <> label++        maybeSearchInfo = case b^.fileBrowserSearchStringL of+            Nothing -> emptyWidget+            Just s -> padRight Max $+                      txt "Search: " <+>+                      showCursor (b^.fileBrowserNameL) (Location (T.length s, 0)) (txt s)++    in withDefAttr fileBrowserAttr $+       vBox [ withDefAttr fileBrowserCurrentDirectoryAttr cwdHeader+            , renderList (renderFileInfo foc maxFilenameLength (b^.fileBrowserSelectedFilesL) (b^.fileBrowserNameL))+                         foc (b^.fileBrowserEntriesL)+            , maybeSearchInfo+            , withDefAttr fileBrowserSelectionInfoAttr selInfo+            ]++renderFileInfo :: Bool -> Int -> Set.Set String -> n -> Bool -> FileInfo -> Widget n+renderFileInfo foc maxLen selFiles n listSel info =+    (if foc+     then (if listSel then forceAttr listSelectedFocusedAttr+               else if sel then forceAttr fileBrowserSelectedAttr else id)+     else (if listSel then forceAttr listSelectedAttr+               else if sel then forceAttr fileBrowserSelectedAttr else id)) $+    padRight Max body+    where+        sel = fileInfoFilename info `Set.member` selFiles+        addAttr = maybe id (withDefAttr . attrForFileType) (fileInfoFileType info)+        body = addAttr (hLimit (maxLen + 1) $+               padRight Max $+               (if foc && listSel then putCursor n (Location (0,0)) else id) $+               str $ fileInfoSanitizedFilename info <> suffix)+        suffix = (if fileInfoFileType info == Just Directory then "/" else "") <>+                 (if sel then "*" else "")++-- | Sanitize a filename for terminal display, replacing non-printable+-- characters with '?'.+sanitizeFilename :: String -> String+sanitizeFilename = fmap toPrint+    where+        toPrint c | isPrint c = c+                  | otherwise = '?'++attrForFileType :: FileType -> AttrName+attrForFileType RegularFile = fileBrowserRegularFileAttr+attrForFileType BlockDevice = fileBrowserBlockDeviceAttr+attrForFileType CharacterDevice = fileBrowserCharacterDeviceAttr+attrForFileType NamedPipe = fileBrowserNamedPipeAttr+attrForFileType Directory = fileBrowserDirectoryAttr+attrForFileType SymbolicLink = fileBrowserSymbolicLinkAttr+attrForFileType UnixSocket = fileBrowserUnixSocketAttr++-- | The base attribute for all file browser attributes.+fileBrowserAttr :: AttrName+fileBrowserAttr = attrName "fileBrowser"++-- | The attribute used for the current directory displayed at the top+-- of the browser.+fileBrowserCurrentDirectoryAttr :: AttrName+fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> attrName "currentDirectory"++-- | The attribute used for the entry information displayed at the+-- bottom of the browser.+fileBrowserSelectionInfoAttr :: AttrName+fileBrowserSelectionInfoAttr = fileBrowserAttr <> attrName "selectionInfo"++-- | The attribute used to render directory entries.+fileBrowserDirectoryAttr :: AttrName+fileBrowserDirectoryAttr = fileBrowserAttr <> attrName "directory"++-- | The attribute used to render block device entries.+fileBrowserBlockDeviceAttr :: AttrName+fileBrowserBlockDeviceAttr = fileBrowserAttr <> attrName "block"++-- | The attribute used to render regular file entries.+fileBrowserRegularFileAttr :: AttrName+fileBrowserRegularFileAttr = fileBrowserAttr <> attrName "regular"++-- | The attribute used to render character device entries.+fileBrowserCharacterDeviceAttr :: AttrName+fileBrowserCharacterDeviceAttr = fileBrowserAttr <> attrName "char"++-- | The attribute used to render named pipe entries.+fileBrowserNamedPipeAttr :: AttrName+fileBrowserNamedPipeAttr = fileBrowserAttr <> attrName "pipe"++-- | The attribute used to render symbolic link entries.+fileBrowserSymbolicLinkAttr :: AttrName+fileBrowserSymbolicLinkAttr = fileBrowserAttr <> attrName "symlink"++-- | The attribute used to render Unix socket entries.+fileBrowserUnixSocketAttr :: AttrName+fileBrowserUnixSocketAttr = fileBrowserAttr <> attrName "unixSocket"++-- | The attribute used for selected entries in the file browser.+fileBrowserSelectedAttr :: AttrName+fileBrowserSelectedAttr = fileBrowserAttr <> attrName "selected"++-- | A file type filter for use with 'setFileBrowserEntryFilter'. This+-- filter permits entries whose file types are in the specified list.+fileTypeMatch :: [FileType] -> FileInfo -> Bool+fileTypeMatch tys i = maybe False (`elem` tys) $ fileInfoFileType i++-- | A filter that matches any directory regardless of name, or any+-- regular file with the specified extension. For example, an extension+-- argument of @"xml"@ would match regular files @test.xml@ and+-- @TEST.XML@ and it will match directories regardless of name.+--+-- This matcher also matches symlinks if and only if their targets are+-- directories. This is intended to make it possible to use this matcher+-- to find files with certain extensions, but also support directory+-- traversal via symlinks.+fileExtensionMatch :: String -> FileInfo -> Bool+fileExtensionMatch ext i = case fileInfoFileType i of+    Just Directory -> True+    Just RegularFile -> ('.' : (toLower <$> ext)) `isSuffixOf` (toLower <$> fileInfoFilename i)+    Just SymbolicLink -> case fileInfoLinkTargetType i of+        Just Directory -> True+        _ -> False+    _ -> False
src/Brick/Widgets/Internal.hs view
@@ -3,43 +3,197 @@   ( renderFinal   , cropToContext   , cropResultToContext+  , renderDynBorder+  , renderWidget   ) where -import Control.Applicative-import Control.Lens ((^.), (&), (%~))-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader-import Data.Default+import Lens.Micro ((^.), (&), (%~), (.~))+import Lens.Micro.Mtl ((%=))+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader+import Data.Maybe (fromMaybe, mapMaybe)+import qualified Data.Map as M+import qualified Data.Set as S import qualified Graphics.Vty as V  import Brick.Types import Brick.Types.Internal import Brick.AttrMap+import Brick.Widgets.Border.Style+import Brick.BorderMap (BorderMap)+import qualified Brick.BorderMap as BM -renderFinal :: AttrMap-            -> [Widget]+renderFinal :: (Ord n)+            => AttrMap+            -> [Widget n]             -> V.DisplayRegion-            -> ([CursorLocation] -> Maybe CursorLocation)-            -> RenderState-            -> (RenderState, V.Picture, Maybe CursorLocation)-renderFinal aMap layerRenders sz chooseCursor rs = (newRS, pic, theCursor)+            -> ([CursorLocation n] -> Maybe (CursorLocation n))+            -> RenderState n+            -> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n])+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 def (fst sz) (snd sz) def aMap-        pic = V.picForLayers $ uncurry V.resize sz <$> (^.imageL) <$> layerResults-        layerCursors = (^.cursorsL) <$> 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) <$> layersTopmostFirst+        layerExtents = reverse $ (^.extentsL) <$> layersTopmostFirst         theCursor = chooseCursor $ concat layerCursors  -- | After rendering the specified widget, crop its result image to the -- dimensions in the rendering context.-cropToContext :: Widget -> Widget+cropToContext :: Widget n -> Widget n cropToContext p =-    Widget (hSize p) (vSize p) $ (render p >>= cropResultToContext)+    Widget (hSize p) (vSize p) (render p >>= cropResultToContext) -cropResultToContext :: Result -> RenderM Result+cropResultToContext :: Result n -> RenderM n (Result n) cropResultToContext result = do     c <- getContext-    return $ result & imageL %~ (V.crop (c^.availWidthL) (c^.availHeightL))+    return $ result & imageL   %~ cropImage   c+                    & cursorsL %~ cropCursors c+                    & extentsL %~ cropExtents c+                    & bordersL %~ cropBorders c++cropImage :: Context n -> V.Image -> V.Image+cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL)++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.+        cropCursor c | outOfContext c = Nothing+                     | otherwise      = Just c+        outOfContext c =+            or [ c^.cursorLocationL.locationRowL    < 0+               , c^.cursorLocationL.locationColumnL < 0+               , c^.cursorLocationL.locationRowL    >= ctx^.availHeightL+               , c^.cursorLocationL.locationColumnL >= ctx^.availWidthL+               ]++cropExtents :: Context n -> [Extent n] -> [Extent n]+cropExtents ctx es = mapMaybe cropExtent es+    where+        cropExtent (Extent n (Location (c, r)) (w, h)) =+            -- Clamp the original extent's UL corner to the context.+            --+            -- Clamp the original extent's LR corner to the context.+            --+            -- Keep the modified extent (i.e. with clamped corners)+            -- only if the resulting extent has non-zero size in both+            -- dimensions.+            let nonEmpty = nonEmptyH && nonEmptyV+                nonEmptyH = newWidth > 0+                nonEmptyV = newHeight > 0+                newWidth = newEndCol - newStartCol+                newHeight = newEndRow - newStartRow+                (newStartCol, newStartRow) = clampCorner (c, r)+                (newEndCol, newEndRow) = clampCorner (c + w, r + h)+                clampCorner (cols, rows) =+                    ( clampRange (ctx^.availWidthL) cols+                    , clampRange (ctx^.availHeightL) rows+                    )+                clampRange bound val =+                    min bound $ max 0 val+                newExtent = Extent n (Location (newStartCol, newStartRow)) (newWidth, newHeight)+            in if nonEmpty+               then Just newExtent+               else Nothing++cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder+cropBorders ctx = BM.crop Edges+    { eTop = 0+    , eBottom = availHeight ctx - 1+    , eLeft = 0+    , eRight = availWidth ctx - 1+    }++renderDynBorder :: DynBorder -> V.Image+renderDynBorder db = V.char (dbAttr db) $ getBorderChar $ dbStyle db+    where+        getBorderChar = case bsDraw <$> dbSegments db of+            --    top   bot   left  right+            Edges False False False False -> const ' '+            Edges False False _     _     -> bsHorizontal+            Edges _     _     False False -> bsVertical+            Edges False True  False True  -> bsCornerTL+            Edges False True  True  False -> bsCornerTR+            Edges True  False False True  -> bsCornerBL+            Edges True  False True  False -> bsCornerBR+            Edges False True  True  True  -> bsIntersectT+            Edges True  False True  True  -> bsIntersectB+            Edges True  True  False True  -> bsIntersectL+            Edges True  True  True  False -> bsIntersectR+            Edges True  True  True  True  -> bsIntersectFull++-- | This function provides a simplified interface to rendering a list+-- of 'Widget's as a 'V.Picture' outside of the context of an 'App'.+-- This can be useful in a testing setting but isn't intended to be used+-- for normal application rendering. The API is deliberately narrower+-- than the main interactive API and is not yet stable. Use at your own+-- risk.+--+-- Consult the [Vty library documentation](https://hackage.haskell.org/package/vty)+-- for details on how to output the resulting 'V.Picture'.+renderWidget :: (Ord n)+             => Maybe AttrMap+             -- ^ Optional attribute map used to render. If omitted,+             -- an empty attribute map with the terminal's default+             -- attribute will be used.+             -> [Widget n]+             -- ^ The widget layers to render, topmost first.+             -> V.DisplayRegion+             -- ^ The size of the display region in which to render the+             -- layers.+             -> V.Picture+renderWidget mAttrMap layerRenders region = pic+    where+        initialRS = RS { viewportMap = M.empty+                       , rsScrollRequests = []+                       , observedNames = S.empty+                       , renderCache = mempty+                       , clickableNames = []+                       , requestedVisibleNames_ = S.empty+                       , reportedExtents = mempty+                       }+        am = fromMaybe (attrMap V.defAttr []) mAttrMap+        (_, pic, _, _) = renderFinal am layerRenders region (const Nothing) initialRS
src/Brick/Widgets/List.hs view
@@ -1,46 +1,100 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-} -- | This module provides a scrollable list type and functions for -- manipulating and rendering it.+--+-- Note that lenses are provided for direct manipulation purposes, but+-- lenses are *not* safe and should be used with care. (For example,+-- 'listElementsL' permits direct manipulation of the list container+-- without performing bounds checking on the selected index.) If you+-- need a safe API, consider one of the various functions for list+-- manipulation. For example, instead of 'listElementsL', consider+-- 'listReplace'. module Brick.Widgets.List-  ( List(listElements, listSelected, listName, listItemHeight)+  ( GenericList+  , List -  -- * Consructing a list+  -- * Constructing a list   , list    -- * Rendering a list   , renderList+  , renderListWithIndex +  -- * Handling events+  , handleListEvent+  , handleListEventVi+   -- * Lenses   , listElementsL   , listSelectedL   , listNameL   , listItemHeightL+  , listSelectedElementL +  -- * Accessors+  , listElements+  , listName+  , listSelectedElement+  , listSelected+  , listItemHeight+   -- * Manipulating a list   , listMoveBy   , listMoveTo+  , listMoveToElement+  , listFindBy   , listMoveUp   , listMoveDown+  , listMoveByPages+  , listMovePageUp+  , listMovePageDown+  , listMoveToBeginning+  , listMoveToEnd   , listInsert   , listRemove   , listReplace-  , listSelectedElement+  , listClear+  , listReverse+  , listModify +  -- * Querying a list+  , listFindFirst+   -- * Attributes   , listAttr   , listSelectedAttr+  , listSelectedFocusedAttr++  -- * Classes+  , Splittable(..)+  , Reversible(..)   ) where -import Control.Applicative ((<$>))-import Control.Lens ((^.), (&), (.~), _2)-import Data.Monoid ((<>))+import Prelude hiding (reverse, splitAt)++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 qualified Data.Algorithm.Diff as D-import Graphics.Vty (Event(..), Key(..))+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup, (<>))+#endif+import Data.Semigroup (sconcat)+import qualified Data.Sequence as Seq+import Graphics.Vty (Event(..), Key(..), Modifier(..)) import qualified Data.Vector as V+import GHC.Generics (Generic)  import Brick.Types import Brick.Main (lookupViewport)@@ -48,211 +102,593 @@ 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 e =-    List { listElements :: !(V.Vector e)+--+-- The 'List' type synonym fixes @t@ to 'V.Vector' for compatibility+-- with previous versions of this library.+--+-- For a container type to be usable with 'GenericList', it must have+-- instances of 'Traversable' and 'Splittable'. The following functions+-- impose further constraints:+--+-- * 'listInsert': 'Applicative' and 'Semigroup'+-- * 'listRemove': 'Semigroup'+-- * 'listClear': 'Monoid'+-- * 'listReverse': 'Reversible'+--+data GenericList n t e =+    List { listElements :: !(t e)+         -- ^ The list's sequence of elements.          , listSelected :: !(Maybe Int)-         , listName :: Name+         -- ^ The list's selected element index, if any.+         , listName :: n+         -- ^ The list's name.          , listItemHeight :: Int-         }+         -- ^ The height of an individual item in the list.+         } deriving (Functor, Foldable, Traversable, Show, Generic) -suffixLenses ''List+suffixLenses ''GenericList -instance HandleEvent (List e) where-    handleEvent e theList = f-        where-            f = case e of-                  EvKey KUp [] -> return $ listMoveUp theList-                  EvKey KDown [] -> return $ listMoveDown theList-                  EvKey KHome [] -> return $ listMoveTo 0 theList-                  EvKey KEnd [] -> return $ listMoveTo (V.length $ listElements theList) theList-                  EvKey KPageDown [] -> do-                      v <- lookupViewport (theList^.listNameL)-                      case v of-                          Nothing -> return theList-                          Just vp -> return $ listMoveBy (vp^.vpSize._2 `div` theList^.listItemHeightL) theList-                  EvKey KPageUp [] -> do-                      v <- lookupViewport (theList^.listNameL)-                      case v of-                          Nothing -> return theList-                          Just vp -> return $ listMoveBy (negate $ vp^.vpSize._2 `div` theList^.listItemHeightL) theList-                  _ -> return theList+-- | 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++-- | 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 [] -> modify listMoveUp+        EvKey KDown [] -> modify listMoveDown+        EvKey KHome [] -> modify listMoveToBeginning+        EvKey KEnd [] -> modify listMoveToEnd+        EvKey KPageDown [] -> listMovePageDown+        EvKey KPageUp [] -> listMovePageUp+        _ -> return ()++-- | Enable list movement with the vi keys with a fallback handler if+-- none match. Use 'handleListEventVi' in place of 'handleListEvent'+-- to add the vi keys bindings to the standard ones. Movements handled+-- include:+--+-- * Up (k)+-- * Down (j)+-- * Page Up (Ctrl-b)+-- * Page Down (Ctrl-f)+-- * Half Page Up (Ctrl-u)+-- * Half Page Down (Ctrl-d)+-- * Go to first element (g)+-- * Go to last element (G)+handleListEventVi :: (Foldable t, Splittable t, Ord n)+                  => (Event -> EventM n (GenericList n t e) ())+                  -- ^ Fallback event handler to use if none of the vi keys+                  -- match.+                  -> Event+                  -> EventM n (GenericList n t e) ()+handleListEventVi fallback e =+    case e of+        EvKey (KChar 'k') []      -> modify listMoveUp+        EvKey (KChar 'j') []      -> modify listMoveDown+        EvKey (KChar 'g') []      -> modify listMoveToBeginning+        EvKey (KChar 'G') []      -> modify listMoveToEnd+        EvKey (KChar 'f') [MCtrl] -> listMovePageDown+        EvKey (KChar 'b') [MCtrl] -> listMovePageUp+        EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double)+        EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double)+        _                         -> fallback e++-- | Move the list selection to the first element in the list.+listMoveToBeginning :: (Foldable t, Splittable t)+                    => GenericList n t e+                    -> GenericList n t e+listMoveToBeginning = listMoveTo 0++-- | Move the list selection to the last element in the list.+listMoveToEnd :: (Foldable t, Splittable t)+              => GenericList n t e+              -> GenericList n t e+listMoveToEnd l = listMoveTo (max 0 $ length (listElements l) - 1) l+ -- | The top-level attribute used for the entire list. listAttr :: AttrName-listAttr = "list"+listAttr = attrName "list" --- | The attribute used only for the currently-selected list item.--- Extends 'listAttr'.+-- | 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" --- | Construct a list in terms of an element type 'e'.-list :: Name+-- | The attribute used only for the currently-selected list item when+-- the list has focus. Extends 'listSelectedAttr'.+listSelectedFocusedAttr :: AttrName+listSelectedFocusedAttr = listSelectedAttr <> attrName "focused"++-- | 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 e+     -- this high).+     -> GenericList n t e list name es h =-    let selIndex = if V.null es then Nothing else Just 0-    in List es selIndex name h+    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 :: List e -> (Bool -> e -> Widget) -> Widget-renderList l drawElem =+-- | 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+           -> 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.+--+-- 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 l drawElem+    drawListElements foc l drawElem -drawListElements :: List e -> (Bool -> e -> Widget) -> Widget-drawListElements l drawElem =+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)-            idx = case l^.listSelectedL of-                Nothing -> 0-                Just i -> i+        -- 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)-            numPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL) +            -- 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+            -- extra item to show a partial item at the top or bottom to+            -- give the expected result when an item is more than one+            -- row high. (Example: 5 rows available with item height+            -- of 3 yields two items: one fully rendered, the other+            -- rendered with only its top 2 or bottom 2 rows visible,+            -- depending on how the viewport state changes.)+            numPerHeight = initialNumPerHeight ++                           if initialNumPerHeight * (l^.listItemHeightL) == c^.availHeightL+                           then 0+                           else 1+             off = start * (l^.listItemHeightL) -            drawnElements = (flip V.imap) es $ \i e ->-                let isSelected = Just (i + start) == l^.listSelectedL-                    elemWidget = drawElem isSelected e+            drawnElements = flip imap es $ \i e ->+                let j = i + start+                    isSelected = Just j == l^.listSelectedL+                    elemWidget = drawElem j isSelected e+                    selItemAttr = if foc+                                  then withDefAttr listSelectedFocusedAttr+                                  else withDefAttr listSelectedAttr                     makeVisible = if isSelected-                                  then (visible . withDefAttr listSelectedAttr)+                                  then visible . selItemAttr                                   else id                 in makeVisible elemWidget          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 e-           -> List 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 e-           -> List 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  -> if pos == 0-                     then 0-                     else if pos == s-                          then pos - 1-                          else if pos < s-                               then s - 1-                               else 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 but--- preserve the currently selected index.-listReplace :: Eq e => V.Vector e -> List e -> List e-listReplace es' l | es' == l^.listElementsL = l-                  | otherwise =-    let sel = fromMaybe 0 (l^.listSelectedL)-        getNewSel es = case (V.null es, V.null es') of-          (_, True)      -> Nothing-          (True, False)  -> Just 0-          (False, False) -> Just (maintainSel (V.toList es) (V.toList es') sel)-        newSel = getNewSel (l^.listElementsL)--    in l & listSelectedL .~ 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.+--+-- 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 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 e -> List e+listMoveUp :: (Foldable t, Splittable t)+           => GenericList n t e+           -> GenericList n t e listMoveUp = listMoveBy (-1) +-- | Move the list selected index up by one page.+listMovePageUp :: (Foldable t, Splittable t, Ord n)+               => EventM n (GenericList n t e) ()+listMovePageUp = listMoveByPages (-1::Double)+ -- | Move the list selected index down by one. (Moves the cursor down, -- adds one to the index.)-listMoveDown :: List e -> List e+listMoveDown :: (Foldable t, Splittable t)+             => GenericList n t e+             -> GenericList n t e listMoveDown = listMoveBy 1 --- | Move the list selected index by the specified amount, subject to--- validation.-listMoveBy :: Int -> List e -> List e+-- | Move the list selected index down by one page.+listMovePageDown :: (Foldable t, Splittable t, Ord n)+                 => EventM n (GenericList n t e) ()+listMovePageDown = listMoveByPages (1::Double)++-- | Move the list selected index by some (fractional) number of pages.+listMoveByPages :: (Foldable t, Splittable t, Ord n, RealFrac m)+                => m+                -> EventM n (GenericList n t e) ()+listMoveByPages pages = do+    theList <- get+    v <- lookupViewport (theList^.listNameL)+    case v of+        Nothing -> return ()+        Just vp -> do+            let nElems = round $ pages * fromIntegral (vp^.vpSize._2) /+                                 fromIntegral (theList^.listItemHeightL)+            modify $ listMoveBy nElems++-- | Move the list selected index.+--+-- If the current selection is @Just x@, the selection is adjusted by+-- the specified amount. The value is clamped to the extents of the list+-- (i.e. the selection does not "wrap").+--+-- If the current selection is @Nothing@ (i.e. there is no selection)+-- and the direction is positive, set to @Just 0@ (first element),+-- otherwise set to @Just (length - 1)@ (last element).+--+-- Complexity: same as 'splitAt' for the container type.+--+-- @+-- listMoveBy for 'List': O(1)+-- listMoveBy for 'Seq.Seq': O(log(min(i,n-i)))+-- @+listMoveBy :: (Foldable t, Splittable t)+           => Int+           -> GenericList n t e+           -> GenericList n t e listMoveBy amt l =-    let newSel = clamp 0 (V.length (l^.listElementsL) - 1) <$> (amt +) <$> (l^.listSelectedL)-    in l & listSelectedL .~ newSel+    let target = case l ^. listSelectedL of+            Nothing+                | amt > 0 -> 0+                | otherwise -> length l - 1+            Just i -> max 0 (amt + i)  -- don't be negative+    in listMoveTo target l  -- | Set the selected index for a list to the specified index, subject -- to validation.-listMoveTo :: Int -> List e -> List 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 --- | Return a list's selected element, if any.-listSelectedElement :: List e -> Maybe (Int, e)-listSelectedElement l = do-  sel <- l^.listSelectedL-  return (sel, (l^.listElementsL) V.! sel)+-- | 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 --- Assuming `xs` is an existing list that we want to update to match the--- state of `ys`. Given a selected index in `xs`, the goal is to compute--- the corresponding index in `ys`.-maintainSel :: (Eq e) => [e] -> [e] -> Int -> Int-maintainSel xs ys sel = let hunks = D.getDiff xs ys-                        in merge 0 sel hunks+-- | 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 -merge :: (Eq e) => Int -> Int -> [D.Diff e] -> Int-merge _   sel []                 = sel-merge idx sel (h:hs) | idx > sel = sel-                     | otherwise = case h of-    D.Both _ _ -> merge sel (idx + 1) hs+-- | 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 -    -- element removed in new list-    D.First _  -> let newSel = if idx < sel-                               then sel - 1-                               else sel-                  in merge newSel idx hs+-- | 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 -    -- element added in new list-    D.Second _ -> let newSel = if idx <= sel-                               then sel + 1-                               else sel-                  in merge newSel (idx + 1) hs+-- | Traversal that targets the selected element, if any.+--+-- Complexity: depends on usage as well as the list's container type.+--+-- @+-- listSelectedElementL for 'List': O(1) -- preview, fold+--                                O(n) -- set, modify, traverse+-- listSelectedElementL for 'Seq.Seq': O(log(min(i, n - i)))  -- all operations+-- @+--+listSelectedElementL :: (Splittable t, Traversable t, Semigroup (t e))+                     => Traversal' (GenericList n t e) e+listSelectedElementL f l =+    case l ^. listSelectedL of+        Nothing -> pure l+        Just i -> listElementsL go l+            where+                go l' = let (left, rest) = splitAt i l'+                            -- middle contains the target element (if any)+                            (middle, right) = splitAt 1 rest+                        in (\m -> left <> m <> right) <$> (traverse f middle)++-- | Return a list's selected element, if any.+--+-- Only evaluates as much of the container as needed.+--+-- 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.+--+-- /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+-- again be the selected one.+--+-- 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.+--+-- Complexity: same as 'traverse' for the container type (typically+-- /O(n)/).+--+-- Complexity: same as 'listSelectedElementL' for the list's container type.+--+-- @+-- listModify for 'List': O(n)+-- listModify for 'Seq.Seq': O(log(min(i, n - i)))+-- @+--+listModify :: (Traversable t, Splittable t, Semigroup (t e))+           => (e -> e)+           -> GenericList n t e+           -> GenericList n t e+listModify f = listSelectedElementL %~ f
src/Brick/Widgets/ProgressBar.hs view
@@ -1,15 +1,21 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} -- | This module provides a progress bar widget. module Brick.Widgets.ProgressBar   ( progressBar+  , customProgressBar   -- * Attributes   , progressCompleteAttr   , progressIncompleteAttr   ) where -import Control.Lens ((^.))+import Lens.Micro ((^.))+import Data.Maybe (fromMaybe)+#if !(MIN_VERSION_base(4,11,0)) import Data.Monoid+#endif+import Graphics.Vty (safeWcswidth)  import Brick.Types import Brick.AttrMap@@ -17,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@@ -31,19 +37,48 @@             -- the progress bar.             -> Float             -- ^ The progress value. Should be between 0 and 1 inclusive.-            -> Widget-progressBar mLabel progress =+            -> Widget n+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 = maybe "" id mLabel-            labelWidth = length label+            label = fromMaybe "" mLabel+            labelWidth = safeWcswidth label             spacesWidth = barWidth - labelWidth-            leftPart = replicate (spacesWidth `div` 2) ' '-            rightPart = replicate (barWidth - (labelWidth + length leftPart)) ' '-            fullBar = leftPart <> label <> rightPart+            leftWidth = spacesWidth `div` 2+            rightWidth = barWidth - labelWidth - leftWidth             completeWidth = round $ progress * toEnum barWidth-            completePart = take completeWidth fullBar-            incompletePart = drop completeWidth fullBar++            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+            adjustedCompleteWidth = if completeWidth == length fullBar && progress < 1.0+                                    then completeWidth - 1+                                    else if completeWidth == 0 && progress > 0.0+                                         then 1+                                         else completeWidth+            (completePart, incompletePart) = splitAt adjustedCompleteWidth fullBar         render $ (withAttr progressCompleteAttr $ str completePart) <+>                  (withAttr progressIncompleteAttr $ str incompletePart)
+ src/Brick/Widgets/Table.hs view
@@ -0,0 +1,389 @@+{-# LANGUAGE MultiWayIf #-}+-- | This module provides a table widget that can draw other widgets+-- in a table layout, draw borders between rows and columns, and allow+-- configuration of row and column alignment. To get started, see+-- 'table'.+module Brick.Widgets.Table+  (+  -- * Types+    Table+  , ColumnAlignment(..)+  , RowAlignment(..)+  , TableException(..)++  -- * Construction+  , table++  -- * Configuration+  , alignLeft+  , alignRight+  , alignCenter+  , alignTop+  , alignMiddle+  , alignBottom+  , setColAlignment+  , setRowAlignment+  , setDefaultColAlignment+  , setDefaultRowAlignment+  , surroundingBorder+  , rowBorders+  , columnBorders++  -- * Rendering+  , renderTable++  -- * Low-level API+  , RenderedTableCells(..)+  , BorderConfiguration(..)+  , tableCellLayout+  , addBorders+  , alignColumns+  )+where++import Control.Monad (forM)+import qualified Control.Exception as E+import Data.List (transpose, intersperse, nub)+import qualified Data.Map as M+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Graphics.Vty (imageHeight, imageWidth, charFill)+import Lens.Micro ((^.))++import Brick.Types+import Brick.Widgets.Core+import Brick.Widgets.Center+import Brick.Widgets.Border++-- | Column alignment modes. Use these modes with the alignment+-- functions in this module to configure column alignment behavior.+data ColumnAlignment =+    AlignLeft+    -- ^ Align all cells to the left.+    | AlignCenter+    -- ^ Center the content horizontally in all cells in the column.+    | AlignRight+    -- ^ Align all cells to the right.+    deriving (Eq, Show, Read)++-- | Row alignment modes. Use these modes with the alignment functions+-- in this module to configure row alignment behavior.+data RowAlignment =+    AlignTop+    -- ^ Align all cells to the top.+    | AlignMiddle+    -- ^ Center the content vertically in all cells in the row.+    | AlignBottom+    -- ^ Align all cells to the bottom.+    deriving (Eq, Show, Read)++-- | A table creation exception.+data TableException =+    TEUnequalRowSizes+    -- ^ Rows did not all have the same number of cells.+    | TEInvalidCellSizePolicy+    -- ^ Some cells in the table did not use the 'Fixed' size policy for+    -- both horizontal and vertical sizing.+    deriving (Eq, Show, Read)++instance E.Exception TableException where++-- | A table data structure for widgets of type 'Widget' @n@. Create a+-- table with 'table'.+data Table n =+    Table { columnAlignments :: M.Map Int ColumnAlignment+          , rowAlignments :: M.Map Int RowAlignment+          , tableRows :: [[Widget n]]+          , defaultColumnAlignment :: ColumnAlignment+          , defaultRowAlignment :: RowAlignment+          , tableBorderConfiguration :: BorderConfiguration+          }++-- | A border configuration for a table.+data BorderConfiguration =+    BorderConfiguration { drawSurroundingBorder :: Bool+                        , drawRowBorders :: Bool+                        , drawColumnBorders :: Bool+                        }++-- | Construct a new table.+--+-- The argument is the list of rows with the topmost row first, with+-- each element of the argument list being the contents of the cells in+-- in each column of the respective row, with the leftmost cell first.+--+-- Each row's height is determined by the height of the tallest cell+-- in that row, and each column's width is determined by the width of+-- the widest cell in that column. This means that control over row+-- and column dimensions is a matter of controlling the size of the+-- individual cells, such as by wrapping cell contents in padding,+-- 'fill' and 'hLimit' or 'vLimit', etc. This also means that it is not+-- necessary to explicitly set the width of most table cells because+-- the table will determine the per-row and per-column dimensions by+-- looking at the largest cell contents. In particular, this means+-- that the table's alignment logic only has an effect when a given+-- cell's contents are smaller than the maximum for its row and column,+-- thus giving the table some way to pad the contents to result in the+-- desired alignment.+--+-- By default:+--+-- * All columns are left-aligned. Use the alignment functions in this+-- module to change that behavior.+-- * All rows are top-aligned. Use the alignment functions in this+-- module to change that behavior.+-- * The table will draw borders between columns, between rows, and+-- around the outside of the table. Border-drawing behavior can be+-- configured with the API in this module. Note that tables always draw+-- with 'joinBorders' enabled. If a cell's contents has smart borders+-- but you don't want those borders to connect to the surrounding table+-- borders, wrap the cell's contents with 'freezeBorders'.+--+-- All cells of all rows MUST use the 'Fixed' growth policy for both+-- horizontal and vertical growth. If the argument list contains any+-- cells that use the 'Greedy' policy, this function will raise a+-- 'TableException'.+--+-- All rows MUST have the same number of cells. If not, this function+-- will raise a 'TableException'.+table :: [[Widget n]] -> Table n+table rows =+    if | not allFixed      -> E.throw TEInvalidCellSizePolicy+       | not allSameLength -> E.throw TEUnequalRowSizes+       | otherwise         -> t+    where+        allSameLength = length (nub (length <$> rows)) <= 1+        allFixed = all fixedRow rows+        fixedRow = all fixedCell+        fixedCell w = hSize w == Fixed && vSize w == Fixed+        t = Table { columnAlignments = mempty+                  , rowAlignments = mempty+                  , tableRows = rows+                  , defaultColumnAlignment = AlignLeft+                  , defaultRowAlignment = AlignTop+                  , tableBorderConfiguration =+                      BorderConfiguration { drawSurroundingBorder = True+                                          , drawRowBorders = True+                                          , drawColumnBorders = True+                                          }+                  }++-- | Configure whether the table draws a border on its exterior.+surroundingBorder :: Bool -> Table n -> Table n+surroundingBorder b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawSurroundingBorder = b } }++-- | Configure whether the table draws borders between its rows.+rowBorders :: Bool -> Table n -> Table n+rowBorders b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawRowBorders = b } }++-- | Configure whether the table draws borders between its columns.+columnBorders :: Bool -> Table n -> Table n+columnBorders b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawColumnBorders = b } }++-- | Align the specified column to the right. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignRight :: Int -> Table n -> Table n+alignRight = setColAlignment AlignRight++-- | Align the specified column to the left. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignLeft :: Int -> Table n -> Table n+alignLeft = setColAlignment AlignLeft++-- | Align the specified column to center. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignCenter :: Int -> Table n -> Table n+alignCenter = setColAlignment AlignCenter++-- | Align the specified row to the top. The argument is the row index,+-- starting with zero. Silently does nothing if the index is out of+-- range.+alignTop :: Int -> Table n -> Table n+alignTop = setRowAlignment AlignTop++-- | Align the specified row to the middle. The argument is the row+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignMiddle :: Int -> Table n -> Table n+alignMiddle = setRowAlignment AlignMiddle++-- | Align the specified row to bottom. The argument is the row index,+-- starting with zero. Silently does nothing if the index is out of+-- range.+alignBottom :: Int -> Table n -> Table n+alignBottom = setRowAlignment AlignBottom++-- | Set the alignment for the specified column index (starting at+-- zero). Silently does nothing if the index is out of range.+setColAlignment :: ColumnAlignment -> Int -> Table n -> Table n+setColAlignment a col t =+    t { columnAlignments = M.insert col a (columnAlignments t) }++-- | Set the alignment for the specified row index (starting at+-- zero). Silently does nothing if the index is out of range.+setRowAlignment :: RowAlignment -> Int -> Table n -> Table n+setRowAlignment a row t =+    t { rowAlignments = M.insert row a (rowAlignments t) }++-- | Set the default column alignment for columns with no explicitly+-- configured alignment.+setDefaultColAlignment :: ColumnAlignment -> Table n -> Table n+setDefaultColAlignment a t =+    t { defaultColumnAlignment = a }++-- | Set the default row alignment for rows with no explicitly+-- configured alignment.+setDefaultRowAlignment :: RowAlignment -> Table n -> Table n+setDefaultRowAlignment a t =+    t { defaultRowAlignment = a }++-- | Render the table.+renderTable :: Table n -> Widget n+renderTable t =+    joinBorders $+    Widget Fixed Fixed $ do+        tableCellLayout t >>= addBorders >>= render++-- | The result of performing table cell intermediate rendering and+-- layout.+data RenderedTableCells n =+    RenderedTableCells { renderedTableRows :: [[Widget n]]+                       -- ^ The table's cells in row-major order.+                       , renderedTableColumnWidths :: [Int]+                       -- ^ The widths of the table's columns.+                       , renderedTableRowHeights :: [Int]+                       -- ^ The heights of the table's rows.+                       , borderConfiguration :: BorderConfiguration+                       -- ^ The border configuration to use.+                       }++-- | Augment rendered table cells with borders according to the+-- border configuration accompanying the cells.+addBorders :: RenderedTableCells n -> RenderM n (Widget n)+addBorders r = do+    let cfg = borderConfiguration r+        rows = renderedTableRows r+        rowHeights = renderedTableRowHeights r+        colWidths = renderedTableColumnWidths r++        contentWidth = sum colWidths+        contentHeight = sum rowHeights++        hBorderLength = contentWidth + if drawColumnBorders cfg+                                       then max (length colWidths - 1) 0+                                       else 0+        vBorderHeight = contentHeight + if drawRowBorders cfg+                                        then max (length rowHeights - 1) 0+                                        else 0+        horizBorder = hLimit hBorderLength hBorder+        vertBorder = vLimit vBorderHeight vBorder++        leftBorder =+            vBox [topLeftCorner, vertBorder, bottomLeftCorner]+        rightBorder =+            vBox [topRightCorner, vertBorder, bottomRightCorner]++        maybeWrap check f =+            if check cfg then f else id+        addSurroundingBorder b =+            leftBorder <+> (horizBorder <=> b <=> horizBorder) <+> rightBorder+        addRowBorders =+            intersperse horizBorder++        rowsWithColumnBorders = (\(h, row) -> hBox $ maybeColumnBorders h row) <$> zip rowHeights rows+        maybeColumnBorders height = maybeIntersperse cfg drawColumnBorders (vLimit height vBorder)+        body = vBox $+               maybeWrap drawRowBorders addRowBorders rowsWithColumnBorders++    return $ maybeWrap drawSurroundingBorder addSurroundingBorder body++tableCellLayout :: Table n -> RenderM n (RenderedTableCells n)+tableCellLayout t = do+    ctx <- getContext+    cellResults <- forM (tableRows t) $ mapM render++    let rowHeights = rowHeight <$> cellResults+        colWidths = colWidth <$> transpose cellResults+        numRows = length rowHeights+        numCols = if length cellResults >= 1+                     then length (cellResults !! 0)+                     else 0+        allRowAligns = (\i -> M.findWithDefault (defaultRowAlignment t) i (rowAlignments t)) <$>+                       [0..numRows - 1]+        allColAligns = (\i -> M.findWithDefault (defaultColumnAlignment t) i (columnAlignments t)) <$>+                       [0..numCols - 1]+        rowHeight = maximum . fmap (imageHeight . image)+        colWidth = maximum . fmap (imageWidth . image)++        toW = Widget Fixed Fixed . return+        fillEmptyCell w h result =+            if imageWidth (image result) == 0 && imageHeight (image result) == 0+            then result { image = charFill (ctx^.attrL) ' ' w h }+            else result+        mkRow (vAlign, height, rowCells) =+            let paddedCells = flip map (zip3 allColAligns colWidths rowCells) $ \(hAlign, width, cell) ->+                    applyColAlignment width hAlign $+                    applyRowAlignment height vAlign $+                    toW $+                    fillEmptyCell width height cell+            in paddedCells++    let rows = mkRow <$> zip3 allRowAligns rowHeights cellResults++    return $ RenderedTableCells { renderedTableRows = rows+                                , renderedTableColumnWidths = colWidths+                                , renderedTableRowHeights = rowHeights+                                , borderConfiguration = tableBorderConfiguration t+                                }++maybeIntersperse :: BorderConfiguration -> (BorderConfiguration -> Bool) -> Widget n -> [Widget n] -> [Widget n]+maybeIntersperse cfg f v | f cfg = intersperse v+                         | otherwise = id++topLeftCorner :: Widget n+topLeftCorner = joinableBorder $ Edges False True False True++topRightCorner :: Widget n+topRightCorner = joinableBorder $ Edges False True True False++bottomLeftCorner :: Widget n+bottomLeftCorner = joinableBorder $ Edges True False False True++bottomRightCorner :: Widget n+bottomRightCorner = joinableBorder $ Edges True False True False++-- | Given a "table row" of widgets, align each one according to the+-- list of specified column alignments in columns of the specified+-- widths.+alignColumns :: [ColumnAlignment]+             -- ^ The column alignments to use for each widget,+             -- respectively.+             -> [Int]+             -- ^ The width of each column in terminal columns,+             -- respectively.+             -> [Widget n]+             -- ^ The column cells to align.+             -> [Widget n]+alignColumns as widths cells =+    (\(w, a, c) -> applyColAlignment w a c) <$> zip3 widths as cells++applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n+applyColAlignment width align w =+    hLimit width $ case align of+        AlignLeft   -> padRight Max w+        AlignCenter -> hCenter w+        AlignRight  -> padLeft Max w++applyRowAlignment :: Int -> RowAlignment -> Widget n -> Widget n+applyRowAlignment rHeight align w =+    vLimit rHeight $ case align of+        AlignTop    -> padBottom Max w+        AlignMiddle -> vCenter w+        AlignBottom -> padTop Max w
+ src/Data/IMap.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+module Data.IMap+    ( IMap+    , Run(..)+    , empty+    , Data.IMap.null+    , singleton+    , insert+    , delete+    , restrict+    , lookup+    , splitLE+    , intersectionWith+    , mapMaybe+    , addToKeys+    , unsafeUnion+    , fromList+    , unsafeRuns+    , unsafeToAscList+    ) where++import Data.List (foldl')+import Data.Monoid+import Data.IntMap.Strict (IntMap)+import GHC.Generics+import Control.DeepSeq+import Prelude hiding (lookup)+import qualified Data.IntMap.Strict as IM++-- | Semantically, 'IMap' and 'IntMap' are identical; but 'IMap' is more+-- efficient when large sequences of contiguous keys are mapped to the same+-- value.+newtype IMap a = IMap { _runs :: IntMap (Run a) } deriving (Show, Functor, Read, Generic, NFData)++{-# INLINE unsafeRuns #-}+-- | This function is unsafe because 'IMap's that compare equal may split their+-- runs into different chunks; consumers must promise that they do not treat+-- run boundaries specially.+unsafeRuns :: IMap a -> IntMap (Run a)+unsafeRuns = _runs++instance Eq a => Eq (IMap a) where+    IMap m == IMap m' = go (IM.toAscList m) (IM.toAscList m') where+        go ((k, Run n a):kvs) ((k', Run n' a'):kvs')+            = k == k' && a == a' && case compare n n' of+                LT -> go kvs ((k'+n, Run (n'-n) a'):kvs')+                EQ -> go kvs kvs'+                GT -> go ((k+n', Run (n-n') a):kvs) kvs'+        go [] [] = True+        go _ _ = False++instance Ord a => Ord (IMap a) where+    compare (IMap m) (IMap m') = go (IM.toAscList m) (IM.toAscList m') where+        go [] [] = EQ+        go [] _  = LT+        go _  [] = GT+        go ((k, Run n a):kvs) ((k', Run n' a'):kvs')+            = compare k k' <> compare a a' <> case compare n n' of+                LT -> go kvs ((k'+n, Run (n'-n) a'):kvs')+                EQ -> go kvs kvs'+                GT -> go ((k+n', Run (n-n') a):kvs) kvs'++-- | Zippy: '(<*>)' combines values at equal keys, discarding any values whose+-- key is in only one of its two arguments.+instance Applicative IMap where+    pure a = IMap . IM.fromDistinctAscList $+        [ (minBound, Run maxBound a)+        , (-1, Run maxBound a)+        , (maxBound-1, Run 2 a)+        ]+    (<*>) = intersectionWith ($)++-- | @Run n a@ represents @n@ copies of the value @a@.+data Run a = Run+    { len :: !Int+    , val :: !a+    } deriving (Eq, Ord, Read, Show, Functor, Generic, NFData)++instance Foldable    Run where foldMap f r = f (val r)+instance Traversable Run where sequenceA (Run n v) = Run n <$> v++empty :: IMap a+empty = IMap IM.empty++null :: IMap a -> Bool+null = IM.null . _runs++singleton :: Int -> Run a -> IMap a+singleton k r+    | len r >= 1 = IMap (IM.singleton k r)+    | otherwise = empty++insert :: Int -> Run a -> IMap a -> IMap a+insert k r m+    | len r < 1 = m+    | otherwise = m { _runs = IM.insert k r (_runs (delete k r m)) }++{-# INLINE delete #-}+delete :: Int -> Run ignored -> IMap a -> IMap a+delete k r m+    | len r < 1 = m+    | otherwise = m { _runs = IM.union (_runs lt) (_runs gt) }+    where+    (lt, ge) = splitLE (k-1) m+    (_ , gt) = splitLE (k+len r-1) ge++-- | Given a range of keys (as specified by a starting key and a length for+-- consistency with other functions in this module), restrict the map to keys+-- in that range. @restrict k r m@ is equivalent to @intersectionWith const m+-- (insert k r empty)@ but potentially more efficient.+restrict :: Int -> Run ignored -> IMap a -> IMap a+restrict k r = id+    . snd+    . splitLE (k-1)+    . fst+    . splitLE (k+len r-1)++lookup :: Int -> IMap a -> Maybe a+lookup k m = case IM.lookupLE k (_runs m) of+    Just (k', Run n a) | k < k'+n -> Just a+    _ -> Nothing++-- | @splitLE n m@ produces a tuple @(le, gt)@ where @le@ has all the+-- associations of @m@ where the keys are @<= n@ and @gt@ has all the+-- associations of @m@ where the keys are @> n@.+splitLE :: Int -> IMap a -> (IMap a, IMap a)+splitLE k m = case IM.lookupLE k (_runs m) of+    Nothing -> (empty, m)+    Just (k', r@(Run n _)) -> case (k' + n - 1 <= k, k' == k) of+        (True , False) -> (m { _runs = lt }, m { _runs = gt })+        (True , True ) -> (m { _runs = IM.insert k r lt }, m { _runs = gt })+        (False, _    ) -> ( m { _runs = IM.insert k'    r { len =     1 + k - k' } lt' }+                          , m { _runs = IM.insert (k+1) r { len = n - 1 - k + k' } gt' }+                          )+        where+        (lt', gt') = IM.split k' (_runs m)+    where+    (lt, gt) = IM.split k (_runs m)++-- | Increment all keys by the given amount. This is like+-- 'IM.mapKeysMonotonic', but restricted to partially-applied addition.+addToKeys :: Int -> IMap a -> IMap a+addToKeys n m = m { _runs = IM.mapKeysMonotonic (n+) (_runs m) }++-- TODO: This is pretty inefficient. IntMap offers some splitting functions+-- that should make it possible to be more efficient here (though the+-- implementation would be significantly messier).+intersectionWith :: (a -> b -> c) -> IMap a -> IMap b -> IMap c+intersectionWith f (IMap runsa) (IMap runsb)+    = IMap . IM.fromDistinctAscList $ merge (IM.toAscList runsa) (IM.toAscList runsb)+    where+    merge as@((ka, ra):at) bs@((kb, rb):bt)+        | ka' < kb = merge at bs+        | kb' < ka = merge as bt+        | otherwise = (kc, Run (kc' - kc + 1) vc) : case compare ka' kb' of+            LT -> merge at bs+            EQ -> merge at bt+            GT -> merge as bt+        where+        ka' = ka + len ra - 1+        kb' = kb + len rb - 1+        kc  = max ka  kb+        kc' = min ka' kb'+        vc  = f (val ra) (val rb)+    merge _ _ = []++mapMaybe :: (a -> Maybe b) -> IMap a -> IMap b+mapMaybe f (IMap runs) = IMap (IM.mapMaybe (traverse f) runs)++fromList :: [(Int, Run a)] -> IMap a+fromList = foldl' (\m (k, r) -> insert k r m) empty++-- | This function is unsafe because 'IMap's that compare equal may split their+-- runs into different chunks; consumers must promise that they do not treat+-- run boundaries specially.+unsafeToAscList :: IMap a -> [(Int, Run a)]+unsafeToAscList = IM.toAscList . _runs++-- | This function is unsafe because it assumes there is no overlap between its+-- arguments. That is, in the call @unsafeUnion a b@, the caller must guarantee+-- that if @lookup k a = Just v@ then @lookup k b = Nothing@ and vice versa.+unsafeUnion :: IMap a -> IMap a -> IMap a+unsafeUnion a b = IMap { _runs = _runs a `IM.union` _runs b }
− src/Data/Text/Markup.hs 
@@ -1,74 +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--import Control.Applicative ((<$>))-import Data.Default (Default, def)-import Data.Monoid-import Data.String (IsString(..))-import qualified Data.Text as T---- | Markup with metadata type 'a' assigned to each character.-data Markup a = Markup [(Char, a)]-              deriving Show--instance Monoid (Markup a) where-    mempty = Markup mempty-    mappend (Markup t1) (Markup t2) =-        Markup (t1 `mappend` t2)--instance (Default 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 :: (Default a) => T.Text -> Markup a-fromText = (@@ def)---- | Extract the text from markup, discarding the markup metadata.-toText :: (Eq a) => Markup a -> T.Text-toText = T.concat . (fst <$>) . 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 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 thePairs-    where-        toList [] = []-        toList ((ch, val):rest) = (T.pack $ ch : (fst <$> matching), val) : toList remaining-            where-                (matching, remaining) = break (\(_, v) -> v /= val) rest---- | Convert a list of text and metadata pairs into markup.-fromList :: [(T.Text, a)] -> Markup a-fromList pairs = Markup $ concatMap (\(t, val) -> [(c, val) | c <- T.unpack t]) pairs
+ tests/List.hs view
@@ -0,0 +1,375 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+module List+  ( main+  )+where++import Prelude hiding (reverse, splitAt)++import Data.Foldable (find)+import Data.Function (on)+import qualified Data.List+import Data.Maybe (isNothing)+import Data.Monoid (Endo(..))+import Data.Proxy+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup((<>)))+#endif++import qualified Data.Sequence as Seq+import qualified Data.Vector as V+import Lens.Micro+import Test.QuickCheck++import Brick.Util (clamp)+import Brick.Widgets.List++instance (Arbitrary n, Arbitrary a) => Arbitrary (List n a) where+    arbitrary = list <$> arbitrary <*> (V.fromList <$> arbitrary) <*> pure 1++-- List move operations that never modify the underlying list+data ListMoveOp a =+    MoveUp+    | MoveDown+    | MoveBy Int+    | MoveTo Int+    | MoveToElement a+    | FindElement a+    deriving (Show)++instance Arbitrary a => Arbitrary (ListMoveOp a) where+    arbitrary =+        oneof [ pure MoveUp+              , pure MoveDown+              , MoveBy <$> arbitrary+              , MoveTo <$> arbitrary+              , MoveToElement <$> arbitrary+              , FindElement <$> arbitrary+              ]++-- List operations.  We don't have "page"-based movement operations+-- because these depend on render context (i.e. effect in EventM)+data ListOp a =+    Insert Int a+    | Remove Int+    | Replace Int [a]+    | Clear+    | Reverse+    | ListMoveOp (ListMoveOp a)+    deriving (Show)++instance Arbitrary a => Arbitrary (ListOp a) where+    arbitrary =+        frequency [ (1, Insert <$> arbitrary <*> arbitrary)+                  , (1, Remove <$> arbitrary)+                  , (1, Replace <$> arbitrary <*> arbitrary)+                  , (1, pure Clear)+                  , (1, pure Reverse)+                  , (6, arbitrary)+                  ]++-- Turn a ListOp into a List endomorphism+op :: Eq a => ListOp a -> List n a -> List n a+op (Insert i a) = listInsert i a+op (Remove i) = listRemove i+op (Replace i xs) =+    -- avoid setting index to Nothing+    listReplace (V.fromList xs) (Just i)+op Clear = listClear+op Reverse = listReverse+op (ListMoveOp mo) = moveOp mo++-- Turn a ListMoveOp into a List endomorphism+moveOp :: (Eq a) => ListMoveOp a -> List n a -> List n a+moveOp MoveUp = listMoveUp+moveOp MoveDown = listMoveDown+moveOp (MoveBy n) = listMoveBy n+moveOp (MoveTo n) = listMoveTo n+moveOp (MoveToElement a) = listMoveToElement a+moveOp (FindElement a) = listFindBy (== a)++applyListOps :: (Foldable t)+             => (op a -> List n a -> List n a)+             -> t (op a)+             -> List n a+             -> List n a+applyListOps f = appEndo . foldMap (Endo . f)++-- | Initial selection is always 0 (or Nothing for empty list)+prop_initialSelection :: [a] -> Bool+prop_initialSelection xs =+    list () (V.fromList xs) 1 ^. listSelectedL ==+        if null xs then Nothing else Just 0++-- list operations keep the selected index in bounds+prop_listOpsMaintainSelectedValid :: (Eq a)+                                  => [ListOp a]+                                  -> List n a+                                  -> Bool+prop_listOpsMaintainSelectedValid ops l =+    let l' = applyListOps op ops l+    in case l' ^. listSelectedL of+        -- either there is no selection and list is empty+        Nothing -> null l'+        -- or the selected index is valid+        Just i -> i >= 0 && i < length l'++-- reversing a list keeps the selected element the same+prop_reverseMaintainsSelectedElement :: (Eq a)+                                     => [ListOp a]+                                     -> List n a+                                     -> Bool+prop_reverseMaintainsSelectedElement ops l =+    -- apply some random list ops to (probably) set a selected element+    let l' = applyListOps op ops l+        l'' = listReverse l'+    in fmap snd (listSelectedElement l') == fmap snd (listSelectedElement l'')++-- reversing maintains size of list+prop_reverseMaintainsSizeOfList :: List n a -> Bool+prop_reverseMaintainsSizeOfList l =+    length l == length (listReverse l)++-- an inserted element may always be found at the given index+-- (when target index is clamped to 0 <= n <= len)+prop_insert :: (Eq a) => Int -> a -> List n a -> Bool+prop_insert i a l =+    let l' = listInsert i a l+        i' = clamp 0 (length l) i+    in listSelectedElement (listMoveTo i' l') == Just (i', a)++-- inserting anywhere always increases size of list by 1+prop_insertSize :: (Eq a) => Int -> a -> List n a -> Bool+prop_insertSize i a l =+    let l' = listInsert i a l+    in length l' == length l + 1++-- inserting an element and moving to it always succeeds and+-- the selected element is the one we inserted.+--+-- The index is not necessarily the index we inserted at, because+-- the element could be present in the original list.  So we don't+-- check that.+--+prop_insertMoveTo :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool+prop_insertMoveTo ops l i a =+    let l' = listInsert i a (applyListOps op ops l)+        sel = listSelectedElement (listMoveToElement a l')+    in fmap snd sel == Just a++-- inserting an element and repeatedly seeking it always+-- reaches the element we inserted, at the index where we+-- inserted it.+--+prop_insertFindBy :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool+prop_insertFindBy ops l i a =+    let l' = applyListOps op ops l+        l'' = set listSelectedL Nothing . listInsert i a $ l'+        seeks = converging ((==) `on` (^. listSelectedL)) (listFindBy (== a)) l''+        i' = clamp 0 (length l') i -- we can't have inserted past len+    in (find ((== Just i') . (^. listSelectedL)) seeks >>= listSelectedElement) == Just (i', a)++-- inserting then deleting always yields a list with the original elems+prop_insertRemove :: (Eq a) => Int -> a -> List n a -> Bool+prop_insertRemove i a l =+    let i' = clamp 0 (length l) i+        l' = listInsert i' a l -- pre-clamped+        l'' = listRemove i' l'+    in l'' ^. listElementsL == l ^. listElementsL++-- deleting in-bounds always reduces size of list by 1+-- deleting out-of-bounds never changes list size+prop_remove :: Int -> List n a -> Bool+prop_remove i l =+    let len = length l+        i' = clamp 0 (len - 1) i+        test+            | len > 0 && i == i' = (== len - 1)  -- i is in bounds+            | otherwise = (== len)               -- i is out of bounds+    in test (length (listRemove i l))++-- deleting an element and re-inserting it at same position+-- gives the original list elements+prop_removeInsert :: (Eq a) => Int -> List n a -> Bool+prop_removeInsert i l =+    let sel = listSelectedElement (listMoveTo i l)+        l' = maybe id (\(i', a) -> listInsert i' a . listRemove i') sel l+    in l' ^. listElementsL == l ^. listElementsL++-- Apply @f@ until @test a (f a) == True@, then return @a@.+converge :: (a -> a -> Bool) -> (a -> a) -> a -> a+converge test f = last . converging test f++-- Apply @f@ until @test a (f a) == True@, returning the start,+-- intermediate and final values as a list.+converging :: (a -> a -> Bool) -> (a -> a) -> a -> [a]+converging test f a+    | test a (f a) = [a]+    | otherwise = a : converging test f (f a)++-- listMoveUp always reaches 0 (or list is empty)+prop_moveUp :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_moveUp ops l =+    let l' = applyListOps op ops l+        l'' = converge ((==) `on` (^. listSelectedL)) listMoveUp l'+        len = length l''+    in maybe (len == 0) (== 0) (l'' ^. listSelectedL)++-- listMoveDown always reaches end of list (or list is empty)+prop_moveDown :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_moveDown ops l =+    let l' = applyListOps op ops l+        l'' = converge ((==) `on` (^. listSelectedL)) listMoveDown l'+        len = length l''+    in maybe (len == 0) (== len - 1) (l'' ^. listSelectedL)++-- move ops never change the list+prop_moveOpsNeverChangeList :: (Eq a) => [ListMoveOp a] -> List n a -> Bool+prop_moveOpsNeverChangeList ops l =+    let l' = applyListOps moveOp ops l+    in l' ^. listElementsL == l ^. listElementsL++-- If the list is empty, empty selection is used.+-- Otherwise, if the specified selected index is not in list bounds,+-- zero is used instead.+prop_replaceSetIndex :: (Eq a)+                     => [ListOp a]+                     -> List n a+                     -> [a]+                     -> Int+                     -> Bool+prop_replaceSetIndex ops l xs i =+    let v = V.fromList xs+        l' = applyListOps op ops l+        l'' = listReplace v (Just i) l'+        i' = clamp 0 (length v - 1) i+        inBounds = i == i'+    in l'' ^. listSelectedL == case (null v, inBounds) of+        (True, _) -> Nothing+        (False, True) -> Just i+        (False, False) -> Just 0++-- Replacing with no index always clears the index+prop_replaceNoIndex :: (Eq a) => [ListOp a] -> List n a -> [a] -> Bool+prop_replaceNoIndex ops l xs =+    let v = V.fromList xs+        l' = applyListOps op ops l+    in isNothing (listReplace v Nothing l' ^. listSelectedL)++-- | Move the list selected index. If the index is `Just x`, adjust by the+-- specified amount; if it is `Nothing` (i.e. there is no selection) and the+-- direction is positive, set to `Just 0` (first element), otherwise set to+-- `Just (length - 1)` (last element). Subject to validation.+prop_moveByWhenNoSelection :: List n a -> Int -> Property+prop_moveByWhenNoSelection l amt =+    let l' = l & listSelectedL .~ Nothing+        len = length l+        expected = if amt > 0 then 0 else len - 1+    in len > 0 ==> listMoveBy amt l' ^. listSelectedL == Just expected++splitAtLength :: (Foldable t, Splittable t) => t a -> Int -> Bool+splitAtLength l i =+    let len = length l+        (h, t) = splitAt i l+    in length h + length t == len && length h == clamp 0 len i++splitAtAppend :: (Splittable t, Semigroup (t a), Eq (t a))+              => t a -> Int -> Bool+splitAtAppend l i = uncurry (<>) (splitAt i l) == l++prop_splitAtLength_Vector :: [a] -> Int -> Bool+prop_splitAtLength_Vector = splitAtLength . V.fromList++prop_splitAtAppend_Vector :: (Eq a) => [a] -> Int -> Bool+prop_splitAtAppend_Vector = splitAtAppend . V.fromList++prop_splitAtLength_Seq :: [a] -> Int -> Bool+prop_splitAtLength_Seq = splitAtLength . Seq.fromList++prop_splitAtAppend_Seq :: (Eq a) => [a] -> Int -> Bool+prop_splitAtAppend_Seq = splitAtAppend . Seq.fromList+++reverseSingleton :: forall t a. (Reversible t, Applicative t, Eq (t a))+                 => Proxy t -> a -> Bool+reverseSingleton _ a =+    let l = pure a :: t a+    in reverse l == l++reverseAppend :: (Reversible t, Semigroup (t a), Eq (t a))+              => t a -> t a -> Bool+reverseAppend l1 l2 =+  reverse (l1 <> l2) == reverse l2 <> reverse l1++prop_reverseSingleton_Vector :: (Eq a) => a -> Bool+prop_reverseSingleton_Vector = reverseSingleton (Proxy :: Proxy V.Vector)++prop_reverseAppend_Vector :: (Eq a) => [a] -> [a] -> Bool+prop_reverseAppend_Vector l1 l2 =+    reverseAppend (V.fromList l1) (V.fromList l2)++prop_reverseSingleton_Seq :: (Eq a) => a -> Bool+prop_reverseSingleton_Seq = reverseSingleton (Proxy :: Proxy Seq.Seq)++prop_reverseAppend_Seq :: (Eq a) => [a] -> [a] -> Bool+prop_reverseAppend_Seq l1 l2 =+    reverseAppend (Seq.fromList l1) (Seq.fromList l2)++-- Laziness tests.  Here we create a custom container type+-- that we use to ensure certain operations do not cause the+-- whole container to be evaluated.+--+newtype L a = L [a]+            deriving (Functor, Foldable, Traversable, Semigroup)++instance Splittable L where+    splitAt i (L xs) = over both L (Data.List.splitAt i xs)++-- moveBy positive amount does not evaluate 'length'+prop_moveByPosLazy :: Bool+prop_moveByPosLazy =+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1+        l' = listMoveBy 1 l+    in l' ^. listSelectedL == Just 1++-- listFindBy is lazy+prop_findByLazy :: Bool+prop_findByLazy =+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1 & listSelectedL .~ Nothing+        l' = listFindBy even l+        l'' = listFindBy even l'+    in l' ^. listSelectedL == Just 1 &&+       l'' ^. listSelectedL == Just 3++prop_listFindFirst :: Bool+prop_listFindFirst =+    let v = L [1..5] :: L Int+        l = list () v 1+        result1 = listFindFirst even l+        result2 = listFindFirst (> 10) l+    in result1 == Just (1, 2) &&+       result2 == Nothing++prop_listSelectedElement_lazy :: Bool+prop_listSelectedElement_lazy =+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1 & listSelectedL .~ Just 3+    in listSelectedElement l == Just (3, 4)++prop_listSelectedElementL_lazy :: Bool+prop_listSelectedElementL_lazy =+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1 & listSelectedL .~ Just 3+    in over listSelectedElementL (*2) l ^? listSelectedElementL == Just 8++return []++main :: IO Bool+main = $quickCheckAll
+ tests/Main.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++import Control.Applicative+import Data.Bool (bool)+import Data.Traversable (sequenceA)+import System.Exit (exitFailure, exitSuccess)++import Data.IMap (IMap, Run(Run))+import Data.IntMap (IntMap)+import Test.QuickCheck+import qualified Data.IMap as IMap+import qualified Data.IntMap as IntMap++import qualified List+import qualified Render++instance Arbitrary v => Arbitrary (Run v) where+    arbitrary = liftA2 (\(Positive n) -> Run n) arbitrary arbitrary++instance Arbitrary v => Arbitrary (IMap v) where+    arbitrary = IMap.fromList <$> arbitrary++instance (a ~ Ordering, Show b) => Show (a -> b) where+    show f = show [f x | x <- [minBound .. maxBound]]++lower :: IMap v -> IntMap v+lower m = IntMap.fromDistinctAscList+    [ (base+offset, v)+    | (base, Run n v) <- IMap.unsafeToAscList m+    , offset <- [0..n-1]+    ]++raise :: Eq v => IntMap v -> IMap v+raise = IMap.fromList . rle . map singletonRun . IntMap.toAscList where+    singletonRun (k, v) = (k, Run 1 v)++    rle ((k, Run n v):(k', Run n' v'):kvs)+        | k+n == k' && v == v' = rle ((k, Run (n+n') v):kvs)+    rle (kv:kvs) = kv:rle kvs+    rle [] = []++lowerRun :: Int -> Run v -> IntMap v+lowerRun k r = IntMap.fromAscList [(k+offset, IMap.val r) | offset <- [0..IMap.len r-1]]++type O = Ordering+type I = IMap Ordering++-- These next two probably have overflow bugs that QuickCheck can't reasonably+-- notice. Hopefully they don't come up in real use cases...+prop_raiseLowerFaithful :: IntMap O -> Bool+prop_raiseLowerFaithful m = m == lower (raise m)++prop_equalityReflexive :: I -> Bool+prop_equalityReflexive m = m == raise (lower m)++prop_equality :: I -> I -> Bool+prop_equality l r = (l == r) == (lower l == lower r)++prop_compare :: I -> I -> Bool+prop_compare l r = compare l r == compare (lower l) (lower r)++prop_applicativeIdentity :: I -> Bool+prop_applicativeIdentity v = (id <$> v) == v++prop_applicativeComposition :: IMap (O -> O) -> IMap (O -> O) -> IMap O -> Bool+prop_applicativeComposition u v w = ((.) <$> u <*> v <*> w) == (u <*> (v <*> w))++prop_applicativeHomomorphism :: (O -> O) -> O -> Bool+prop_applicativeHomomorphism f x = (f <$> pure x :: I) == pure (f x)++prop_applicativeInterchange :: IMap (O -> O) -> O -> Bool+prop_applicativeInterchange u y = (u <*> pure y) == (($ y) <$> u)++prop_empty :: Bool+prop_empty = lower (IMap.empty :: I) == IntMap.empty++prop_singleton :: Int -> Run O -> Bool+prop_singleton k r = lower (IMap.singleton k r) == lowerRun k r++prop_insert :: Int -> Run O -> I -> Bool+prop_insert k r m = lower (IMap.insert k r m) == IntMap.union (lowerRun k r) (lower m)++prop_delete :: Int -> Run () -> I -> Bool+prop_delete k r m = lower (IMap.delete k r m) == lower m IntMap.\\ lowerRun k r++prop_splitLE :: Int -> I -> Bool+prop_splitLE k m = (lower le, lower gt) == (le', gt') where+    (le, gt) = IMap.splitLE k m+    (lt, eq, gt') = IntMap.splitLookup k (lower m)+    le' = maybe id (IntMap.insert k) eq lt++prop_intersectionWith :: (O -> O -> O) -> I -> I -> Bool+prop_intersectionWith f l r = lower (IMap.intersectionWith f l r) == IntMap.intersectionWith f (lower l) (lower r)++prop_addToKeys :: Int -> I -> Bool+prop_addToKeys n m = lower (IMap.addToKeys n m) == IntMap.mapKeysMonotonic (n+) (lower m)++prop_lookup :: Int -> I -> Bool+prop_lookup k m = IMap.lookup k m == IntMap.lookup k (lower m)++prop_restrict :: Int -> Run () -> I -> Bool+prop_restrict k r m = lower (IMap.restrict k r m) == IntMap.intersection (lower m) (lowerRun k r)++prop_mapMaybe :: (O -> Maybe O) -> I -> Bool+prop_mapMaybe f m = lower (IMap.mapMaybe f m) == IntMap.mapMaybe f (lower m)++prop_null :: I -> Bool+prop_null m = IMap.null m == IntMap.null (lower m)++return []++main :: IO ()+main =+  (and <$> sequenceA [$quickCheckAll, List.main, Render.main])+  >>= bool exitFailure exitSuccess
+ tests/Render.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}+module Render+  ( main+  )+where++import Brick+import Control.Monad (when)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V+import qualified Graphics.Vty.CrossPlatform.Testing as V+import Brick.Widgets.Border (hBorder)+import Control.Exception (SomeException, try)++region :: V.DisplayRegion+region = (30, 10)++renderDisplay :: Ord n => [Widget n] -> IO ()+renderDisplay ws = do+    outp <- V.mkDefaultOutput+    ctx <- V.displayContext outp region+    V.outputPicture ctx (renderWidget Nothing ws region)+    V.releaseDisplay outp++myWidget :: Widget ()+myWidget = str "Why" <=> hBorder <=> str "not?"++-- Since you can't Read a Picture, we have to compare the result with+-- the Shown one+expectedResult :: String+expectedResult = "Picture {picCursor = NoCursor, picLayers = [VertJoin {partTop = VertJoin {partTop = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"Why                           \", outputWidth = 30, charWidth = 30}, partBottom = VertJoin {partTop = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\\9472\", outputWidth = 30, charWidth = 30}, partBottom = HorizText {attr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}, displayText = \"not?                          \", outputWidth = 30, charWidth = 30}, outputWidth = 30, outputHeight = 2}, outputWidth = 30, outputHeight = 3}, partBottom = BGFill {outputWidth = 30, outputHeight = 7}, outputWidth = 30, outputHeight = 10}], picBackground = Background {backgroundChar = ' ', backgroundAttr = Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default}}}"++main :: IO Bool+main = do+    result <- try (renderDisplay [myWidget]) :: IO (Either SomeException ())+    case result of+        Left _ -> do+            putStrLn "Terminal is not available, skipping test"+            -- Even though we could not actually run the test, we return+            -- True here to prevent the absence of a terminal from+            -- causing a test suite failure in an automated context.+            -- This means that this test effectively doesn't get+            -- considered at all in the automated context.+            return True+        Right () -> do+            let matched = actualResult == expectedResult+                actualResult = show (renderWidget Nothing [myWidget] region)+                msg = if matched then "rendering match" else "rendering mismatch"++            putStrLn ""+            putStrLn $ "renderWidget test outcome: " <> msg++            when (not matched) $ do+                putStrLn "Expected result:"+                putStrLn expectedResult++                putStrLn "Actual result:"+                putStrLn actualResult++            return matched