packages feed

brick 0.52.1 → 2.12

raw patch · 100 files changed

Files

CHANGELOG.md view
@@ -2,6 +2,834 @@ Brick changelog --------------- +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 ------ @@ -327,14 +1155,14 @@  * The Forms API got two new functions, `setFormConcat` and    `setFieldConcat`, used for controlling the previously hard-coded    concatenation behavior of form fields. These are optional and both-   concatentation settings default to their former hard-coded values,+   concatenation settings default to their former hard-coded values,    `vBox` (#172).  0.36.1 ------  Package changes:- * Raiseed upper bound to support GHC 8.4.2 (#171)+ * Raised upper bound to support GHC 8.4.2 (#171)  Other changes:  * Improved List accessor documentation (thanks liam <liam@magicseaweed.com>)@@ -348,7 +1176,7 @@  * Dynamic border support: adjacent widgets that use borders can make    those borders seamlessly connect to each other! Thanks    so much to Daniel Wagner for this feature! Please see-   `programs/DynamicBorderDemo.hs` for a demonstraton. Also see the+   `programs/DynamicBorderDemo.hs` for a demonstration. Also see the    "Joinable Borders" section of the User Guide.  0.35.1@@ -1044,7 +1872,7 @@ 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+  caused a crash during image cropping in vty; now the behavior is   handled sanely (fixes #22; reported by Hans-Peter Deifel)  0.2.2
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015-2018, Jonathan Daugherty.+Copyright (c) 2015-2025, Jonathan Daugherty. All rights reserved.  Redistribution and use in source and binary forms, with or without
README.md view
@@ -2,17 +2,20 @@  `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 look based on your current application state and you-provide a state transformation function to handle events.+interface should be drawn based on your current application state and+you provide a state transformation function to handle events.  `brick` exposes a declarative API. Unlike most GUI toolkits which-require you to write a long and tedious sequence of "create a widget,-now bind an event handler", `brick` just requires you to describe your-interface using a set of declarative layout combinators.+require you to write a long and tedious sequence of widget creations+and layout setup, `brick` just requires you to describe your interface+using a set of declarative layout combinators. Event-handling is done by+pattern-matching on incoming events and updating your application state.  Under the hood, this library builds upon [vty](http://hackage.haskell.org/package/vty), so some knowledge of Vty-will be helpful in using this library.+will be necessary to use this library. Brick depends on+`vty-crossplatform`, so Brick should work anywhere Vty works (Unix and+Windows). Brick releases prior to 2.0 only support Unix-based systems.  Example -------@@ -20,6 +23,7 @@ Here's an example interface (see `programs/ReadmeDemo.hs`):  ```+joinBorders $ withBorderStyle unicode $ borderWithLabel (str "Hello!") $ (center (str "Left") <+> vBorder <+> center (str "Right"))@@ -34,44 +38,81 @@ │   Left    │   Right    │ │           │            │ │           │            │-└────────────────────────┘+└───────────┴────────────┘ ```  Featured Projects ----------------- -To get an idea of what some people have done with `brick`, take a look-at these projects:-- * [`tetris`](https://github.com/SamTay/tetris), an implementation of the Tetris game- * [`gotta-go-fast`](https://github.com/callum-oakley/gotta-go-fast), a typing tutor- * [`haskell-player`](https://github.com/potomak/haskell-player), an `afplay` frontend- * [`mushu`](https://github.com/elaye/mushu), an `MPD` client- * [`matterhorn`](https://github.com/matterhorn-chat/matterhorn), a client for [Mattermost](https://about.mattermost.com/)- * [`viewprof`](https://github.com/maoe/viewprof), a GHC profile viewer- * [`tart`](https://github.com/jtdaugherty/tart), a mouse-driven ASCII art drawing program- * [`silly-joy`](https://github.com/rootmos/silly-joy), an interpreter for Joy- * [`herms`](https://github.com/jackkiefer/herms), a command-line tool for managing kitchen recipes- * [`purebred`](https://github.com/purebred-mua/purebred), a mail user agent- * [`2048Haskell`](https://github.com/8Gitbrix/2048Haskell), an implementation of the 2048 game- * [`bhoogle`](https://github.com/andrevdm/bhoogle), a [Hoogle](https://www.haskell.org/hoogle/) client- * [`clifm`](https://github.com/pasqu4le/clifm), a file manager- * [`towerHanoi`](https://github.com/shajenM/projects/tree/master/towerHanoi), animated solutions to The Tower of Hanoi- * [`VOIDSPACE`](https://github.com/ChrisPenner/void-space), a space-themed typing-tutor game- * [`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--These third-party packages also extend `brick`:-- * [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) [[Hackage]](http://hackage.haskell.org/package/brick-filetree) - A widget for exploring a directory tree and selecting or flagging files and directories+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! -Release Announcements / News-----------------------------+| 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 | -Find out about `brick` releases and other news on Twitter:+These additional packages also extend `brick`: -https://twitter.com/brick_haskell/+| 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 ---------------@@ -92,9 +133,8 @@ Documentation for `brick` comes in a variety of forms:  * [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-* [Samuel Tay's brick tutorial](https://github.com/jtdaugherty/brick/blob/master/docs/samtay-tutorial.md)-* Haddock (all modules)-* [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs) ([Screenshots](https://github.com/jtdaugherty/brick/blob/master/docs/programs-screenshots.md))+* [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@@ -104,26 +144,28 @@   * Vertical and horizontal box layout widgets  * Basic single- and multi-line text editor widgets- * List widget+ * List and table widgets  * Progress bar widget  * Simple dialog box widget  * Border-drawing widgets (put borders around or in between things)- * Generic scrollable viewports+ * Animation support+ * Generic scrollable viewports and viewport scroll bars  * General-purpose layout control combinators  * Extensible widget-building API  * User-customizable attribute themes  * Type-safe, validated input form API (see the `Brick.Forms` module)  * A filesystem browser for file and directory selection  * Borders can be configured to automatically connect!- -Brick-Users Discussion----------------------- -The `brick-users` Google Group / e-mail list is a place to discuss-library changes, give feedback, and ask questions. You can subscribe at:+Brick Discussion+---------------- -[https://groups.google.com/group/brick-users](https://groups.google.com/group/brick-users)+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 ------ @@ -142,14 +184,24 @@ packages and widgets. If you use that, you'll also be helping to test whether the exported interface is usable and complete! +A note on Windows support+-------------------------++Brick supports Windows implicitly by way of Vty's Windows support.+While I don't (and can't) personally test Brick on Windows hosts,+it should be possible to use Brick on Windows. If you have any+trouble, report any issues here. If needed, we'll migrate them to the+[vty-windows](https://github.com/chhackett/vty-windows) repository if+they need to be fixed there.+ Reporting bugs --------------  Please file bug reports as GitHub issues.  For best results:   - Include the versions of relevant software packages: your terminal-   emulator, `brick`, `ghc`, and `vty` will be the most important-   ones.+   emulator, `brick`, `ghc`, `vty`, and Vty platform packages will be+   the most important ones.   - Clearly describe the behavior you expected ... @@ -162,6 +214,8 @@ If you decide to contribute, that's great! Here are some guidelines you should consider to make submitting patches easier for all concerned: + - Patches written completely or partially by AI are unlikely to be+   accepted.  - If you want to take on big things, talk to me first; let's have a    design/vision discussion before you start coding. Create a GitHub    issue and we can use that as the place to hash things out.@@ -169,7 +223,12 @@    codebase.  - Please adjust or provide Haddock and/or user guide documentation    relevant to any changes you make.- - New commits should be `-Wall` clean.+ - Please ensure that commits are `-Wall` clean.+ - Please ensure that each commit makes a single, logical, isolated+   change as much as possible.+ - Please do not submit changes that your linter told you to make. I+   will probably decline them. Relatedly: please do not submit changes+   that change only style without changing functionality.  - Please do NOT include package version changes in your patches.    Package version changes are only done at release time when the full    scope of a release's changes can be evaluated to determine the
brick.cabal view
@@ -1,5 +1,5 @@ name:                brick-version:             0.52.1+version:             2.12 synopsis:            A declarative terminal user interface library description:   Write terminal user interfaces (TUIs) painlessly with 'brick'! You@@ -32,48 +32,34 @@ license-file:        LICENSE author:              Jonathan Daugherty <cygnus@foobox.com> maintainer:          Jonathan Daugherty <cygnus@foobox.com>-copyright:           (c) Jonathan Daugherty 2015-2018+copyright:           (c) Jonathan Daugherty 2015-2025 category:            Graphics build-type:          Simple cabal-version:       1.18 Homepage:            https://github.com/jtdaugherty/brick/ Bug-reports:         https://github.com/jtdaugherty/brick/issues-tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1, GHC == 8.6.5, GHC == 8.8.1+tested-with:         GHC == 8.2.2+                      || == 8.4.4+                      || == 8.6.5+                      || == 8.8.4+                      || == 8.10.7+                      || == 9.0.2+                      || == 9.2.8+                      || == 9.4.8+                      || == 9.6.7+                      || == 9.8.4+                      || == 9.10.3+                      || == 9.12.2  extra-doc-files:     README.md,                      docs/guide.rst,-                     docs/samtay-tutorial.md,                      docs/snake-demo.gif,                      CHANGELOG.md,-                     docs/programs-screenshots.md,-                     docs/programs-screenshots/brick-attr-demo.png,-                     docs/programs-screenshots/brick-border-demo.png,-                     docs/programs-screenshots/brick-cache-demo.png,-                     docs/programs-screenshots/brick-custom-event-demo.png,-                     docs/programs-screenshots/brick-dialog-demo.png,-                     docs/programs-screenshots/brick-dynamic-border-demo.png,-                     docs/programs-screenshots/brick-edit-demo.png,-                     docs/programs-screenshots/brick-file-browser-demo.png,-                     docs/programs-screenshots/brick-fill-demo.png,-                     docs/programs-screenshots/brick-form-demo.png,-                     docs/programs-screenshots/brick-hello-world-demo.png,-                     docs/programs-screenshots/brick-layer-demo.png,-                     docs/programs-screenshots/brick-list-demo.png,-                     docs/programs-screenshots/brick-list-vi-demo.png,-                     docs/programs-screenshots/brick-markup-demo.png,-                     docs/programs-screenshots/brick-mouse-demo.png,-                     docs/programs-screenshots/brick-padding-demo.png,-                     docs/programs-screenshots/brick-progressbar-demo.png,-                     docs/programs-screenshots/brick-readme-demo.png,-                     docs/programs-screenshots/brick-suspend-resume-demo.png,-                     docs/programs-screenshots/brick-text-wrap-demo.png,-                     docs/programs-screenshots/brick-theme-demo.png,-                     docs/programs-screenshots/brick-viewport-scroll-demo.png,-                     docs/programs-screenshots/brick-visibility-demo.png+                     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@@ -81,18 +67,25 @@  library   default-language:    Haskell2010-  ghc-options:         -Wall -Wcompat -O2+  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@@ -105,40 +98,87 @@     Brick.Widgets.FileBrowser     Brick.Widgets.List     Brick.Widgets.ProgressBar+    Brick.Widgets.Table     Data.IMap-    Data.Text.Markup   other-modules:+    Brick.Animation.Clock     Brick.Types.Common     Brick.Types.TH+    Brick.Types.EventM     Brick.Types.Internal     Brick.Widgets.Internal -  build-depends:       base <= 4.13.0.0,-                       vty >= 5.24,-                       transformers,+  build-depends:       base >= 4.9.0.0 && < 4.23.0.0,+                       vty >= 6.0,+                       vty-crossplatform,+                       bimap >= 0.5 && < 0.6,                        data-clist >= 0.1,                        directory >= 1.2.5.0,-                       dlist,                        exceptions >= 0.10.0,                        filepath,                        containers >= 0.5.7,-                       microlens >= 0.3.0.0,+                       microlens >= 0.3.0.0 && < 0.6,                        microlens-th,                        microlens-mtl,+                       mtl,                        config-ini,                        vector,-                       contravariant,                        stm >= 2.4.3,                        text,-                       text-zipper >= 0.7.1,+                       text-zipper >= 0.13,                        template-haskell,-                       deepseq >= 1.3 && < 1.5,-                       unix,+                       deepseq >= 1.3 && < 1.6,+                       unix-compat,                        bytestring,-                       word-wrap >= 0.2-  if impl(ghc < 8.0)-    build-depends:     semigroups+                       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@@ -148,8 +188,7 @@   default-extensions:  CPP   main-is:             ReadmeDemo.hs   build-depends:       base,-                       brick,-                       text+                       brick  executable brick-file-browser-demo   if !flag(demos)@@ -162,7 +201,8 @@   build-depends:       base,                        vty,                        brick,-                       text+                       text,+                       mtl  executable brick-form-demo   if !flag(demos)@@ -177,6 +217,7 @@                        text,                        microlens,                        microlens-th,+                       vty-crossplatform,                        vty  executable brick-text-wrap-demo@@ -189,7 +230,6 @@   main-is:             TextWrapDemo.hs   build-depends:       base,                        brick,-                       text,                        word-wrap  executable brick-cache-demo@@ -203,9 +243,7 @@   build-depends:       base,                        brick,                        vty,-                       text,-                       microlens >= 0.3.0.0,-                       microlens-th+                       mtl  executable brick-visibility-demo   if !flag(demos)@@ -217,8 +255,23 @@   build-depends:       base,                        brick,                        vty,-                       text,                        microlens >= 0.3.0.0,+                       microlens-th,+                       microlens-mtl++executable brick-viewport-scrollbars-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             ViewportScrollbarsDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       vty-crossplatform,+                       microlens-mtl,                        microlens-th  executable brick-viewport-scroll-demo@@ -231,9 +284,7 @@   main-is:             ViewportScrollDemo.hs   build-depends:       base,                        brick,-                       vty,-                       text,-                       microlens+                       vty  executable brick-dialog-demo   if !flag(demos)@@ -244,9 +295,7 @@   main-is:             DialogDemo.hs   build-depends:       base,                        brick,-                       vty,-                       text,-                       microlens+                       vty  executable brick-mouse-demo   if !flag(demos)@@ -258,10 +307,10 @@   build-depends:       base,                        brick,                        vty,-                       text,                        microlens >= 0.3.0.0,                        microlens-th,-                       text-zipper+                       microlens-mtl,+                       mtl  executable brick-layer-demo   if !flag(demos)@@ -273,9 +322,9 @@   build-depends:       base,                        brick,                        vty,-                       text,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl  executable brick-suspend-resume-demo   if !flag(demos)@@ -287,10 +336,20 @@   build-depends:       base,                        brick,                        vty,-                       text,                        microlens >= 0.3.0.0,                        microlens-th +executable brick-cropping-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             CroppingDemo.hs+  build-depends:       base,+                       brick,+                       vty+ executable brick-padding-demo   if !flag(demos)     Buildable: False@@ -300,9 +359,7 @@   main-is:             PaddingDemo.hs   build-depends:       base,                        brick,-                       vty,-                       text,-                       microlens+                       vty  executable brick-theme-demo   if !flag(demos)@@ -314,8 +371,7 @@   build-depends:       base,                        brick,                        vty,-                       text,-                       microlens+                       mtl  executable brick-attr-demo   if !flag(demos)@@ -326,22 +382,22 @@   main-is:             AttrDemo.hs   build-depends:       base,                        brick,-                       vty,-                       text,-                       microlens+                       vty -executable brick-markup-demo+executable brick-tabular-list-demo   if !flag(demos)     Buildable: False   hs-source-dirs:      programs   ghc-options:         -threaded -Wall -Wcompat -O2   default-language:    Haskell2010-  main-is:             MarkupDemo.hs+  main-is:             TabularListDemo.hs   build-depends:       base,                        brick,                        vty,-                       text,-                       microlens+                       microlens >= 0.3.0.0,+                       microlens-mtl,+                       microlens-th,+                       vector  executable brick-list-demo   if !flag(demos)@@ -353,8 +409,9 @@   build-depends:       base,                        brick,                        vty,-                       text,                        microlens >= 0.3.0.0,+                       microlens-mtl,+                       mtl,                        vector  executable brick-list-vi-demo@@ -367,10 +424,25 @@   build-depends:       base,                        brick,                        vty,-                       text,                        microlens >= 0.3.0.0,+                       microlens-mtl,+                       mtl,                        vector +executable brick-animation-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             AnimationDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       vty-crossplatform,+                       containers,+                       microlens-platform+ executable brick-custom-event-demo   if !flag(demos)     Buildable: False@@ -381,9 +453,9 @@   build-depends:       base,                        brick,                        vty,-                       text,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl  executable brick-fill-demo   if !flag(demos)@@ -393,10 +465,7 @@   default-language:    Haskell2010   main-is:             FillDemo.hs   build-depends:       base,-                       brick,-                       vty,-                       text,-                       microlens+                       brick  executable brick-hello-world-demo   if !flag(demos)@@ -406,10 +475,7 @@   default-language:    Haskell2010   main-is:             HelloWorldDemo.hs   build-depends:       base,-                       brick,-                       vty,-                       text,-                       microlens+                       brick  executable brick-edit-demo   if !flag(demos)@@ -421,11 +487,24 @@   build-depends:       base,                        brick,                        vty,-                       text,-                       vector,                        microlens >= 0.3.0.0,-                       microlens-th+                       microlens-th,+                       microlens-mtl +executable brick-editor-line-numbers-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             EditorLineNumbersDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       microlens >= 0.3.0.0,+                       microlens-th,+                       microlens-mtl+ executable brick-border-demo   if !flag(demos)     Buildable: False@@ -437,8 +516,7 @@   build-depends:       base,                        brick,                        vty,-                       text,-                       microlens+                       text  executable brick-dynamic-border-demo   if !flag(demos)@@ -449,10 +527,7 @@   default-language:    Haskell2010   main-is:             DynamicBorderDemo.hs   build-depends:       base <= 5,-                       brick,-                       vty,-                       text,-                       microlens+                       brick  executable brick-progressbar-demo   if !flag(demos)@@ -465,23 +540,21 @@   build-depends:       base,                        brick,                        vty,-                       text,-                       microlens+                       microlens-mtl,+                       microlens-th  test-suite brick-tests   type:                exitcode-stdio-1.0   hs-source-dirs:      tests-  ghc-options:         -Wall -Wcompat -O2-  if impl(ghc >= 8)-    ghc-options:       -Wno-orphans+  ghc-options:         -Wall -Wcompat -Wno-orphans -O2   default-language:    Haskell2010   main-is:             Main.hs-  other-modules:       List+  other-modules:       List Render   build-depends:       base <=5,                        brick,                        containers,                        microlens,                        vector,+                       vty,+                       vty-crossplatform,                        QuickCheck-  if impl(ghc < 8.0)-    build-depends:     semigroups
docs/guide.rst view
@@ -11,7 +11,8 @@ and as direct as possible. ``brick`` builds on `vty`_; `vty` provides the terminal input and output interface and drawing primitives, while ``brick`` builds on those to provide a high-level application-abstraction and combinators for expressing user interface layouts.+abstraction, combinators for expressing user interface layouts, and+infrastructure for handling events.  This documentation is intended to provide a high-level overview of the library's design along with guidance for using it, but details on@@ -21,7 +22,7 @@ two important functions:  - A *drawing function* that turns your application state into a-  specification of how your interface should look, and+  specification of how your interface should be drawn, and - An *event handler* that takes your application state and an input   event and decides whether to change the state or quit the program. @@ -30,9 +31,9 @@ attributes (e.g. foreground color), and express layout constraints (e.g. padding, centering, box layouts, scrolling viewports, etc.). -These functions get packaged into a structure that we hand off to the-``brick`` library's main event loop. We'll cover that in detail in `The-App Type`_.+These functions get packaged into an ``App`` structure that we hand off+to the ``brick`` library's main event loop. We'll cover that in detail+in `The App Type`_.  Installation ------------@@ -52,6 +53,13 @@    $ cd brick    $ cabal new-build +Your package will need some dependencies:++* ``brick``,+* ``vty >= 6.0``, and+* ``vty-crossplatform`` or ``vty-unix`` or ``vty-windows``, depending+  on which platform(s) your application supports.+ Building the Demonstration Programs ----------------------------------- @@ -68,16 +76,17 @@ documentation and as you explore the library source and write your own programs. -- Use of `microlens`_ packages: ``brick`` uses ``microlens`` family of-  packages internally and also exposes lenses for many types in the+- Use of `microlens`_ packages: ``brick`` uses the ``microlens`` family+  of packages internally and also exposes lenses for many types in the   library. However, if you prefer not to use the lens interface in your   program, all lens interfaces have non-lens equivalents exported by   the same module. In general, the "``L``" suffix on something tells   you it is a lens; the name without the "``L``" suffix is the non-lens-  version. You can get by without using ``brick``'s lens interface but-  your life will probably be much more pleasant once your application-  state becomes sufficiently complex if you use lenses to modify it (see-  `appHandleEvent: Handling Events`_).+  version. You can get by without using ``brick``'s lens interface+  but your life will probably be much more pleasant if you use lenses+  to modify your application state once it becomes sufficiently+  complex (see `appHandleEvent: Handling Events`_ and `Event Handlers+  for Component State`_). - Attribute names: some modules export attribute names (see `How   Attributes Work`_) associated with user interface elements. These tend   to end in an "``Attr``" suffix (e.g. ``borderAttr``). In addition,@@ -96,8 +105,8 @@ Brick applications must be compiled with the threaded RTS using the GHC ``-threaded`` option. -The App Type-============+The ``App`` Type+================  To use the library we must provide it with a value of type ``Brick.Main.App``. This type is a record type whose fields perform@@ -108,8 +117,8 @@    data App s e n =        App { appDraw         :: s -> [Widget n]            , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)-           , appHandleEvent  :: s -> BrickEvent n e -> EventM n (Next s)-           , appStartEvent   :: s -> EventM n s+           , appHandleEvent  :: BrickEvent n e -> EventM n s ()+           , appStartEvent   :: EventM n s ()            , appAttrMap      :: s -> AttrMap            } @@ -150,16 +159,16 @@     main :: IO ()    main = do-     let app = App { ... }-         initialState = ...-     finalState <- defaultMain app initialState-     -- Use finalState and exit+       let app = App { ... }+           initialState = ...+       finalState <- defaultMain app initialState+       -- Use finalState and exit  The ``customMain`` function is for more advanced uses; for details see `Using Your Own Event Type`_. -appDraw: Drawing an Interface------------------------------+``appDraw``: Drawing an Interface+---------------------------------  The value of ``appDraw`` is a function that turns the current application state into a list of *layers* of type ``Widget``, listed@@ -201,109 +210,162 @@ ``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets`` namespace provides specific kinds of functionality. -appHandleEvent: Handling Events--------------------------------+``appHandleEvent``: Handling Events+-----------------------------------  The value of ``appHandleEvent`` is a function that decides how to modify the application state as a result of an event:  .. code:: haskell -   appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)+   appHandleEvent :: BrickEvent n e -> EventM n s () -The first parameter of type ``s`` is your application's state at the-time the event arrives. ``appHandleEvent`` is responsible for deciding-how to change the state based on the event and then return it.+``appHandleEvent`` is responsible for deciding how to change the state+based on incoming events. The single parameter to the event handler is+the event to be handled. Its type variables ``n`` and ``e`` correspond+to the *resource name type* and *event type* of your application,+respectively, and must match the corresponding types in ``App`` and+``EventM``. -The second parameter of type ``BrickEvent n e`` is the event itself.-The type variables ``n`` and ``e`` correspond to the *resource name-type* and *event type* of your application, respectively, and must match-the corresponding types in ``App`` and ``EventM``.+The ``EventM`` monad is parameterized on the *resource name type*+``n`` and your application's state type ``s``. The ``EventM`` monad+is a state monad over ``s``, so one way to access and modify your+application's state in an event handler is to use the ``MonadState``+type class and associated operations from the ``mtl`` package. The+recommended approach, however, is to use the lens operations from the+``microlens-mtl`` package with lenses to perform concise state updates.+We'll cover this topic in more detail in `Event Handlers for Component+State`_. -The return value type ``Next s`` value describes what should happen-after the event handler is finished. We have three choices:+Once the event handler has performed any relevant state updates, it can+also indicate what should happen once the event handler has finished+executing. By default, after an event handler has completed, Brick will+redraw the screen with the application state (by calling ``appDraw``)+and wait for the next input event. However, there are two other options: -* ``Brick.Main.continue s``: continue executing the event loop with the-  specified application state ``s`` as the next value. Commonly this is-  where you'd modify the state based on the event and return it.-* ``Brick.Main.halt s``: halt the event loop and return the final-  application state value ``s``. This state value is returned to the-  caller of ``defaultMain`` or ``customMain`` where it can be used prior-  to finally exiting ``main``.-* ``Brick.Main.suspendAndResume act``: suspend the ``brick`` event loop-  and execute the specified ``IO`` action ``act``. The action ``act``-  must be of type ``IO s``, so when it executes it must return the next-  application state. When ``suspendAndResume`` is used, the ``brick``-  event loop is shut down and the terminal state is restored to its-  state when the ``brick`` event loop began execution. When it finishes-  executing, the event loop will be resumed using the returned state-  value. This is useful for situations where your program needs to-  suspend your interface and execute some other program that needs to-  gain control of the terminal (such as an external editor).+* ``Brick.Main.halt``: halt the event loop. The application state as it+  exists after the event handler completes is returned to the caller+  of ``defaultMain`` or ``customMain``.+* ``Brick.Main.continueWithoutRedraw``: continue executing the event+  loop, but do not redraw the screen using the new state before waiting+  for another input event. This is faster than the default continue+  behavior since it doesn't redraw the screen; it just leaves up the+  previous screen contents. This function is only useful when you know+  that your event handler's state change(s) won't cause anything on+  the screen to change. Use this only when you are certain that no+  redraw of the screen is needed *and* when you are trying to address a+  performance problem. (See also `The Rendering Cache`_ for details on+  how to deal with rendering performance issues.) -The ``EventM`` monad is the event-handling monad. This monad is a-transformer around ``IO`` so you are free to do I/O in this monad by-using ``liftIO``. Beyond I/O, this monad is used to make scrolling-requests to the renderer (see `Viewports`_) and obtain named extents-(see `Extents`_). Keep in mind that time spent blocking in your event-handler is time during which your UI is unresponsive, so consider this-when deciding whether to have background threads do work instead of-inlining the work in the event handler.+The ``EventM`` monad is a transformer around ``IO`` so I/O is possible+in this monad by using ``liftIO``. Keep in mind, however, that event+handlers should execute as quickly as possible to avoid introducing+screen redraw latency. Consider using background threads to work+asynchronously when handling an event would otherwise cause redraw+latency. -Widget Event Handlers-*********************+``EventM`` is also used to make scrolling requests to the renderer (see+`Viewports`_), obtain named extents (see `Extents`_), and other duties. -Event handlers are responsible for transforming the application state.-While you can use ordinary methods to do this such as pattern matching-and pure function calls, some widget state types such as the ones-provided by the ``Brick.Widgets.List`` and ``Brick.Widgets.Edit``-modules provide their own widget-specific event-handling functions.-For example, ``Brick.Widgets.Edit`` provides ``handleEditorEvent`` and-``Brick.Widgets.List`` provides ``handleListEvent``.+Event Handlers for Component State+********************************** -Since these event handlers run in ``EventM``, they have access to-rendering viewport states via ``Brick.Main.lookupViewport`` and the-``IO`` monad via ``liftIO``.+The top-level ``appHandleEvent`` handler is responsible for managing+the application state, but it also needs to be able to update the state+associated with UI components such as those that come with Brick. -To use these handlers in your program, invoke them on the relevant piece-of state in your application state. In the following example we use an-``Edit`` state from ``Brick.Widgets.Edit``:+For example, consider an application that uses Brick's built-in text+editor from ``Brick.Widgets.Edit``. The built-in editor is similar to+the main application in that it has three important elements: -.. code:: haskell+* The editor state of type ``Editor t n``: this stores the editor's+  contents, cursor position, etc.+* The editor's drawing function, ``renderEditor``: this is responsible+  for drawing the editor in the UI.+* The editor's event handler, ``handleEditorEvent``: this is responsible+  for updating the editor's contents and cursor position in response to+  key events. -   data Name = Edit1-   type MyState = Editor String Name+To use the built-in editor, the application must: -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = continue =<< handleEditorEvent e s+* Embed an ``Editor t n`` somewhere in the application state ``s``,+* Render the editor's state at the appropriate place in ``appDraw`` with+  ``renderEditor``, and+* Dispatch events to the editor in the ``appHandleEvent`` with+  ``handleEditorEvent``. -This pattern works well enough when your application state has an-event handler as shown in the ``Edit`` example above, but it can-become unpleasant if the value on which you want to invoke a handler-is embedded deeply within your application state. If you have chosen-to generate lenses for your application state fields, you can use the-convenience function ``handleEventLensed`` by specifying your state, a-lens, and the event:+An example application state using an editor might look like this:  .. code:: haskell -   data Name = Edit1-   data MyState = MyState { _theEdit :: Editor String Name-                          }+   data MyState n = MyState { _editor :: Editor Text n }    makeLenses ''MyState -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = continue =<< handleEventLensed s theEdit handleEditorEvent e+This declares the ``MyState`` type with an ``Editor`` contained within+it and uses Template Haskell to generate a lens, ``editor``, to allow us+to easily update the editor state in our event handler. -You might consider that preferable to the desugared version:+To dispatch events to the ``editor`` we'd start by writing the+application event handler:  .. code:: haskell -   myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState)-   myEvent s (VtyEvent e) = do-     newVal <- handleEditorEvent e (s^.theEdit)-     continue $ s & theEdit .~ newVal+   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       ... +But there's a problem: ``handleEditorEvent``'s type indicates that it+can only run over a state of type ``Editor t n``, but our handler runs+on ``MyState``. Specifically, ``handleEditorEvent`` has this type:++.. code:: haskell++   handleEditorEvent :: BrickEvent n e -> EventM n (Editor t n) ()++This means that to use ``handleEditorEvent``, it must be composed+into the application's event handler, but since the state types ``s``+and ``Editor t n`` do not match, we need a way to compose these event+handlers. There are two ways to do this:++* Use ``Lens.Micro.Mtl.zoom`` from the ``microlens-mtl`` package+  (re-exported by ``Brick.Types`` for convenience). This function is+  required when you want to change the state type to a field embedded in+  your application state using a lens. For example:++.. code:: haskell++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       zoom editor $ handleEditorEvent e++* Use ``Brick.Types.nestEventM``: this function lets you provide a state+  value and run ``EventM`` using that state. The following+  ``nestEventM`` example is equivalent to the ``zoom`` example above:++.. code:: haskell++   import Lens.Micro (_1)+   import Lens.Micro.Mtl (use, (.=))++   handleEvent :: BrickEvent n e -> EventM n MyState ()+   handleEvent e = do+       editorState <- use editor+       (newEditorState, ()) <- nestEventM editorState $ do+           handleEditorEvent e+       editor .= newEditorState++The ``zoom`` function, together with lenses for your application state's+fields, is by far the best way to manage your state in ``EventM``. As+you can see from the examples above, the ``zoom`` approach avoids a lot+of boilerplate. The ``nestEventM`` approach is provided in cases where+the state that you need to mutate is not easily accessed by ``zoom``.++Finally, if you prefer to avoid the use of lenses, you can always use+the ``MonadState`` API to get, put, and modify your state. Keep in+mind that the ``MonadState`` approach will still require the use of+``nestEventM`` when events scoped to widget states such as ``Editor``+need to be handled.+ Using Your Own Event Type ************************* @@ -327,13 +389,13 @@  With this type declaration we can now use counter events in our app by using the application type ``App s CounterEvent n``. To handle these-events we'll just need to look for ``AppEvent`` values in the event+events we'll just need to check for ``AppEvent`` values in the event handler:  .. code:: haskell -   myEvent :: s -> BrickEvent n CounterEvent -> EventM n (Next s)-   myEvent s (AppEvent (Counter i)) = ...+   myEvent :: BrickEvent n CounterEvent -> EventM n s ()+   myEvent (AppEvent (Counter i)) = ...  The next step is to actually *generate* our custom events and inject them into the ``brick`` event stream so they make it to the@@ -348,7 +410,7 @@    main :: IO ()    main = do        eventChan <- Brick.BChan.newBChan 10-       let buildVty = Graphics.Vty.mkVty Graphics.Vty.defaultConfig+       let buildVty = Graphics.Vty.CrossPlatform.mkVty Graphics.Vty.Config.defaultConfig        initialVty <- buildVty        finalState <- customMain initialVty buildVty                        (Just eventChan) app initialState@@ -357,7 +419,11 @@ The ``customMain`` function lets us have control over how the ``vty`` library is initialized *and* how ``brick`` gets custom events to give to our event handler. ``customMain`` is the entry point into ``brick`` when-you need to use your own event type as shown here.+you need to use your own event type as shown here. In this example we're+using ``mkVty`` provided by the ``vty-crossplatform`` package, which+provides build-time support for both Unix and Windows. If you prefer,+you can use either the ``vty-unix`` package or the ``vty-windows``+package directly instead if you only want to support one platform.  With all of this in place, sending our custom events to the event handler is straightforward:@@ -384,8 +450,8 @@ your event handler when choosing the channel capacity and design event producers so that they can block if the channel is full. -Starting up: appStartEvent-**************************+``appStartEvent``: Starting up+------------------------------  When an application starts, it may be desirable to perform some of the duties typically only possible when an event has arrived, such as@@ -396,16 +462,17 @@  .. code:: haskell -   appStartEvent :: s -> EventM n s+   appStartEvent :: EventM n s () -This function takes the initial application state and returns it in-``EventM``, possibly changing it and possibly making viewport requests.-This function is invoked once and only once, at application startup.-For more details, see `Viewports`_. You will probably just want to use-``return`` as the implementation of this function for most applications.+This function is a handler action to run on the initial application+state. This function is invoked once and only once, at application+startup. This might be a place to make initial viewport scroll requests+or make changes to the Vty environment. You will probably just want+to use ``return ()`` as the implementation of this function for most+applications. -appChooseCursor: Placing the Cursor------------------------------------+``appChooseCursor``: Placing the Cursor+---------------------------------------  The rendering process for a ``Widget`` may return information about where that widget would like to place the cursor. For example, a text@@ -462,9 +529,10 @@  .. code:: haskell -   myApp = App { ...-               , appChooseCursor = \_ -> showCursorNamed CustomName-               }+   myApp =+       App { ...+           , appChooseCursor = \_ -> showCursorNamed CustomName+           }  See the next section for more information on using names. @@ -515,9 +583,8 @@  .. code:: haskell -   do-     let vp = viewportScroll Viewport1-     vScrollBy vp 1+   let vp = viewportScroll Viewport1+   vScrollBy vp 1  The solution is to ensure that for a given resource type (in this case viewport), a unique name is assigned in each use.@@ -530,10 +597,10 @@    ui = (viewport Viewport1 Vertical $ str "Foo") <+>         (viewport Viewport2 Vertical $ str "Bar") <+> -appAttrMap: Managing Attributes--------------------------------+``appAttrMap``: Managing Attributes+----------------------------------- -In ``brick`` we use an *attribute map* to assign attibutes to elements+In ``brick`` we use an *attribute map* to assign attributes to elements of the interface. Rather than specifying specific attributes when drawing a widget (e.g. red-on-black text) we specify an *attribute name* that is an abstract name for the kind of thing we are drawing, e.g.@@ -620,7 +687,7 @@ that will always consume the same number of rows or columns no matter how many it is given. Widgets can advertise different vertical and horizontal growth policies for example, the-``Brick.Widgets.Border.hCenter`` function centers a widget and is+``Brick.Widgets.Center.hCenter`` function centers a widget and is ``Greedy`` horizontally and defers to the widget it centers for vertical growth behavior. @@ -756,27 +823,71 @@                                , (specificAttr, fg white)                                ] -Functions ``Brick.Util.fg`` and ``Brick.Util.bg`` specify-partial attributes, and map lookups start with the desired name-(``general/specific`` in this case) and walk up the name hierarchy (to-``general``), merging partial attribute settings as they go, letting-already-specified attribute settings take precedence. Finally, any-attribute settings not specified by map lookups fall back to the map's-*default attribute*, specified above as ``Graphics.Vty.defAttr``. In-this way, if you want everything in your application to have a ``blue``-background color, you only need to specify it *once*: in the attribute-map's default attribute. Any other attribute names can merely customize-the foreground color.+When drawing a widget, Brick keeps track of the current attribute it+is using to draw to the screen. The attribute it tracks is specified+by its *attribute name*, which is a hierarchical name referring to the+attribute in the attribute map. In the example above, the map contains+two attribute names: ``generalAttr`` and ``specificAttr``. Both names+are made up of segments: ``general`` is the first segment for both+names, and ``specific`` is the second segment for ``specificAttr``.+This tells Brick that ``specificAttr`` is a more specialized version+of ``generalAttr``. We'll see below how that affects the resulting+attributes that Brick uses. -In addition to using the attribute map provided by ``appAttrMap``,-the map can be customized on a per-widget basis by using the attribute-map combinators:+When it comes to drawing something on the screen with either of these+attributes, Brick looks up the desired attribute name in the map+and uses the result to draw to the screen. In the example above,+``withAttr`` is used to tell Brick that when drawing ``str "foobar"``,+the attribute ``specificAttr`` should be used. Brick looks that name+up in the attribute map and finds a match: an attribute with a white+foreground color. However, what happens next is important: Brick then+looks up the more general attribute name derived from ``specificAttr``,+which it gets by removing the last segment in the name, ``specific``.+The resulting name, ``general``, is then looked up. The new result is+then *merged* with the initial lookup, yielding an attribute with a+white foreground color and a blue background color. This happens because+the ``specificAttr`` entry did not specify a background color. If it+had, that would have been used instead. In this way, we can create+inheritance relationships between attributes, much the same way CSS+supports inheritance of styles based on rule specificity. -* ``Brick.Widgets.Core.updateAttrMap``-* ``Brick.Widgets.Core.forceAttr``-* ``Brick.Widgets.Core.withDefAttr``-* ``Brick.Widgets.Core.overrideAttr``+Brick uses Vty's attribute type, ``Attr``, which has three components:+foreground color, background color, and style. These three components+can be independently specified to have an explicit value, and any+component not explicitly specified can default to whatever the terminal+is currently using. Vty styles can be combined together, e.g. underline+and bold, so styles are cumulative. +What if a widget attempts to draw with an attribute name that is not+specified in the map at all? In that case, the attribute map's "default+attribute" is used. In the example above, the default attribute for the+map is Vty's ``defAttr`` value, which means that the terminal's default+colors and style should be used. But that attribute can be customized+as well, and any attribute map lookup results will get merged with the+default attribute for the map. So, for example, if you'd like your+entire application background to be blue unless otherwise specified, you+could create an attribute map as follows:++.. code:: haskell++   let myMap = attrMap (bg blue) [ ... ]++This way, we can avoid repeating the desired background color and all of+the other map entries can just set foreground colors and styles where+needed.++In addition to using the attribute map provided by ``appAttrMap``, the+map and attribute lookup behavior can be customized on a per-widget+basis by using various functions from ``Brick.Widgets.Core``:++* ``updateAttrMap`` -- allows transformations of the attribute map,+* ``forceAttr`` -- forces all attribute lookups to map to the value of+  the specified attribute name,+* ``withDefAttr`` -- changes the default attribute for the attribute map+  to the one with the specified name, and+* ``overrideAttr`` -- creates attribute map lookup synonyms between+  attribute names.+ Attribute Themes ================ @@ -784,7 +895,7 @@ follows:  * The application provides a default theme built in to the program.-* The application customizes the them by loading theme customizations+* The application customizes the theme by loading theme customizations   from a user-specified customization file. * The application can save new customizations to files for later   re-loading.@@ -867,16 +978,20 @@ If the theme is further customized at runtime, any changes can be saved with ``Brick.Themes.saveCustomizations``. -Wide Character Support and the TextWidth class-==============================================+Wide Character Support and the ``TextWidth`` class+================================================== -Brick supports rendering wide characters in all widgets, and the brick-editor supports entering and editing wide characters. Wide characters-are those such as many Asian characters and emoji that need more than-a single terminal column to be displayed. Brick relies on Vty's use of-the `utf8proc`_ library to determine the column width of each character-rendered.+Brick attempts to support rendering wide characters in all widgets,+and the brick editor supports entering and editing wide characters.+Wide characters are those such as many Asian characters and emoji+that need more than a single terminal column to be displayed. +Unfortunately, there is not a fully correct solution to determining+the character width that the user's terminal will use for a given+character. The current recommendation is to avoid use of wide characters+due to these issues. If you still must use them, you can read `vty`_'s+documentation for options that will affect character width calculations.+ As a result of supporting wide characters, it is important to know that computing the length of a string to determine its screen width will *only* work for single-column characters. So, for example, if you want@@ -886,26 +1001,28 @@     let width = Data.Text.length t -because if the string contains any wide characters, their widths-will not be counted properly. In order to get this right, use the-``TextWidth`` type class to compute the width:+If the string contains any wide characters, their widths will not be+counted properly. In order to get this right, use the ``TextWidth`` type+class to compute the width:  .. code:: haskell     let width = Brick.Widgets.Core.textWidth t -The ``TextWidth`` type class uses Vty's character width routine (and-thus ``utf8proc``) to compute the correct width. If you need to compute-the width of a single character, use ``Graphics.Text.wcwidth``.+The ``TextWidth`` type class uses Vty's character width routine to+compute the width by looking up the string's characters in a Unicode+width table. If you need to compute the width of a single character, use+``Graphics.Text.wcwidth``.  Extents ======= -When an application needs to know where a particular widget was drawn by-the renderer, the application can request that the renderer record the-*extent* of the widget--its upper-left corner and size--and provide it-in an event handler. In the following example, the application needs to-know where the bordered box containing "Foo" is rendered:+When an application needs to know where a particular widget was drawn+by the renderer, the application can request that the renderer record+the *extent* of the widget--its upper-left corner and size--and provide+access to it in an event handler. Extents are represented using Brick's+``Brick.Types.Extent`` type. In the following example, the application+needs to know where the bordered box containing "Foo" is rendered:  .. code:: haskell @@ -924,22 +1041,21 @@         reportExtent FooBox $         border $ str "Foo" -Now, whenever the ``ui`` is rendered, the location and size of the-bordered box containing "Foo" will be recorded. We can then look it up-in event handlers in ``EventM``:+Now, whenever the ``ui`` is rendered, the extent of the bordered box+containing "Foo" will be recorded. We can then look it up in event+handlers in ``EventM``:  .. code:: haskell -   do-     mExtent <- Brick.Main.lookupExtent FooBox-     case mExtent of+   mExtent <- Brick.Main.lookupExtent FooBox+   case mExtent of        Nothing -> ...-       Just (Extent _ upperLeft (width, height) offset) -> ...+       Just (Extent _ upperLeft (width, height)) -> ...  Paste Support ============= -Some terminal emulators support "bracketed paste" support. This feature+Some terminal emulators support "bracketed paste" mode. This feature enables OS-level paste operations to send the pasted content as a single chunk of data and bypass the usual input processing that the application does. This enables more secure handling of pasted data since@@ -957,10 +1073,10 @@    import qualified Graphics.Vty as V     do-     vty <- Brick.Main.getVtyHandle-     let output = V.outputIface vty-     when (V.supportsMode output V.BracketedPaste) $-         liftIO $ V.setMode output V.BracketedPaste True+       vty <- Brick.Main.getVtyHandle+       let output = V.outputIface vty+       when (V.supportsMode output V.BracketedPaste) $+           liftIO $ V.setMode output V.BracketedPaste True  Once enabled, paste mode will generate Vty ``EvPaste`` events. These events will give you the entire pasted content as a ``ByteString`` which@@ -978,10 +1094,10 @@ .. code:: haskell     do-     vty <- Brick.Main.getVtyHandle-     let output = outputIface vty-     when (supportsMode output Mouse) $-       liftIO $ setMode output Mouse True+       vty <- Brick.Main.getVtyHandle+       let output = outputIface vty+       when (supportsMode output Mouse) $+           liftIO $ setMode output Mouse True  Bear in mind that some terminals do not support mouse interaction, so use Vty's ``getModeStatus`` to find out whether your terminal will@@ -1002,7 +1118,7 @@  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row button mods) = ...+   handleEvent (VtyEvent (EvMouseDown col row button mods) = ...  Brick Mouse Events ------------------@@ -1012,27 +1128,60 @@ language. The disadvantage to the low-level interface described above is that you still need to determine *what* was clicked, i.e., the part of the interface that was under the mouse cursor. There are two ways to do-this with ``brick``: with *extent checking* and *click reporting*.+this with ``brick``: with *click reporting* and *extent checking*. +Click reporting+***************++The *click reporting* approach is the most high-level approach offered+by ``brick`` and the one that we recommend you use. In this approach,+we use ``Brick.Widgets.Core.clickable`` when drawing the interface to+request that a given widget generate ``MouseDown`` and ``MouseUp``+events when it is clicked.++.. code:: haskell++   data Name = MyButton++   ui :: Widget Name+   ui = center $+        clickable MyButton $+        border $+        str "Click me"++   handleEvent (MouseDown MyButton button modifiers coords) = ...+   handleEvent (MouseUp MyButton button coords) = ...++This approach enables event handlers to use pattern matching to check+for mouse clicks on specific regions; this uses `Extent checking`_+under the hood but makes it possible to denote which widgets are+clickable in the interface description. The event's click coordinates+are local to the widget being clicked. In the above example, a click+on the upper-left corner of the border would result in coordinates of+``(0,0)``.+ Extent checking ***************  The *extent checking* approach entails requesting extents (see `Extents`_) for parts of your interface, then checking the Vty mouse-click event's coordinates against one or more extents.+click event's coordinates against one or more extents. This approach+is slightly lower-level than the direct mouse click reporting approach+above but is provided in case you need more control over how mouse+clicks are dealt with.  The most direct way to do this is to check a specific extent:  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do-     mExtent <- lookupExtent SomeExtent-     case mExtent of-       Nothing -> continue s-       Just e -> do-         if Brick.Main.clickedExtent (col, row) e-           then ...-           else ...+   handleEvent (VtyEvent (EvMouseDown col row _ _)) = do+       mExtent <- lookupExtent SomeExtent+       case mExtent of+           Nothing -> return ()+           Just e -> do+               if Brick.Main.clickedExtent (col, row) e+                   then ...+                   else ...  This approach works well enough if you know which extent you're interested in checking, but what if there are many extents and you@@ -1041,10 +1190,10 @@  .. code:: haskell -   handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do-     extents <- Brick.Main.findClickedExtents (col, row)-     -- Then check to see if a specific extent is in the list, or just-     -- take the first one in the list.+   handleEvent (VtyEvent (EvMouseDown col row _ _)) = do+       extents <- Brick.Main.findClickedExtents (col, row)+       -- Then check to see if a specific extent is in the list, or just+       -- take the first one in the list.  This approach finds all clicked extents and returns them in a list with the following properties:@@ -1058,35 +1207,6 @@ As a result, the extents are ordered in a natural way, starting with the most specific extents and proceeding to the most general. -Click reporting-***************--The *click reporting* approach is the most high-level approach-offered by ``brick``. When rendering the interface we use-``Brick.Widgets.Core.clickable`` to request that a given widget generate-``MouseDown`` and ``MouseUp`` events when it is clicked.--.. code:: haskell--   data Name = MyButton--   ui :: Widget Name-   ui = center $-        clickable MyButton $-        border $-        str "Click me"--   handleEvent s (MouseDown MyButton button modifiers coords) = ...-   handleEvent s (MouseUp MyButton button coords) = ...--This approach enables event handlers to use pattern matching to check-for mouse clicks on specific regions; this uses extent reporting-under the hood but makes it possible to denote which widgets are-clickable in the interface description. The event's click coordinates-are local to the widget being clicked. In the above example, a click-on the upper-left corner of the border would result in coordinates of-``(0,0)``.- Viewports ========= @@ -1159,14 +1279,14 @@  .. code:: haskell -   hScrollPage        :: Direction -> EventM n ()-   hScrollBy          :: Int       -> EventM n ()-   hScrollToBeginning ::              EventM n ()-   hScrollToEnd       ::              EventM n ()-   vScrollPage        :: Direction -> EventM n ()-   vScrollBy          :: Int       -> EventM n ()-   vScrollToBeginning ::              EventM n ()-   vScrollToEnd       ::              EventM n ()+   hScrollPage        :: Direction -> EventM n s ()+   hScrollBy          :: Int       -> EventM n s ()+   hScrollToBeginning ::              EventM n s ()+   hScrollToEnd       ::              EventM n s ()+   vScrollPage        :: Direction -> EventM n s ()+   vScrollBy          :: Int       -> EventM n s ()+   vScrollToBeginning ::              EventM n s ()+   vScrollToEnd       ::              EventM n s ()  In each case the scrolling function scrolls the viewport by the specified amount in the specified direction; functions prefixed with@@ -1182,11 +1302,10 @@  .. code:: haskell -   myHandler :: s -> e -> EventM n (Next s)-   myHandler s e = do+   myHandler :: e -> EventM n s ()+   myHandler e = do        let vp = viewportScroll Viewport1        hScrollBy vp 1-       continue s  Scrolling Viewports With Visibility Requests --------------------------------------------@@ -1205,7 +1324,7 @@    -- Assuming that App uses 'Name' for its resource names:    data Name = Viewport1    let w = viewport Viewport1 Horizontal $-           (visible $ str "Hello," <+> (str " world!")+           (visible $ str "Hello,") <+> (str " world!")  This example requests that the ``Viewport1`` viewport be scrolled so that "Hello," is visible. We could extend this example with a value@@ -1225,6 +1344,29 @@   its selected item visible regardless of its size, which makes   the list widget scrolling-unaware. +Showing Scroll Bars on Viewports+--------------------------------++Brick supports drawing both vertical and horizontal scroll bars on+viewports. To enable scroll bars, wrap your call to ``viewport`` with+a call to ``withVScrollBars`` and/or ``withHScrollBars``. If you don't+like the appearance of the resulting scroll bars, you can customize+how they are drawn by making your own ``ScrollbarRenderer`` and using+``withVScrollBarRenderer`` and/or ``withHScrollBarRenderer``. Note that+when you enable scrollbars, the content of your viewport will lose one+column of available space if vertical scroll bars are enabled and one+row of available space if horizontal scroll bars are enabled.++Scroll bars can also be configured to draw "handles" with+``withHScrollBarHandles`` and ``withVScrollBarHandles``.++Lastly, scroll bars can be configured to report mouse events on+each scroll bar element. To enable mouse click reporting, use+``withClickableHScrollBars`` and ``withClickableVScrollBars``.++For a demonstration of the scroll bar API in action, see the+``ViewportScrollbarsDemo.hs`` demonstration program.+ Viewport Restrictions --------------------- @@ -1265,7 +1407,7 @@ A Form Example -------------- -Let's look at an example data type that we'd want to use as the+Let's consider an example data type that we'd want to use as the basis for an input interface. This example comes directly from the ``FormDemo.hs`` demonstration program. @@ -1352,9 +1494,14 @@ to initialize all of the form fields. Each form field will use the lens provided to extract the initial value from the ``UserInfo`` record, convert it into an appropriate state type for the field in question, and-later validate that state and convert it back into the approprate type+later validate that state and convert it back into the appropriate type for storage in ``UserInfo``. +The form value itself -- of type ``Form`` -- must be stored in your+application state. You should only ever call ``newForm`` when you need+to initialize a totally new form. Once initialized, the form needs to be+kept around and updated by event handlers in order to work.+ For example, if the initial ``UserInfo`` value's ``_age`` field has the value ``0``, the ``editShowableField`` will call ``show`` on ``0``, convert that to ``Text``, and initialize the editor for ``_age`` with@@ -1390,7 +1537,7 @@ .. code:: haskell      (str "Name: " <+>) @@=-      editTextField name NameField (Just 1)+        editTextField name NameField (Just 1)  Now when we invoke ``renderForm`` on a form using the above example, we'll see a ``"Name:"`` label to the left of the editor field for@@ -1414,7 +1561,7 @@ * ``focusedFormInputAttr`` - this attribute is used to render the form   field that has the focus. * ``invalidFormInputAttr`` - this attribute is used to render any form-  field that has user input that has valid validation.+  field that has user input that has invalid validation.  Your application should set both of these. Some good mappings in the attribute map are:@@ -1425,14 +1572,14 @@ Handling Form Events -------------------- -Handling form events is easy: we just call-``Brick.Forms.handleFormEvent`` with the ``BrickEvent`` and the-``Form``. This automatically dispatches input events to the-currently-focused input field, and it also manages focus changes with-``Tab`` and ``Shift-Tab`` keybindings. (For details on all of its-behaviors, see the Haddock documentation for ``handleFormEvent``.) It's-still up to the application to decide when events should go to the form-in the first place.+Handling form events is easy: we just use ``zoom`` to call+``Brick.Forms.handleFormEvent`` with the ``BrickEvent`` and a lens+to access the ``Form`` in the application state. This automatically+dispatches input events to the currently-focused input field, and it+also manages focus changes with ``Tab`` and ``Shift-Tab`` keybindings.+(For details on all of its behaviors, see the Haddock documentation for+``handleFormEvent``.) It's still up to the application to decide when+events should go to the form in the first place.  Since the form field handlers take ``BrickEvent`` values, that means that custom fields could even handle application-specific events (of the@@ -1478,6 +1625,161 @@ the ``FormFieldState`` and ``FormField`` data types along with the implementations of the built-in form field types. +Customizable Keybindings+========================++Brick applications typically start out by explicitly checking incoming+events for specific keys in ``appHandleEvent``. While this works well+enough, it results in *tight coupling* between the input key events and+the event handlers that get run. As applications evolve, it becomes+important to decouple the input key events and their handlers to allow+the input keys to be customized by the user. That's where Brick's+customizable keybindings API comes in.++The customizable keybindings API provides:++* ``Brick.Keybindings.Parse``: parsing and loading user-provided+  keybinding configuration files,+* ``Brick.Keybindings.Pretty``: pretty-printing keybindings and+  generating keybinding help text in ``Widget``, plain text, and+  Markdown formats so you can provide help to users both within the+  program and outside of it,+* ``Brick.Keybindings.KeyEvents``: specifying the application's abstract+  key events and their configuration names,+* ``Brick.Keybindings.KeyConfig``: bundling default and customized+  keybindings for each abstract event into a structure for use by the+  dispatcher, and+* ``Brick.Keybindings.KeyDispatcher``: specifying handlers and+  dispatching incoming key events to them.++This section of the User Guide describes the API at a high level,+but Brick also provides a complete working example of the custom+keybinding API in ``programs/CustomKeybindingDemo.hs`` and+provides detailed documentation on how to use the API, including a+step-by-step process for using it, in the module documentation for+``Brick.Keybindings.KeyDispatcher``.++The following table compares Brick application design decisions and+runtime behaviors in a typical application to those of an application+that uses the customizable keybindings API:+++---------------------+------------------------+-------------------------++| **Approach**        | **Before runtime**     | **At runtime**          |++---------------------+------------------------+-------------------------++| Typical application | The application author | #. An input event       |+| (no custom          | decides which keys will|    arrives when the user|+| keybindings)        | trigger application    |    presses a key.       |+|                     | behaviors. The event   | #. The event handler    |+|                     | handler is written to  |    pattern-matches on   |+|                     | pattern-match on       |    the input event to   |+|                     | specific keys.         |    check for a match and|+|                     |                        |    then runs the        |+|                     |                        |    corresponding        |+|                     |                        |    handler.             |++---------------------+------------------------+-------------------------++| Application with    | The application author | #. A Vty input event    |+| custom keybindings  | specifies the possible |    arrives when the user|+| API integrated      | *abstract events* that |    presses a key.       |+|                     | correspond to the      | #. The input event is   |+|                     | application's          |    provided to          |+|                     | behaviors. The events  |    ``appHandleEvent``.  |+|                     | are given default      | #. ``appHandleEvent``   |+|                     | keybindings. The       |    passes the event on  |+|                     | application provides   |    to a                 |+|                     | event handlers for the |    ``KeyDispatcher``.   |+|                     | abstract events, not   | #. The key dispatcher   |+|                     | specific keys. If      |    checks to see whether|+|                     | desired, the           |    the input key event  |+|                     | application can load   |    maps to an abstract  |+|                     | user-defined custom    |    event.               |+|                     | keybindings from an INI| #. If the dispatcher    |+|                     | file at startup to     |    finds a match, the   |+|                     | override the           |    corresponding        |+|                     | application's defaults.|    abstract event's key |+|                     |                        |    handler is run.      |++---------------------+------------------------+-------------------------+++Keybinding Collisions+---------------------++An important issue to consider in using the custom keybinding API is+that it is possible for the user to map the same key to more than one+event. We refer to this situation as a *keybinding collision*. Whether+the collision represents a problem depends on how the events in question+are going to be handled by the application. This section provides an+example scenario and describes a way to deal with this situation.++Suppose an application has two key events:++.. code:: haskell++   data KeyEvent = QuitEvent+                 | CloseWindowEvent++   allKeyEvents :: KeyEvents KeyEvent+   allKeyEvents =+       K.keyEvents [ ("quit",         QuitEvent)+                   , ("close-window", CloseWindowEvent)+                   ]++   defaultBindings :: [(KeyEvent, [Binding])]+   defaultBindings =+       [ (QuitEvent,        [ctrl 'q'])+       , (CloseWindowEvent, [bind KEsc])+       ]++Suppose also that the application using the above key events has a+feature that opens a window, and that ``CloseWindowEvent`` is used to+close the window, while ``QuitEvent`` is used to quit the application.++A user might then provide a custom INI file to rebind keys as follows::++   [keybindings]+   quit = Esc+   close-window = Esc++While this is a valid configuration for the user to provide, it would+result in a keybinding collision for ``Esc`` since it is now bound+to two events. Whether that's a problem depends entirely on how+``QuitEvent`` and ``CloseWindowEvent`` are handled:++* If the application handles both events in the same event handler,+  the ``KeyDispatcher`` for those events would fail to construct since+  ``Esc`` maps to more than one event. Building a ``KeyDispatcher``+  from a ``KeyConfig`` with such a collision would fail and return+  information about the collisions.+* If the application handles the two events in different dispatchers+  then the collision has no effect and is not a problem since different+  ``KeyDispatcher`` values would be constructed to handle the events+  separately. This could happen, for instance, if the application only+  ever handled ``CloseWindowEvent`` when the window in question was+  open and only handled ``QuitEvent`` when the window had been closed.+  This kind of "modal" approach to handling events means that we only+  consider a key to have a collision if it is bound to two or more+  events that are handled in the same event handling context.++There's also another situation that would be problematic, which is+when an abstract event like ``QuitEvent`` has a key mapping that+collides with a key handler that is bound to a specific key using+``Brick.Keybindings.KeyDispatcher.onKey`` rather than an abstract event:++.. code:: haskell++    K.onKey (K.bind '\t') "Increment the counter by 10" $+        counter %= (+ 10)++If ``onKey`` is used, the handler it creates is only triggered by the+specified key (``Tab`` in the example above). But the handler may be+included alongside handlers in the same dispatcher that are *also*+triggered by ``Tab``, so if those event handlers were provided together+when creating a ``KeyDispatcher`` then it would fail to construct due to+the collision.++Brick provides ``Brick.Keybindings.KeyConfig.keyEventMappings`` to help+finding collisions at the key configuration level. Finding out about+collisions at the dispatcher level is possible by handling the failure+case when calling ``Brick.Keybindings.KeyDispatcher.keyDispatcher``.+ Joining Borders =============== @@ -1500,7 +1802,7 @@ Border-joining works by iteratively *redrawing* the edges of widgets as those edges come into contact with other widgets during rendering. If the adjacent edge locations of two widgets both use joinable borders,-the Brick will re-draw one of the characters to so that it connects+the Brick will re-draw one of the characters so that it connects seamlessly with the adjacent border.  How Joining Works@@ -1664,6 +1966,14 @@ so by consulting the ``ctxDynBorders`` field of the rendering context before writing to your ``Result``'s ``borders`` field. +Animations+==========++Brick provides animation support in ``Brick.Animation``. See the Haddock+documentation in that module for a complete explanation of the API; see+``programs/AnimationDemo.hs`` (``brick-animation-demo``) for a working+example.+ The Rendering Cache =================== @@ -1683,8 +1993,8 @@         border $         str "This will be cached" -In the example above, the first time the ``border $ str "This will be-cached"`` widget is rendered, the resulting Vty image will be stored+In the example above, the first time the ``border $ str "This will be cached"``+widget is rendered, the resulting Vty image will be stored in the rendering cache under the key ``ExpensiveThing``. On subsequent renderings the cached Vty image will be used instead of re-rendering the widget. This example doesn't need caching to improve performance, but@@ -1699,12 +2009,12 @@  .. code:: haskell -   handleEvent s ... = do-     -- Invalidate just a single cache entry:-     Brick.Main.invalidateCacheEntry ExpensiveThing+   handleEvent ... = do+       -- Invalidate just a single cache entry:+       Brick.Main.invalidateCacheEntry ExpensiveThing -     -- Invalidate the entire cache (useful on a resize):-     Brick.Main.invalidateCache+       -- Invalidate the entire cache (useful on a resize):+       Brick.Main.invalidateCache  Implementing Custom Widgets ===========================@@ -1845,4 +2155,3 @@ .. _Hackage: http://hackage.haskell.org/ .. _microlens: http://hackage.haskell.org/package/microlens .. _bracketed paste mode: https://cirw.in/blog/bracketed-paste-.. _utf8proc: http://julialang.org/utf8proc/
− docs/programs-screenshots.md 
@@ -1,73 +0,0 @@-# Demo program screenshots--## [AttrDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/AttrDemo.hs)-![attr demo](./programs-screenshots/brick-attr-demo.png)--## [BorderDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/BorderDemo.hs)-![border demo](./programs-screenshots/brick-border-demo.png)--## [CacheDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/CacheDemo.hs)-![cache demo](./programs-screenshots/brick-cache-demo.png)--## [CustomEventDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/CustomEventDemo.hs)-![custom-event demo](./programs-screenshots/brick-custom-event-demo.png)--## [DialogDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/DialogDemo.hs)-![dialog demo](./programs-screenshots/brick-dialog-demo.png)--## [DynamicBorderDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/DynamicBorderDemo.hs)-![dynamic-border demo](./programs-screenshots/brick-dynamic-border-demo.png)--## [EditDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/EditDemo.hs)-![edit demo](./programs-screenshots/brick-edit-demo.png)--## [FileBrowserDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FileBrowserDemo.hs)-![file-browser demo](./programs-screenshots/brick-file-browser-demo.png)--## [FillDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FillDemo.hs)-![fill demo](./programs-screenshots/brick-fill-demo.png)--## [FormDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/FormDemo.hs)-![form demo](./programs-screenshots/brick-form-demo.png)--## [HelloWorldDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/HelloWorldDemo.hs)-![hello-world demo](./programs-screenshots/brick-hello-world-demo.png)--## [LayerDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/LayerDemo.hs)-![layer demo](./programs-screenshots/brick-layer-demo.png)--## [ListDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ListDemo.hs)-![list demo](./programs-screenshots/brick-list-demo.png)--## [ListViDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ListViDemo.hs)-![list-vi demo](./programs-screenshots/brick-list-vi-demo.png)--## [MarkupDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/MarkupDemo.hs)-![markup demo](./programs-screenshots/brick-markup-demo.png)--## [MouseDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/MouseDemo.hs)-![mouse demo](./programs-screenshots/brick-mouse-demo.png)--## [PaddingDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/PaddingDemo.hs)-![padding demo](./programs-screenshots/brick-padding-demo.png)--## [ProgressBarDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ProgressBarDemo.hs)-![progressbar demo](./programs-screenshots/brick-progressbar-demo.png)--## [ReadmeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ReadmeDemo.hs)-![readme demo](./programs-screenshots/brick-readme-demo.png)--## [SuspendAndResumeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/SuspendAndResumeDemo.hs)-![suspend-resume demo](./programs-screenshots/brick-suspend-resume-demo.png)--## [TextWrapDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/TextWrapDemo.hs)-![text-wrap demo](./programs-screenshots/brick-text-wrap-demo.png)--## [ThemeDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ThemeDemo.hs)-![theme demo](./programs-screenshots/brick-theme-demo.png)--## [ViewportScrollDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/ViewportScrollDemo.hs)-![viewport-scroll demo](./programs-screenshots/brick-viewport-scroll-demo.png)--## [VisibilityDemo.hs](https://github.com/jtdaugherty/brick/blob/master/programs/VisibilityDemo.hs)-![visibility demo](./programs-screenshots/brick-visibility-demo.png)
− docs/programs-screenshots/brick-attr-demo.png

binary file changed (52808 → absent bytes)

− docs/programs-screenshots/brick-border-demo.png

binary file changed (19670 → absent bytes)

− docs/programs-screenshots/brick-cache-demo.png

binary file changed (44698 → absent bytes)

− docs/programs-screenshots/brick-custom-event-demo.png

binary file changed (12081 → absent bytes)

− docs/programs-screenshots/brick-dialog-demo.png

binary file changed (14232 → absent bytes)

− docs/programs-screenshots/brick-dynamic-border-demo.png

binary file changed (25746 → absent bytes)

− docs/programs-screenshots/brick-edit-demo.png

binary file changed (18668 → absent bytes)

− docs/programs-screenshots/brick-file-browser-demo.png

binary file changed (43038 → absent bytes)

− docs/programs-screenshots/brick-fill-demo.png

binary file changed (12794 → absent bytes)

− docs/programs-screenshots/brick-form-demo.png

binary file changed (20724 → absent bytes)

− docs/programs-screenshots/brick-hello-world-demo.png

binary file changed (10794 → absent bytes)

− docs/programs-screenshots/brick-layer-demo.png

binary file changed (22655 → absent bytes)

− docs/programs-screenshots/brick-list-demo.png

binary file changed (18011 → absent bytes)

− docs/programs-screenshots/brick-list-vi-demo.png

binary file changed (18448 → absent bytes)

− docs/programs-screenshots/brick-markup-demo.png

binary file changed (12852 → absent bytes)

− docs/programs-screenshots/brick-mouse-demo.png

binary file changed (35768 → absent bytes)

− docs/programs-screenshots/brick-padding-demo.png

binary file changed (22308 → absent bytes)

− docs/programs-screenshots/brick-progressbar-demo.png

binary file changed (16385 → absent bytes)

− docs/programs-screenshots/brick-readme-demo.png

binary file changed (11141 → absent bytes)

− docs/programs-screenshots/brick-suspend-resume-demo.png

binary file changed (12771 → absent bytes)

− docs/programs-screenshots/brick-text-wrap-demo.png

binary file changed (27669 → absent bytes)

− docs/programs-screenshots/brick-theme-demo.png

binary file changed (13429 → absent bytes)

− docs/programs-screenshots/brick-viewport-scroll-demo.png

binary file changed (32432 → absent bytes)

− docs/programs-screenshots/brick-visibility-demo.png

binary file changed (50627 → absent bytes)

− docs/samtay-tutorial.md 
@@ -1,546 +0,0 @@--# Brick Tutorial by Samuel Tay--This tutorial was written by Samuel Tay, Copyright 2017-(https://github.com/samtay, https://samtay.github.io/). It is provided-as part of the brick distribution with permission.--## Introduction--I'm going to give a short introduction to-[brick](https://hackage.haskell.org/package/brick), a Haskell library-for building terminal user interfaces. So far I've used `brick` to-implement [Conway's Game of Life](https://github.com/samtay/conway) and-a [Tetris clone](https://github.com/samtay/tetris). I'll explain the-basics, walk through an example [snake](https://github.com/samtay/snake)-application, and then explain some more complicated scenarios.--The first thing I'll say is that this package has some of the most-impressive documentation and resources, which makes it easy to figure-out pretty much anything you need to do. I'll try to make this useful,-but I imagine if you're reading this then it is mostly being used as a-reference in addition to the existing resources:--1. [Demo programs](https://github.com/jtdaugherty/brick/tree/master/programs)-(clone down to explore the code and run them locally)-2. [User guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst)-3. [Haddock docs](https://hackage.haskell.org/package/brick-0.18)-4. [Google group](https://groups.google.com/forum/#!forum/brick-users)--### The basic idea--`brick` is very declarative. Once your base application logic is in-place, the interface is generally built by two functions: drawing and-handling events. The drawing function--```haskell-appDraw :: s -> [Widget n]-```--takes your app state `s` and produces the visuals `[Widget n]`. The-handler--```haskell-appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)-```--takes your app state, an event (e.g. user presses the `'m'` key), and-produces the resulting app state. *That's pretty much it.*--## `snake`--We're going to build the [classic-snake](https://en.wikipedia.org/wiki/Snake_(video_game)) game that you-might recall from arcades or the first cell phones. The full source code-is [here](https://github.com/samtay/snake). This is the end product:--![](snake-demo.gif)--### Structure of the app--The library makes it easy to separate the concerns of your application-and the interface; I like to have a module with all of the core business-logic that exports the core state of the app and functions for modifying-it, and then have an interface module that just handles the setup,-drawing, and handling events. So let's just use the `simple` stack-template and add two modules--```-├── LICENSE-├── README.md-├── Setup.hs-├── snake.cabal-├── src-│   ├── Main.hs-│   ├── Snake.hs-│   └── UI.hs-└── stack.yaml-```--and our dependencies to `test.cabal`--```yaml-executable snake-  hs-source-dirs:      src-  main-is:             Main.hs-  ghc-options:         -threaded-  exposed-modules:     Snake-                     , UI-  default-language:    Haskell2010-  build-depends:       base >= 4.7 && < 5-                     , brick-                     , containers-                     , linear-                     , microlens-                     , microlens-th-                     , random-```--### `Snake`--Since this tutorial is about `brick`, I'll elide most of the-implementation details of the actual game, but here are some of the key-types and scaffolding:--```haskell-{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}-module Snake where--import Control.Applicative ((<|>))-import Control.Monad (guard)-import Data.Maybe (fromMaybe)--import Data.Sequence (Seq, ViewL(..), ViewR(..), (<|))-import qualified Data.Sequence as S-import Lens.Micro.TH (makeLenses)-import Lens.Micro ((&), (.~), (%~), (^.))-import Linear.V2 (V2(..), _x, _y)-import System.Random (Random(..), newStdGen)---- Types--data Game = Game-  { _snake  :: Snake        -- ^ snake as a sequence of points in R2-  , _dir    :: Direction    -- ^ direction-  , _food   :: Coord        -- ^ location of the food-  , _foods  :: Stream Coord -- ^ infinite list of random food locations-  , _dead   :: Bool         -- ^ game over flag-  , _paused :: Bool         -- ^ paused flag-  , _score  :: Int          -- ^ score-  , _frozen :: Bool         -- ^ freeze to disallow duplicate turns-  } deriving (Show)--type Coord = V2 Int-type Snake = Seq Coord--data Stream a = a :| Stream a-  deriving (Show)--data Direction-  = North-  | South-  | East-  | West-  deriving (Eq, Show)-```--All of this is pretty self-explanatory, with the possible exception-of lenses if you haven't seen them. At first glance they may seem-complicated (and the underlying theory arguably is), but using them as-getters and setters is very straightforward. So, if you are following-along because you are writing a terminal app like this, I'd recommend-using them, but they are not required to use `brick`.--Here are the core functions for playing the game:--```haskell--- | Step forward in time-step :: Game -> Game-step g = fromMaybe g $ do-  guard (not $ g ^. paused || g ^. dead)-  let g' = g & frozen .~ False-  return . fromMaybe (move g') $ die g' <|> eatFood g'---- | Possibly die if next head position is disallowed-die :: Game -> Maybe Game---- | Possibly eat food if next head position is food-eatFood :: Game -> Maybe Game---- | Move snake along in a marquee fashion-move :: Game -> Game---- | Turn game direction (only turns orthogonally)------ Implicitly unpauses yet freezes game-turn :: Direction -> Game -> Game---- | Initialize a paused game with random food location-initGame :: IO Game-```--### `UI`--To start, we need to determine what our `App s e n` type parameters are.-This will completely describe the interface application and be passed-to one of the library's `main` style functions for execution. Note that-`s` is the app state, `e` is an event type, and `n` is a resource name.-The `e` is abstracted so that we can provide custom events. The `n`-is usually a custom sum type called `Name` which allows us to *name*-particular viewports. This is important so that we can keep track of-where the user currently has *focus*, such as typing in one of two-textboxes; however, for this simple snake game we don't need to worry-about that.--In simpler cases, the state `s` can directly coincide with a core-datatype such as our `Snake.Game`. In many cases however, it will be-necessary to wrap the core state within the ui state `s` to keep track-of things that are interface specific (more on this later).--Let's write out our app definition and leave some undefined functions:--```haskell-{-# LANGUAGE OverloadedStrings #-}-module UI where--import Control.Monad (forever, void)-import Control.Monad.IO.Class (liftIO)-import Control.Concurrent (threadDelay, forkIO)-import Data.Maybe (fromMaybe)--import Snake--import Brick-  ( App(..), AttrMap, BrickEvent(..), EventM, Next, Widget-  , customMain, neverShowCursor-  , continue, halt-  , hLimit, vLimit, vBox, hBox-  , padRight, padLeft, padTop, padAll, Padding(..)-  , withBorderStyle-  , str-  , attrMap, withAttr, emptyWidget, AttrName, on, fg-  , (<+>)-  )-import Brick.BChan (newBChan, writeBChan)-import qualified Brick.Widgets.Border as B-import qualified Brick.Widgets.Border.Style as BS-import qualified Brick.Widgets.Center as C-import qualified Graphics.Vty as V-import Data.Sequence (Seq)-import qualified Data.Sequence as S-import Linear.V2 (V2(..))-import Lens.Micro ((^.))---- Types---- | Ticks mark passing of time------ This is our custom event that will be constantly fed into the app.-data Tick = Tick---- | Named resources------ Not currently used, but will be easier to refactor--- if we call this "Name" now.-type Name = ()--data Cell = Snake | Food | Empty---- App definition--app :: App Game Tick Name-app = App { appDraw = drawUI-          , appChooseCursor = neverShowCursor-          , appHandleEvent = handleEvent-          , appStartEvent = return-          , appAttrMap = const theMap-          }--main :: IO ()-main = undefined---- Handling events--handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent = undefined---- Drawing--drawUI :: Game -> [Widget Name]-drawUI = undefined--theMap :: AttrMap-theMap = undefined-```--#### Custom Events--So far I've only used `brick` to make games which need to be redrawn-as time passes, with or without user input. This requires using-`Brick.customMain` with that `Tick` event type, and opening a forked-process to `forever` feed that event type into the channel. Since this-is a common scenario, there is a `Brick.BChan` module that makes this-pretty quick:--```haskell-main :: IO ()-main = do-  chan <- newBChan 10-  forkIO $ forever $ do-    writeBChan chan Tick-    threadDelay 100000 -- decides how fast your game moves-  g <- initGame-  let buildVty = V.mkVty V.defaultConfig-  initialVty <- buildVty-  void $ customMain initialVty buildVty (Just chan) app g-```--We do need to import `Vty.Graphics` since `customMain` allows us-to specify a custom `IO Vty.Graphics.Vty` handle, but we're only-customizing the existence of the event channel `BChan Tick`. The app-is now bootstrapped, and all we need to do is implement `handleEvent`,-`drawUI`, and `theMap` (handles styling).--#### Handling events--Handling events is largely straightforward, and can be very clean when-your underlying application logic is taken care of in a core module. All-we do is essentially map events to the proper state modifiers.--```haskell-handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent g (AppEvent Tick)                       = continue $ step g-handleEvent g (VtyEvent (V.EvKey V.KUp []))         = continue $ turn North g-handleEvent g (VtyEvent (V.EvKey V.KDown []))       = continue $ turn South g-handleEvent g (VtyEvent (V.EvKey V.KRight []))      = continue $ turn East g-handleEvent g (VtyEvent (V.EvKey V.KLeft []))       = continue $ turn West g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'k') [])) = continue $ turn North g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'j') [])) = continue $ turn South g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'l') [])) = continue $ turn East g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'h') [])) = continue $ turn West g-handleEvent g (VtyEvent (V.EvKey (V.KChar 'r') [])) = liftIO (initGame) >>= continue-handleEvent g (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt g-handleEvent g (VtyEvent (V.EvKey V.KEsc []))        = halt g-handleEvent g _                                     = continue g-```--It's probably obvious, but `continue` will continue execution with-the supplied state value, which is then drawn. We can also `halt` to-stop execution, which will essentially finish the evaluation of our-`customMain` and result in `IO Game`, where the resulting game is the-last value that we supplied to `halt`.--#### Drawing--Drawing is fairly simple as well but can require a good amount of code-to position things how you want them. I like to break up the visual-space into regions with drawing functions for each one.--```haskell-drawUI :: Game -> [Widget Name]-drawUI g =-  [ C.center $ padRight (Pad 2) (drawStats g) <+> drawGrid g ]--drawStats :: Game -> Widget Name-drawStats = undefined--drawGrid :: Game -> Widget Name-drawGrid = undefined-```--This will center the overall interface (`C.center`), put the stats and-grid widgets horizontally side by side (`<+>`), and separate them by a-2-character width (`padRight (Pad 2)`).--Let's move forward with the stats column:--```haskell-drawStats :: Game -> Widget Name-drawStats g = hLimit 11-  $ vBox [ drawScore (g ^. score)-         , padTop (Pad 2) $ drawGameOver (g ^. dead)-         ]--drawScore :: Int -> Widget Name-drawScore n = withBorderStyle BS.unicodeBold-  $ B.borderWithLabel (str "Score")-  $ C.hCenter-  $ padAll 1-  $ str $ show n--drawGameOver :: Bool -> Widget Name-drawGameOver dead =-  if dead-     then withAttr gameOverAttr $ C.hCenter $ str "GAME OVER"-     else emptyWidget--gameOverAttr :: AttrName-gameOverAttr = "gameOver"-```--I'm throwing in that `hLimit 11` to prevent the widget greediness caused-by the outer `C.center`. I'm also using `vBox` to show some other-options of aligning widgets; `vBox` and `hBox` align a list of widgets-vertically and horizontally, respectfully. They can be thought of as-folds over the binary `<=>` and `<+>` operations.--The score is straightforward, but it is the first border in-this tutorial. Borders are well documented in the [border-demo](https://github.com/jtdaugherty/brick/blob/master/programs/BorderDemo.hs)-and the Haddocks for that matter.--We also only show the "game over" widget if the game is actually over.-In that case, we are rendering the string widget with the `gameOverAttr`-attribute name. Attribute names are basically type safe *names* that-we can assign to widgets to apply predetermined styles, similar to-assigning a class name to a div in HTML and defining the CSS styles for-that class elsewhere.--Attribute names implement `IsString`, so they are easy to construct with-the `OverloadedStrings` pragma.--Now for the main event:--```haskell-drawGrid :: Game -> Widget Name-drawGrid g = withBorderStyle BS.unicodeBold-  $ B.borderWithLabel (str "Snake")-  $ vBox rows-  where-    rows         = [hBox $ cellsInRow r | r <- [height-1,height-2..0]]-    cellsInRow y = [drawCoord (V2 x y) | x <- [0..width-1]]-    drawCoord    = drawCell . cellAt-    cellAt c-      | c `elem` g ^. snake = Snake-      | c == g ^. food      = Food-      | otherwise           = Empty--drawCell :: Cell -> Widget Name-drawCell Snake = withAttr snakeAttr cw-drawCell Food  = withAttr foodAttr cw-drawCell Empty = withAttr emptyAttr cw--cw :: Widget Name-cw = str "  "--snakeAttr, foodAttr, emptyAttr :: AttrName-snakeAttr = "snakeAttr"-foodAttr = "foodAttr"-emptyAttr = "emptyAttr"--```--There's actually nothing new here! We've already covered all the-`brick` functions necessary to draw the grid. My approach to grids is-to render a square cell widget `cw` with different colors depending-on the cell state. The easiest way to draw a colored square is to-stick two characters side by side. If we assign an attribute with a-matching foreground and background, then it doesn't matter what the two-characters are (provided that they aren't some crazy Unicode characters-that might render to an unexpected size). However, if we want empty-cells to render with the same color as the user's default background-color, then spaces are a good choice.--Finally, we'll define the attribute map:--```haskell-theMap :: AttrMap-theMap = attrMap V.defAttr-  [ (snakeAttr, V.blue `on` V.blue)-  , (foodAttr, V.red `on` V.red)-  , (gameOverAttr, fg V.red `V.withStyle` V.bold)-  ]-```--Again, styles aren't terribly complicated, but it-will be one area where you might have to look in the-[vty](http://hackage.haskell.org/package/vty) package (specifically-[Graphics.Vty.Attributes](http://hackage.haskell.org/package/vty-5.15.1/docs/Graphics-Vty-Attributes.html)) to find what you need.--Another thing to mention is that the attributes form a hierarchy and-can be combined in a parent-child relationship via `mappend`. I haven't-actually used this feature, but it does sound quite handy. For a more-detailed discussion see the-[Brick.AttrMap](https://hackage.haskell.org/package/brick-0.18/docs/Brick-AttrMap.html) haddocks.--## Variable speed--One difficult problem I encountered was implementing a variable speed in-the GoL. I could have just used the same approach above with the minimum-thread delay (corresponding to the maximum speed) and counted `Tick`-events, only issuing an actual `step` in the game when the modular count-of `Tick`s reached an amount corresponding to the current game speed,-but that's kind of an ugly approach.--Instead, I reached out to the author and he advised me to use a `TVar`-within the app state.  I had never used `TVar`, but it's pretty easy!--```haskell-main :: IO ()-main = do-  chan <- newBChan 10-  tv   <- atomically $ newTVar (spToInt initialSpeed)-  forkIO $ forever $ do-    writeBChan chan Tick-    int <- atomically $ readTVar tv-    threadDelay int-  let buildVty = V.mkVty V.defaultConfig-  initialVty <- buildVty-  customMain initialVty buildVty (Just chan) app (initialGame tv)-    >>= printResult-```--The `tv <- atomically $ newTVar (value :: a)` creates a new mutable-reference to a value of type `a`, i.e. `TVar a`, and returns it in `IO`.-In this case `value` is an `Int` which represents the delay between game-steps. Then in the forked process, we read the delay from the `TVar`-reference and use that to space out the calls to `writeBChan chan Tick`.--I store that same `tv :: TVar Int` in the brick app state, so that the-user can change the speed:--```haskell-handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game)-handleEvent g (VtyEvent (V.EvKey V.KRight [V.MCtrl])) = handleSpeed g (+)-handleEvent g (VtyEvent (V.EvKey V.KLeft [V.MCtrl]))  = handleSpeed g (-)--handleSpeed :: Game -> (Float -> Float -> Float) -> EventM n (Next Game)-handleSpeed g (+/-) = do-  let newSp = validS $ (g ^. speed) +/- speedInc-  liftIO $ atomically $ writeTVar (g ^. interval) (spToInt newSp)-  continue $ g & speed .~ newSp---- where---- | Speed increments = 0.01 gives 100 discrete speed settings-speedInc :: Float-speedInc = 0.01---- | Game state-data Game = Game-  { _board    :: Board -- ^ Board state-  , _time     :: Int   -- ^ Time elapsed-  , _paused   :: Bool  -- ^ Playing vs. paused-  , _speed    :: Float -- ^ Speed in [0..1]-  , _interval :: TVar Int -- ^ Interval kept in TVar-  , _focus    :: F.FocusRing Name -- ^ Keeps track of grid focus-  , _selected :: Cell -- ^ Keeps track of cell focus-  }-```--## Conclusion--`brick` let's you build TUIs very quickly. I was able to write `snake`-along with this tutorial within a few hours. More complicated interfaces-can be tougher, but if you can successfully separate the interface and-core functionality, you'll have an easier time tacking on the frontend.--Lastly, let me remind you to look in the-[demo programs](https://github.com/jtdaugherty/brick/tree/master/programs)-to figure stuff out, as *many* scenarios are covered throughout them.--## Links-* [brick](https://hackage.haskell.org/package/brick)-* [snake](https://github.com/samtay/snake)-* [tetris](https://github.com/samtay/tetris)-* [conway](https://github.com/samtay/conway)
+ programs/AnimationDemo.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+module Main where++import Control.Monad (void)+import Lens.Micro.Platform+import Data.List (intersperse)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Data.Map as M+import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import Brick.BChan+import Brick.Util (fg)+import Brick.Main (App(..), neverShowCursor, customMain, halt)+import Brick.AttrMap (AttrName, AttrMap, attrMap, attrName)+import Brick.Types (Widget, EventM, BrickEvent(..), Location(..))+import Brick.Widgets.Border (border)+import Brick.Widgets.Center (center)+import Brick.Widgets.Core ((<+>), str, vBox, hBox, hLimit, vLimit, translateBy, withDefAttr)+import qualified Brick.Animation as A++data CustomEvent =+    AnimationUpdate (EventM () St ())+    -- ^ The state update constructor required by the animation API++data St =+    St { _stAnimationManager :: A.AnimationManager St CustomEvent ()+       -- ^ The animation manager that will run all of our animations+       , _animation1 :: Maybe (A.Animation St ())+       , _animation2 :: Maybe (A.Animation St ())+       , _animation3 :: Maybe (A.Animation St ())+       , _clickAnimations :: M.Map Location (A.Animation St ())+       -- ^ The various fields for storing animation states. For mouse+       -- animations, we store animations for each screen location that+       -- was clicked.+       }++makeLenses ''St++drawUI :: St -> [Widget ()]+drawUI st = drawClickAnimations st <> [drawAnimations st]++drawClickAnimations :: St -> [Widget ()]+drawClickAnimations st =+    drawClickAnimation st <$> M.toList (st^.clickAnimations)++drawClickAnimation :: St -> (Location, A.Animation St ()) -> Widget ()+drawClickAnimation st (l, a) =+    translateBy l $+    A.renderAnimation (const $ str " ") st (Just a)++drawAnimations :: St -> Widget ()+drawAnimations st =+    let animStatus label key a =+            str (label <> ": ") <+>+            maybe (str "Not running") (const $ str "Running") a <+>+            str (" (Press " <> key <> " to toggle)")+        statusMessages = statusMessage <$> zip [(0::Int)..] animations+        statusMessage (i, (c, config)) =+            animStatus ("Animation #" <> (show $ i + 1)) [c]+                       (st^.(animationTarget config))+        animationDrawings = hBox $ intersperse (str " ") $+                            drawSingleAnimation <$> animations+        drawSingleAnimation (_, config) =+            A.renderAnimation (const $ str " ") st (st^.(animationTarget config))+    in vBox [ str "Click and drag the mouse or press keys to start animations."+            , str " "+            , vBox statusMessages+            , animationDrawings+            ]++clip1 :: A.Clip a ()+clip1 = A.newClip_ $ str <$> [".", "o", "O", "^", " "]++clip2 :: A.Clip a ()+clip2 = A.newClip_ $ str <$> ["|", "/", "-", "\\"]++clip3 :: A.Clip a ()+clip3 =+    A.newClip_ $+    (hLimit 9 . vLimit 9 . border . center) <$>+    [ border $ str " "+    , border $ vBox $ replicate 3 $ str $ replicate 3 ' '+    , border $ vBox $ replicate 5 $ str $ replicate 5 ' '+    ]++mouseClickClip :: A.Clip a ()+mouseClickClip =+    A.newClip_+    [ withDefAttr attr6 $ str "0"+    , withDefAttr attr5 $ str "O"+    , withDefAttr attr4 $ str "o"+    , withDefAttr attr3 $ str "•"+    , withDefAttr attr2 $ str "*"+    , withDefAttr attr2 $ str "."+    ]++attr6 :: AttrName+attr6 = attrName "attr6"++attr5 :: AttrName+attr5 = attrName "attr5"++attr4 :: AttrName+attr4 = attrName "attr4"++attr3 :: AttrName+attr3 = attrName "attr3"++attr2 :: AttrName+attr2 = attrName "attr2"++attr1 :: AttrName+attr1 = attrName "attr1"++attrs :: AttrMap+attrs =+    attrMap V.defAttr+        [ (attr6, fg V.white)+        , (attr5, fg V.brightYellow)+        , (attr4, fg V.brightGreen)+        , (attr3, fg V.cyan)+        , (attr2, fg V.blue)+        , (attr1, fg V.black)+        ]++-- | Animation settings grouped together for lookup by keystroke.+data AnimationConfig =+    AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ()))+                    , animationClip :: A.Clip St ()+                    , animationFrameTime :: Integer+                    , animationMode :: A.RunMode+                    }++animations :: [(Char, AnimationConfig)]+animations =+    [ ('1', AnimationConfig animation1 clip1 1000 A.Loop)+    , ('2', AnimationConfig animation2 clip2 100 A.Loop)+    , ('3', AnimationConfig animation3 clip3 100 A.Once)+    ]++-- | Start the animation specified by this config.+startAnimationFromConfig :: AnimationConfig -> EventM () St ()+startAnimationFromConfig config = do+    mgr <- use stAnimationManager+    A.startAnimation mgr (animationClip config)+                         (animationFrameTime config)+                         (animationMode config)+                         (animationTarget config)++-- | If the animation specified in this config is not running, start it.+-- Otherwise stop it.+toggleAnimationFromConfig :: AnimationConfig -> EventM () St ()+toggleAnimationFromConfig config = do+    mgr <- use stAnimationManager+    mOld <- use (animationTarget config)+    case mOld of+        Just a -> A.stopAnimation mgr a+        Nothing -> startAnimationFromConfig config++-- | Start a new mouse click animation at the specified location if one+-- is not already running there.+startMouseClickAnimation :: Location -> EventM () St ()+startMouseClickAnimation l = do+    mgr <- use stAnimationManager+    a <- use (clickAnimations.at l)+    case a of+        Just {} -> return ()+        Nothing -> A.startAnimation mgr mouseClickClip 100 A.Once (clickAnimations.at l)++appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e = do+    case e of+        -- A mouse click starts an animation at the click location.+        VtyEvent (V.EvMouseDown col row _ _) ->+            startMouseClickAnimation (Location (col, row))++        -- If we got a character keystroke, see if there is a specific+        -- animation mapped to that character and toggle the resulting+        -- animation.+        VtyEvent (V.EvKey (V.KChar c) [])+            | Just aConfig <- lookup c animations ->+                toggleAnimationFromConfig aConfig++        -- Apply a state update from the animation manager.+        AppEvent (AnimationUpdate act) -> act++        VtyEvent (V.EvKey V.KEsc []) -> halt++        _ -> return ()++theApp :: App St CustomEvent ()+theApp =+    App { appDraw = drawUI+        , appChooseCursor = neverShowCursor+        , appHandleEvent = appEvent+        , appStartEvent = return ()+        , appAttrMap = const attrs+        }++main :: IO ()+main = do+    chan <- newBChan 10+    mgr <- A.startAnimationManager 50 chan AnimationUpdate++    let initialState =+            St { _stAnimationManager = mgr+               , _animation1 = Nothing+               , _animation2 = Nothing+               , _animation3 = Nothing+               , _clickAnimations = mempty+               }+        buildVty = do+            v <- mkVty V.defaultConfig+            V.setMode (V.outputIface v) V.Mouse True+            return v++    initialVty <- buildVty+    void $ customMain initialVty buildVty (Just chan) theApp initialState
programs/AttrDemo.hs view
@@ -23,28 +23,28 @@   , modifyDefAttr   ) import Brick.Util (on, fg)-import Brick.AttrMap (attrMap, AttrMap)+import Brick.AttrMap (attrMap, AttrMap, attrName)  ui :: Widget n ui =     vBox [ str "This text uses the global default attribute."-         , withAttr "foundFull" $+         , withAttr (attrName "foundFull") $            str "Specifying an attribute name means we look it up in the attribute tree."-         , (withAttr "foundFgOnly" $-           str ("When we find a value, we merge it with its parent in the attribute")-           <=> str "name tree all the way to the root (the global default).")-         , withAttr "missing" $+         , withAttr (attrName "foundFgOnly") $+           str "When we find a value, we merge it with its parent in the attribute"+           <=> str "name tree all the way to the root (the global default)."+         , withAttr (attrName "missing") $            str "A missing attribute name just resumes the search at its parent."-         , withAttr ("general" <> "specific") $+         , withAttr (attrName "general" <> attrName "specific") $            str "In this way we build complete attribute values by using an inheritance scheme."-         , withAttr "foundFull" $+         , withAttr (attrName "foundFull") $            str "You can override everything ..."-         , withAttr "foundFgOnly" $+         , withAttr (attrName "foundFgOnly") $            str "... or only what you want to change and inherit the rest."          , str "Attribute names are assembled with the Monoid append operation to indicate"-         , str "hierarchy levels, e.g. \"window\" <> \"title\"."+         , str "hierarchy levels, e.g. attrName \"window\" <> attrName \"title\"."          , str " "-         , withAttr "linked" $+         , withAttr (attrName "linked") $            str "This text is hyperlinked in terminals that support hyperlinking."          , str " "          , hyperlink "http://www.google.com/" $@@ -59,18 +59,19 @@  theMap :: AttrMap theMap = attrMap globalDefault-    [ ("foundFull",               white `on` green)-    , ("foundFgOnly",             fg red)-    , ("general",                 yellow `on` black)-    , ("general" <> "specific",   fg cyan)-    , ("linked",                  fg yellow `withURL` "http://www.google.com/")+    [ (attrName "foundFull",               white `on` green)+    , (attrName "foundFgOnly",             fg red)+    , (attrName "general",                 yellow `on` black)+    , (attrName "general" <> attrName "specific",+                                           fg cyan)+    , (attrName "linked",                  fg yellow `withURL` "http://www.google.com/")     ]  app :: App () e () app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const theMap         , appChooseCursor = neverShowCursor         }
programs/BorderDemo.hs view
@@ -2,10 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif- #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif@@ -20,16 +16,17 @@   ( Widget   ) import Brick.Widgets.Core-  ( (<=>)-  , (<+>)+  ( (<+>)   , withAttr   , vLimit   , hLimit   , hBox+  , vBox   , updateAttrMap   , withBorderStyle   , txt   , str+  , padLeftRight   ) import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B@@ -69,20 +66,23 @@     B.borderWithLabel (str "label") $     vLimit 5 $     C.vCenter $-    txt $ "  " <> styleName <> " style  "+    padLeftRight 2 $+    txt $ styleName <> " style"  titleAttr :: A.AttrName-titleAttr = "title"+titleAttr = A.attrName "title" -borderMappings :: [(A.AttrName, V.Attr)]-borderMappings =+attrs :: [(A.AttrName, V.Attr)]+attrs =     [ (B.borderAttr,         V.yellow `on` V.black)+    , (B.vBorderAttr,        fg V.cyan)+    , (B.hBorderAttr,        fg V.magenta)     , (titleAttr,            fg V.cyan)     ]  colorDemo :: Widget () colorDemo =-    updateAttrMap (A.applyAttrMappings borderMappings) $+    updateAttrMap (A.applyAttrMappings attrs) $     B.borderWithLabel (withAttr titleAttr $ str "title") $     hLimit 20 $     vLimit 5 $@@ -91,13 +91,14 @@  ui :: Widget () ui =-    hBox borderDemos-    <=> B.hBorder-    <=> colorDemo-    <=> B.hBorderWithLabel (str "horizontal border label")-    <=> (C.center (str "Left of vertical border")-         <+> B.vBorder-         <+> C.center (str "Right of vertical border"))+    vBox [ hBox borderDemos+         , B.hBorder+         , colorDemo+         , B.hBorderWithLabel (str "horizontal border label")+         , (C.center (str "Left of vertical border")+             <+> B.vBorder+             <+> C.center (str "Right of vertical border"))+         ]  main :: IO () main = M.simpleMain ui
programs/CacheDemo.hs view
@@ -1,12 +1,8 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- import Control.Monad (void)+import Control.Monad.State (modify) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif@@ -20,7 +16,8 @@   , BrickEvent(..)   ) import Brick.Widgets.Core-  ( vBox+  ( Padding(..)+  , vBox   , padTopBottom   , withDefAttr   , cached@@ -33,6 +30,7 @@   ) import Brick.AttrMap   ( AttrName+  , attrName   , attrMap   ) @@ -54,26 +52,26 @@              , padTopBottom 1 $                cached ExpensiveWidget $                withDefAttr emphAttr $ str $ "This widget is cached (state = " <> show i <> ")"-             , padBottom (T.Pad 1) $+             , padBottom (Pad 1) $                withDefAttr emphAttr $ str $ "This widget is not cached (state = " <> show i <> ")"              , hCenter $ str "Press 'i' to invalidate the cache,"              , str "'+' to change the state value, and"              , str "'Esc' to quit."              ] -appEvent :: Int -> BrickEvent Name e -> T.EventM Name (T.Next Int)-appEvent i (VtyEvent (V.EvKey (V.KChar '+') [])) = M.continue $ i + 1-appEvent i (VtyEvent (V.EvKey (V.KChar 'i') [])) = M.invalidateCacheEntry ExpensiveWidget >> M.continue i-appEvent i (VtyEvent (V.EvKey V.KEsc [])) = M.halt i-appEvent i _ = M.continue i+appEvent :: BrickEvent Name e -> T.EventM Name Int ()+appEvent (VtyEvent (V.EvKey (V.KChar '+') [])) = modify (+ 1)+appEvent (VtyEvent (V.EvKey (V.KChar 'i') [])) = M.invalidateCacheEntry ExpensiveWidget+appEvent (VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return ()  emphAttr :: AttrName-emphAttr = "emphasis"+emphAttr = attrName "emphasis"  app :: M.App Int e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const $ attrMap V.defAttr [(emphAttr, V.white `on` V.blue)]           , M.appChooseCursor = M.neverShowCursor
+ programs/CroppingDemo.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain)+import Brick.Types+  ( Widget+  )+import Brick.Widgets.Core+  ( vBox+  , hBox+  , txt+  , (<=>)+  , padRight+  , cropLeftBy+  , cropRightBy+  , cropTopBy+  , cropBottomBy+  , cropLeftTo+  , cropRightTo+  , cropTopTo+  , cropBottomTo+  , Padding(..)+  )+import Brick.Widgets.Border (border)+import Brick.AttrMap (attrMap)+import qualified Graphics.Vty as V++example :: Widget n+example =+    border+    (txt "Example" <=> txt "Widget")++mkExample :: Widget n -> Widget n+mkExample = padRight (Pad 2)++ui :: Widget ()+ui =+    vBox [ txt "Uncropped" <=> example+         , hBox [ mkExample $ txt "cropLeftBy 2"   <=> cropLeftBy 2 example+                , mkExample $ txt "cropRightBy 2"  <=> cropRightBy 2 example+                , mkExample $ txt "cropTopBy 2"    <=> cropTopBy 2 example+                , mkExample $ txt "cropBottomBy 2" <=> cropBottomBy 2 example+                ]+         , hBox [ mkExample $ txt "cropLeftTo 4"   <=> cropLeftTo 4 example+                , mkExample $ txt "cropRightTo 4"  <=> cropRightTo 4 example+                , mkExample $ txt "cropTopTo 1"    <=> cropTopTo 1 example+                , mkExample $ txt "cropBottomTo 1" <=> cropBottomTo 1 example+                ]+         ]++app :: App () e ()+app =+    App { appDraw = const [ui]+        , appHandleEvent = resizeOrQuit+        , appStartEvent = return ()+        , appAttrMap = const $ attrMap V.defAttr []+        , appChooseCursor = neverShowCursor+        }++main :: IO ()+main = defaultMain app ()
programs/CustomEventDemo.hs view
@@ -3,8 +3,9 @@ {-# LANGUAGE CPP #-} module Main where -import Lens.Micro ((^.), (&), (.~), (%~))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void, forever) import Control.Concurrent (threadDelay, forkIO) #if !(MIN_VERSION_base(4,11,0))@@ -16,8 +17,7 @@ import Brick.Main   ( App(..)   , showFirstCursor-  , customMain-  , continue+  , customMainWithDefaultVty   , halt   ) import Brick.AttrMap@@ -25,7 +25,6 @@   ) import Brick.Types   ( Widget-  , Next   , EventM   , BrickEvent(..)   )@@ -50,14 +49,15 @@             <=>             (str $ "Counter value is: " <> (show $ st^.stCounter)) -appEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St)-appEvent st e =+appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e =     case e of-        VtyEvent (V.EvKey V.KEsc []) -> halt st-        VtyEvent _ -> continue $ st & stLastBrickEvent .~ (Just e)-        AppEvent Counter -> continue $ st & stCounter %~ (+1)-                                          & stLastBrickEvent .~ (Just e)-        _ -> continue st+        VtyEvent (V.EvKey V.KEsc []) -> halt+        VtyEvent _ -> stLastBrickEvent .= (Just e)+        AppEvent Counter -> do+            stCounter %= (+1)+            stLastBrickEvent .= (Just e)+        _ -> return ()  initialState :: St initialState =@@ -70,7 +70,7 @@     App { appDraw = drawUI         , appChooseCursor = showFirstCursor         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         } @@ -82,6 +82,5 @@         writeBChan chan Counter         threadDelay 1000000 -    let buildVty = V.mkVty V.defaultConfig-    initialVty <- buildVty-    void $ customMain initialVty buildVty (Just chan) theApp initialState+    (_, vty) <- customMainWithDefaultVty (Just chan) theApp initialState+    V.shutdown vty
+ programs/CustomKeybindingDemo.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl ((<~), (.=), (%=), use)+import Control.Monad (void, forM_, when)+import qualified Data.Set as S+import Data.Maybe (fromJust)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Graphics.Vty as V+import System.Environment (getArgs)+import System.Exit (exitFailure)++import qualified Brick.Types as T+import Brick.Types (Widget)+import qualified Brick.Keybindings as K+import Brick.AttrMap+import Brick.Util (fg)+import qualified Brick.Main as M+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C+import Brick.Widgets.Core++-- | The abstract key events for the application.+data KeyEvent = QuitEvent+              | IncrementEvent+              | DecrementEvent+              deriving (Ord, Eq, Show)++-- | The mapping of key events to their configuration field names.+allKeyEvents :: K.KeyEvents KeyEvent+allKeyEvents =+    K.keyEvents [ ("quit",      QuitEvent)+                , ("increment", IncrementEvent)+                , ("decrement", DecrementEvent)+                ]++-- | Default key bindings for each abstract key event.+defaultBindings :: [(KeyEvent, [K.Binding])]+defaultBindings =+    [ (QuitEvent,      [K.ctrl 'q', K.bind V.KEsc])+    , (IncrementEvent, [K.bind '+'])+    , (DecrementEvent, [K.bind '-'])+    ]++data St =+    St { _keyConfig :: K.KeyConfig KeyEvent+       -- ^ The key config to use.+       , _lastKey :: Maybe (V.Key, [V.Modifier])+       -- ^ The last key that was pressed.+       , _lastKeyHandled :: Bool+       -- ^ Whether the last key was handled by a handler.+       , _counter :: Int+       -- ^ The counter value to manipulate in the handlers.+       , _customBindingsPath :: Maybe FilePath+       -- ^ Set if the application found custom keybindings in the+       -- specified file.+       , _dispatcher :: K.KeyDispatcher KeyEvent (T.EventM () St)+       -- ^ The key dispatcher we'll use to dispatch input events.+       }++makeLenses ''St++-- | Key event handlers for our application.+handlers :: [K.KeyEventHandler KeyEvent (T.EventM () St)]+handlers =+    -- The first three handlers are triggered by keys mapped to abstract+    -- events, thus decoupling the configured key bindings from these+    -- handlers.+    [ K.onEvent QuitEvent "Quit the program"+          M.halt+    , K.onEvent IncrementEvent "Increment the counter" $+          counter %= succ+    , K.onEvent DecrementEvent "Decrement the counter" $+          counter %= subtract 1++    -- These handlers are always triggered by specific keys and thus+    -- cannot be rebound.+    , K.onKey (K.bind '\t') "Increment the counter by 10" $+          counter %= (+ 10)+    , K.onKey (K.bind V.KBackTab) "Decrement the counter by 10" $+          counter %= subtract 10+    ]++appEvent :: T.BrickEvent () e -> T.EventM () St ()+appEvent (T.VtyEvent (V.EvKey k mods)) = do+    -- Dispatch the key to the event handler to which the key is mapped,+    -- if any. Also record in lastKeyHandled whether the dispatcher+    -- found a matching handler.+    d <- use dispatcher+    lastKey .= Just (k, mods)+    lastKeyHandled <~ K.handleKey d k mods+appEvent _ =+    return ()++drawUi :: St -> [Widget ()]+drawUi st = [body]+    where+        binding = uncurry K.binding <$> st^.lastKey++        -- Generate key binding help using the library so we can embed+        -- it in the UI.+        keybindingHelp = B.borderWithLabel (txt "Active Keybindings") $+                         K.keybindingHelpWidget (st^.keyConfig) handlers++        lastKeyDisplay = withDefAttr lastKeyAttr $+                         txt $ maybe "(none)" K.ppBinding binding++        -- Show the status of the last pressed key, whether we handled+        -- it, and other bits of the application state.+        status = B.borderWithLabel (txt "Status") $+                 hLimit 40 $+                 padRight Max $+                 vBox [ txt   "Last key:         " <+> lastKeyDisplay+                      , str $ "Last key handled: " <> show (st^.lastKeyHandled)+                      , str $ "Counter:          " <> show (st^.counter)+                      ]++        -- Show info about whether the application is currently using+        -- custom bindings loaded from an INI file.+        customBindingInfo =+            B.borderWithLabel (txt "Custom Bindings") $+            case st^.customBindingsPath of+                Nothing ->+                    hLimit 40 $+                    txtWrap $ "No custom bindings loaded. Create an INI file with a " <>+                              (Text.pack $ show sectionName) <>+                              " section or use 'programs/custom_keys.ini'. " <>+                              "Pass its path to this program on the command line."+                Just f -> str "Loaded custom bindings from:" <=> str (show f)++        body = C.center $+               (padRight (Pad 2) $ status <=> customBindingInfo) <+>+               keybindingHelp++lastKeyAttr :: AttrName+lastKeyAttr = attrName "lastKey"++app :: M.App St e ()+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = return ()+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const $ attrMap V.defAttr [ (K.eventNameAttr, fg V.magenta)+                                                     , (K.eventDescriptionAttr, fg V.cyan)+                                                     , (K.keybindingAttr, fg V.yellow)+                                                     , (lastKeyAttr, fg V.white `V.withStyle` V.bold)+                                                     ]+          , M.appChooseCursor = M.showFirstCursor+          }++sectionName :: Text.Text+sectionName = "keybindings"++main :: IO ()+main = do+    args <- getArgs++    -- If the command line specified the path to an INI file with custom+    -- bindings, attempt to load it.+    (customBindings, customFile) <- case args of+        [iniFilePath] -> do+            result <- K.keybindingsFromFile allKeyEvents sectionName iniFilePath+            case result of+                -- A section was found and had zero more bindings.+                Right (Just bindings) ->+                    return (bindings, Just iniFilePath)++                -- No section was found at all.+                Right Nothing -> do+                    putStrLn $ "Error: found no section " <> show sectionName <> " in " <> show iniFilePath+                    exitFailure++                -- There was some problem parsing the file as an INI+                -- file.+                Left e -> do+                    putStrLn $ "Error reading keybindings file " <> show iniFilePath <> ": " <> e+                    exitFailure++        _ -> return ([], Nothing)++    -- Create a key config that includes the default bindings as well as+    -- the custom bindings we loaded from the INI file, if any.+    let kc = K.newKeyConfig allKeyEvents defaultBindings customBindings++    -- Before starting the application, check on whether any events have+    -- colliding bindings. Exit if so.+    --+    -- Note that in a Real Application, we would more than likely+    -- want to check for collisions among specific sets of+    -- events. For example, if 'Esc' was bound to both 'quit' and+    -- 'close-dialog-box', we might not care about such a collision+    -- if the application only ever handled the 'close-dialog-box'+    -- event in a separate mode and only ever handled 'quit' at the+    -- top-level of the event handler. But if we had two events such as+    -- 'dialog-box-okay' and 'dialog-box-cancel' that were intended to+    -- be handled in the same mode, we might want to check that those+    -- two events did not have the same binding.+    forM_ (K.keyEventMappings kc) $ \(b, evs) -> do+        when (S.size evs > 1) $ do+            Text.putStrLn $ "Error: key '" <> K.ppBinding b <> "' is bound to multiple events:"+            forM_ evs $ \e ->+                Text.putStrLn $ "  " <> Text.pack (show e) <> " (" <> fromJust (K.keyEventName allKeyEvents e) <> ")"+            exitFailure++    -- Now build a key dispatcher for our event handlers. If this fails+    -- due to key collision detection, we'll print out info about the+    -- collisions.+    d <- case K.keyDispatcher kc handlers of+        Right d -> return d+        Left collisions -> do+            putStrLn "Error: some key events have the same keys bound to them."++            forM_ collisions $ \(b, hs) -> do+                Text.putStrLn $ "Handlers with the '" <> K.ppBinding b <> "' binding:"+                forM_ hs $ \h -> do+                    let trigger = case K.kehEventTrigger $ K.khHandler h of+                            K.ByKey k   -> "triggered by the key '" <> K.ppBinding k <> "'"+                            K.ByEvent e -> "triggered by the event '" <> fromJust (K.keyEventName allKeyEvents e) <> "'"+                        desc = K.handlerDescription $ K.kehHandler $ K.khHandler h++                    Text.putStrLn $ "  " <> desc <> " (" <> trigger <> ")"++            exitFailure++    void $ M.defaultMain app $ St { _keyConfig = kc+                                  , _lastKey = Nothing+                                  , _lastKeyHandled = False+                                  , _counter = 0+                                  , _customBindingsPath = customFile+                                  , _dispatcher = d+                                  }++    -- Now demonstrate how the library's generated key binding help text+    -- looks in plain text and Markdown formats. These can be used to+    -- generate documentation for users. Note that the output generated+    -- here takes the active bindings into account! If you don't want+    -- that, use a key config that doesn't have any custom bindings+    -- applied.+    let sections = [("Main", handlers)]++    putStrLn "Generated plain text help:"+    Text.putStrLn $ K.keybindingTextTable kc sections++    putStrLn "Generated Markdown help:"+    Text.putStrLn $ K.keybindingMarkdownTable kc sections
programs/DialogDemo.hs view
@@ -25,25 +25,31 @@ data Choice = Red | Blue | Green             deriving Show -drawUI :: D.Dialog Choice -> [Widget ()]+data Name =+    RedButton+    | BlueButton+    | GreenButton+    deriving (Show, Eq, Ord)++drawUI :: D.Dialog Choice Name -> [Widget Name] drawUI d = [ui]     where         ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." -appEvent :: D.Dialog Choice -> BrickEvent () e -> T.EventM () (T.Next (D.Dialog Choice))-appEvent d (VtyEvent ev) =+appEvent :: BrickEvent Name e -> T.EventM Name (D.Dialog Choice Name) ()+appEvent (VtyEvent ev) =     case ev of-        V.EvKey V.KEsc [] -> M.halt d-        V.EvKey V.KEnter [] -> M.halt d-        _ -> M.continue =<< D.handleDialogEvent ev d-appEvent d _ = M.continue d+        V.EvKey V.KEsc [] -> M.halt+        V.EvKey V.KEnter [] -> M.halt+        _ -> D.handleDialogEvent ev+appEvent _ = return () -initialState :: D.Dialog Choice-initialState = D.dialog (Just "Title") (Just (0, choices)) 50+initialState :: D.Dialog Choice Name+initialState = D.dialog (Just $ str "Title") (Just (RedButton, choices)) 50     where-        choices = [ ("Red", Red)-                  , ("Blue", Blue)-                  , ("Green", Green)+        choices = [ ("Red",   RedButton,   Red)+                  , ("Blue",  BlueButton,  Blue)+                  , ("Green", GreenButton, Green)                   ]  theMap :: A.AttrMap@@ -53,12 +59,12 @@     , (D.buttonSelectedAttr, bg V.yellow)     ] -theApp :: M.App (D.Dialog Choice) e ()+theApp :: M.App (D.Dialog Choice Name) e Name theApp =     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
programs/EditDemo.hs view
@@ -5,6 +5,7 @@  import Lens.Micro import Lens.Micro.TH+import Lens.Micro.Mtl import qualified Graphics.Vty as V  import qualified Brick.Main as M@@ -47,18 +48,19 @@             str " " <=>             str "Press Tab to switch between editors, Esc to quit." -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.VtyEvent ev) =-    case ev of-        V.EvKey V.KEsc [] -> M.halt st-        V.EvKey (V.KChar '\t') [] -> M.continue $ st & focusRing %~ F.focusNext-        V.EvKey V.KBackTab [] -> M.continue $ st & focusRing %~ F.focusPrev--        _ -> M.continue =<< case F.focusGetCurrent (st^.focusRing) of-               Just Edit1 -> T.handleEventLensed st edit1 E.handleEditorEvent ev-               Just Edit2 -> T.handleEventLensed st edit2 E.handleEditorEvent ev-               Nothing -> return st-appEvent st _ = M.continue st+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    M.halt+appEvent (T.VtyEvent (V.EvKey (V.KChar '\t') [])) =+    focusRing %= F.focusNext+appEvent (T.VtyEvent (V.EvKey V.KBackTab [])) =+    focusRing %= F.focusPrev+appEvent ev = do+    r <- use focusRing+    case F.focusGetCurrent r of+      Just Edit1 -> zoom edit1 $ E.handleEditorEvent ev+      Just Edit2 -> zoom edit2 $ E.handleEditorEvent ev+      Nothing -> return ()  initialState :: St initialState =@@ -80,7 +82,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = appCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
+ programs/EditorLineNumbersDemo.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Main where++import Control.Monad (void)+import Lens.Micro+import Lens.Micro.TH+import Lens.Micro.Mtl+import qualified Graphics.Vty as V+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup ((<>))+#endif++import qualified Brick.Main as M+import qualified Brick.Types as T+import Brick.Widgets.Core+  ( (<+>)+  , vBox+  , hLimit+  , vLimit+  , str+  , visible+  , viewport+  , withDefAttr+  )+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Edit as E+import qualified Brick.AttrMap as A+import Brick.Util (on, fg)++data Name = Edit+          | EditLines+          deriving (Ord, Show, Eq)++data St =+    St { _edit :: E.Editor String Name+       }++makeLenses ''St++drawUI :: St -> [T.Widget Name]+drawUI st = [ui]+    where+        e = renderWithLineNumbers (st^.edit)+        ui = C.center $ hLimit 50 $ vLimit 10 e++-- | Given an editor, render the editor with line numbers to the left of+-- the editor.+--+-- This essentially exploits knowledge of how the editor is implemented:+-- we make a viewport containing line numbers that is just as high as+-- the editor, then request that the line number associated with the+-- editor's current line position be made visible, thus scrolling it+-- into view. This is slightly brittle, however, because it relies on+-- essentially keeping the line number viewport and the editor viewport+-- in the same vertical scrolling state; with direct scrolling requests+-- from EventM it is easily possible to put the two viewports into a+-- state where they do not have the same vertical scrolling offset. That+-- means that visibility requests made with 'visible' won't necessarily+-- have the same effect in each viewport in that case. So this is+-- only really usable in the case where you're sure that the editor's+-- viewport and the line number viewports will not be managed by direct+-- viewport operations in EventM. That's what I'd recommend anyway, but+-- still, this is an important caveat.+--+-- There's another important caveat here: this particular implementation+-- has @O(n)@ performance for editor height @n@ because we generate+-- the entire list of line numbers on each rendering depending on the+-- height of the editor. That means that for sufficiently large files,+-- it will get more expensive to render the line numbers. There is a way+-- around this problem, which is to take the approach that the @List@+-- implementation takes: only render a region of visible line numbers+-- around the currently-edited line that is just large enough to be+-- guaranteed to fill the viewport, then translate that so that it+-- appears at the right viewport offset, thus faking a viewport filled+-- with line numbers when in fact we'd only ever render at most @2 * K ++-- 1@ line numbers for a viewport height of @K@. That's more involved,+-- so I didn't do it here, but that would be the way to go for a Real+-- Application.+renderWithLineNumbers :: E.Editor String Name -> T.Widget Name+renderWithLineNumbers e =+    lineNumbersVp <+> editorVp+    where+        lineNumbersVp = hLimit (maxNumWidth + 1) $ viewport EditLines T.Vertical body+        editorVp = E.renderEditor (str . unlines) True e+        body = withDefAttr lineNumberAttr $ vBox numWidgets+        numWidgets = mkNumWidget <$> numbers+        mkNumWidget i = maybeVisible i $ str $ show i+        maybeVisible i+            | i == curLine + 1 =+                visible . withDefAttr currentLineNumberAttr+            | otherwise =+                id+        numbers = [1..h]+        contents = E.getEditContents e+        h = length contents+        curLine = fst $ E.getCursorPosition e+        maxNumWidth = length $ show h++appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    M.halt+appEvent ev = do+    zoom edit $ E.handleEditorEvent ev++initialState :: St+initialState =+    St (E.editor Edit Nothing "")++lineNumberAttr :: A.AttrName+lineNumberAttr = A.attrName "lineNumber"++currentLineNumberAttr :: A.AttrName+currentLineNumberAttr = lineNumberAttr <> A.attrName "current"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (E.editAttr,              V.white `on` V.blue)+    , (E.editFocusedAttr,       V.black `on` V.yellow)+    , (lineNumberAttr,          fg V.cyan)+    , (currentLineNumberAttr,   V.defAttr `V.withStyle` V.bold)+    ]++theApp :: M.App St e Name+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = const $ M.showCursorNamed Edit+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = do+    void $ M.defaultMain theApp initialState
programs/FileBrowserDemo.hs view
@@ -8,10 +8,11 @@ #endif import qualified Graphics.Vty as V +import Control.Monad.State (get) import qualified Data.Text as Text import qualified Brick.Main as M import qualified Brick.Widgets.List as L-import Brick.AttrMap (AttrName)+import Brick.AttrMap (AttrName, attrName) import Brick.Types   ( Widget   , BrickEvent(..)@@ -27,8 +28,9 @@   ( vBox, (<=>), padTop   , hLimit, vLimit, txt   , withDefAttr, emptyWidget+  , Padding(..)   )-import Brick.Widgets.FileBrowser as FB+import qualified Brick.Widgets.FileBrowser as FB import qualified Brick.AttrMap as A import Brick.Util (on, fg) import qualified Brick.Types as T@@ -36,7 +38,7 @@ data Name = FileBrowser1           deriving (Eq, Show, Ord) -drawUI :: FileBrowser Name -> [Widget Name]+drawUI :: FB.FileBrowser Name -> [Widget Name] drawUI b = [center $ ui <=> help]     where         ui = hCenter $@@ -44,8 +46,8 @@              hLimit 50 $              borderWithLabel (txt "Choose a file") $              FB.renderFileBrowser True b-        help = padTop (T.Pad 1) $-               vBox [ case fileBrowserException b of+        help = padTop (Pad 1) $+               vBox [ case FB.fileBrowserException b of                           Nothing -> emptyWidget                           Just e -> hCenter $ withDefAttr errorAttr $                                     txt $ Text.pack $ E.displayException e@@ -55,25 +57,27 @@                     , hCenter $ txt "Esc: quit"                     ] -appEvent :: FB.FileBrowser Name -> BrickEvent Name e -> T.EventM Name (T.Next (FB.FileBrowser Name))-appEvent b (VtyEvent ev) =+appEvent :: BrickEvent Name e -> T.EventM Name (FB.FileBrowser Name) ()+appEvent (VtyEvent ev) = do+    b <- get     case ev of-        V.EvKey V.KEsc [] | not (fileBrowserIsSearching b) ->-            M.halt b+        V.EvKey V.KEsc [] | not (FB.fileBrowserIsSearching b) ->+            M.halt         _ -> do-            b' <- FB.handleFileBrowserEvent ev b+            FB.handleFileBrowserEvent ev             -- If the browser has a selected file after handling the             -- event (because the user pressed Enter), shut down.             case ev of-                V.EvKey V.KEnter [] ->-                    case fileBrowserSelection b' of-                        [] -> M.continue b'-                        _ -> M.halt b'-                _ -> M.continue b'-appEvent b _ = M.continue b+                V.EvKey V.KEnter [] -> do+                    b' <- get+                    case FB.fileBrowserSelection b' of+                        [] -> return ()+                        _ -> M.halt+                _ -> return ()+appEvent _ = return ()  errorAttr :: AttrName-errorAttr = "error"+errorAttr = attrName "error"  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -90,12 +94,12 @@     , (errorAttr, fg V.red)     ] -theApp :: M.App (FileBrowser Name) e Name+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.appStartEvent = return ()           , M.appAttrMap = const theMap           }
programs/FillDemo.hs view
@@ -4,11 +4,12 @@ import Brick.Widgets.Border  ui :: Widget ()-ui = vBox [ vLimitPercent 20 $ vBox [ str "This text is at the top."+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."+          , str "This text is at the bottom with another fill beneath it."+          , fill 'x'           ]  main :: IO ()
programs/FormDemo.hs view
@@ -11,6 +11,8 @@ #endif  import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)+ import Brick import Brick.Forms   ( Form@@ -112,29 +114,31 @@ app :: App (Form UserInfo e Name) e Name app =     App { appDraw = draw-        , appHandleEvent = \s ev ->+        , appHandleEvent = \ev -> do+            f <- gets formFocus             case ev of-                VtyEvent (V.EvResize {})     -> continue s-                VtyEvent (V.EvKey V.KEsc [])   -> halt s+                VtyEvent (V.EvResize {}) -> return ()+                VtyEvent (V.EvKey V.KEsc []) -> halt                 -- Enter quits only when we aren't in the multi-line editor.                 VtyEvent (V.EvKey V.KEnter [])-                    | focusGetCurrent (formFocus s) /= Just AddressField -> halt s+                    | focusGetCurrent f /= Just AddressField -> halt                 _ -> do-                    s' <- handleFormEvent ev s+                    handleFormEvent ev                      -- Example of external validation:                     -- Require age field to contain a value that is at least 18.-                    continue $ setFieldValid ((formState s')^.age >= 18) AgeField s'+                    st <- gets formState+                    modify $ setFieldValid (st^.age >= 18) AgeField          , appChooseCursor = focusRingCursor formFocus-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const theMap         }  main :: IO () main = do     let buildVty = do-          v <- V.mkVty =<< V.standardIOConfig+          v <- mkVty V.defaultConfig           V.setMode (V.outputIface v) V.Mouse True           return v
programs/LayerDemo.hs view
@@ -1,80 +1,108 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Main where -import Lens.Micro ((^.), (&), (%~))+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void) import qualified Graphics.Vty as V  import qualified Brick.Types as T-import Brick.Types (locationRowL, locationColumnL, Widget)+import Brick.Types (locationRowL, locationColumnL, Location(..), Widget) import qualified Brick.Main as M import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Center as C import Brick.Widgets.Core   ( translateBy   , str+  , relativeTo+  , reportExtent+  , withDefAttr   )+import Brick.Util (fg) import Brick.AttrMap   ( attrMap+  , AttrName+  , attrName   )  data St =-    St { _topLayerLocation :: T.Location+    St { _middleLayerLocation :: T.Location        , _bottomLayerLocation :: T.Location        }  makeLenses ''St -drawUi :: St -> [Widget ()]+data Name =+    MiddleLayerElement+    deriving (Ord, Eq, Show)++drawUi :: St -> [Widget Name] drawUi st =     [ C.centerLayer $       B.border $ str "This layer is centered but other\nlayers are placed underneath it."-    , topLayer st-    , bottomLayer st+    , arrowLayer+    , middleLayer (st^.middleLayerLocation)+    , bottomLayer (st^.bottomLayerLocation)     ] -topLayer :: St -> Widget ()-topLayer st =-    translateBy (st^.topLayerLocation) $-    B.border $ str "Top layer\n(Arrow keys move)"+arrowLayer :: Widget Name+arrowLayer =+    let msg = "Relatively\n" <>+              "positioned\n" <>+              "arrow---->"+    in relativeTo MiddleLayerElement (Location (-10, -2)) $+       withDefAttr arrowAttr $+       str msg -bottomLayer :: St -> Widget ()-bottomLayer st =-    translateBy (st^.bottomLayerLocation) $+middleLayer :: Location -> Widget Name+middleLayer l =+    translateBy l $+    reportExtent MiddleLayerElement $+    B.border $ str "Middle layer\n(Arrow keys move)"++bottomLayer :: Location -> Widget Name+bottomLayer l =+    translateBy l $     B.border $ str "Bottom layer\n(Ctrl-arrow keys move)" -appEvent :: St -> T.BrickEvent () e -> T.EventM () (T.Next St)-appEvent st (T.VtyEvent (V.EvKey V.KDown []))  =-    M.continue $ st & topLayerLocation.locationRowL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp []))    =-    M.continue $ st & topLayerLocation.locationRowL %~ (subtract 1)-appEvent st (T.VtyEvent (V.EvKey V.KRight [])) =-    M.continue $ st & topLayerLocation.locationColumnL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft []))  =-    M.continue $ st & topLayerLocation.locationColumnL %~ (subtract 1)+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KDown []))  =+    middleLayerLocation.locationRowL %= (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp []))    =+    middleLayerLocation.locationRowL %= (subtract 1)+appEvent (T.VtyEvent (V.EvKey V.KRight [])) =+    middleLayerLocation.locationColumnL %= (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft []))  =+    middleLayerLocation.locationColumnL %= (subtract 1) -appEvent st (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) =-    M.continue $ st & bottomLayerLocation.locationRowL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) =-    M.continue $ st & bottomLayerLocation.locationRowL %~ (subtract 1)-appEvent st (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) =-    M.continue $ st & bottomLayerLocation.locationColumnL %~ (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) =-    M.continue $ st & bottomLayerLocation.locationColumnL %~ (subtract 1)+appEvent (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) =+    bottomLayerLocation.locationRowL %= (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) =+    bottomLayerLocation.locationRowL %= (subtract 1)+appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) =+    bottomLayerLocation.locationColumnL %= (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) =+    bottomLayerLocation.locationColumnL %= (subtract 1) -appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st-appEvent st _ = M.continue st+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return () -app :: M.App St e ()+arrowAttr :: AttrName+arrowAttr = attrName "attr"++app :: M.App St e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent-          , M.appAttrMap = const $ attrMap V.defAttr []+          , M.appAttrMap = const $ attrMap V.defAttr [(arrowAttr, fg V.cyan)]           , M.appChooseCursor = M.neverShowCursor           }  main :: IO ()-main = void $ M.defaultMain app $ St (T.Location (0, 0)) (T.Location (0, 0))+main = void $ M.defaultMain app $ St (T.Location (20, 5)) (T.Location (0, 0))
programs/ListDemo.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where  import Lens.Micro ((^.))+import Lens.Micro.Mtl import Control.Monad (void)+import Control.Monad.State (modify) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif@@ -48,26 +49,28 @@                               , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List () Char -> T.BrickEvent () e -> T.EventM () (T.Next (L.List () Char))-appEvent l (T.VtyEvent e) =+appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent (T.VtyEvent e) =     case e of-        V.EvKey (V.KChar '+') [] ->-            let el = nextElement (L.listElements l)-                pos = Vec.length $ l^.(L.listElementsL)-            in M.continue $ L.listInsert pos el l+        V.EvKey (V.KChar '+') [] -> do+            els <- use L.listElementsL+            let el = nextElement els+                pos = Vec.length els+            modify $ L.listInsert pos el -        V.EvKey (V.KChar '-') [] ->-            case l^.(L.listSelectedL) of-                Nothing -> M.continue l-                Just i -> M.continue $ L.listRemove i l+        V.EvKey (V.KChar '-') [] -> do+            sel <- use L.listSelectedL+            case sel of+                Nothing -> return ()+                Just i -> modify $ L.listRemove i -        V.EvKey V.KEsc [] -> M.halt l+        V.EvKey V.KEsc [] -> M.halt -        ev -> M.continue =<< L.handleListEvent ev l+        ev -> L.handleListEvent ev     where       nextElement :: Vec.Vector Char -> Char       nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])-appEvent l _ = M.continue l+appEvent _ = return ()  listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a =@@ -80,7 +83,7 @@ initialState = L.list () (Vec.fromList ['a','b','c']) 1  customAttr :: A.AttrName-customAttr = L.listSelectedAttr <> "custom"+customAttr = L.listSelectedAttr <> A.attrName "custom"  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -94,7 +97,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
programs/ListViDemo.hs view
@@ -1,14 +1,15 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where  import Control.Monad (void)+import Control.Monad.State (modify) import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import qualified Graphics.Vty as V import Lens.Micro ((^.))+import Lens.Micro.Mtl  import qualified Brick.AttrMap as A import qualified Brick.Main as M@@ -39,26 +40,28 @@                               , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List () Char -> T.BrickEvent () e -> T.EventM () (T.Next (L.List () Char))-appEvent l (T.VtyEvent e) =+appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()+appEvent (T.VtyEvent e) =     case e of-        V.EvKey (V.KChar '+') [] ->-            let el = nextElement (L.listElements l)-                pos = Vec.length $ l^.(L.listElementsL)-            in M.continue $ L.listInsert pos el l+        V.EvKey (V.KChar '+') [] -> do+            els <- use L.listElementsL+            let el = nextElement els+                pos = Vec.length els+            modify $ L.listInsert pos el -        V.EvKey (V.KChar '-') [] ->-            case l^.(L.listSelectedL) of-                Nothing -> M.continue l-                Just i  -> M.continue $ L.listRemove i l+        V.EvKey (V.KChar '-') [] -> do+            sel <- use L.listSelectedL+            case sel of+                Nothing -> return ()+                Just i  -> modify $ L.listRemove i -        V.EvKey V.KEsc [] -> M.halt l+        V.EvKey V.KEsc [] -> M.halt -        ev -> M.continue =<< (L.handleListEventVi L.handleListEvent) ev l+        ev -> L.handleListEventVi L.handleListEvent ev     where       nextElement :: Vec.Vector Char -> Char       nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])-appEvent l _ = M.continue l+appEvent _ = return ()  listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a =@@ -71,7 +74,7 @@ initialState = L.list () (Vec.fromList ['a','b','c']) 1  customAttr :: A.AttrName-customAttr = L.listSelectedAttr <> "custom"+customAttr = L.listSelectedAttr <> A.attrName "custom"  theMap :: A.AttrMap theMap = A.attrMap V.defAttr@@ -85,7 +88,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
− programs/MarkupDemo.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-module Main where--#if !(MIN_VERSION_base(4,11,0))-import Data.Monoid ((<>))-#endif-import qualified Graphics.Vty as V--import Brick.Main (App(..), defaultMain, resizeOrQuit, neverShowCursor)-import Brick.Types-  ( Widget-  , Padding(..)-  )-import Brick.Widgets.Core-  ( (<=>)-  , (<+>)-  , padLeft-  )-import Brick.Util (on, fg)-import Brick.Markup (markup, (@?))-import Brick.AttrMap (attrMap, AttrMap)-import Data.Text.Markup ((@@))--ui :: Widget ()-ui = (m1 <=> m2) <+> (padLeft (Pad 1) m3)-    where-        m1 = markup $ ("Hello" @@ fg V.blue) <> ", " <> ("world!" @@ fg V.red)-        m2 = markup $ ("Hello" @? "keyword1") <> ", " <> ("world!" @? "keyword2")-        m3 = markup $ ("Hello," @? "keyword1") <> "\n" <> ("world!" @? "keyword2")--theMap :: AttrMap-theMap = attrMap V.defAttr-    [ ("keyword1",      fg V.magenta)-    , ("keyword2",      V.white `on` V.blue)-    ]--app :: App () e ()-app =-    App { appDraw = const [ui]-        , appHandleEvent = resizeOrQuit-        , appAttrMap = const theMap-        , appStartEvent = return-        , appChooseCursor = neverShowCursor-        }--main :: IO ()-main = defaultMain app ()
programs/MouseDemo.hs view
@@ -1,14 +1,12 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif-import Lens.Micro ((^.), (&), (.~), (%~))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl import Control.Monad (void)+import Control.Monad.Trans (liftIO) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif@@ -23,8 +21,6 @@ import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B import Brick.Widgets.Core-import Data.Text.Zipper (moveCursor)-import Data.Tuple (swap)  data Name = Info | Button1 | Button2 | Button3 | Prose | TextBox           deriving (Show, Ord, Eq)@@ -48,15 +44,15 @@ buttonLayer :: St -> Widget Name buttonLayer st =     C.vCenterLayer $-      C.hCenterLayer (padBottom (T.Pad 1) $ str "Click a button:") <=>+      C.hCenterLayer (padBottom (Pad 1) $ str "Click a button:") <=>       C.hCenterLayer (hBox $ padLeftRight 1 <$> buttons) <=>       C.hCenterLayer (padTopBottom 1 $ str "Or enter text and then click in this editor:") <=>       C.hCenterLayer (vLimit 3 $ hLimit 50 $ E.renderEditor (str . unlines) True (st^.edit))     where         buttons = mkButton <$> buttonData-        buttonData = [ (Button1, "Button 1", "button1")-                     , (Button2, "Button 2", "button2")-                     , (Button3, "Button 3", "button3")+        buttonData = [ (Button1, "Button 1", attrName "button1")+                     , (Button2, "Button 2", attrName "button2")+                     , (Button3, "Button 3", attrName "button3")                      ]         mkButton (name, label, attr) =             let wasClicked = (fst <$> st^.lastReportedClick) == Just name@@ -72,11 +68,7 @@   B.border $   C.hCenterLayer $   vLimit 8 $-  -- n.b. if clickable and viewport are inverted here, click event-  -- coordinates will only identify the viewable range, not the actual-  -- editor widget coordinates.   viewport Prose Vertical $-  clickable Prose $   vBox $ map str $ lines (st^.prose)  infoLayer :: St -> Widget Name@@ -84,38 +76,46 @@     c <- T.getContext     let h = c^.T.availHeightL         msg = case st^.lastReportedClick of-                Nothing -> "nothing"-                Just (name, T.Location l) -> show name <> " at " <> show l+                Nothing ->+                    "Click and hold/drag to report a mouse click"+                Just (name, T.Location l) ->+                    "Mouse down at " <> show name <> " @ " <> show l     T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $-               withDefAttr "info" $-               C.hCenter (str ("Last reported click: " <> msg))+               withDefAttr (attrName "info") $+               C.hCenter $ str msg -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.MouseDown n _ _ loc) = do-    let T.Location pos = loc-    M.continue $ st & lastReportedClick .~ Just (n, loc)-                    & edit %~ E.applyEdit (if n == TextBox then moveCursor (swap pos) else id)-appEvent st (T.MouseUp _ _ _) = M.continue $ st & lastReportedClick .~ Nothing-appEvent st (T.VtyEvent (V.EvMouseUp _ _ _)) = M.continue $ st & lastReportedClick .~ Nothing-appEvent st (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) = M.vScrollBy (M.viewportScroll Prose) (-1) >> M.continue st-appEvent st (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) = M.vScrollBy (M.viewportScroll Prose) 1 >> M.continue st-appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st-appEvent st (T.VtyEvent ev) = M.continue =<< T.handleEventLensed st edit E.handleEditorEvent ev-appEvent st _ = M.continue st+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent ev@(T.MouseDown n _ _ loc) = do+    lastReportedClick .= Just (n, loc)+    zoom edit $ E.handleEditorEvent ev+appEvent (T.MouseUp {}) =+    lastReportedClick .= Nothing+appEvent (T.VtyEvent (V.EvMouseUp {})) =+    lastReportedClick .= Nothing+appEvent (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) =+    M.vScrollBy (M.viewportScroll Prose) (-1)+appEvent (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) =+    M.vScrollBy (M.viewportScroll Prose) 1+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =+    M.halt+appEvent ev =+    zoom edit $ E.handleEditorEvent ev  aMap :: AttrMap aMap = attrMap V.defAttr-    [ ("info",      V.white `on` V.magenta)-    , ("button1",   V.white `on` V.cyan)-    , ("button2",   V.white `on` V.green)-    , ("button3",   V.white `on` V.blue)+    [ (attrName "info",      V.white `on` V.magenta)+    , (attrName "button1",   V.white `on` V.cyan)+    , (attrName "button2",   V.white `on` V.green)+    , (attrName "button3",   V.white `on` V.blue)     , (E.editFocusedAttr, V.black `on` V.yellow)     ]  app :: M.App St e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = do+              vty <- M.getVtyHandle+              liftIO $ V.setMode (V.outputIface vty) V.Mouse True           , M.appHandleEvent = appEvent           , M.appAttrMap = const aMap           , M.appChooseCursor = M.showFirstCursor@@ -123,13 +123,7 @@  main :: IO () main = do-    let buildVty = do-          v <- V.mkVty =<< V.standardIOConfig-          V.setMode (V.outputIface v) V.Mouse True-          return v--    initialVty <- buildVty-    void $ M.customMain initialVty buildVty Nothing app $ St [] Nothing+    void $ M.defaultMain app $ St [] Nothing            (unlines [ "Try clicking on various UI elements."                     , "Observe that the click coordinates identify the"                     , "underlying widget coordinates."
programs/PaddingDemo.hs view
@@ -4,7 +4,6 @@ import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain) import Brick.Types   ( Widget-  , Padding(..)   ) import Brick.Widgets.Core   ( vBox@@ -17,22 +16,23 @@   , padBottom   , padTopBottom   , padLeftRight+  , Padding(..)   )-import Brick.Widgets.Border as B-import Brick.Widgets.Center as C+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.Center as C import Brick.AttrMap (attrMap) import qualified Graphics.Vty as V  ui :: Widget () ui =-    vBox [ hBox [ padLeft Max $ vCenter $ str "Left-padded"+    vBox [ hBox [ padLeft Max $ C.vCenter $ str "Left-padded"                 , B.vBorder-                , padRight Max $ vCenter $ str "Right-padded"+                , padRight Max $ C.vCenter $ str "Right-padded"                 ]          , B.hBorder-         , hBox [ padTop Max $ hCenter $ str "Top-padded"+         , hBox [ padTop Max $ C.hCenter $ str "Top-padded"                 , B.vBorder-                , padBottom Max $ hCenter $ str "Bottom-padded"+                , padBottom Max $ C.hCenter $ str "Bottom-padded"                 ]          , B.hBorder          , hBox [ padLeftRight 2 $ str "Padded by 2 on left/right"@@ -49,7 +49,7 @@ app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         , appChooseCursor = neverShowCursor         }
programs/ProgressBarDemo.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} module Main where  import Control.Monad (void)@@ -7,6 +8,8 @@ import Data.Monoid #endif import qualified Graphics.Vty as V+import Lens.Micro.Mtl+import Lens.Micro.TH  import qualified Brick.AttrMap as A import qualified Brick.Main as M@@ -18,13 +21,16 @@ import Brick.Widgets.Core   ( (<+>), (<=>)   , str+  , strWrap   , updateAttrMap   , overrideAttr   ) import Brick.Util (fg, bg, on, clamp) -data MyAppState n = MyAppState { x, y, z :: Float }+data MyAppState n = MyAppState { _x, _y, _z :: Float, _showLabel :: Bool } +makeLenses ''MyAppState+ drawUI :: MyAppState () -> [Widget ()] drawUI p = [ui]     where@@ -33,37 +39,62 @@              (A.mapAttrNames [ (xDoneAttr, P.progressCompleteAttr)                              , (xToDoAttr, P.progressIncompleteAttr)                              ]-             ) $ bar $ x p+             ) $ bar $ _x p       -- or use individual mapAttrName calls       yBar = updateAttrMap              (A.mapAttrName yDoneAttr P.progressCompleteAttr .               A.mapAttrName yToDoAttr P.progressIncompleteAttr) $-             bar $ y p+             bar $ _y p       -- or use overrideAttr calls       zBar = overrideAttr P.progressCompleteAttr zDoneAttr $              overrideAttr P.progressIncompleteAttr zToDoAttr $-             bar $ z p-      lbl c = Just $ show $ fromEnum $ c * 100+             bar $ _z p+      -- custom bars+      cBar1 = overrideAttr P.progressCompleteAttr cDoneAttr1 $+              overrideAttr P.progressIncompleteAttr cToDoAttr1+              $ bar' '▰' '▱' $ _x p+      cBar2 = overrideAttr P.progressCompleteAttr cDoneAttr2 $+              overrideAttr P.progressIncompleteAttr cToDoAttr2+              $ bar' '|' '─' $ _y p+      cBar3 = overrideAttr P.progressCompleteAttr cDoneAttr $+              overrideAttr P.progressIncompleteAttr cToDoAttr+              $ bar' '⣿' '⠶' $ _z p+      lbl c = if _showLabel p+              then Just $ " " ++ (show $ fromEnum $ c * 100) ++ " "+              else Nothing       bar v = P.progressBar (lbl v) v+      bar' cc ic v = P.customProgressBar cc ic (lbl v) v       ui = (str "X: " <+> xBar) <=>            (str "Y: " <+> yBar) <=>            (str "Z: " <+> zBar) <=>+           (str "X: " <+> cBar1) <=>+           (str "Y: " <+> cBar2) <=>+           (str "Z: " <+> cBar3) <=>            str "" <=>-           str "Hit 'x', 'y', or 'z' to advance progress, or 'q' to quit"+           (strWrap $ concat [ "Hit 'x', 'y', or 'z' to advance progress,"+                             , "'t' to toggle labels, 'r' to revert values, "+                             , "'Ctrl + r' to reset values or 'q' to quit"+                             ]) -appEvent :: MyAppState () -> T.BrickEvent () e -> T.EventM () (T.Next (MyAppState ()))-appEvent p (T.VtyEvent e) =+appEvent :: T.BrickEvent () e -> T.EventM () (MyAppState ()) ()+appEvent (T.VtyEvent e) =     let valid = clamp (0.0 :: Float) 1.0     in case e of-         V.EvKey (V.KChar 'x') [] -> M.continue $ p { x = valid $ x p + 0.05 }-         V.EvKey (V.KChar 'y') [] -> M.continue $ p { y = valid $ y p + 0.03 }-         V.EvKey (V.KChar 'z') [] -> M.continue $ p { z = valid $ z p + 0.02 }-         V.EvKey (V.KChar 'q') [] -> M.halt p-         _ -> M.continue p-appEvent p _ = M.continue p+         V.EvKey (V.KChar 'x') [] -> x %= valid . (+ 0.05)+         V.EvKey (V.KChar 'y') [] -> y %= valid . (+ 0.03)+         V.EvKey (V.KChar 'z') [] -> z %= valid . (+ 0.02)+         V.EvKey (V.KChar 't') [] -> showLabel %= not+         V.EvKey (V.KChar 'r') [V.MCtrl] -> do+           x .= 0+           y .= 0+           z .= 0+         V.EvKey (V.KChar 'r') [] -> T.put initialState+         V.EvKey (V.KChar 'q') [] -> M.halt+         _ -> return ()+appEvent _ = return ()  initialState :: MyAppState ()-initialState = MyAppState 0.25 0.18 0.63+initialState = MyAppState 0.25 0.18 0.63 True  theBaseAttr :: A.AttrName theBaseAttr = A.attrName "theBase"@@ -80,6 +111,18 @@ zDoneAttr = theBaseAttr <> A.attrName "Z:done" zToDoAttr = theBaseAttr <> A.attrName "Z:remaining" +cDoneAttr, cToDoAttr :: A.AttrName+cDoneAttr = A.attrName "C:done"+cToDoAttr = A.attrName "C:remaining"++cDoneAttr1, cToDoAttr1 :: A.AttrName+cDoneAttr1 = A.attrName "C1:done"+cToDoAttr1 = A.attrName "C1:remaining"++cDoneAttr2, cToDoAttr2 :: A.AttrName+cDoneAttr2 = A.attrName "C2:done"+cToDoAttr2 = A.attrName "C2:remaining"+ theMap :: A.AttrMap theMap = A.attrMap V.defAttr          [ (theBaseAttr,               bg V.brightBlack)@@ -88,6 +131,12 @@          , (yDoneAttr,                 V.magenta `on` V.yellow)          , (zDoneAttr,                 V.blue `on` V.green)          , (zToDoAttr,                 V.blue `on` V.red)+         , (cDoneAttr,                 fg V.blue)+         , (cToDoAttr,                 fg V.blue)+         , (cDoneAttr1,                fg V.red)+         , (cToDoAttr1,                fg V.brightWhite)+         , (cDoneAttr2,                fg V.green)+         , (cToDoAttr2,                fg V.brightGreen)          , (P.progressIncompleteAttr,  fg V.yellow)          ] @@ -96,7 +145,7 @@     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor           , M.appHandleEvent = appEvent-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appAttrMap = const theMap           }
programs/ReadmeDemo.hs view
@@ -1,12 +1,13 @@ module Main where -import Brick-import Brick.Widgets.Center-import Brick.Widgets.Border-import Brick.Widgets.Border.Style+import Brick (Widget, simpleMain, (<+>), str, withBorderStyle, joinBorders)+import Brick.Widgets.Center (center)+import Brick.Widgets.Border (borderWithLabel, vBorder)+import Brick.Widgets.Border.Style (unicode)  ui :: Widget () ui =+    joinBorders $     withBorderStyle unicode $     borderWithLabel (str "Hello!") $     (center (str "Left") <+> vBorder <+> center (str "Right"))
programs/SuspendAndResumeDemo.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE CPP #-} module Main where -import Lens.Micro ((.~), (^.), (&))+import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) import Control.Monad (void) #if !(MIN_VERSION_base(4,11,0))@@ -13,7 +13,7 @@  import Brick.Main   ( App(..), neverShowCursor, defaultMain-  , suspendAndResume, halt, continue+  , suspendAndResume, halt   ) import Brick.AttrMap   ( attrMap@@ -21,7 +21,6 @@ import Brick.Types   ( Widget   , EventM-  , Next   , BrickEvent(..)   ) import Brick.Widgets.Core@@ -42,16 +41,16 @@                   , str "(Press Esc to quit or Space to ask for input)"                   ] -appEvent :: St -> BrickEvent () e -> EventM () (Next St)-appEvent st (VtyEvent e) =+appEvent :: BrickEvent () e -> EventM () St ()+appEvent (VtyEvent e) =     case e of-        V.EvKey V.KEsc [] -> halt st+        V.EvKey V.KEsc [] -> halt         V.EvKey (V.KChar ' ') [] -> suspendAndResume $ do             putStrLn "Suspended. Please enter something and press enter to resume:"             s <- getLine-            return $ st & stExternalInput .~ s-        _ -> continue st-appEvent st _ = continue st+            return $ St { _stExternalInput = s }+        _ -> return ()+appEvent _ = return ()  initialState :: St initialState =@@ -63,7 +62,7 @@     App { appDraw = drawUI         , appChooseCursor = neverShowCursor         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap V.defAttr []         }
+ programs/TableDemo.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+module Main where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Brick+import Brick.Widgets.Table+import Brick.Widgets.Center (center)++ui :: Widget ()+ui = center $ renderTable leftTable <+>+              padLeft (Pad 5) (renderTable rightTableA <=>+                               renderTable rightTableB <=>+                               renderTable rightTableC)++innerTable :: Table ()+innerTable =+    surroundingBorder False $+    table [ [txt "inner", txt "table"]+          , [txt "is",    txt "here"]+          ]++leftTable :: Table ()+leftTable =+    alignCenter 1 $+    alignRight 2 $+    alignMiddle 2 $+    table [ [txt "Left",             txt "Center",      txt "Right"]+          , [txt "X",                txt "Some things", txt "A"]+          , [renderTable innerTable, txt "are",         txt "B"]+          , [txt "Z",                txt "centered",    txt "C"]+          ]++rightTableA :: Table ()+rightTableA =+    rowBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",     txt "without"]+          , [txt "table", txt "row borders"]+          ]++rightTableB :: Table ()+rightTableB =+    columnBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",       txt "table"]+          , [txt "without", txt "column borders"]+          ]++rightTableC :: Table ()+rightTableC =+    surroundingBorder False $+    rowBorders False $+    columnBorders False $+    setDefaultColAlignment AlignCenter $+    table [ [txt "A",       txt "table"]+          , [txt "without", txt "any borders"]+          ]++main :: IO ()+main = simpleMain ui
+ programs/TabularListDemo.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+module Main where++import Lens.Micro ((^.))+import Lens.Micro.Mtl+import Lens.Micro.TH+import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Graphics.Vty as V++import qualified Brick.Main as M+import qualified Brick.Types as T+import qualified Brick.Widgets.Border as B+import qualified Brick.Widgets.List as L+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Table as Table+import qualified Brick.AttrMap as A+import qualified Data.Vector as Vec+import Brick.Types+  ( Widget+  )+import Brick.Widgets.Core+  ( (<=>)+  , str+  , vLimit+  , hLimit+  , vBox+  , hBox+  , withDefAttr+  )+import Brick.Util (on)++data Row = Row String String String++data AppState =+    AppState { _tabularList :: L.List () Row+             , _colIndex :: Int+             }++makeLenses ''AppState++drawUI :: AppState -> [Widget ()]+drawUI s = [ui]+    where+        l = s^.tabularList+        label = str $ "Row " <> cur <> " / col " <> show (s^.colIndex + 1)+        cur = case l^.(L.listSelectedL) of+                Nothing -> "-"+                Just i -> show (i + 1)+        box = B.borderWithLabel label $+              hLimit totalWidth $+              vLimit 15 $+              listDrawElement 0 False headerRow <=>+              L.renderList (listDrawElement (s^.colIndex)) True l+        ui = C.vCenter $ vBox [ C.hCenter box+                              , str " "+                              , C.hCenter $ str "Press +/- to add/remove list elements."+                              , C.hCenter $ str "Use arrow keys to change selection."+                              , C.hCenter $ str "Press Esc to exit."+                              ]++appEvent :: T.BrickEvent () e -> T.EventM () AppState ()+appEvent (T.VtyEvent e) =+    case e of+        V.EvKey (V.KChar '+') [] -> do+            els <- use (tabularList.L.listElementsL)+            let el = Row (show pos) (show $ pos * 3) (show $ pos * 9)+                pos = Vec.length els+            tabularList %= L.listInsert pos el++        V.EvKey (V.KChar '-') [] -> do+            sel <- use (tabularList.L.listSelectedL)+            case sel of+                Nothing -> return ()+                Just i -> tabularList %= L.listRemove i++        V.EvKey V.KLeft [] ->+            colIndex %= (\i -> max 0 (i - 1))+        V.EvKey V.KRight [] ->+            colIndex %= (\i -> min (length columnAlignments - 1) (i + 1))++        V.EvKey V.KEsc [] -> M.halt++        ev -> T.zoom tabularList $ L.handleListEvent ev+appEvent _ = return ()++listDrawElement :: Int -> Bool -> Row -> Widget ()+listDrawElement colIdx sel (Row a b c) =+    let ws = [str a, str b, str c]+        maybeSelect es = selectCell <$> zip [0..] es+        selectCell (i, w) = if sel && i == colIdx+                            then withDefAttr selectedCellAttr w+                            else w+    in hLimit totalWidth $+       hBox $+       maybeSelect $+       Table.alignColumns columnAlignments columnWidths ws++initialState :: AppState+initialState =+    AppState { _tabularList = L.list () (Vec.fromList initialRows) 1+             , _colIndex = 0+             }++selectedCellAttr :: A.AttrName+selectedCellAttr = A.attrName "selectedCell"++theMap :: A.AttrMap+theMap = A.attrMap V.defAttr+    [ (L.listAttr,            V.white `on` V.blue)+    , (selectedCellAttr,      V.blue `on` V.white)+    ]++columnWidths :: [Int]+columnWidths = [10, 15, 20]++totalWidth :: Int+totalWidth = sum columnWidths++headerRow :: Row+headerRow = Row "Col 1" "Col 2" "Col 3"++columnAlignments :: [Table.ColumnAlignment]+columnAlignments = [Table.AlignLeft, Table.AlignCenter, Table.AlignRight]++initialRows :: [Row]+initialRows =+    [ Row "one" "two" "three"+    , Row "foo" "bar" "baz"+    , Row "stuff" "things" "blah"+    ]++theApp :: M.App AppState e ()+theApp =+    M.App { M.appDraw = drawUI+          , M.appChooseCursor = M.showFirstCursor+          , M.appHandleEvent = appEvent+          , M.appStartEvent = return ()+          , M.appAttrMap = const theMap+          }++main :: IO ()+main = void $ M.defaultMain theApp initialState
+ programs/TailDemo.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Text as T+import Control.Monad (void)+import Control.Concurrent+import Lens.Micro.TH+import Lens.Micro.Mtl+import System.Random++import Brick+import Brick.BChan+import Brick.Widgets.Border+import qualified Graphics.Vty as V++data AppState =+    AppState { _textAreaHeight :: Int+             , _textAreaWidth :: Int+             , _textAreaContents :: [T.Text]+             }++makeLenses ''AppState++draw :: AppState -> Widget n+draw st =+    header st <=> box st++header :: AppState -> Widget n+header st =+    padBottom (Pad 1) $+    hBox [ padRight (Pad 7) $+           (str $ "Max width: " <> show (_textAreaWidth st)) <=>+           (str "Left(-)/Right(+)")+         , (str $ "Max height: " <> show (_textAreaHeight st)) <=>+           (str "Down(-)/Up(+)")+         ]++box :: AppState -> Widget n+box st =+    border $+    hLimit (_textAreaWidth st) $+    vLimit (_textAreaHeight st) $+    (renderBottomUp (txtWrap <$> _textAreaContents st))++-- | Given a list of widgets, draw them bottom-up in a vertical+-- arrangement, i.e., the first widget in this list will appear at the+-- bottom of the rendering area. Rendering stops when the rendering area+-- is full, i.e., items that cannot be rendered are never evaluated or+-- drawn.+renderBottomUp :: [Widget n] -> Widget n+renderBottomUp ws =+    Widget Greedy Greedy $ do+        let go _ [] = return V.emptyImage+            go remainingHeight (c:cs) = do+                cResult <- render c+                let img = image cResult+                    newRemainingHeight = remainingHeight - V.imageHeight img+                if newRemainingHeight == 0+                   then return img+                   else if newRemainingHeight < 0+                        then return $ V.cropTop remainingHeight img+                        else do+                            rest <- go newRemainingHeight cs+                            return $ V.vertCat [rest, img]++        ctx <- getContext+        img <- go (availHeight ctx) ws+        render $ fill ' ' <=> raw img++textLines :: [T.Text]+textLines =+    [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut"+    , "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco"+    , "laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit"+    , "in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat"+    , "cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."+    ]++handleEvent :: BrickEvent n CustomEvent -> EventM n AppState ()+handleEvent (AppEvent (NewLine l)) =+    textAreaContents %= (l :)+handleEvent (VtyEvent (V.EvKey V.KUp [])) =+    textAreaHeight %= (+ 1)+handleEvent (VtyEvent (V.EvKey V.KDown [])) =+    textAreaHeight %= max 0 . subtract 1+handleEvent (VtyEvent (V.EvKey V.KRight [])) =+    textAreaWidth %= (+ 1)+handleEvent (VtyEvent (V.EvKey V.KLeft [])) =+    textAreaWidth %= max 0 . subtract 1+handleEvent (VtyEvent (V.EvKey V.KEsc [])) =+    halt+handleEvent _ =+    return ()++data CustomEvent =+    NewLine T.Text++app :: App AppState CustomEvent ()+app =+    App { appDraw = (:[]) . draw+        , appChooseCursor = neverShowCursor+        , appHandleEvent = handleEvent+        , appAttrMap = const $ attrMap V.defAttr []+        , appStartEvent = return ()+        }++initialState :: AppState+initialState =+    AppState { _textAreaHeight = 20+             , _textAreaWidth = 40+             , _textAreaContents = []+             }++-- | Run forever, generating new lines of text for the application+-- window, prefixed with a line number. This function simulates the kind+-- of behavior that you'd get from running 'tail -f' on a file.+generateLines :: BChan CustomEvent -> IO ()+generateLines chan = go (1::Integer)+    where+        go lineNum = do+            -- Wait a random amount of time (in milliseconds)+            let delayOptions = [500, 1000, 2000]+            delay <- randomVal delayOptions+            threadDelay $ delay * 1000++            -- Choose a random line of text from our collection+            l <- randomVal textLines++            -- Send it to the application to be added to the UI+            writeBChan chan $ NewLine $ (T.pack $ "Line " <> show lineNum <> " - ") <> l++            go $ lineNum + 1++randomVal :: [a] -> IO a+randomVal as = do+    idx <- randomRIO (0, length as - 1)+    return $ as !! idx++main :: IO ()+main = do+    chan <- newBChan 10++    -- Run thread to simulate incoming data+    void $ forkIO $ generateLines chan++    (_, vty) <- customMainWithDefaultVty (Just chan) app initialState+    V.shutdown vty
programs/ThemeDemo.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Monad (void)+import Control.Monad.State (put) import Graphics.Vty   ( white, blue, green, yellow, black, magenta   , Event(EvKey)@@ -18,7 +18,6 @@   ( Widget   , BrickEvent(VtyEvent)   , EventM-  , Next   ) import Brick.Widgets.Center   ( hCenter@@ -32,7 +31,7 @@   , withDefAttr   ) import Brick.Util (on, fg)-import Brick.AttrMap (AttrName)+import Brick.AttrMap (AttrName, attrName)  ui :: Widget n ui =@@ -44,7 +43,7 @@          ]  keybindingAttr :: AttrName-keybindingAttr = "keybinding"+keybindingAttr = attrName "keybinding"  theme1 :: Theme theme1 =@@ -58,28 +57,28 @@              [ (keybindingAttr, fg yellow)              ] -appEvent :: Int -> BrickEvent () e -> EventM () (Next Int)-appEvent _ (VtyEvent (EvKey (KChar '1') [])) = continue 1-appEvent _ (VtyEvent (EvKey (KChar '2') [])) = continue 2-appEvent s (VtyEvent (EvKey (KChar 'q') [])) = halt s-appEvent s (VtyEvent (EvKey KEsc [])) = halt s-appEvent s _ = continue s+appEvent :: BrickEvent () e -> EventM () Int ()+appEvent (VtyEvent (EvKey (KChar '1') [])) = put 1+appEvent (VtyEvent (EvKey (KChar '2') [])) = put 2+appEvent (VtyEvent (EvKey (KChar 'q') [])) = halt+appEvent (VtyEvent (EvKey KEsc [])) = halt+appEvent _ = return ()  app :: App Int e () app =     App { appDraw = const [ui]         , appHandleEvent = appEvent-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = \s ->             -- Note that in practice this is not ideal: we don't want-            -- to build an attribute from a theme every time this is+            -- to build an attribute map from a theme every time this is             -- invoked, because it gets invoked once per redraw. Instead             -- we'd build the attribute map at startup and store it in             -- the application state. Here I just use themeToAttrMap to             -- show the mechanics of the API.-            if s == 1-            then themeToAttrMap theme1-            else themeToAttrMap theme2+            themeToAttrMap $ if s == 1+                             then theme1+                             else theme2         , appChooseCursor = neverShowCursor         }
programs/ViewportScrollDemo.hs view
@@ -2,10 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- import Control.Monad (void) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))@@ -63,22 +59,22 @@ vp3Scroll :: M.ViewportScroll Name vp3Scroll = M.viewportScroll VP3 -appEvent :: () -> T.BrickEvent Name e -> T.EventM Name (T.Next ())-appEvent _ (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = M.vScrollBy vp3Scroll 1 >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = M.vScrollBy vp3Scroll (-1) >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.hScrollBy vp3Scroll 1 >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = M.hScrollBy vp3Scroll (-1) >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KDown []))  = M.vScrollBy vp1Scroll 1 >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KUp []))    = M.vScrollBy vp1Scroll (-1) >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KRight [])) = M.hScrollBy vp2Scroll 1 >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KLeft []))  = M.hScrollBy vp2Scroll (-1) >> M.continue ()-appEvent _ (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt ()-appEvent _ _ = M.continue ()+appEvent :: T.BrickEvent Name e -> T.EventM Name () ()+appEvent (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = M.vScrollBy vp3Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = M.vScrollBy vp3Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.hScrollBy vp3Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = M.hScrollBy vp3Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KDown []))  = M.vScrollBy vp1Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KUp []))    = M.vScrollBy vp1Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KRight [])) = M.hScrollBy vp2Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KLeft []))  = M.hScrollBy vp2Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return ()  app :: M.App () e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const $ attrMap V.defAttr []           , M.appChooseCursor = M.neverShowCursor
+ programs/ViewportScrollbarsDemo.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Lens.Micro.TH+import Lens.Micro.Mtl+import Control.Monad (void)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import qualified Brick.Types as T+import qualified Brick.Main as M+import qualified Brick.Widgets.Center as C+import qualified Brick.Widgets.Border as B+import Brick.Types+  ( Widget+  , ViewportType(Horizontal, Both)+  , VScrollBarOrientation(..)+  , HScrollBarOrientation(..)+  )+import Brick.Util+  ( fg+  )+import Brick.AttrMap+  ( AttrMap+  , attrMap+  )+import Brick.Widgets.Core+  ( Padding(..)+  , hLimit+  , vLimit+  , padRight+  , hBox+  , vBox+  , viewport+  , str+  , fill+  , withVScrollBars+  , withHScrollBars+  , withHScrollBarRenderer+  , withVScrollBarRenderer+  , withVScrollBarHandles+  , withHScrollBarHandles+  , withClickableHScrollBars+  , withClickableVScrollBars+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , scrollbarAttr+  , scrollbarHandleAttr+  )++customHScrollbars :: HScrollbarRenderer n+customHScrollbars =+    HScrollbarRenderer { renderHScrollbar = vLimit 1 $ fill '^'+                       , renderHScrollbarTrough = vLimit 1 $ fill ' '+                       , renderHScrollbarHandleBefore = str "<<"+                       , renderHScrollbarHandleAfter = str ">>"+                       , scrollbarHeightAllocation = 2+                       }++customVScrollbars :: VScrollbarRenderer n+customVScrollbars =+    VScrollbarRenderer { renderVScrollbar = C.hCenter $ hLimit 1 $ fill '*'+                       , renderVScrollbarTrough = fill ' '+                       , renderVScrollbarHandleBefore = C.hCenter $ str "-^-"+                       , renderVScrollbarHandleAfter = C.hCenter $ str "-v-"+                       , scrollbarWidthAllocation = 5+                       }++data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name+          deriving (Ord, Show, Eq)++data St = St { _lastClickedElement :: Maybe (T.ClickableScrollbarElement, Name) }++makeLenses ''St++drawUi :: St -> [Widget Name]+drawUi st = [ui]+    where+        ui = C.center $ hLimit 80 $ vLimit 21 $+             (vBox [ pair+                   , C.hCenter (str "Last clicked scroll bar element:")+                   , str $ show $ _lastClickedElement st+                   ])+        pair = hBox [ padRight (Pad 5) $+                      B.border $+                      withClickableHScrollBars SBClick $+                      withHScrollBars OnBottom $+                      withHScrollBarRenderer customHScrollbars $+                      withHScrollBarHandles $+                      viewport VP1 Horizontal $+                      str $ "Press left and right arrow keys to scroll this viewport.\n" <>+                            "This viewport uses a\n" <>+                            "custom scroll bar renderer!"+                    , B.border $+                      withClickableVScrollBars SBClick $+                      withVScrollBars OnLeft $+                      withVScrollBarRenderer customVScrollbars $+                      withVScrollBarHandles $+                      viewport VP2 Both $+                      vBox $+                      (str $ unlines $+                       [ "Press up and down arrow keys to"+                       , "scroll this viewport vertically."+                       , "This viewport uses a custom"+                       , "scroll bar renderer with"+                       , "a larger space allocation and"+                       , "even more fancy rendering."+                       ])+                      : (str <$> [ "Line " <> show i | i <- [2..55::Int] ])+                    ]++vp1Scroll :: M.ViewportScroll Name+vp1Scroll = M.viewportScroll VP1++vp2Scroll :: M.ViewportScroll Name+vp2Scroll = M.viewportScroll VP2++appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KRight []))  = M.hScrollBy vp1Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KLeft []))   = M.hScrollBy vp1Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KDown []))   = M.vScrollBy vp2Scroll 1+appEvent (T.VtyEvent (V.EvKey V.KUp []))     = M.vScrollBy vp2Scroll (-1)+appEvent (T.VtyEvent (V.EvKey V.KEsc []))    = M.halt+appEvent (T.MouseDown (SBClick el n) _ _ _) = do+    lastClickedElement .= Just (el, n)+    case n of+        VP1 -> do+            let vp = M.viewportScroll VP1+            case el of+                T.SBHandleBefore -> M.hScrollBy vp (-1)+                T.SBHandleAfter  -> M.hScrollBy vp 1+                T.SBTroughBefore -> M.hScrollBy vp (-10)+                T.SBTroughAfter  -> M.hScrollBy vp 10+                T.SBBar          -> return ()+        VP2 -> do+            let vp = M.viewportScroll VP2+            case el of+                T.SBHandleBefore -> M.vScrollBy vp (-1)+                T.SBHandleAfter  -> M.vScrollBy vp 1+                T.SBTroughBefore -> M.vScrollBy vp (-10)+                T.SBTroughAfter  -> M.vScrollBy vp 10+                T.SBBar          -> return ()+        _ ->+            return ()+appEvent _ = return ()++theme :: AttrMap+theme =+    attrMap V.defAttr+    [ (scrollbarAttr,       fg V.white)+    , (scrollbarHandleAttr, fg V.brightYellow)+    ]++app :: M.App St e Name+app =+    M.App { M.appDraw = drawUi+          , M.appStartEvent = return ()+          , M.appHandleEvent = appEvent+          , M.appAttrMap = const theme+          , M.appChooseCursor = M.neverShowCursor+          }++main :: IO ()+main = do+    let buildVty = do+          v <- mkVty V.defaultConfig+          V.setMode (V.outputIface v) V.Mouse True+          return v++    initialVty <- buildVty+    void $ M.customMain initialVty buildVty Nothing app (St Nothing)
programs/VisibilityDemo.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} module Main where@@ -6,6 +5,7 @@ import Control.Monad (void) import Lens.Micro import Lens.Micro.TH+import Lens.Micro.Mtl #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif@@ -15,7 +15,7 @@ import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B-import Brick.AttrMap (AttrMap, AttrName, attrMap)+import Brick.AttrMap (AttrMap, AttrName, attrMap, attrName) import Brick.Util (on) import Brick.Types   ( Widget@@ -55,7 +55,7 @@ vp3Size = (25, 25)  selectedAttr :: AttrName-selectedAttr = "selected"+selectedAttr = attrName "selected"  drawUi :: St -> [Widget Name] drawUi st = [ui]@@ -102,17 +102,17 @@ vp3Scroll :: M.ViewportScroll Name vp3Scroll = M.viewportScroll VP3 -appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)-appEvent st (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = M.continue $ st & vp3Index._2 %~ max 1 .  subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KDown []))         = M.continue $ st & vp1Index %~ min vp1Size . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KUp []))           = M.continue $ st & vp1Index %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KRight []))        = M.continue $ st & vp2Index %~ min vp2Size . (+ 1)-appEvent st (T.VtyEvent (V.EvKey V.KLeft []))         = M.continue $ st & vp2Index %~ max 1 . subtract 1-appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st-appEvent st _ = M.continue st+appEvent :: T.BrickEvent Name e -> T.EventM Name St ()+appEvent (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = vp3Index._1 %= min (vp3Size^._1) . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = vp3Index._1 %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = vp3Index._2 %= min (vp3Size^._1) . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = vp3Index._2 %= max 1 .  subtract 1+appEvent (T.VtyEvent (V.EvKey V.KDown []))         = vp1Index %= min vp1Size . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KUp []))           = vp1Index %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KRight []))        = vp2Index %= min vp2Size . (+ 1)+appEvent (T.VtyEvent (V.EvKey V.KLeft []))         = vp2Index %= max 1 . subtract 1+appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt+appEvent _ = return ()  theMap :: AttrMap theMap = attrMap V.defAttr@@ -122,7 +122,7 @@ app :: M.App St e Name app =     M.App { M.appDraw = drawUi-          , M.appStartEvent = return+          , M.appStartEvent = return ()           , M.appHandleEvent = appEvent           , M.appAttrMap = const theMap           , M.appChooseCursor = M.neverShowCursor
+ programs/custom_keys.ini view
@@ -0,0 +1,4 @@+[keybindings]+quit = x+increment = i+decrement = d
src/Brick.hs view
@@ -1,8 +1,11 @@ -- | This module is provided as a convenience to import the most--- important parts of the API all at once. Note that the Haddock--- documentation for this library is for /reference/ usage; if you--- are looking for an introduction or tutorial, see the README for links--- to plenty of material!+-- important parts of the API all at once. If you are new to Brick and+-- are looking to learn it, the best place to start is the+-- [Brick User Guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst).+-- The README also has links to other learning resources. Unlike+-- most Haskell libraries that only have API documentation, Brick+-- is best learned by reading the User Guide and other materials and+-- referring to the API docs only as needed. Enjoy! module Brick   ( module Brick.Main   , module Brick.Types
+ src/Brick/Animation.hs view
@@ -0,0 +1,588 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+-- | This module provides some infrastructure for adding animations to+-- Brick applications. See @programs/AnimationDemo.hs@ for a complete+-- working example of this API.+--+-- At a high level, this works as follows:+--+-- This module provides a threaded animation manager that manages a set+-- of running animations. The application creates the manager and starts+-- animations, which automatically loop or run once, depending on their+-- configuration. Each animation has some state in the application's+-- state that is automatically managed by the animation manager using a+-- lens-based API. Whenever animations need to be redrawn, the animation+-- manager sends a custom event with a state update to the application,+-- which must be evaluated by the main event loop to update animation+-- states. Each animation is associated with a 'Clip' -- sequence of+-- frames -- which may be static or may be built from the application+-- state at rendering time.+--+-- To use this module:+--+-- * Use a custom event type @e@ in your 'Brick.Main.App' and give the+--   event type a constructor @EventM n s () -> e@ (where @s@ and+--   @n@ are those in @App s e n@). This will require the use of+--   'Brick.Main.customMain' and will also require the creation of a+--   'Brick.BChan.BChan' for custom events.+--+-- * Add an 'AnimationManager' field to the application state @s@.+--+-- * Create an 'AnimationManager' at startup with+--   'startAnimationManager', providing the custom event constructor and+--   'BChan' created above. Store the manager in the application state.+--+-- * For each animation you want to run at any given time, add a field+--   to the application state of type @Maybe (Animation s n)@,+--   initialized to 'Nothing'. A value of 'Nothing' indicates that the+--   animation is not running.+--+-- * Ensure that each animation state field in @s@ has a lens, usually+--   by using 'Lens.Micro.TH.makeLenses'.+--+-- * Start new animations in 'EventM' with 'startAnimation'; stop them+--   with 'stopAnimation'. Supply clips for new animations with+--   'newClip', 'newClip_', and the clip transformation functions.+--+-- * Call 'renderAnimation' in 'Brick.Main.appDraw' for each animation in the+--   application state.+--+-- * If needed, stop the animation manager with 'stopAnimationManager'.+--+-- See 'AnimationManager' and the docs for the rest of this module for+-- details.+module Brick.Animation+  ( -- * Animation managers+    AnimationManager+  , startAnimationManager+  , stopAnimationManager+  , minTickTime++  -- * Animations+  , Animation+  , animationFrameIndex++  -- * Starting and stopping animations+  , RunMode(..)+  , startAnimation+  , stopAnimation++  -- * Rendering animations+  , renderAnimation++  -- * Creating clips+  , Clip+  , newClip+  , newClip_+  , clipLength++  -- * Transforming clips+  , pingPongClip+  , reverseClip+  )+where++import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread, myThreadId)+import qualified Control.Concurrent.STM as STM+import Control.Monad (forever, when)+import Control.Monad.State.Strict+import Data.Foldable (foldrM)+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+import qualified Data.Vector as V+import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just)+import Lens.Micro.TH (makeLenses)+import Lens.Micro.Mtl++import Brick.BChan+import Brick.Types (EventM, Widget)+import qualified Brick.Animation.Clock as C++-- | A sequence of a animation frames.+newtype Clip s n = Clip (V.Vector (s -> Widget n))+                     deriving (Semigroup)++-- | Get the number of frames in a clip.+clipLength :: Clip s n -> Int+clipLength (Clip fs) = V.length fs++-- | Build a clip.+--+-- Each frame in a clip is represented by a function from a state to a+-- 'Widget'. This allows applications to determine on a per-frame basis+-- what should be drawn in an animation based on application state, if+-- desired, in the same style as 'Brick.Main.appDraw'.+--+-- If the provided list is empty, this calls 'error'.+newClip :: [s -> Widget n] -> Clip s n+newClip [] = error "clip: got an empty list"+newClip fs = Clip $ V.fromList fs++-- | Like 'newClip' but for static frames.+newClip_ :: [Widget n] -> Clip s n+newClip_ ws = newClip $ const <$> ws++-- | Extend a clip so that when the end of the original clip is reached,+-- it continues in reverse order to create a loop.+--+-- For example, if this is given a clip with frames A, B, C, and D, then+-- this returns a clip with frames A, B, C, D, C, and B.+--+-- If the given clip contains less than two frames, this is equivalent+-- to 'id'.+pingPongClip :: Clip s n -> Clip s n+pingPongClip (Clip fs) | V.length fs >= 2 =+    Clip $ fs <> V.reverse (V.init $ V.tail fs)+pingPongClip c = c++-- | Reverse a clip.+reverseClip :: Clip s n -> Clip s n+reverseClip (Clip fs) = Clip $ V.reverse fs++data AnimationManagerRequest s n =+    Tick C.Time+    | StartAnimation (Clip s n) Integer RunMode (Traversal' s (Maybe (Animation s n)))+    -- ^ Clip, frame duration in milliseconds, run mode, updater+    | StopAnimation (Animation s n)+    | Shutdown++-- | The running mode for an animation.+data RunMode =+    Once+    -- ^ Run the animation once and then end+    | Loop+    -- ^ Run the animation in a loop forever+    deriving (Eq, Show, Ord)++newtype AnimationID = AnimationID Int+                    deriving (Eq, Ord, Show, Hashable)++-- | The state of a running animation.+--+-- Put one of these (wrapped in 'Maybe') in your application state for+-- each animation that you'd like to run concurrently.+data Animation s n =+    Animation { animationFrameIndex :: Int+              -- ^ The animation's current frame index, provided for+              -- convenience. Applications won't need to access this in+              -- most situations; use 'renderAnimation' instead.+              , animationID :: AnimationID+              -- ^ The animation's internally-managed ID+              , animationClip :: Clip s n+              -- ^ The animation's clip+              }++-- | Render an animation.+renderAnimation :: (s -> Widget n)+                -- ^ The fallback function to use for drawing if the+                -- animation is not running+                -> s+                -- ^ The state to provide when rendering the animation's+                -- current frame+                -> Maybe (Animation s n)+                -- ^ The animation state itself+                -> Widget n+renderAnimation fallback input mAnim =+    draw input+    where+        draw = fromMaybe fallback $ do+            a <- mAnim+            let idx = animationFrameIndex a+                Clip fs = animationClip a+            fs V.!? idx++data AnimationState s n =+    AnimationState { _animationStateID :: AnimationID+                   , _animationNumFrames :: Int+                   , _animationCurrentFrame :: Int+                   , _animationFrameMilliseconds :: Integer+                   , _animationRunMode :: RunMode+                   , animationFrameUpdater :: Traversal' s (Maybe (Animation s n))+                   , _animationNextFrameTime :: C.Time+                   }++makeLenses ''AnimationState++-- | A manager for animations. The type variables for this type are the+-- same as those for 'Brick.Main.App'.+--+-- This asynchronously manages a set of running animations, advancing+-- each one over time. When a running animation's current frame needs+-- to be changed, the manager sends an 'EventM' update for that+-- animation to the application's event loop to perform the update to+-- the animation in the application state. The manager will batch such+-- updates if more than one animation needs to be changed at a time.+--+-- The manager has a /tick duration/ in milliseconds which is the+-- resolution at which animations are checked to see if they should+-- be updated. Animations also have their own frame duration in+-- milliseconds. For example, if a manager has a tick duration of 50+-- milliseconds and is running an animation with a frame duration of 100+-- milliseconds, then the manager will advance that animation by one+-- frame every two ticks. On the other hand, if a manager has a tick+-- duration of 100 milliseconds and is running an animation with a frame+-- duration of 50 milliseconds, the manager will advance that animation+-- by two frames on each tick.+--+-- Animation managers are started with 'startAnimationManager' and+-- stopped with 'stopAnimationManager'.+--+-- Animations are started with 'startAnimation' and stopped with+-- 'stopAnimation'. Each animation must be associated with an+-- application state field accessible with a traversal given to+-- 'startAnimation'.+--+-- When an animation is started, every time it advances a frame, and+-- when it is ended, the manager communicates these changes to the+-- application by using the custom event constructor provided to+-- 'startAnimationManager'. The manager uses that to schedule a state+-- update which the application is responsible for evaluating. The state+-- updates are built from the traversals provided to 'startAnimation'.+--+-- The manager-updated 'Animation' values in the application state are+-- then drawn with 'renderAnimation'.+--+-- Animations in 'Loop' mode are run forever until stopped with+-- 'stopAnimation'; animations in 'Once' mode run once and are removed+-- from the application state (set to 'Nothing') when they finish. All+-- state updates to the application state are performed by the manager's+-- custom event mechanism; the application never needs to directly+-- modify the 'Animation' application state fields except to initialize+-- them to 'Nothing'.+--+-- There is nothing here to prevent an application from running multiple+-- managers, each at a different tick rate. That may have performance+-- consequences, though, due to the loss of batch efficiency in state+-- updates, so we recommend using only one manager per application at a+-- sufficiently short tick duration.+data AnimationManager s e n =+    AnimationManager { animationMgrRequestThreadId :: ThreadId+                     , animationMgrTickThreadId :: ThreadId+                     , animationMgrOutputChan :: BChan e+                     , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s n)+                     , animationMgrEventConstructor :: EventM n s () -> e+                     , animationMgrRunning :: STM.TVar Bool+                     }++tickThreadBody :: Int+               -> STM.TChan (AnimationManagerRequest s n)+               -> IO ()+tickThreadBody tickMilliseconds outChan = do+    let nextTick = C.addOffset tickOffset+        tickOffset = C.offsetFromMs $ toInteger tickMilliseconds+        go targetTime = do+            now <- C.getTime+            STM.atomically $ STM.writeTChan outChan $ Tick now++            -- threadDelay does not guarantee that we will wake up on+            -- time; it only ensures that we won't wake up earlier than+            -- requested. Since we can therefore oversleep, instead of+            -- always sleeping for tickMilliseconds (which would cause+            -- us to drift off of schedule as delays accumulate) we+            -- determine sleep time by measuring the distance between+            -- now and the next scheduled tick. This is still unreliable+            -- as we can still oversleep, but it keeps the oversleeping+            -- under control over time. It means most ticks may be+            -- slightly late (about 1-2 milliseconds is common) but this+            -- will prevent that per-tick error from accumulating.+            let nextTickTime = nextTick targetTime+                sleepMs = fromInteger $+                          C.offsetToMs $+                          C.subtractTime nextTickTime now++            -- threadDelay works microseconds.+            threadDelay $ sleepMs * 1000+            go nextTickTime++    go =<< C.getTime++setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n+setNextFrameTime t a = a & animationNextFrameTime .~ t++data ManagerState s e n =+    ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n)+                 , _managerStateOutChan :: BChan e+                 , _managerStateEventBuilder :: EventM n s () -> e+                 , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s n)+                 , _managerStateIDVar :: STM.TVar AnimationID+                 }++makeLenses ''ManagerState++animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s n)+                           -> BChan e+                           -> (EventM n s () -> e)+                           -> IO ()+animationManagerThreadBody inChan outChan mkEvent = do+    idVar <- STM.newTVarIO $ AnimationID 1+    let initial = ManagerState { _managerStateInChan = inChan+                               , _managerStateOutChan = outChan+                               , _managerStateEventBuilder = mkEvent+                               , _managerStateAnimations = mempty+                               , _managerStateIDVar = idVar+                               }+    evalStateT runManager initial++type ManagerM s e n a = StateT (ManagerState s e n) IO a++getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s n)+getNextManagerRequest = do+    inChan <- use managerStateInChan+    liftIO $ STM.atomically $ STM.readTChan inChan++sendApplicationStateUpdate :: EventM n s () -> ManagerM s e n ()+sendApplicationStateUpdate act = do+    outChan <- use managerStateOutChan+    mkEvent <- use managerStateEventBuilder+    liftIO $ writeBChan outChan $ mkEvent act++removeAnimation :: AnimationID -> ManagerM s e n ()+removeAnimation aId =+    managerStateAnimations %= HM.delete aId++lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s n))+lookupAnimation aId =+    HM.lookup aId <$> use managerStateAnimations++insertAnimation :: AnimationState s n -> ManagerM s e n ()+insertAnimation a =+    managerStateAnimations %= HM.insert (a^.animationStateID) a++getNextAnimationID :: ManagerM s e n AnimationID+getNextAnimationID = do+    var <- use managerStateIDVar+    liftIO $ STM.atomically $ do+        AnimationID i <- STM.readTVar var+        let next = AnimationID $ i + 1+        STM.writeTVar var next+        return $ AnimationID i++runManager :: ManagerM s e n ()+runManager = forever $ do+    getNextManagerRequest >>= handleManagerRequest++handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n ()+handleManagerRequest (StartAnimation clip frameMs runMode updater) = do+    aId <- getNextAnimationID+    now <- liftIO C.getTime+    let next = C.addOffset frameOffset now+        frameOffset = C.offsetFromMs frameMs+        a = AnimationState { _animationStateID = aId+                           , _animationNumFrames = clipLength clip+                           , _animationCurrentFrame = 0+                           , _animationFrameMilliseconds = frameMs+                           , _animationRunMode = runMode+                           , animationFrameUpdater = updater+                           , _animationNextFrameTime = next+                           }++    insertAnimation a+    sendApplicationStateUpdate $ updater .= Just (Animation { animationID = aId+                                                            , animationFrameIndex = 0+                                                            , animationClip = clip+                                                            })+handleManagerRequest (StopAnimation a) = do+    let aId = animationID a+    mA <- lookupAnimation aId+    case mA of+        Nothing -> return ()+        Just aState -> do+            -- Remove the animation from the manager+            removeAnimation aId++            -- Set the current animation state in the application state+            -- to none+            sendApplicationStateUpdate $ clearStateAction aState+handleManagerRequest Shutdown = do+    as <- HM.elems <$> use managerStateAnimations++    let updater = sequence_ $ clearStateAction <$> as+    when (not $ null as) $ do+        sendApplicationStateUpdate updater++    liftIO $ myThreadId >>= killThread+handleManagerRequest (Tick tickTime) = do+    -- Check all animation states for frame advances+    -- based on the relationship between the tick time+    -- and each animation's next frame time+    mUpdateAct <- checkAnimations tickTime+    case mUpdateAct of+        Nothing -> return ()+        Just act -> sendApplicationStateUpdate act++clearStateAction :: AnimationState s n -> EventM n s ()+clearStateAction a = animationFrameUpdater a .= Nothing++frameUpdateAction :: AnimationState s n -> EventM n s ()+frameUpdateAction a =+    animationFrameUpdater a._Just %=+        (\an -> an { animationFrameIndex = a^.animationCurrentFrame })++updateAnimationState :: C.Time -> AnimationState s n -> AnimationState s n+updateAnimationState now a =+    let differenceMs = C.offsetToMs $+                       C.subtractTime now (a^.animationNextFrameTime)+        numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds))+        newNextTime = C.addOffset (C.offsetFromMs $ numFrames * (a^.animationFrameMilliseconds))+                                  (a^.animationNextFrameTime)++    -- The new frame is obtained by advancing from the current frame by+    -- numFrames.+    in setNextFrameTime newNextTime $ advanceBy numFrames a++checkAnimations :: C.Time -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimations now = do+    let go a updaters = do+          result <- checkAnimation now a+          return $ case result of+              Nothing -> updaters+              Just u  -> u : updaters++    anims <- use managerStateAnimations+    updaters <- foldrM go [] anims++    case updaters of+        [] -> return Nothing+        _ -> return $ Just $ sequence_ updaters++-- For each active animation, check to see if the animation's next frame+-- time has passed. If it has, advance its frame counter as appropriate+-- and schedule its frame index to be updated in the application state.+checkAnimation :: C.Time -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimation now a+    | isFinished a = do+        -- This animation completed in a previous check, so clear it+        -- from the manager and the application state.+        removeAnimation (a^.animationStateID)+        return $ Just $ clearStateAction a+    | (now < a^.animationNextFrameTime) =+        -- This animation is not due for an update, so don't do+        -- anything.+        return Nothing+    | otherwise = do+        -- This animation is still running, so determine how many frames+        -- have elapsed for it and then advance the frame index based+        -- the elapsed time. Also set its next frame time.+        let a' = updateAnimationState now a+        managerStateAnimations %= HM.insert (a'^.animationStateID) a'+        return $ Just $ frameUpdateAction a'++isFinished :: AnimationState s n -> Bool+isFinished a =+    case a^.animationRunMode of+        Once -> a^.animationCurrentFrame == a^.animationNumFrames - 1+        Loop -> False++advanceBy :: Integer -> AnimationState s n -> AnimationState s n+advanceBy n a+    | n <= 0 = a+    | otherwise =+        advanceBy (n - 1) $+        advanceByOne a++advanceByOne :: AnimationState s n -> AnimationState s n+advanceByOne a =+    if a^.animationCurrentFrame == a^.animationNumFrames - 1+    then case a^.animationRunMode of+        Loop -> a & animationCurrentFrame .~ 0+        Once -> a+    else a & animationCurrentFrame %~ (+ 1)++-- | The minimum tick duration in milliseconds allowed by+-- 'startAnimationManager'.+minTickTime :: Int+minTickTime = 25++-- | Start a new animation manager. For full details about how managers+-- work, see 'AnimationManager'.+--+-- If the specified tick duration is less than 'minTickTime', this will+-- call 'error'. This bound is in place to prevent API misuse leading to+-- ticking so fast that the terminal can't keep up with redraws.+startAnimationManager :: (MonadIO m)+                      => Int+                      -- ^ The tick duration for this manager in milliseconds+                      -> BChan e+                      -- ^ The event channel to use to send updates to+                      -- the application (i.e. the same one given to+                      -- e.g. 'Brick.Main.customVty')+                      -> (EventM n s () -> e)+                      -- ^ A constructor for building custom events+                      -- that perform application state updates. The+                      -- application must evaluate these custom events'+                      -- 'EventM' actions in order to record animation+                      -- updates in the application state.+                      -> m (AnimationManager s e n)+startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime =+    error $ "startAnimationManager: tick duration too small (minimum is " <> show minTickTime <> ")"+startAnimationManager tickMilliseconds outChan mkEvent = liftIO $ do+    inChan <- STM.newTChanIO+    reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent+    tickTid <- forkIO $ tickThreadBody tickMilliseconds inChan+    runningVar <- STM.newTVarIO True+    return $ AnimationManager { animationMgrRequestThreadId = reqTid+                              , animationMgrTickThreadId = tickTid+                              , animationMgrEventConstructor = mkEvent+                              , animationMgrOutputChan = outChan+                              , animationMgrInputChan = inChan+                              , animationMgrRunning = runningVar+                              }++-- | Execute the specified action only when this manager is running.+whenRunning :: (MonadIO m) => AnimationManager s e n -> IO () -> m ()+whenRunning mgr act = do+    running <- liftIO $ STM.atomically $ STM.readTVar (animationMgrRunning mgr)+    when running $ liftIO act++-- | Stop the animation manager, ending all running animations.+stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m ()+stopAnimationManager mgr =+    whenRunning mgr $ do+        tellAnimationManager mgr Shutdown+        killThread $ animationMgrTickThreadId mgr+        STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False++-- | Send a request to an animation manager.+tellAnimationManager :: (MonadIO m)+                     => AnimationManager s e n+                     -- ^ The manager+                     -> AnimationManagerRequest s n+                     -- ^ The request to send+                     -> m ()+tellAnimationManager mgr req =+    liftIO $+    STM.atomically $+    STM.writeTChan (animationMgrInputChan mgr) req++-- | Start a new animation at its first frame.+--+-- This will result in an application state update to initialize the+-- animation state at the provided traversal's location.+startAnimation :: (MonadIO m)+               => AnimationManager s e n+               -- ^ The manager to run the animation+               -> Clip s n+               -- ^ The frames for the animation+               -> Integer+               -- ^ The animation's frame duration in milliseconds+               -> RunMode+               -- ^ The animation's run mode+               -> Traversal' s (Maybe (Animation s n))+               -- ^ Where in the application state to manage this+               -- animation's state+               -> m ()+startAnimation mgr frames frameMs runMode updater =+    tellAnimationManager mgr $ StartAnimation frames frameMs runMode updater++-- | Stop an animation.+--+-- This will result in an application state update to remove the+-- animation state.+stopAnimation :: (MonadIO m)+              => AnimationManager s e n+              -> Animation s n+              -> m ()+stopAnimation mgr a =+    tellAnimationManager mgr $ StopAnimation a
+ src/Brick/Animation/Clock.hs view
@@ -0,0 +1,64 @@+-- | This module provides an API for working with+-- 'Data.Time.Clock.System.SystemTime' values similar to that of+-- 'Data.Time.Clock.UTCTime'. @SystemTime@s are more efficient to+-- obtain than @UTCTime@s, which is important to avoid animation+-- tick thread delays associated with expensive clock reads. In+-- addition, the @UTCTime@-based API provides unpleasant @Float@-based+-- conversions. Since the @SystemTime@-based API doesn't provide some+-- of the operations we need, and since it is easier to work with at+-- millisecond granularity, it is extended here for internal use.+module Brick.Animation.Clock+  ( Time+  , getTime+  , addOffset+  , subtractTime++  , Offset+  , offsetFromMs+  , offsetToMs+  )+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Time.Clock.System as C++newtype Time = Time C.SystemTime+             deriving (Ord, Eq)++-- | Signed difference in milliseconds+newtype Offset = Offset Integer+               deriving (Ord, Eq)++offsetFromMs :: Integer -> Offset+offsetFromMs = Offset++offsetToMs :: Offset -> Integer+offsetToMs (Offset ms) = ms++getTime :: (MonadIO m) => m Time+getTime = Time <$> liftIO C.getSystemTime++addOffset :: Offset -> Time -> Time+addOffset (Offset ms) (Time (C.MkSystemTime s ns)) =+    Time $ C.MkSystemTime (fromInteger s') (fromInteger ns')+    where+        -- Note that due to the behavior of divMod, this works even when+        -- the offset is negative: the number of seconds is decremented+        -- and the remainder of nanoseconds is correct.+        s' = newSec + toInteger s+        (newSec, ns') = (nsPerMs * ms + toInteger ns)+                          `divMod` (msPerS * nsPerMs)++subtractTime :: Time -> Time -> Offset+subtractTime t1 t2 = Offset $ timeToMs t1 - timeToMs t2++timeToMs :: Time -> Integer+timeToMs (Time (C.MkSystemTime s ns)) =+    (toInteger s) * msPerS ++    (toInteger ns) `div` nsPerMs++nsPerMs :: Integer+nsPerMs = 1000000++msPerS :: Integer+msPerS = 1000
src/Brick/AttrMap.hs view
@@ -2,9 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} -- | This module provides types and functions for managing an attribute -- map which maps attribute names ('AttrName') to attributes ('Attr').--- This module is designed to be used with the 'OverloadedStrings'--- language extension to permit easy construction of 'AttrName' values--- and you should also use 'mappend' ('<>') to combine names. -- -- Attribute maps work by mapping hierarchical attribute names to -- attributes and inheriting parent names' attributes when child names@@ -17,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@@ -30,6 +27,7 @@   -- * Construction   , attrMap   , forceAttrMap+  , forceAttrMapAllowStyle   , attrName   -- * Inspection   , attrNameComponents@@ -45,19 +43,13 @@   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-import Data.Monoid-#endif- import qualified Data.Semigroup as Sem  import Control.DeepSeq import Data.Bits ((.|.)) import qualified Data.Map as M-import Data.Maybe (catMaybes)+import Data.Maybe (mapMaybe) import Data.List (inits)-import Data.String (IsString(..)) import GHC.Generics (Generic)  import Graphics.Vty (Attr(..), MaybeDefault(..), Style)@@ -70,9 +62,9 @@ -- example: -- -- @--- "window" <> "border"--- "window" <> "title"--- "header" <> "clock" <> "seconds"+-- attrName "window" <> attrName "border"+-- attrName "window" <> attrName "title"+-- attrName "header" <> attrName "clock" <> attrName "seconds" -- @ data AttrName = AttrName [String]               deriving (Show, Read, Eq, Ord, Generic, NFData)@@ -84,12 +76,10 @@     mempty = AttrName []     mappend = (Sem.<>) -instance IsString AttrName where-    fromString = AttrName . (:[])- -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr)              | ForceAttr Attr+             | ForceAttrAllowStyle Attr AttrMap              deriving (Show, Generic, NFData)  -- | Create an attribute name from a string.@@ -111,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@@ -134,6 +129,7 @@ -- @ 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@@ -152,27 +148,36 @@ -- For example: -- -- @--- attrMapLookup ("foo" <> "bar") (attrMap a []) == a--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red)]) == red \`on\` blue--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", red `on` cyan)]) == red \`on\` cyan--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo" <> "bar", fg red), ("foo", bg cyan)]) == red \`on\` cyan--- attrMapLookup ("foo" <> "bar") (attrMap (bg blue) [("foo", fg red)]) == red \`on\` blue+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap a []) == a+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", fg red)]) == red \`on\` blue+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", red `on` cyan)]) == red \`on\` cyan+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo" <> attrName "bar", fg red), ("foo", bg cyan)]) == red \`on\` cyan+-- attrMapLookup (attrName "foo" <> attrName "bar") (attrMap (bg blue) [(attrName "foo", fg red)]) == red \`on\` blue -- @ attrMapLookup :: AttrName -> AttrMap -> Attr attrMapLookup _ (ForceAttr a) = a+attrMapLookup a (ForceAttrAllowStyle forced m) =+    -- Look up the attribute in the contained map, then keep only its+    -- style.+    let result = attrMapLookup a m+    in forced { attrStyle = attrStyle forced `combineStyles` attrStyle result+              } attrMapLookup (AttrName []) (AttrMap theDefault _) = theDefault attrMapLookup (AttrName ns) (AttrMap theDefault m) =-    let results = catMaybes $ (\n -> M.lookup n m) <$> (AttrName <$> (inits ns))+    let results = mapMaybe (\n -> M.lookup (AttrName n) m) (inits ns)     in foldl combineAttrs theDefault results  -- | Set the default attribute value in an attribute map. setDefaultAttr :: Attr -> AttrMap -> AttrMap setDefaultAttr _ (ForceAttr a) = ForceAttr a+setDefaultAttr newDefault (ForceAttrAllowStyle a m) =+    ForceAttrAllowStyle a (setDefaultAttr newDefault m) setDefaultAttr newDefault (AttrMap _ m) = AttrMap newDefault m  -- | Get the default attribute value in an attribute map. getDefaultAttr :: AttrMap -> Attr getDefaultAttr (ForceAttr a) = a+getDefaultAttr (ForceAttrAllowStyle _ m) = getDefaultAttr m getDefaultAttr (AttrMap d _) = d  combineAttrs :: Attr -> Attr -> Attr@@ -197,6 +202,7 @@ applyAttrMappings :: [(AttrName, Attr)] -> AttrMap -> AttrMap applyAttrMappings _ (ForceAttr a) = ForceAttr a applyAttrMappings ms (AttrMap d m) = AttrMap d ((M.fromList ms) `M.union` m)+applyAttrMappings ms (ForceAttrAllowStyle a m) = ForceAttrAllowStyle a (applyAttrMappings ms m)  -- | Update an attribute map such that a lookup of 'ontoName' returns -- the attribute value specified by 'fromName'.  This is useful for
src/Brick/BChan.hs view
@@ -8,10 +8,6 @@   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif- import Control.Concurrent.STM.TBQueue import Control.Monad.STM (atomically, orElse)
src/Brick/BorderMap.hs view
@@ -1,13 +1,12 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} module Brick.BorderMap     ( BorderMap     , Edges(..)     , eTopL, eBottomL, eRightL, eLeftL-    , empty, emptyCoordinates, singleton+    , empty, clear, emptyCoordinates, singleton     , insertH, insertV, insert     , unsafeUnion     , coordinates, bounds@@ -18,7 +17,9 @@     ) 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@@ -54,14 +55,23 @@ emptyCoordinates :: Edges Int -> BorderMap a emptyCoordinates cs = BorderMap { _coordinates = cs, _values = pure IM.empty } --- | An empty 'BorderMap' that only tracks the point (0,0).+-- | An empty 'BorderMap' that tracks the same points as the input.+clear :: BorderMap a -> BorderMap b+clear = emptyCoordinates . coordinates++-- | An empty 'BorderMap' that does not track any points. empty :: BorderMap a-empty = emptyCoordinates (pure 0)+empty = emptyCoordinates Edges+    { eTop = 0+    , eBottom = -1+    , eLeft = 0+    , eRight = -1+    }  -- | A 'BorderMap' that tracks only the given the point (and initially maps it -- to the given value). singleton :: Location -> a -> BorderMap a-singleton l v = translate l . insert origin v $ empty+singleton l v = translate l . insert origin v . emptyCoordinates $ pure 0  {-# INLINE coordinates #-} -- | The positions of the edges of the rectangle whose border is retained in a@@ -165,8 +175,8 @@     }     where     bounds' = neighbors coordinates'-    values' = pure gc-        <*> _coordinates m+    values' = gc+        <$> _coordinates m         <*> coordinates'         <*> bounds'         <*> _values m
src/Brick/Focus.hs view
@@ -1,7 +1,5 @@ -- | This module provides a type and functions for handling focus rings -- of values.------ This interface is experimental. module Brick.Focus   ( FocusRing   , focusRing@@ -18,7 +16,7 @@ where  import Lens.Micro ((^.))-import Data.Maybe (listToMaybe)+import Data.List (find) import qualified Data.CircularList as C  import Brick.Types@@ -27,6 +25,7 @@ -- | A focus ring containing a sequence of resource names to focus and a -- currently-focused name. newtype FocusRing n = FocusRing (C.CList n)+                    deriving (Show)  -- | Construct a focus ring from the list of resource names. focusRing :: [n] -> FocusRing n@@ -60,13 +59,13 @@               -> (Bool -> a -> b)               -- ^ A function that takes a value and its focus state.               -> a-              -- ^ The wiget state value that we need to check for focus.+              -- ^ The widget state value that we need to check for focus.               -> b               -- ^ The rest of the computation. withFocusRing ring f a = f (focusGetCurrent ring == Just (getName a)) a  -- | Get the currently-focused resource name from the ring. If the ring--- is emtpy, return 'Nothing'.+-- is empty, return 'Nothing'. focusGetCurrent :: FocusRing n -> Maybe n focusGetCurrent (FocusRing l) = C.focus l @@ -109,8 +108,5 @@                 -> Maybe (CursorLocation n)                 -- ^ The cursor position, if any, that matches the                 -- resource name currently focused by the 'FocusRing'.-focusRingCursor getRing st ls =-    listToMaybe $ filter isCurrent ls-    where-        isCurrent cl = cl^.cursorLocationNameL ==-                       (focusGetCurrent $ getRing st)+focusRingCursor getRing st = find $ \cl ->+    cl^.cursorLocationNameL == focusGetCurrent (getRing st)
src/Brick/Forms.hs view
@@ -3,10 +3,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}--- | NOTE: This API is experimental and will probably change. Please try--- it out! Feedback is very much appreciated, and your patience in the--- face of breaking API changes is also appreciated! It's also worth--- bearing in mind that this API is designed to support a narrow range+{-# 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.@@ -32,6 +31,11 @@ -- 'FormField's combined for a single 'FormFieldState' (e.g. a radio -- button sequence). --+-- To use a 'Form', you must include it within your application state+-- type. You can use 'formState' to access the underlying state whenever+-- you need it. See @programs/FormDemo.hs@ for a complete working+-- example.+-- -- Also note that, by default, forms and their field inputs are -- concatenated together in a 'vBox'. This can be customized on a -- per-field basis and for the entire form by using the functions@@ -45,6 +49,7 @@     Form   , FormFieldState(..)   , FormField(..)+  , FormFieldVisibilityMode(..)    -- * Creating and using forms   , newForm@@ -60,10 +65,13 @@   , setFormConcat   , setFieldConcat   , setFormFocus+  , updateFormState+  , setFieldVisibilityMode    -- * Simple form field constructors   , editTextField   , editShowableField+  , editShowableFieldWithValidate   , editPasswordField   , radioField   , checkboxField@@ -85,7 +93,7 @@ #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif-import Data.Maybe (isJust, isNothing)+import Data.Maybe (fromJust, isJust, isNothing) import Data.List (elemIndex) import Data.Vector (Vector) @@ -99,6 +107,7 @@ import Text.Read (readMaybe)  import Lens.Micro+import Lens.Micro.Mtl  -- | A form field. This represents an interactive input field in the -- form. Its user input is validated and thus converted into a type of@@ -118,12 +127,12 @@               -- ^ A validation function converting this field's state               -- into a value of your choosing. @Nothing@ indicates a               -- validation failure. For example, this might validate-              -- an 'Editor' state value by parsing its text contents s-              -- aan integer and return 'Maybe' 'Int'. This is for pure-              -- avalue validation; if additional validation is required-              -- a(e.g. via 'IO'), use this field's state value in an-              -- aexternal validation routine and use 'setFieldValid' to-              -- afeed the result back into the form.+              -- an 'Editor' state value by parsing its text contents as+              -- an integer and return 'Maybe' 'Int'. This is for pure+              -- value validation; if additional validation is required+              -- (e.g. via 'IO'), use this field's state value in an+              -- external validation routine and use 'setFieldValid' to+              -- feed the result back into the form.               , formFieldExternallyValid :: Bool               -- ^ Whether the field is valid according to an external               -- validation source. Defaults to always being 'True' and@@ -134,12 +143,25 @@               -- ^ A function to render this form field. Parameters are               -- whether the field is currently focused, followed by the               -- field state.-              , formFieldHandleEvent :: BrickEvent n e -> b -> EventM n b-              -- ^ An event handler for this field. This receives the-              -- event and the field state and returns a new field-              -- state.+              , formFieldHandleEvent :: BrickEvent n e -> EventM n b ()+              -- ^ An event handler for this field.               } +-- | How to bring form fields into view when a form is rendered in a+-- viewport with 'viewport'.+data FormFieldVisibilityMode =+    ShowFocusedFieldOnly+    -- ^ Make only the focused field's selected input visible. For+    -- composite fields this will not bring all options into view.+    | ShowCompositeField+    -- ^ Make all inputs in the focused field visible. For composite+    -- fields this will bring all options into view as long as the+    -- viewport is large enough to show them all.+    | ShowAugmentedField+    -- ^ Like 'ShowCompositeField' but includes rendering augmentations+    -- applied with '@@='.+    deriving (Eq, Show)+ -- | A form field state accompanied by the fields that manipulate that -- state. The idea is that some record field in your form state has -- one or more form fields that manipulate that value. This data type@@ -169,6 +191,9 @@                       -- ^ 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.@@ -181,10 +206,14 @@                       , formFieldConcat :: [Widget n] -> Widget n                       -- ^ Concatenation function for this field's input                       -- renderings.+                      , formFieldVisibilityMode :: FormFieldVisibilityMode+                      -- ^ This field's visibility mode for use in+                      -- viewports.                       } -> FormFieldState s e n  -- | A form: a sequence of input fields that manipulate the fields of an--- underlying state that you choose.+-- underlying state that you choose. This value must be stored in the+-- Brick application's state. -- -- Type variables are as follows: --@@ -208,6 +237,8 @@          -- ^ Concatenation function for this form's field renderings.          } +suffixLenses ''Form+ -- | Compose a new rendering augmentation function with the one in the -- form field collection. For example, we might put a label on the left -- side of a form field:@@ -226,6 +257,25 @@     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 }@@ -251,13 +301,13 @@ newForm mkEs s =     let es = mkEs <*> pure s     in Form { formFieldStates = es-            , formFocus       = focusRing $ concat $ formFieldNames <$> es+            , formFocus       = focusRing $ concatMap formFieldNames es             , formState       = s             , formConcatAll   = vBox             }  formFieldNames :: FormFieldState s e n -> [n]-formFieldNames (FormFieldState _ _ fields _ _) = formFieldName <$> fields+formFieldNames (FormFieldState _ _ _ fields _ _ _) = formFieldName <$> fields  -- | A form field for manipulating a boolean value. This represents -- 'True' as @[X] label@ and 'False' as @[ ] label@.@@ -301,9 +351,9 @@ checkboxCustomField lb check rb stLens name label initialState =     let initVal = initialState ^. stLens -        handleEvent (MouseDown n _ _ _) s | n == name = return $ not s-        handleEvent (VtyEvent (EvKey (KChar ' ') [])) s = return $ not s-        handleEvent _ s = return s+        handleEvent (MouseDown n _ _ _) | n == name = modify not+        handleEvent (VtyEvent (EvKey (KChar ' ') [])) = modify not+        handleEvent _ = return ()      in FormFieldState { formFieldState = initVal                       , formFields = [ FormField name Just True@@ -311,14 +361,17 @@                                                  handleEvent                                      ]                       , formFieldLens = stLens+                      , formFieldUpdate =+                          \val _ -> val                       , formFieldRenderHelper = id                       , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly                       } -renderCheckbox :: Char -> Char -> Char -> T.Text -> n -> Bool -> Bool -> Widget n+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 showCursor n (Location (1,0)) 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 " ") <>@@ -327,6 +380,9 @@ -- | 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)@@ -356,8 +412,8 @@                                Just e -> listMoveToElement e l                setList s l = s & stLens .~ (snd <$> listSelectedElement l) -        handleEvent (VtyEvent e) s = handleListEvent e s-        handleEvent _ s = return s+        handleEvent (VtyEvent e) = handleListEvent e+        handleEvent _ = return ()      in FormFieldState { formFieldState = initVal                       , formFields = [ FormField name Just True@@ -365,9 +421,15 @@                                                  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. --@@ -414,12 +476,12 @@                 [(val, _, _)] -> Just val                 _ -> Nothing -        handleEvent _ (MouseDown n _ _ _) s =+        handleEvent _ (MouseDown n _ _ _) =             case lookupOptionValue n of-                Nothing -> return s-                Just v -> return v-        handleEvent new (VtyEvent (EvKey (KChar ' ') [])) _ = return new-        handleEvent _ _ s = return s+                Nothing -> return ()+                Just v -> put v+        handleEvent new (VtyEvent (EvKey (KChar ' ') [])) = put new+        handleEvent _ _ = return ()          optionFields = mkOptionField <$> options         mkOptionField (val, name, label) =@@ -432,28 +494,34 @@     in FormFieldState { formFieldState = initVal                       , formFields = optionFields                       , formFieldLens = stLens+                      , formFieldUpdate = \val _ -> val                       , formFieldRenderHelper = id                       , formFieldConcat = vBox+                      , formFieldVisibilityMode = ShowFocusedFieldOnly                       } -renderRadio :: (Eq a) => Char -> Char -> Char -> a -> n -> T.Text -> Bool -> a -> Widget n+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 showCursor name (Location (1,0)) else id+        csr = if foc then putCursor name (Location (1,0)) else id     in clickable name $        addAttr $ csr $-       hBox [ txt $ T.singleton lb-            , txt $ if isSet then T.singleton check else " "-            , txt $ T.singleton rb <> " " <> label-            ]+       txt $ T.concat+       [ T.singleton lb+       , if isSet then T.singleton check else " "+       , T.singleton rb <> " " <> label+       ]  -- | A form field for using an editor to edit the text representation of -- a value. The other editing fields in this module are special cases of -- 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)@@ -468,7 +536,7 @@           -- the editor's initial contents. The resulting text may           -- contain newlines.           -> ([T.Text] -> Maybe a)-          -- ^ The validation function that converts the editors+          -- ^ The validation function that converts the editor's           -- contents into a valid value of type @a@.           -> ([T.Text] -> Widget n)           -- ^ The rendering function for the editor's contents (see@@ -488,19 +556,23 @@                      then id                      else Z.moveCursor pos         initialText = ini $ initialState ^. stLens-        handleEvent (VtyEvent e) ed = handleEditorEvent e ed-        handleEvent _ ed = return ed      in FormFieldState { formFieldState = initVal                       , formFields = [ FormField n                                                  (val . getEditContents)                                                  True                                                  (\b e -> wrapEditor $ renderEditor renderText b e)-                                                 handleEvent+                                                 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'@@ -509,6 +581,9 @@ -- useful in cases where the user-facing representation of a value -- matches the 'Show' representation exactly, such as with 'Int'. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+-- -- This field responds to all events handled by 'editor', including -- mouse events. editShowableField :: (Ord n, Show n, Read a, Show a)@@ -520,8 +595,39 @@                   -- ^ The initial form state.                   -> FormFieldState s e n editShowableField stLens n =+    editShowableFieldWithValidate stLens n (const True)++-- | A form field using a single-line editor to edit the 'Show' representation+-- of a state field value of type @a@. This automatically uses its 'Read'+-- instance to validate the input, and also accepts an additional user-defined+-- pass for validation. This field is mostly useful in cases where the+-- user-facing representation of a value matches the 'Show' representation+-- exactly, such as with 'Int', but you don't want to accept just /any/ 'Int'.+--+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+--+-- This field responds to all events handled by 'editor', including+-- mouse events.+editShowableFieldWithValidate :: (Ord n, Show n, Read a, Show a)+                              => Lens' s a+                              -- ^ The state lens for this value.+                              -> n+                              -- ^ The resource name for the input field.+                              -> (a -> Bool)+                              -- ^ Additional validation step for input.+                              -- 'True' indicates that the value is+                              -- valid.+                              -> s+                              -- ^ The initial form state.+                              -> FormFieldState s e n+editShowableFieldWithValidate stLens n isValid =     let ini = T.pack . show-        val = readMaybe . T.unpack . T.intercalate "\n"+        val ls = do+            v <- readMaybe $ T.unpack $ T.intercalate "\n" ls+            if isValid v+               then return v+               else Nothing         limit = Just 1         renderText = txt . T.unlines     in editField stLens n limit ini val renderText id@@ -529,6 +635,9 @@ -- | A form field using an editor to edit a text value. Since the value -- is free-form text, it is always valid. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+-- -- This field responds to all events handled by 'editor', including -- mouse events. editTextField :: (Ord n, Show n)@@ -551,6 +660,9 @@ -- value represented as a password. The value is always considered valid -- and is always represented with one asterisk per password character. --+-- This field's attributes are governed by those exported from+-- 'Brick.Widgets.Edit'.+-- -- This field responds to all events handled by 'editor', including -- mouse events. editPasswordField :: (Ord n, Show n)@@ -573,15 +685,22 @@  -- | The namespace for the other form attributes. formAttr :: AttrName-formAttr = "brickForm"+formAttr = attrName "brickForm" --- | The attribute for form input fields with invalid values.+-- | The attribute for form input fields with invalid values. Note that+-- this attribute will affect any field considered invalid and will take+-- priority over any attributes that the field uses to render itself. invalidFormInputAttr :: AttrName-invalidFormInputAttr = formAttr <> "invalidInput"+invalidFormInputAttr = formAttr <> attrName "invalidInput" --- | The attribute for form input fields that have the focus.+-- | The attribute for form input fields that have the focus. Note that+-- this attribute only affects fields that do not already use their own+-- attributes when rendering, such as editor- and list-based fields.+-- Those need to be styled by setting the appropriate attributes; see+-- the documentation for field constructors to find out which attributes+-- need to be configured. focusedFormInputAttr :: AttrName-focusedFormInputAttr = formAttr <> "focusedInput"+focusedFormInputAttr = formAttr <> attrName "focusedInput"  -- | Returns whether all form fields in the form currently have valid -- values according to the fields' validation functions. This is useful@@ -595,8 +714,53 @@ -- force the user to repair invalid inputs before moving on from a form -- editing session. invalidFields :: Form s e n -> [n]-invalidFields f = concat $ getInvalidFields <$> formFieldStates f+invalidFields f = concatMap getInvalidFields (formFieldStates f) +-- | Set the visibility mode of the specified form field's collection+-- when the form is rendered in viewport. This is used to change how+-- focused fields are brought into view when they're outside of view+-- in a viewport and gain focus. In practice, this means this function+-- need only be called on one form field name in a collection in order+-- to affect the visibility behavior of that field's entire input+-- collection.+--+-- There are two visibility modes:+--+-- * 'ShowFocusedFieldOnly' - this is the default behavior. In this+--   mode, when a field receives focus, it is brought into view but+--   other inputs in the same field collection (e.g. a set of radio+--   buttons) will not be brought into view along with it.+--+-- * 'ShowCompositeField' - in this mode, when a field receives focus,+--   all of the inputs in its collection (e.g. a set of radio buttons)+--   are brought into view as long as the viewport is large enough to+--   show them all. If it isn't, the viewport will show as many as space+--   allows.+--+-- * 'ShowAugmentedField' - in this mode, when a field receives focus,+--   all of the inputs in its collection (e.g. a set of radio buttons)+--   and its rendering augmentations (as applied with '@@=') are brought+--   into view as long as the viewport is large enough to show them all.+setFieldVisibilityMode :: (Eq n)+                       => n+                       -- ^ The name of the form field whose visibility mode is to be set.+                       -> FormFieldVisibilityMode+                       -- ^ The mode to set.+                       -> Form s e n+                       -- ^ The form to modify.+                       -> Form s e n+setFieldVisibilityMode n mode form =+    let go1 [] = []+        go1 (s:ss) =+            let s' = case s of+                       FormFieldState st l upd fs rh concatAll _ ->+                           if n `elem` formFieldNames s+                           then FormFieldState st l upd fs rh concatAll mode+                           else s+            in s' : go1 ss++    in form { formFieldStates = go1 (formFieldStates form) }+ -- | Manually indicate that a field has invalid contents. This can be -- useful in situations where validation beyond the form element's -- validator needs to be performed and the result of that validation@@ -613,21 +777,21 @@     let go1 [] = []         go1 (s:ss) =             let s' = case s of-                       FormFieldState st l fs rh concatAll ->+                       FormFieldState st l upd fs rh concatAll visMode ->                            let go2 [] = []                                go2 (f@(FormField fn val _ r h):ff)                                    | n == fn = FormField fn val v r h : ff                                    | otherwise = f : go2 ff-                           in FormFieldState st l (go2 fs) rh concatAll+                           in FormFieldState st l upd (go2 fs) rh concatAll visMode             in s' : go1 ss      in form { formFieldStates = go1 (formFieldStates form) }  getInvalidFields :: FormFieldState s e n -> [n]-getInvalidFields (FormFieldState st _ fs _ _) =+getInvalidFields (FormFieldState st _ _ fs _ _ _) =     let gather (FormField n validate extValid _ _) =-            if (not extValid || (isNothing $ validate st)) then [n] else []-    in concat $ gather <$> fs+            if not extValid || isNothing (validate st) then [n] else []+    in concatMap gather fs  -- | Render a form. --@@ -641,7 +805,9 @@ -- 'invalidFormInputAttr' attribute. -- -- Finally, all of the resulting field renderings are concatenated with--- the form's concatenation function (see 'setFormConcat').+-- the form's concatenation function (see 'setFormConcat'). A visibility+-- request is also issued for the currently-focused form field in case+-- the form is rendered within a viewport. renderForm :: (Eq n) => Form s e n -> Widget n renderForm (Form es fr _ concatAll) =     concatAll $ renderFormFieldState fr <$> es@@ -654,18 +820,27 @@                      => FocusRing n                      -> FormFieldState s e n                      -> Widget n-renderFormFieldState fr (FormFieldState st _ fields helper concatFields) =-    let renderFields [] = []+renderFormFieldState fr (FormFieldState st _ _ fields helper concatFields visMode) =+    let curFocus = focusGetCurrent fr+        foc = case curFocus of+                  Nothing -> False+                  Just n -> n `elem` fieldNames+        maybeVisible = if foc && visMode == ShowCompositeField then visible else id+        renderFields [] = []         renderFields ((FormField n validate extValid renderField _):fs) =             let maybeInvalid = if (isJust $ validate st) && extValid                                then id                                else forceAttr invalidFormInputAttr-                foc = Just n == focusGetCurrent fr-            in maybeInvalid (renderField foc st) : renderFields fs-    in helper $ concatFields $ renderFields fields+                fieldFoc = Just n == curFocus+                maybeFieldVisible = if fieldFoc && visMode == ShowFocusedFieldOnly then visible else id+            in (n, maybeFieldVisible $ maybeInvalid $ renderField fieldFoc st) : renderFields fs+        (fieldNames, renderedFields) = unzip $ renderFields fields+        maybeHelperVisible =+            if foc && visMode == ShowAugmentedField then visible else id+    in maybeHelperVisible $ helper $ maybeVisible $ concatFields renderedFields --- | Dispatch an event to the appropriate form field and return a new--- form. This handles the following events in this order:+-- | Dispatch an event to the currently focused form field. This handles+-- the following events in this order: -- -- * On @Tab@ keypresses, this changes the focus to the next field in --   the form.@@ -690,44 +865,31 @@ -- lens. The external validation flag is ignored during this step to -- ensure that external validators have a chance to get the intermediate -- validated value.-handleFormEvent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n)-handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) f =-    return $ f { formFocus = focusNext $ formFocus f }-handleFormEvent (VtyEvent (EvKey KBackTab [])) f =-    return $ f { formFocus = focusPrev $ formFocus f }-handleFormEvent e@(MouseDown n _ _ _) f =-    handleFormFieldEvent n e $ f { formFocus = focusSetCurrent n (formFocus f) }-handleFormEvent e@(MouseUp n _ _) f =-    handleFormFieldEvent n e $ f { formFocus = focusSetCurrent n (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KUp [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryBefore grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KDown [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryAfter grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KLeft [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryBefore grp n) (formFocus f) }-handleFormEvent e@(VtyEvent (EvKey KRight [])) f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  ->-            case getFocusGrouping f n of-                Nothing -> forwardToCurrent e f-                Just grp -> return $ f { formFocus = focusSetCurrent (entryAfter grp n) (formFocus f) }-handleFormEvent e f = forwardToCurrent e f+handleFormEvent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()+handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) =+    formFocusL %= focusNext+handleFormEvent (VtyEvent (EvKey KBackTab [])) =+    formFocusL %= focusPrev+handleFormEvent e@(MouseDown n _ _ _) = do+    formFocusL %= focusSetCurrent n+    handleFormFieldEvent e n+handleFormEvent e@(MouseUp n _ _) = do+    formFocusL %= focusSetCurrent n+    handleFormFieldEvent e n+handleFormEvent e@(VtyEvent (EvKey KUp [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryBefore grp n)+handleFormEvent e@(VtyEvent (EvKey KDown [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryAfter grp n)+handleFormEvent e@(VtyEvent (EvKey KLeft [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryBefore grp n)+handleFormEvent e@(VtyEvent (EvKey KRight [])) =+    withFocusAndGrouping e $ \n grp ->+        formFocusL %= focusSetCurrent (entryAfter grp n)+handleFormEvent e =+    forwardToCurrent e  getFocusGrouping :: (Eq n) => Form s e n -> n -> Maybe [n] getFocusGrouping f n = findGroup (formFieldStates f)@@ -741,34 +903,52 @@  entryAfter :: (Eq a) => [a] -> a -> a entryAfter as a =-    let Just i = elemIndex a as+    let i = fromJust $ elemIndex a as         i' = if i == length as - 1 then 0 else i + 1     in as !! i'  entryBefore :: (Eq a) => [a] -> a -> a entryBefore as a =-    let Just i = elemIndex a as+    let i = fromJust $ elemIndex a as         i' = if i == 0 then length as - 1 else i - 1     in as !! i' -forwardToCurrent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n)-forwardToCurrent e f =-    case focusGetCurrent (formFocus f) of-        Nothing -> return f-        Just n  -> handleFormFieldEvent n e f+withFocusAndGrouping :: (Eq n)+                     => BrickEvent n e+                     -> (n -> [n] -> EventM n (Form s e n) ())+                     -> EventM n (Form s e n) ()+withFocusAndGrouping e act = do+    foc <- gets formFocus+    case focusGetCurrent foc of+        Nothing -> return ()+        Just n -> do+            f <- get+            case getFocusGrouping f n of+                Nothing -> forwardToCurrent e+                Just grp -> act n grp -handleFormFieldEvent :: (Eq n) => n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)-handleFormFieldEvent n ev f = findFieldState [] (formFieldStates f)-    where-        findFieldState _ [] = return f+withFocus :: (n -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()+withFocus act = do+    foc <- gets formFocus+    case focusGetCurrent foc of+        Nothing -> return ()+        Just n -> act n++forwardToCurrent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()+forwardToCurrent =+    withFocus . handleFormFieldEvent++handleFormFieldEvent :: (Eq n) => BrickEvent n e -> n -> EventM n (Form s e n) ()+handleFormFieldEvent ev n = do+    let findFieldState _ [] = return ()         findFieldState prev (e:es) =             case e of-                FormFieldState st stLens fields helper concatAll -> do+                FormFieldState st stLens upd fields helper concatAll visMode -> do                     let findField [] = return Nothing                         findField (field:rest) =                             case field of                                 FormField n' validate _ _ handleFunc | n == n' -> do-                                    nextSt <- handleFunc ev st+                                    (nextSt, ()) <- nestEventM st (handleFunc ev)                                     -- If the new state validates, go ahead and update                                     -- the form state with it.                                     case validate nextSt of@@ -779,10 +959,12 @@                     result <- findField fields                     case result of                         Nothing -> findFieldState (prev <> [e]) es-                        Just (newSt, maybeSt) ->-                            let newFieldState = FormFieldState newSt stLens fields helper concatAll-                            in return $ f { formFieldStates = prev <> [newFieldState] <> es-                                          , formState = case maybeSt of-                                              Nothing -> formState f-                                              Just s  -> formState f & stLens .~ s-                                          }+                        Just (newSt, maybeSt) -> do+                            let newFieldState = FormFieldState newSt stLens upd fields helper concatAll visMode+                            formFieldStatesL .= prev <> [newFieldState] <> es+                            case maybeSt of+                              Nothing -> return ()+                              Just s  -> formStateL.stLens .= s++    states <- gets formFieldStates+    findFieldState [] states
+ src/Brick/Keybindings.hs view
@@ -0,0 +1,20 @@+-- | The re-exporting catch-all module for the customizable keybindings+-- API.+--+-- To get started using this API, see the documentation in+-- @KeyDispatcher@ as well as the User Guide section on customizable+-- keybindings.+module Brick.Keybindings+  ( module Brick.Keybindings.KeyEvents+  , module Brick.Keybindings.KeyConfig+  , module Brick.Keybindings.KeyDispatcher+  , module Brick.Keybindings.Pretty+  , module Brick.Keybindings.Parse+  )+where++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.KeyDispatcher+import Brick.Keybindings.Pretty+import Brick.Keybindings.Parse
+ src/Brick/Keybindings/KeyConfig.hs view
@@ -0,0 +1,258 @@+-- | This module provides 'KeyConfig' and associated functions. A+-- 'KeyConfig' is the basis for the custom keybinding system in this+-- library.+--+-- To get started, see 'newKeyConfig'. Once a 'KeyConfig' has been+-- constructed, see 'Brick.Keybindings.KeyHandlerMap.keyDispatcher'.+--+-- Since a key configuration can have keys bound to multiple events, it+-- is the application author's responsibility to check for collisions+-- since the nature of the collisions will depend on how the application+-- is implemented. To check for collisions, use the result of+-- 'keyEventMappings'.+module Brick.Keybindings.KeyConfig+  ( KeyConfig+  , newKeyConfig+  , BindingState(..)++  -- * Specifying bindings+  , Binding(..)+  , ToBinding(..)+  , binding+  , fn+  , meta+  , ctrl+  , shift++  -- * Querying KeyConfigs+  , firstDefaultBinding+  , firstActiveBinding+  , allDefaultBindings+  , allActiveBindings+  , keyEventMappings++  -- * Misc+  , keyConfigEvents+  , lookupKeyConfigBindings+  )+where++import Data.List (nub)+import qualified Data.Map.Strict as M+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Set as S+import Data.Maybe (fromMaybe, listToMaybe, catMaybes)+import qualified Graphics.Vty as Vty++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.Normalize++-- | A key binding.+--+-- The easiest way to express 'Binding's is to use the helper functions+-- in this module that work with instances of 'ToBinding', e.g.+--+-- @+-- let ctrlB = 'ctrl' \'b\'+--     shiftX = 'shift' \'x\'+--     ctrlMetaK = 'ctrl' $ 'meta' \'k\'+--     -- Or with Vty keys directly:+--     ctrlDown = 'ctrl' 'Graphics.Vty.Input.KDown'+-- @+data Binding =+    Binding { kbKey :: Vty.Key+            -- ^ The key itself.+            , kbMods :: S.Set Vty.Modifier+            -- ^ The set of modifiers.+            } deriving (Eq, Show, Ord)++-- | Construct a 'Binding'. Modifier order is ignored. If modifiers+-- are given and the binding is for a character key, it is forced to+-- lowercase.+binding :: Vty.Key -> [Vty.Modifier] -> Binding+binding k mods =+    Binding { kbKey = normalizeKey mods k+            , kbMods = S.fromList mods+            }++-- | An explicit configuration of key bindings for a key event.+data BindingState =+    BindingList [Binding]+    -- ^ Bind the event to the specified list of bindings.+    | Unbound+    -- ^ Disable all bindings for the event, including default bindings.+    deriving (Show, Eq, Ord)++-- | A configuration of custom key bindings. A 'KeyConfig'+-- stores everything needed to resolve a key event into one or+-- more key bindings. Make a 'KeyConfig' with 'newKeyConfig',+-- then use it to dispatch to 'KeyEventHandler's with+-- 'Brick.Keybindings.KeyHandlerMap.keyDispatcher'.+--+-- Make a new 'KeyConfig' with 'newKeyConfig'.+--+-- A 'KeyConfig' stores:+--+-- * A collection of named key events, mapping the event type @k@ to+--   'Text' labels.+-- * For each event @k@, optionally store a list of default key bindings+--   for that event.+-- * An optional customized binding list for each event, setting the+--   event to either 'Unbound' or providing explicit overridden bindings+--   with 'BindingList'.+data KeyConfig k =+    KeyConfig { keyConfigCustomBindings :: [(k, BindingState)]+              -- ^ The list of custom binding states for events with+              -- custom bindings. We use a list to ensure that we+              -- preserve key bindings for keys that are mapped to more+              -- than one event. This may be valid or invalid depending+              -- on the events in question; whether those bindings+              -- constitute a collision is up to the application+              -- developer to check.+              , keyConfigEvents :: KeyEvents k+              -- ^ The base mapping of events and their names that is+              -- used in this configuration.+              , keyConfigDefaultBindings :: M.Map k [Binding]+              -- ^ A mapping of events and their default key bindings,+              -- if any.+              }+              deriving (Show, Eq)++-- | Build a 'KeyConfig' with the specified 'KeyEvents' event-to-name+-- mapping, list of default bindings by event, and list of custom+-- bindings by event.+newKeyConfig :: (Ord k)+             => KeyEvents k+             -- ^ The base mapping of key events and names to use.+             -> [(k, [Binding])]+             -- ^ Default bindings by key event, such as from a+             -- configuration file or embedded code. Optional on a+             -- per-event basis.+             -> [(k, BindingState)]+             -- ^ Custom bindings by key event, such as from a+             -- configuration file. Explicitly setting an event to+             -- 'Unbound' here has the effect of disabling its default+             -- bindings. Optional on a per-event basis. Note that this+             -- function does not check for collisions since it is up to+             -- the application to determine whether a key bound to more+             -- than one event constitutes a collision!+             -> KeyConfig k+newKeyConfig evs defaults bindings =+    KeyConfig { keyConfigCustomBindings = bindings+              , keyConfigEvents = evs+              , keyConfigDefaultBindings = M.fromList defaults+              }++-- | Return a list of mappings including each key bound to any event+-- combined with the list of events to which it is bound. This is useful+-- for identifying problematic key binding collisions. Since key binding+-- collisions cannot be determined in general, we leave it up to the+-- application author to determine which key-to-event bindings are+-- problematic.+keyEventMappings :: (Ord k, Eq k) => KeyConfig k -> [(Binding, S.Set k)]+keyEventMappings kc = M.toList resultMap+    where+        -- Get all default bindings+        defaultBindings = M.toList $ keyConfigDefaultBindings kc+        -- Get all explicitly unbound events+        explicitlyUnboundEvents = fmap fst $ filter ((== Unbound) . snd) $ keyConfigCustomBindings kc+        -- Remove explicitly unbound events from the default set of+        -- bindings+        defaultBindingsWithoutUnbound = filter ((`notElem` explicitlyUnboundEvents) . fst) defaultBindings+        -- Now get customized binding lists+        customizedKeybindingLists = catMaybes $ (flip fmap) (keyConfigCustomBindings kc) $ \(k, bState) -> do+            case bState of+                Unbound -> Nothing+                BindingList bs -> Just (k, bs)+        -- Now build a map from binding to event list+        allPairs = defaultBindingsWithoutUnbound <>+                   customizedKeybindingLists+        addBindings m (ev, bs) =+            M.unionWith S.union m $ M.fromList [(b, S.singleton ev) | b <- bs]+        resultMap = foldl addBindings mempty allPairs++-- | Look up the binding state for the specified event. This returns+-- 'Nothing' when the event has no explicitly configured custom+-- 'BindingState'.+lookupKeyConfigBindings :: (Ord k) => KeyConfig k -> k -> Maybe BindingState+lookupKeyConfigBindings kc e = lookup e $ keyConfigCustomBindings kc++-- | A convenience function to return the first result of+-- 'allDefaultBindings', if any.+firstDefaultBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding+firstDefaultBinding kc ev = do+    bs <- M.lookup ev (keyConfigDefaultBindings kc)+    case bs of+        (b:_) -> Just b+        _ -> Nothing++-- | Returns the list of default bindings for the specified event,+-- irrespective of whether the event has been explicitly configured with+-- other bindings or set to 'Unbound'.+allDefaultBindings :: (Ord k) => KeyConfig k -> k -> [Binding]+allDefaultBindings kc ev =+    fromMaybe [] $ M.lookup ev (keyConfigDefaultBindings kc)++-- | A convenience function to return the first result of+-- 'allActiveBindings', if any.+firstActiveBinding :: (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding+firstActiveBinding kc ev = listToMaybe $ allActiveBindings kc ev++-- | Return all active key bindings for the specified event. This+-- returns customized bindings if any have been set in the 'KeyConfig',+-- no bindings if the event has been explicitly set to 'Unbound', or the+-- default bindings if the event is absent from the customized bindings.+allActiveBindings :: (Show k, Ord k) => KeyConfig k -> k -> [Binding]+allActiveBindings kc ev = nub foundBindings+    where+        defaultBindings = allDefaultBindings kc ev+        foundBindings = case lookupKeyConfigBindings kc ev of+            Just (BindingList bs) -> bs+            Just Unbound -> []+            Nothing -> defaultBindings++-- | The class of types that can form the basis of 'Binding's.+--+-- This is provided to make it easy to write and modify bindings in less+-- verbose ways.+class ToBinding a where+    -- | Binding constructor.+    bind :: a -> Binding++instance ToBinding Vty.Key where+    bind k = Binding { kbMods = mempty, kbKey = k }++instance ToBinding Char where+    bind = bind . Vty.KChar++instance ToBinding Binding where+    bind = id++addModifier :: (ToBinding a) => Vty.Modifier -> a -> Binding+addModifier m val =+    let b = bind val+        newMods = S.insert m $ kbMods b+    in b { kbMods = newMods+         , kbKey = normalizeKey (S.toList newMods) $ kbKey b+         }++-- | Add Meta to a binding. If the binding is for a character key, force+-- it to lowercase.+meta :: (ToBinding a) => a -> Binding+meta = addModifier Vty.MMeta++-- | Add Ctrl to a binding. If the binding is for a character key, force+-- it to lowercase.+ctrl :: (ToBinding a) => a -> Binding+ctrl = addModifier Vty.MCtrl++-- | Add Shift to a binding. If the binding is for a character key, force+-- it to lowercase.+shift :: (ToBinding a) => a -> Binding+shift = addModifier Vty.MShift++-- | Function key binding.+fn :: Int -> Binding+fn = bind . Vty.KFun
+ src/Brick/Keybindings/KeyDispatcher.hs view
@@ -0,0 +1,241 @@+-- | This is the entry point into the keybinding infrastructure in+-- this library. Note that usage of this API is not required to create+-- working Brick applications; this API is provided for applications+-- that need to support custom keybindings that are less tightly coupled+-- to application behavior.+--+-- The workflow for this API is as follows:+--+-- * Create a data type @k@ with a constructor for each abstract+--   application event that you want to trigger with an input key.+-- * To each event @k@, assign a unique user-readable name (such as a+--   name you could imagine using in a configuration file to refer to+--   the event) and a list of default key bindings.+-- * Use the resulting data to create a 'KeyConfig' with 'newKeyConfig'.+--   If desired, provide custom keybindings to 'newKeyConfig' from+--   within the program or load them from an INI file with routines like+--   'Brick.Keybindings.Parse.keybindingsFromFile'.+-- * Optionally check for configuration-wide keybinding collisions with+--   'Brick.Keybindings.KeyConfig.keyEventMappings'.+-- * Implement application event handlers that will be run in response+--   to either specific hard-coded keys or events @k@, both in some+--   monad @m@ of your choosing, using constructors 'onKey' and+--   'onEvent'.+-- * Use the created 'KeyConfig' and handlers to create a+--   'KeyDispatcher' with 'keyDispatcher', dealing with collisions if+--   they arise.+-- * As user input events arrive, dispatch them to the appropriate+--   handler in the dispatcher using 'handleKey'.+module Brick.Keybindings.KeyDispatcher+  ( -- * Key dispatching+    KeyDispatcher+  , keyDispatcher+  , handleKey++  -- * Building handlers+  , onEvent+  , onKey++  -- * Handlers and triggers+  , Handler(..)+  , KeyHandler(..)+  , KeyEventHandler(..)+  , EventTrigger(..)++  -- * Misc+  , keyDispatcherToList+  , lookupVtyEvent+  )+where++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Graphics.Vty as Vty+import Data.Function (on)+import Data.List (groupBy, sortBy)++import Brick.Keybindings.KeyConfig++-- | A dispatcher keys that map to abstract events @k@ and whose+-- handlers run in the monad @m@.+newtype KeyDispatcher k m = KeyDispatcher (M.Map Binding (KeyHandler k m))++-- | A 'Handler' represents a handler implementation to be invoked in+-- response to some event that runs in the monad @m@.+--+-- In general, you should never need to make one of these manually.+-- Instead, use 'onEvent' and 'onKey'. This type's internals are exposed+-- for easy inspection, not construction.+data Handler m =+    Handler { handlerDescription :: T.Text+            -- ^ The description of this handler's behavior.+            , handlerAction :: m ()+            -- ^ The action to take when this handler is invoked.+            }++-- | A handler for a specific key.+--+-- In general, you should never need to create one of these manually.+-- The internals are exposed to make inspection easy.+data KeyHandler k m =+    KeyHandler { khHandler :: KeyEventHandler k m+               -- ^ The handler to invoke. Note that this maintains+               -- the original abstract key event handler; this allows+               -- us to obtain the original 'EventTrigger' for the+               -- 'KeyEventHandler' upon which this 'KeyHandler'+               -- is built. This can be important for keybinding+               -- consistency checks or collision checks as well as help+               -- text generation.+               , khBinding :: Binding+               -- ^ The specific key binding that should trigger this+               -- handler.+               }++-- | Find the key handler that matches a Vty key event, if any. Modifier+-- order is unimportant since the lookup for a matching binding ignores+-- modifier order.+--+-- This works by looking up an event handler whose binding is the+-- specified key and modifiers based on the 'KeyConfig' that was used to+-- build the 'KeyDispatcher'.+--+-- Ordinarily you will not need to use this function; use 'handleKey'+-- instead. This is provided for more direct access to the+-- 'KeyDispatcher' internals.+lookupVtyEvent :: Vty.Key -> [Vty.Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)+lookupVtyEvent k mods (KeyDispatcher m) = M.lookup (Binding k $ S.fromList mods) m++-- | Handle a keyboard event by looking it up in the 'KeyDispatcher'+-- and invoking the matching binding's handler if one is found. Return+-- @True@ if the a matching handler was found and run; return @False@ if+-- no matching binding was found.+handleKey :: (Monad m)+          => KeyDispatcher k m+          -- ^ The dispatcher to use.+          -> Vty.Key+          -- ^ The key to handle.+          -> [Vty.Modifier]+          -- ^ The modifiers for the key, if any.+          -> m Bool+handleKey d k mods = do+    case lookupVtyEvent k mods d of+        Just kh -> (handlerAction $ kehHandler $ khHandler kh) >> return True+        Nothing -> return False++-- | Build a 'KeyDispatcher' to dispatch keys to handle events of type+-- @k@ using actions in a Monad @m@. If any collisions are detected,+-- this fails with 'Left' and returns the list of colliding event+-- handlers for each overloaded binding. (Each returned 'KeyHandler'+-- contains the original 'KeyEventHandler' that was used to build it so+-- those can be inspected to understand which handlers are mapped to the+-- same key, either via an abstract key event using 'onEvent' or via a+-- statically configured key using 'onKey'.)+--+-- This works by taking a list of abstract 'KeyEventHandler's and+-- building a 'KeyDispatcher' of event handlers based on specific Vty+-- keys using the provided 'KeyConfig' to map between abstract key+-- events of type @k@ and Vty keys. Event handlers triggered by an event+-- @k@ are set up to be triggered by either the customized bindings for+-- @k@ in the 'KeyConfig', no bindings at all if the 'KeyConfig' has+-- marked @k@ as 'Unbound', or the default bindings for @k@ otherwise.+--+-- Once you have a 'KeyDispatcher', you can dispatch an input key event+-- to it and invoke the corresponding handler (if any) with 'handleKey'.+keyDispatcher :: (Ord k)+              => KeyConfig k+              -> [KeyEventHandler k m]+              -> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)+keyDispatcher conf ks =+    let pairs = buildKeyDispatcherPairs ks conf+        groups = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) pairs+        badGroups = filter ((> 1) . length) groups+        combine :: [(Binding, KeyHandler k m)] -> (Binding, [KeyHandler k m])+        combine as =+            let b = fst $ head as+            in (b, snd <$> as)+    in if null badGroups+       then Right $ KeyDispatcher $ M.fromList pairs+       else Left $ combine <$> badGroups++-- | Convert a key dispatcher to a list of pairs of bindings and their+-- handlers.+keyDispatcherToList :: KeyDispatcher k m+                    -> [(Binding, KeyHandler k m)]+keyDispatcherToList (KeyDispatcher m) = M.toList m++buildKeyDispatcherPairs :: (Ord k)+                        => [KeyEventHandler k m]+                        -> KeyConfig k+                        -> [(Binding, KeyHandler k m)]+buildKeyDispatcherPairs ks conf = pairs+    where+        pairs = mkPair <$> handlers+        mkPair h = (khBinding h, h)+        handlers = concatMap (keyHandlersFromConfig conf) ks++keyHandlersFromConfig :: (Ord k)+                      => KeyConfig k+                      -> KeyEventHandler k m+                      -> [KeyHandler k m]+keyHandlersFromConfig kc eh =+    let allBindingsFor ev | Just (BindingList ks) <- lookupKeyConfigBindings kc ev = ks+                          | Just Unbound <- lookupKeyConfigBindings kc ev = []+                          | otherwise = allDefaultBindings kc ev+        bindings = case kehEventTrigger eh of+            ByKey b    -> [b]+            ByEvent ev -> allBindingsFor ev+    in [ KeyHandler { khHandler = eh, khBinding = b } | b <- bindings ]++mkHandler :: T.Text -> m () -> Handler m+mkHandler msg action =+    Handler { handlerDescription = msg+            , handlerAction = action+            }++-- | Specify a handler for the specified key event.+onEvent :: k+        -- ^ The key event whose bindings should trigger this handler.+        -> T.Text+        -- ^ The description of the handler.+        -> m ()+        -- ^ The handler to invoke.+        -> KeyEventHandler k m+onEvent ev msg action =+    KeyEventHandler { kehHandler = mkHandler msg action+                    , kehEventTrigger = ByEvent ev+                    }++-- | Specify a handler for the specified key.+onKey :: (ToBinding a)+      => a+      -- ^ The binding that should trigger this handler.+      -> T.Text+      -- ^ The description of the handler.+      -> m ()+      -- ^ The handler to invoke.+      -> KeyEventHandler k m+onKey b msg action =+    KeyEventHandler { kehHandler = mkHandler msg action+                    , kehEventTrigger = ByKey $ bind b+                    }++-- | A trigger for an event handler.+data EventTrigger k =+    ByKey Binding+    -- ^ The key event is always triggered by a specific key.+    | ByEvent k+    -- ^ The trigger is an abstract key event.+    deriving (Show, Eq, Ord)++-- | A handler for an abstract key event.+--+-- In general, you should never need to create these manually. Instead,+-- use 'onEvent' and 'onKey'. The internals of this type are exposed to+-- allow inspection of handler data for e.g. custom help generation.+data KeyEventHandler k m =+    KeyEventHandler { kehHandler :: Handler m+                    -- ^ The handler to invoke.+                    , kehEventTrigger :: EventTrigger k+                    -- ^ The trigger for the handler.+                    }
+ src/Brick/Keybindings/KeyEvents.hs view
@@ -0,0 +1,52 @@+-- | This module provides 'KeyEvents', a data type for mapping+-- application-defined abstract events to user-facing names (e.g.+-- for use in configuration files and documentation). This data+-- structure gives you a place to define the correspondence between+-- your application's key events and their names. A 'KeyEvents' also+-- effectively tells the key binding system about the collection of+-- possible abstract events that can be handled.+--+-- A 'KeyEvents' is used to construct a+-- 'Brick.Keybindings.KeyConfig.KeyConfig' with+-- 'Brick.Keybindings.KeyConfig.newKeyConfig'.+module Brick.Keybindings.KeyEvents+  ( KeyEvents+  , keyEvents+  , keyEventsList+  , lookupKeyEvent+  , keyEventName+  )+where++import qualified Data.Bimap as B+import qualified Data.Text as T++-- | A bidirectional mapping between events @k@ and their user-readable+-- names.+data KeyEvents k = KeyEvents (B.Bimap T.Text k)+                 deriving (Eq, Show)++-- | Build a new 'KeyEvents' map from the specified list of events and+-- names. Key event names are stored in lowercase.+--+-- Calls 'error' if any events have the same name (ignoring case) or if+-- multiple names map to the same event.+keyEvents :: (Ord k) => [(T.Text, k)] -> KeyEvents k+keyEvents pairs =+    let m = B.fromList [(T.strip $ T.toLower n, e) | (n, e) <- pairs]+    in if B.size m /= length pairs+       then error "keyEvents: input list contains duplicates by name or by event value"+       else KeyEvents $ B.fromList pairs++-- | Convert the 'KeyEvents' to a list.+keyEventsList :: KeyEvents k -> [(T.Text, k)]+keyEventsList (KeyEvents m) = B.toList m++-- | Look up the specified event name to get its abstract event. The+-- lookup ignores leading and trailing whitespace as well as case.+lookupKeyEvent :: (Ord k) => KeyEvents k -> T.Text -> Maybe k+lookupKeyEvent (KeyEvents m) name = B.lookup (T.strip $ T.toLower name) m++-- | Given an abstract event, get its event name.+keyEventName :: (Ord k) => KeyEvents k -> k -> Maybe T.Text+keyEventName (KeyEvents m) e = B.lookupR e m
+ src/Brick/Keybindings/Normalize.hs view
@@ -0,0 +1,14 @@+module Brick.Keybindings.Normalize+  ( normalizeKey+  )+where++import Data.Char (toLower)+import qualified Graphics.Vty as Vty++-- | A keybinding involving modifiers should have its key character+-- normalized to lowercase since it's impossible to get uppercase keys+-- from the terminal when modifiers are present.+normalizeKey :: [Vty.Modifier] -> Vty.Key -> Vty.Key+normalizeKey (_:_) (Vty.KChar c) = Vty.KChar $ toLower c+normalizeKey _ k = k
+ src/Brick/Keybindings/Parse.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides key binding string parsing functions for use+-- in e.g. reading key bindings from configuration files.+module Brick.Keybindings.Parse+  ( parseBinding+  , parseBindingList+  , normalizeKey++  , keybindingsFromIni+  , keybindingsFromFile+  , keybindingIniParser+  )+where++import Control.Monad (forM)+import Data.Maybe (catMaybes)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Graphics.Vty as Vty+import Text.Read (readMaybe)+import qualified Data.Ini.Config as Ini++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.Normalize++-- | Parse a key binding list into a 'BindingState'.+--+-- A key binding list either the string @"unbound"@ or is a+-- comma-separated list of 'Binding's parsed with 'parseBinding'.+parseBindingList :: T.Text -> Either String BindingState+parseBindingList t =+    if T.toLower t == "unbound"+    then return Unbound+    else BindingList <$> mapM (parseBinding . T.strip) (T.splitOn "," $ T.strip t)++-- | Parse a key binding string. Key binding strings specify zero or+-- more modifier keys and a base key, separated by hyphens.+--+-- @+-- (modifier "-")* key+-- @+--+-- e.g. @c-down@, @backspace@, @ctrl-shift-f1@.+--+-- where each @modifier@ is parsed case-insensitively as follows:+--+-- * @"s", "shift"@: 'Vty.MShift'+-- * @"m", "meta"@: 'Vty.MMeta'+-- * @"a", "alt"@: 'Vty.MAlt'+-- * @"c", "ctrl", "control"@: 'Vty.MCtrl'+--+-- and @key@ is parsed case-insensitively as follows:+--+-- * "f1", "f2", ...: 'Vty.KFun'+-- * "esc": 'Vty.KEsc'+-- * "backspace": 'Vty.KBS'+-- * "enter": 'Vty.KEnter'+-- * "left": 'Vty.KLeft'+-- * "right": 'Vty.KRight'+-- * "up": 'Vty.KUp'+-- * "down": 'Vty.KDown'+-- * "upleft": 'Vty.KUpLeft'+-- * "upright": 'Vty.KUpRight'+-- * "downleft": 'Vty.KDownLeft'+-- * "downright": 'Vty.KDownRight'+-- * "center": 'Vty.KCenter'+-- * "backtab": 'Vty.KBackTab'+-- * "printscreen": 'Vty.KPrtScr'+-- * "pause": 'Vty.KPause'+-- * "insert": 'Vty.KIns'+-- * "home": 'Vty.KHome'+-- * "pgup": 'Vty.KPageUp'+-- * "del": 'Vty.KDel'+-- * "end": 'Vty.KEnd'+-- * "pgdown": 'Vty.KPageDown'+-- * "begin": 'Vty.KBegin'+-- * "menu": 'Vty.KMenu'+-- * "space": @' '@+-- * "tab": @'\\t'@+-- * Otherwise, 'Vty.KChar'+parseBinding :: T.Text -> Either String Binding+parseBinding s = go (T.splitOn "-" $ T.toLower s) []+  where go [k] mods = do+          k' <- pKey k+          return $ binding k' mods+        go (k:ks) mods = do+          m <- case k of+            "s"       -> return Vty.MShift+            "shift"   -> return Vty.MShift+            "m"       -> return Vty.MMeta+            "meta"    -> return Vty.MMeta+            "a"       -> return Vty.MAlt+            "alt"     -> return Vty.MAlt+            "c"       -> return Vty.MCtrl+            "ctrl"    -> return Vty.MCtrl+            "control" -> return Vty.MCtrl+            _         -> Left ("Unknown modifier prefix: " ++ show k)+          go ks (m:mods)+        go [] _ = Left "Empty keybinding not allowed"+        pKey "esc"       = return Vty.KEsc+        pKey "backspace" = return Vty.KBS+        pKey "enter"     = return Vty.KEnter+        pKey "left"      = return Vty.KLeft+        pKey "right"     = return Vty.KRight+        pKey "up"        = return Vty.KUp+        pKey "down"      = return Vty.KDown+        pKey "upleft"    = return Vty.KUpLeft+        pKey "upright"   = return Vty.KUpRight+        pKey "downleft"  = return Vty.KDownLeft+        pKey "downright" = return Vty.KDownRight+        pKey "center"    = return Vty.KCenter+        pKey "backtab"   = return Vty.KBackTab+        pKey "printscreen" = return Vty.KPrtScr+        pKey "pause"     = return Vty.KPause+        pKey "insert"    = return Vty.KIns+        pKey "home"      = return Vty.KHome+        pKey "pgup"      = return Vty.KPageUp+        pKey "del"       = return Vty.KDel+        pKey "end"       = return Vty.KEnd+        pKey "pgdown"    = return Vty.KPageDown+        pKey "begin"     = return Vty.KBegin+        pKey "menu"      = return Vty.KMenu+        pKey "space"     = return (Vty.KChar ' ')+        pKey "tab"       = return (Vty.KChar '\t')+        pKey t+          | T.length t == 1 =+              return (Vty.KChar $ T.last s)+          | Just n <- T.stripPrefix "f" t =+              case readMaybe (T.unpack n) of+                  Nothing -> Left ("Unknown keybinding: " ++ show t)+                  Just i -> return (Vty.KFun i)+          | otherwise = Left ("Unknown keybinding: " ++ show t)++-- | Parse custom key bindings from the specified INI file using the+-- provided event name mapping.+--+-- Each line in the specified section can take the form+--+-- > <event-name> = <"unbound"|[binding,...]>+--+-- where the event name must be a valid event name in the specified+-- 'KeyEvents' and each binding is valid as parsed by 'parseBinding'.+--+-- Returns @Nothing@ if the named section was not found; otherwise+-- returns a (possibly empty) list of binding states for each event in+-- @evs@.+keybindingsFromIni :: KeyEvents k+                   -- ^ The key event name mapping to use to parse the+                   -- configuration data.+                   -> T.Text+                   -- ^ The name of the INI configuration section to+                   -- read.+                   -> T.Text+                   -- ^ The text of the INI document to read.+                   -> Either String (Maybe [(k, BindingState)])+keybindingsFromIni evs section doc =+    Ini.parseIniFile doc (keybindingIniParser evs section)++-- | Parse custom key bindings from the specified INI file path. This+-- does not catch or convert any exceptions resulting from I/O errors.+-- See 'keybindingsFromIni' for details.+keybindingsFromFile :: KeyEvents k+                    -- ^ The key event name mapping to use to parse the+                    -- configuration data.+                    -> T.Text+                    -- ^ The name of the INI configuration section to+                    -- read.+                    -> FilePath+                    -- ^ The path to the INI file to read.+                    -> IO (Either String (Maybe [(k, BindingState)]))+keybindingsFromFile evs section path =+    keybindingsFromIni evs section <$> T.readFile path++-- | The low-level INI parser for custom key bindings used by this+-- module, exported for applications that use the @config-ini@ package.+keybindingIniParser :: KeyEvents k -> T.Text -> Ini.IniParser (Maybe [(k, BindingState)])+keybindingIniParser evs section =+    Ini.sectionMb section $ do+        fmap catMaybes $ forM (keyEventsList evs) $ \(name, e) -> do+            fmap (e,) <$> Ini.fieldMbOf name parseBindingList
+ src/Brick/Keybindings/Pretty.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module provides functions for pretty-printing key bindings+-- and for generating Markdown, plain text, and Brick displays of event+-- handler key binding configurations.+module Brick.Keybindings.Pretty+  (+  -- * Generating help output+    keybindingTextTable+  , keybindingMarkdownTable+  , keybindingHelpWidget++  -- * Pretty-printing primitives+  , ppBinding+  , ppMaybeBinding+  , ppKey+  , ppModifier++  -- * Attributes for Widget rendering+  , keybindingHelpBaseAttr+  , eventNameAttr+  , eventDescriptionAttr+  , keybindingAttr+  )+where++import Brick+import Data.List (sort, intersperse)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import qualified Data.Set as S+import qualified Data.Text as T+import qualified Graphics.Vty as Vty++import Brick.Keybindings.KeyEvents+import Brick.Keybindings.KeyConfig+import Brick.Keybindings.KeyDispatcher++data TextHunk = Verbatim T.Text+              | Comment T.Text++-- | Generate a Markdown document of sections indicating the key binding+-- state for each event handler.+keybindingMarkdownTable :: (Ord k)+                        => KeyConfig k+                        -- ^ The key binding configuration in use.+                        -> [(T.Text, [KeyEventHandler k m])]+                        -- ^ Key event handlers by named section.+                        -> T.Text+keybindingMarkdownTable kc sections = title <> keybindSectionStrings+    where title = "# Keybindings\n"+          keybindSectionStrings = T.concat $ sectionText <$> sections+          sectionText (heading, handlers) =+              mkHeading heading <>+              mkKeybindEventSectionHelp kc keybindEventHelpMarkdown T.unlines handlers+          mkHeading n =+              "\n# " <> n <>+              "\n| Keybinding | Event Name | Description |" <>+              "\n| ---------- | ---------- | ----------- |\n"++-- | Generate a plain text document of sections indicating the key+-- binding state for each event handler.+keybindingTextTable :: (Ord k)+                    => KeyConfig k+                    -- ^ The key binding configuration in use.+                    -> [(T.Text, [KeyEventHandler k m])]+                    -- ^ Key event handlers by named section.+                    -> T.Text+keybindingTextTable kc sections = title <> keybindSectionStrings+    where title = "Keybindings\n===========\n"+          keybindSectionStrings = T.concat $ sectionText <$> sections+          sectionText (heading, handlers) =+              mkHeading heading <>+              mkKeybindEventSectionHelp kc (keybindEventHelpText keybindingWidth eventNameWidth) T.unlines handlers+          keybindingWidth = 15+          eventNameWidth = 30+          mkHeading n =+              "\n" <> n <>+              "\n" <> (T.replicate (T.length n) "=") <>+              "\n"++keybindEventHelpText :: Int -> Int -> (TextHunk, T.Text, [TextHunk]) -> T.Text+keybindEventHelpText width eventNameWidth (evName, desc, evs) =+    let getText (Comment s) = s+        getText (Verbatim s) = s+    in padTo width (T.intercalate ", " $ getText <$> evs) <> " " <>+       padTo eventNameWidth (getText evName) <> " " <>+       desc++padTo :: Int -> T.Text -> T.Text+padTo n s = s <> T.replicate (n - T.length s) " "++mkKeybindEventSectionHelp :: (Ord k)+                          => KeyConfig k+                          -> ((TextHunk, T.Text, [TextHunk]) -> a)+                          -> ([a] -> a)+                          -> [KeyEventHandler k m]+                          -> a+mkKeybindEventSectionHelp kc mkKeybindHelpFunc vertCat kbs =+  vertCat $ mkKeybindHelpFunc <$> (mkKeybindEventHelp kc <$> kbs)++keybindEventHelpMarkdown :: (TextHunk, T.Text, [TextHunk]) -> T.Text+keybindEventHelpMarkdown (evName, desc, evs) =+    let quote s = "`" <> s <> "`"+        format (Comment s) = s+        format (Verbatim s) = quote s+        name = case evName of+            Comment s -> s+            Verbatim s -> quote s+    in "| " <> (T.intercalate ", " $ format <$> evs) <>+       " | " <> name <>+       " | " <> desc <>+       " |"++mkKeybindEventHelp :: (Ord k)+                   => KeyConfig k+                   -> KeyEventHandler k m+                   -> (TextHunk, T.Text, [TextHunk])+mkKeybindEventHelp kc h =+  let trig = kehEventTrigger h+      unbound = [Comment "(unbound)"]+      (label, evText) = case trig of+          ByKey b ->+              (Comment "(non-customizable key)", [Verbatim $ ppBinding b])+          ByEvent ev ->+              let name = maybe (Comment "(unnamed)") Verbatim $ keyEventName (keyConfigEvents kc) ev+              in case lookupKeyConfigBindings kc ev of+                  Nothing ->+                      if not (null (allDefaultBindings kc ev))+                      then (name, Verbatim <$> ppBinding <$> allDefaultBindings kc ev)+                      else (name, unbound)+                  Just Unbound ->+                      (name, unbound)+                  Just (BindingList bs) ->+                      let result = if not (null bs)+                                   then Verbatim <$> ppBinding <$> bs+                                   else unbound+                      in (name, result)+  in (label, handlerDescription $ kehHandler h, evText)++-- | Build a 'Widget' displaying key binding information for a single+-- related group of event handlers. This is provided for convenience+-- so that basic help text for the application's event handlers can be+-- produced and embedded in the UI.+--+-- The resulting widget lists the key events (and keys) bound to the+-- specified handlers, along with the events' names and the list of+-- available key bindings for each handler.+keybindingHelpWidget :: (Ord k)+                     => KeyConfig k+                     -- ^ The key binding configuration in use.+                     -> [KeyEventHandler k m]+                     -- ^ The list of the event handlers to include in+                     -- the help display.+                     -> Widget n+keybindingHelpWidget kc =+    withDefAttr keybindingHelpBaseAttr .+    mkKeybindEventSectionHelp kc keybindEventHelpWidget (vBox . intersperse (str " "))++keybindEventHelpWidget :: (TextHunk, T.Text, [TextHunk]) -> Widget n+keybindEventHelpWidget (evName, desc, evs) =+    let evText = T.intercalate ", " (getText <$> evs)+        getText (Comment s) = s+        getText (Verbatim s) = s+        label = withDefAttr eventNameAttr $ case evName of+            Comment s -> txt s+            Verbatim s -> txt s+    in vBox [ withDefAttr eventDescriptionAttr $ txt desc+            , label <+> txt " = " <+> withDefAttr keybindingAttr (txt evText)+            ]++-- | Pretty-print a 'Binding' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppBinding :: Binding -> T.Text+ppBinding (Binding k mods) =+    T.intercalate "-" $ (ppModifier <$> modifierList mods) <> [ppKey k]++modifierList :: S.Set Vty.Modifier -> [Vty.Modifier]+modifierList = sort . S.toList++-- | Pretty-print a 'Binding' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'; if no binding is given,+-- produce a message indicating no binding.+ppMaybeBinding :: Maybe Binding -> T.Text+ppMaybeBinding Nothing =+    "(no binding)"+ppMaybeBinding (Just b) =+    ppBinding b++-- | Pretty-print a 'Vty.Key' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppKey :: Vty.Key -> T.Text+ppKey (Vty.KChar c)   = ppChar c+ppKey (Vty.KFun n)    = "F" <> (T.pack $ show n)+ppKey Vty.KBackTab    = "BackTab"+ppKey Vty.KEsc        = "Esc"+ppKey Vty.KBS         = "Backspace"+ppKey Vty.KEnter      = "Enter"+ppKey Vty.KUp         = "Up"+ppKey Vty.KDown       = "Down"+ppKey Vty.KLeft       = "Left"+ppKey Vty.KRight      = "Right"+ppKey Vty.KHome       = "Home"+ppKey Vty.KEnd        = "End"+ppKey Vty.KPageUp     = "PgUp"+ppKey Vty.KPageDown   = "PgDown"+ppKey Vty.KDel        = "Del"+ppKey Vty.KUpLeft     = "UpLeft"+ppKey Vty.KUpRight    = "UpRight"+ppKey Vty.KDownLeft   = "DownLeft"+ppKey Vty.KDownRight  = "DownRight"+ppKey Vty.KCenter     = "Center"+ppKey Vty.KPrtScr     = "PrintScreen"+ppKey Vty.KPause      = "Pause"+ppKey Vty.KIns        = "Insert"+ppKey Vty.KBegin      = "Begin"+ppKey Vty.KMenu       = "Menu"++-- | Pretty-print a character in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppChar :: Char -> T.Text+ppChar '\t' = "Tab"+ppChar ' '  = "Space"+ppChar c    = T.singleton c++-- | Pretty-print a 'Vty.Modifier' in the same format that is parsed by+-- 'Brick.Keybindings.Parse.parseBinding'.+ppModifier :: Vty.Modifier -> T.Text+ppModifier Vty.MMeta  = "M"+ppModifier Vty.MAlt   = "A"+ppModifier Vty.MCtrl  = "C"+ppModifier Vty.MShift = "S"++-- | The base attribute for 'Widget' keybinding help.+keybindingHelpBaseAttr :: AttrName+keybindingHelpBaseAttr = attrName "keybindingHelp"++-- | The attribute for event names in keybinding help 'Widget's.+eventNameAttr :: AttrName+eventNameAttr = keybindingHelpBaseAttr <> attrName "eventName"++-- | The attribute for event descriptions in keybinding help 'Widget's.+eventDescriptionAttr :: AttrName+eventDescriptionAttr = keybindingHelpBaseAttr <> attrName "eventDescription"++-- | The attribute for keybinding lists in keybinding help 'Widget's.+keybindingAttr :: AttrName+keybindingAttr = keybindingHelpBaseAttr <> attrName "keybinding"
src/Brick/Main.hs view
@@ -1,17 +1,21 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-} module Brick.Main   ( App(..)   , defaultMain   , customMain   , customMainWithVty+  , customMainWithDefaultVty   , simpleMain   , resizeOrQuit   , simpleApp    -- * Event handler functions-  , continue+  , continueWithoutRedraw   , halt   , suspendAndResume+  , suspendAndResume'+  , makeVisible   , lookupViewport   , lookupExtent   , findClickedExtents@@ -45,21 +49,18 @@   , renderFinal   , getRenderState   , resetRenderState+  , renderWidget   ) where  import qualified Control.Exception as E import Lens.Micro ((^.), (&), (.~), (%~), _1, _2)-import Control.Monad (forever)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State-import Control.Monad.Trans.Reader+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader import Control.Concurrent (forkIO, killThread)-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-import Data.Monoid (mempty)-#endif import qualified Data.Foldable as F+import Data.List (find) import Data.Maybe (listToMaybe) import qualified Data.Map as M import qualified Data.Set as S@@ -73,27 +74,31 @@   , displayBounds   , shutdown   , nextEvent-  , mkVty-  , defaultConfig+  , restoreInputState+  , inputIface   )+import Graphics.Vty.CrossPlatform (mkVty)+import Graphics.Vty.Config (defaultConfig) import Graphics.Vty.Attributes (defAttr)  import Brick.BChan (BChan, newBChan, readBChan, readBChan2, writeBChan)-import Brick.Types (Widget, EventM(..))+import Brick.Types.EventM import Brick.Types.Internal import Brick.Widgets.Internal import Brick.AttrMap  -- | The library application abstraction. Your application's operations--- are represented here and passed to one of the various main functions--- in this module. An application is in terms of an application state--- type 's', an application event type 'e', and a resource name type--- 'n'. In the simplest case 'e' is unused (left polymorphic or set to--- '()'), but you may define your own event type and use 'customMain'--- to provide custom events. The state type is the type of application--- state to be provided by you and iteratively modified by event--- handlers. The resource name type is the type of names you can assign--- to rendering resources such as viewports and cursor locations.+-- are provided in an @App@ and then the @App@ is provided to one of the+-- various main functions in this module. An application @App s e n@+-- is in terms of an application state type @s@, an application event+-- type @e@, and a resource name type @n@. In the simplest case 'e' is+-- unused (left polymorphic or set to @()@), but you may define your own+-- event type and use 'customMain' to provide custom events. The state+-- type @s@ is the type of application state to be provided by you and+-- iteratively modified by event handlers. The resource name type @n@+-- is the type of names you can assign to rendering resources such as+-- viewports and cursor locations. Your application must define this+-- type. data App s e n =     App { appDraw :: s -> [Widget n]         -- ^ This function turns your application state into a list of@@ -106,12 +111,10 @@         -- is that many widgets may request a cursor placement but your         -- application state is what you probably want to use to decide         -- which one wins.-        , appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)-        -- ^ This function takes the current application state and an-        -- event and returns an action to be taken and a corresponding-        -- transformed application state. Possible options are-        -- 'continue', 'suspendAndResume', and 'halt'.-        , appStartEvent :: s -> EventM n s+        , appHandleEvent :: BrickEvent n e -> EventM n s ()+        -- ^ This function handles an event and updates the current+        -- application state.+        , appStartEvent :: EventM n s ()         -- ^ This function gets called once just prior to the first         -- drawing of your application. Here is where you can make         -- initial scrolling requests, for example.@@ -120,8 +123,8 @@         }  -- | The default main entry point which takes an application and an--- initial state and returns the final state returned by a 'halt'--- operation.+-- initial state and returns the final state from 'EventM' once the+-- program exits. defaultMain :: (Ord n)             => App s e n             -- ^ The application.@@ -129,9 +132,9 @@             -- ^ The initial application state.             -> IO s defaultMain app st = do-    let builder = mkVty defaultConfig-    initialVty <- builder-    customMain initialVty builder Nothing app st+    (s, vty) <- customMainWithDefaultVty Nothing app st+    shutdown vty+    return s  -- | A simple main entry point which takes a widget and renders it. This -- event loop terminates when the user presses any key, but terminal@@ -154,7 +157,7 @@ simpleApp w =     App { appDraw = const [w]         , appHandleEvent = resizeOrQuit-        , appStartEvent = return+        , appStartEvent = return ()         , appAttrMap = const $ attrMap defAttr []         , appChooseCursor = neverShowCursor         }@@ -164,44 +167,47 @@ -- a halt. This is a convenience function useful as an 'appHandleEvent' -- value for simple applications using the 'Event' type that do not need -- to get more sophisticated user input.-resizeOrQuit :: s -> BrickEvent n e -> EventM n (Next s)-resizeOrQuit s (VtyEvent (EvResize _ _)) = continue s-resizeOrQuit s _ = halt s--data InternalNext n a = InternalSuspendAndResume (RenderState n) (IO a)-                      | InternalHalt a+resizeOrQuit :: BrickEvent n e -> EventM n s ()+resizeOrQuit (VtyEvent (EvResize _ _)) = return ()+resizeOrQuit _ = halt  readBrickEvent :: BChan (BrickEvent n e) -> BChan e -> IO (BrickEvent n e) readBrickEvent brickChan userChan = either id AppEvent <$> readBChan2 brickChan userChan  runWithVty :: (Ord n)-           => Vty+           => VtyContext            -> BChan (BrickEvent n e)            -> Maybe (BChan e)            -> App s e n            -> RenderState n            -> s-           -> IO (InternalNext n s)-runWithVty vty brickChan mUserChan app initialRS initialSt = do-    pid <- forkIO $ supplyVtyEvents vty brickChan+           -> IO (s, VtyContext)+runWithVty vtyCtx brickChan mUserChan app initialRS initialSt = do     let readEvent = case mUserChan of           Nothing -> readBChan brickChan           Just uc -> readBrickEvent brickChan uc-        runInner rs st = do-          (result, newRS) <- runVty vty readEvent app st (resetRenderState rs)+        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-              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+              Halt ->+                  return (nextSt, newCtx)+              Continue ->+                  runInner newCtx newRS newExtents True nextSt+              ContinueWithoutRedraw ->+                  runInner newCtx newRS newExtents False nextSt +    runInner vtyCtx initialRS mempty True initialSt+ -- | The custom event loop entry point to use when the simpler ones -- don't permit enough control. Returns the final application state -- after the application halts.+--+-- 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.@@ -221,10 +227,38 @@            -- ^ The initial application state.            -> IO s customMain initialVty buildVty mUserChan app initialAppState = do+    let restoreInitialState = restoreInputState $ inputIface initialVty+     (s, vty) <- customMainWithVty initialVty buildVty mUserChan app initialAppState+        `E.catch` (\(e::E.SomeException) -> restoreInitialState >> E.throw e)+     shutdown vty+    restoreInitialState     return s +-- | Like 'customMainWithVty', except that Vty is initialized with the+-- default configuration.+--+-- The returned 'Vty' handle still has control of the terminal. The+-- caller is responsible for calling 'shutdown' to restore the terminal+-- state.+customMainWithDefaultVty :: (Ord n)+                         => Maybe (BChan e)+                         -- ^ An event channel for sending custom+                         -- events to the event loop (you write to this+                         -- channel, the event loop reads from it).+                         -- Provide 'Nothing' if you don't plan on+                         -- sending custom events.+                         -> App s e n+                         -- ^ The application.+                         -> s+                         -- ^ The initial application state.+                         -> IO (s, Vty)+customMainWithDefaultVty mUserChan app initialAppState = do+    let builder = mkVty defaultConfig+    vty <- builder+    customMainWithVty vty builder mUserChan app initialAppState+ -- | Like 'customMain', except the last 'Vty' handle used by the -- application is returned without being shut down with 'shutdown'. This -- allows the caller to re-use the 'Vty' handle for something else, such@@ -248,41 +282,80 @@                   -- ^ The initial application state.                   -> IO (s, Vty) customMainWithVty initialVty buildVty mUserChan app initialAppState = do-    let run vty rs st brickChan = do-            result <- runWithVty vty brickChan mUserChan app rs st-                `E.catch` (\(e::E.SomeException) -> shutdown vty >> E.throw e)-            case result of-                InternalHalt s -> return (s, vty)-                InternalSuspendAndResume newRS action -> do-                    shutdown vty-                    newAppState <- action-                    newVty <- buildVty-                    run newVty (newRS { renderCache = mempty }) newAppState brickChan+    brickChan <- newBChan 20+    vtyCtx <- newVtyContext buildVty (Just initialVty) (writeBChan brickChan . VtyEvent) -    let emptyES = ES [] mempty-        emptyRS = RS M.empty mempty S.empty mempty mempty-        eventRO = EventRO M.empty initialVty mempty emptyRS+    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 -    (st, eState) <- runStateT (runReaderT (runEventM (appStartEvent app initialAppState)) eventRO) emptyES-    let initialRS = RS M.empty (esScrollRequests eState) S.empty mempty []-    brickChan <- newBChan 20-    run initialVty initialRS st brickChan+    (((), 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+                       } -supplyVtyEvents :: Vty -> BChan (BrickEvent n e) -> IO ()-supplyVtyEvents vty chan =-    forever $ do-        e <- nextEvent vty-        writeBChan chan $ VtyEvent e+    (s, ctx) <- runWithVty vtyCtx brickChan mUserChan app initialRS appState+                `E.catch` (\(e::E.SomeException) -> shutdownVtyContext vtyCtx >> E.throw e) +    -- Shut down the context's event thread but do NOT shut down Vty+    -- itself because we want the handle to be live when we return it to+    -- the caller.+    shutdownVtyContextThread ctx+    return (s, vtyContextHandle ctx)++supplyVtyEvents :: Vty -> (Event -> IO ()) -> IO ()+supplyVtyEvents vty putEvent =+    forever $ putEvent =<< nextEvent vty++newVtyContextFrom :: VtyContext -> IO VtyContext+newVtyContextFrom old =+    newVtyContext (vtyContextBuilder old) Nothing (vtyContextPutEvent old)++newVtyContext :: IO Vty -> Maybe Vty -> (Event -> IO ()) -> IO VtyContext+newVtyContext builder handle putEvent = do+    vty <- case handle of+        Just h -> return h+        Nothing -> builder+    tId <- forkIO $ supplyVtyEvents vty putEvent+    return VtyContext { vtyContextHandle = vty+                      , vtyContextBuilder = builder+                      , vtyContextThread = tId+                      , vtyContextPutEvent = putEvent+                      }++shutdownVtyContext :: VtyContext -> IO ()+shutdownVtyContext ctx = do+    shutdown $ vtyContextHandle ctx+    shutdownVtyContextThread ctx++shutdownVtyContextThread :: VtyContext -> IO ()+shutdownVtyContextThread ctx =+    killThread $ vtyContextThread ctx+ runVty :: (Ord n)-       => Vty+       => VtyContext        -> IO (BrickEvent n e)        -> App s e n        -> s        -> RenderState n-       -> IO (Next s, RenderState n)-runVty vty readEvent app appState rs = do-    (firstRS, exts) <- renderApp vty app appState rs+       -> [Extent n]+       -> Bool+       -> IO (s, NextAction, RenderState n, [Extent n], VtyContext)+runVty vtyCtx readEvent app appState rs prevExtents draw = do+    (firstRS, exts) <- if draw+                       then renderApp vtyCtx app appState rs+                       else return (rs, prevExtents)+     e <- readEvent      (e', nextRS, nextExts) <- case e of@@ -291,67 +364,73 @@         -- want the event handler to have access to accurate viewport         -- information.         VtyEvent (EvResize _ _) -> do-            (rs', exts') <- renderApp vty app appState $ firstRS & observedNamesL .~ S.empty+            (rs', exts') <- renderApp vtyCtx app appState $ firstRS & observedNamesL .~ S.empty             return (e, rs', exts')         VtyEvent (EvMouseDown c r button mods) -> do             let matching = findClickedExtents_ (c, r) exts             case matching of-                (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) ->+                (Extent n (Location (ec, er)) _:_) ->                     -- If the clicked extent was registered as                     -- clickable, send a click event. Otherwise, just                     -- send the raw mouse event-                    case n `elem` firstRS^.clickableNamesL of-                        True -> do-                            let localCoords = Location (lc, lr)-                                lc = c - ec + oC-                                lr = r - er + oR+                    if n `elem` firstRS^.clickableNamesL+                    then do+                        let localCoords = Location (lc, lr)+                            lc = c - ec+                            lr = r - er -                                -- If the clicked extent was a viewport,-                                -- adjust the local coordinates by-                                -- adding the viewport upper-left corner-                                -- offset.-                                newCoords = case M.lookup n (viewportMap firstRS) of-                                  Nothing -> localCoords-                                  Just vp -> localCoords & _1 %~ (+ (vp^.vpLeft))-                                                         & _2 %~ (+ (vp^.vpTop))+                            -- If the clicked extent was a viewport,+                            -- adjust the local coordinates by+                            -- adding the viewport upper-left corner+                            -- offset.+                            newCoords = case M.lookup n (viewportMap firstRS) of+                              Nothing -> localCoords+                              Just vp -> localCoords & _1 %~ (+ (vp^.vpLeft))+                                                     & _2 %~ (+ (vp^.vpTop)) -                            return (MouseDown n button mods newCoords, firstRS, exts)-                        False -> return (e, firstRS, exts)+                        return (MouseDown n button mods newCoords, firstRS, exts)+                    else return (e, firstRS, exts)                 _ -> return (e, firstRS, exts)         VtyEvent (EvMouseUp c r button) -> do             let matching = findClickedExtents_ (c, r) exts             case matching of-                (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) ->+                (Extent n (Location (ec, er)) _:_) ->                     -- If the clicked extent was registered as                     -- clickable, send a click event. Otherwise, just                     -- send the raw mouse event-                    case n `elem` firstRS^.clickableNamesL of-                        True -> do-                            let localCoords = Location (lc, lr)-                                lc = c - ec + oC-                                lr = r - er + oR-                                -- If the clicked extent was a viewport,-                                -- adjust the local coordinates by-                                -- adding the viewport upper-left corner-                                -- offset.-                                newCoords = case M.lookup n (viewportMap firstRS) of-                                  Nothing -> localCoords-                                  Just vp -> localCoords & _1 %~ (+ (vp^.vpLeft))-                                                         & _2 %~ (+ (vp^.vpTop))-                            return (MouseUp n button newCoords, firstRS, exts)-                        False -> return (e, firstRS, exts)+                    if n `elem` firstRS^.clickableNamesL+                    then do+                        let localCoords = Location (lc, lr)+                            lc = c - ec+                            lr = r - er+                            -- If the clicked extent was a viewport,+                            -- adjust the local coordinates by+                            -- adding the viewport upper-left corner+                            -- offset.+                            newCoords = case M.lookup n (viewportMap firstRS) of+                              Nothing -> localCoords+                              Just vp -> localCoords & _1 %~ (+ (vp^.vpLeft))+                                                     & _2 %~ (+ (vp^.vpTop))+                        return (MouseUp n button newCoords, firstRS, exts)+                    else return (e, firstRS, exts)                 _ -> return (e, firstRS, exts)         _ -> return (e, firstRS, exts) -    let emptyES = ES [] mempty-        eventRO = EventRO (viewportMap nextRS) vty nextExts nextRS+    let emptyES = ES [] mempty mempty Continue vtyCtx+        eventRO = EventRO (viewportMap nextRS) nextExts nextRS -    (next, eState) <- runStateT (runReaderT (runEventM (appHandleEvent app appState e'))-                                eventRO) emptyES-    return (next, nextRS { rsScrollRequests = esScrollRequests eState-                         , renderCache = applyInvalidations (cacheInvalidateRequests eState) $-                                         renderCache nextRS-                         })+    (((), newAppState), eState) <- runStateT (runStateT (runReaderT (runEventM (appHandleEvent app e'))+                                eventRO) appState) emptyES+    return ( newAppState+           , nextAction eState+           , nextRS { rsScrollRequests = esScrollRequests eState+                    , renderCache = applyInvalidations (cacheInvalidateRequests eState) $+                                    renderCache nextRS+                    , requestedVisibleNames_ = requestedVisibleNames eState+                    }+           , nextExts+           , vtyContext eState+           )  applyInvalidations :: (Ord n) => S.Set (CacheInvalidateRequest n) -> M.Map n v -> M.Map n v applyInvalidations ns cache =@@ -366,51 +445,63 @@ -- information from the most recent rendering. Returns 'Nothing' if -- no such state could be found, either because the name was invalid -- or because no rendering has occurred (e.g. in an 'appStartEvent'--- handler).-lookupViewport :: (Ord n) => n -> EventM n (Maybe Viewport)+-- handler). An important consequence of this behavior is that if this+-- function is called before a viewport is rendered for the first+-- time, no state will be found because the renderer only knows about+-- viewports it has rendered in the most recent rendering. As a result,+-- if you need to make viewport transformations before they are drawn+-- for the first time, you may need to use 'viewportScroll' and its+-- associated functions without relying on this function. Those+-- functions queue up scrolling requests that can be made in advance of+-- the next rendering to affect the viewport.+lookupViewport :: (Ord n) => n -> EventM n s (Maybe Viewport) lookupViewport n = EventM $ asks (M.lookup n . eventViewportMap)  -- | Did the specified mouse coordinates (column, row) intersect the -- specified extent? clickedExtent :: (Int, Int) -> Extent n -> Bool-clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h) _) =+clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h)) =    c >= lc && c < (lc + w) &&    r >= lr && r < (lr + h)  -- | Given a resource name, get the most recent rendering extent for the -- name (if any).-lookupExtent :: (Eq n) => n -> EventM n (Maybe (Extent n))-lookupExtent n = EventM $ asks (listToMaybe . filter f . latestExtents)+lookupExtent :: (Eq n) => n -> EventM n s (Maybe (Extent n))+lookupExtent n = EventM $ asks (find f . latestExtents)     where-        f (Extent n' _ _ _) = n == n'+        f (Extent n' _ _) = n == n'  -- | Given a mouse click location, return the extents intersected by the -- click. The returned extents are sorted such that the first extent in -- the list is the most specific extent and the last extent is the most -- generic (top-level). So if two extents A and B both intersected the -- mouse click but A contains B, then they would be returned [B, A].-findClickedExtents :: (Int, Int) -> EventM n [Extent n]+findClickedExtents :: (Int, Int) -> EventM n s [Extent n] findClickedExtents pos = EventM $ asks (findClickedExtents_ pos . latestExtents)  findClickedExtents_ :: (Int, Int) -> [Extent n] -> [Extent n] findClickedExtents_ pos = reverse . filter (clickedExtent pos)  -- | Get the Vty handle currently in use.-getVtyHandle :: EventM n Vty-getVtyHandle = EventM $ asks eventVtyHandle+getVtyHandle :: EventM n s Vty+getVtyHandle = vtyContextHandle <$> getVtyContext +setVtyContext :: VtyContext -> EventM n s ()+setVtyContext ctx =+    EventM $ lift $ lift $ modify $ \s -> s { vtyContext = ctx }+ -- | Invalidate the rendering cache entry with the specified resource -- name.-invalidateCacheEntry :: (Ord n) => n -> EventM n ()+invalidateCacheEntry :: (Ord n) => n -> EventM n s () invalidateCacheEntry n = EventM $ do-    lift $ modify (\s -> s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert (InvalidateSingle n) $ cacheInvalidateRequests s })  -- | Invalidate the entire rendering cache.-invalidateCache :: (Ord n) => EventM n ()+invalidateCache :: (Ord n) => EventM n s () invalidateCache = EventM $ do-    lift $ modify (\s -> s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s })+    lift $ lift $ modify (\s -> s { cacheInvalidateRequests = S.insert InvalidateEntire $ cacheInvalidateRequests s }) -getRenderState :: EventM n (RenderState n)+getRenderState :: EventM n s (RenderState n) getRenderState = EventM $ asks oldState  resetRenderState :: RenderState n -> RenderState n@@ -418,9 +509,9 @@     s & observedNamesL .~ S.empty       & clickableNamesL .~ mempty -renderApp :: Vty -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n])-renderApp vty app appState rs = do-    sz <- displayBounds $ outputIface vty+renderApp :: (Ord n) => VtyContext -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n])+renderApp vtyCtx app appState rs = do+    sz <- displayBounds $ outputIface $ vtyContextHandle vtyCtx     let (newRS, pic, theCursor, exts) = renderFinal (appAttrMap app appState)                                         (appDraw app appState)                                         sz@@ -428,11 +519,14 @@                                         rs         picWithCursor = case theCursor of             Nothing -> pic { picCursor = NoCursor }-            Just cloc -> pic { picCursor = AbsoluteCursor (cloc^.locationColumnL)-                                                          (cloc^.locationRowL)+            Just cloc -> pic { picCursor = (if cursorLocationVisible cloc+                                            then AbsoluteCursor+                                            else PositionOnly True)+                                           (cloc^.locationColumnL)+                                           (cloc^.locationRowL)                              } -    update vty picWithCursor+    update (vtyContextHandle vtyCtx) picWithCursor      return (newRS, exts) @@ -455,7 +549,7 @@ showCursorNamed :: (Eq n) => n -> [CursorLocation n] -> Maybe (CursorLocation n) showCursorNamed name locs =     let matches l = l^.cursorLocationNameL == Just name-    in listToMaybe $ filter matches locs+    in find matches locs  -- | A viewport scrolling handle for managing the scroll state of -- viewports.@@ -463,38 +557,38 @@     ViewportScroll { viewportName :: n                    -- ^ The name of the viewport to be controlled by                    -- this scrolling handle.-                   , hScrollPage :: Direction -> EventM n ()+                   , hScrollPage :: forall s. Direction -> EventM n s ()                    -- ^ Scroll the viewport horizontally by one page in                    -- the specified direction.-                   , hScrollBy :: Int -> EventM n ()+                   , hScrollBy :: forall s. Int -> EventM n s ()                    -- ^ Scroll the viewport horizontally by the                    -- specified number of rows or columns depending on                    -- the orientation of the viewport.-                   , hScrollToBeginning :: EventM n ()+                   , hScrollToBeginning :: forall s. EventM n s ()                    -- ^ Scroll horizontally to the beginning of the                    -- viewport.-                   , hScrollToEnd :: EventM n ()+                   , hScrollToEnd :: forall s. EventM n s ()                    -- ^ Scroll horizontally to the end of the viewport.-                   , vScrollPage :: Direction -> EventM n ()+                   , vScrollPage :: forall s. Direction -> EventM n s ()                    -- ^ Scroll the viewport vertically by one page in                    -- the specified direction.-                   , vScrollBy :: Int -> EventM n ()+                   , vScrollBy :: forall s. Int -> EventM n s ()                    -- ^ Scroll the viewport vertically by the specified                    -- number of rows or columns depending on the                    -- orientation of the viewport.-                   , vScrollToBeginning :: EventM n ()+                   , vScrollToBeginning :: forall s. EventM n s ()                    -- ^ Scroll vertically to the beginning of the viewport.-                   , vScrollToEnd :: EventM n ()+                   , vScrollToEnd :: forall s. EventM n s ()                    -- ^ Scroll vertically to the end of the viewport.-                   , setTop :: Int -> EventM n ()+                   , setTop :: forall s. Int -> EventM n s ()                    -- ^ Set the top row offset of the viewport.-                   , setLeft :: Int -> EventM n ()+                   , setLeft :: forall s. Int -> EventM n s ()                    -- ^ Set the left column offset of the viewport.                    } -addScrollRequest :: (n, ScrollRequest) -> EventM n ()+addScrollRequest :: (n, ScrollRequest) -> EventM n s () addScrollRequest req = EventM $ do-    lift $ modify (\s -> s { esScrollRequests = req : esScrollRequests s })+    lift $ lift $ modify (\s -> s { esScrollRequests = req : esScrollRequests s })  -- | Build a viewport scroller for the viewport with the specified name. viewportScroll :: n -> ViewportScroll n@@ -513,18 +607,59 @@                    }  -- | Continue running the event loop with the specified application--- state.-continue :: s -> EventM n (Next s)-continue = return . Continue+-- state without redrawing the screen. This is faster than 'continue'+-- because it skips the redraw, but the drawback is that you need to+-- be really sure that you don't want a screen redraw. If your state+-- changed in a way that needs to be reflected on the screen, just don't+-- call this; 'EventM' blocks default to triggering redraws when they+-- finish executing. This function is for cases where you know that you+-- did something that won't have an impact on the screen state and you+-- want to save on redraw cost.+continueWithoutRedraw :: EventM n s ()+continueWithoutRedraw =+    EventM $ lift $ lift $ modify $ \es -> es { nextAction = ContinueWithoutRedraw }  -- | Halt the event loop and return the specified application state as -- the final state value.-halt :: s -> EventM n (Next s)-halt = return . Halt+halt :: EventM n s ()+halt =+    EventM $ lift $ lift $ modify $ \es -> es { nextAction = Halt }  -- | Suspend the event loop, save the terminal state, and run the -- specified action. When it returns an application state value, restore--- the terminal state, empty the rendering cache, redraw the application--- from the new state, and resume the event loop.-suspendAndResume :: IO s -> EventM n (Next s)-suspendAndResume = return . SuspendAndResume+-- the terminal state, empty the rendering cache, update the application+-- state with the returned state, and continue execution of the event+-- handler that called this.+--+-- Note that any changes made to the terminal's input state are ignored+-- when Brick resumes execution and are not preserved in the final+-- terminal input state after the Brick application returns the terminal+-- to the user.+suspendAndResume :: (Ord n) => IO s -> EventM n s ()+suspendAndResume act = suspendAndResume' act >>= put++-- | Suspend the event loop, save the terminal state, and run the+-- specified action. When it completes, restore the terminal state,+-- empty the rendering cache, return the result, and continue execution+-- of the event handler that called this.+--+-- Note that any changes made to the terminal's input state are ignored+-- when Brick resumes execution and are not preserved in the final+-- terminal input state after the Brick application returns the terminal+-- to the user.+suspendAndResume' :: (Ord n) => IO a -> EventM n s a+suspendAndResume' act = do+    ctx <- getVtyContext+    liftIO $ shutdownVtyContext ctx+    result <- liftIO act+    setVtyContext =<< (liftIO $ newVtyContextFrom ctx)+    invalidateCache+    return result++-- | Request that the specified UI element be made visible on the+-- next rendering. This is provided to allow event handlers to make+-- visibility requests in the same way that the 'visible' function does+-- at rendering time.+makeVisible :: (Ord n) => n -> EventM n s ()+makeVisible n = EventM $ do+    lift $ lift $ modify (\s -> s { requestedVisibleNames = S.insert n $ requestedVisibleNames s })
− src/Brick/Markup.hs 
@@ -1,60 +0,0 @@--- | This module provides an API for turning "markup" values into--- widgets. This module uses the "Data.Text.Markup" interface in this--- package to assign attributes to substrings in a text string; to--- manipulate markup using (for example) syntax highlighters, see that--- module.-module Brick.Markup-  ( Markup-  , markup-  , (@?)-  , GetAttr(..)-  )-where--import Lens.Micro ((.~), (&), (^.))-import Control.Monad (forM)-import qualified Data.Text as T-import Data.Text.Markup--import Graphics.Vty (Attr, vertCat, horizCat, text', defAttr)--import Brick.AttrMap-import Brick.Types---- | A type class for types that provide access to an attribute in the--- rendering monad.  You probably won't need to instance this.-class GetAttr a where-    -- | Where to get the attribute for this attribute metadata.-    getAttr :: a -> RenderM n Attr--instance GetAttr Attr where-    getAttr a = do-        c <- getContext-        return $ mergeWithDefault a (c^.ctxAttrMapL)--instance GetAttr AttrName where-    getAttr = lookupAttrName---- | Build a piece of markup from text with an assigned attribute name.--- When the markup is rendered, the attribute name will be looked up in--- the rendering context's 'AttrMap' to determine the attribute to use--- for this piece of text.-(@?) :: T.Text -> AttrName -> Markup AttrName-(@?) = (@@)---- | Build a widget from markup.-markup :: (Eq a, GetAttr a) => Markup a -> Widget n-markup m =-    Widget Fixed Fixed $ do-      let markupLines = markupToList m-          mkLine pairs = do-              is <- forM pairs $ \(t, aSrc) -> do-                  a <- getAttr aSrc-                  return $ text' a t-              if null is-                 then do-                     def <- getAttr defAttr-                     return $ text' def $ T.singleton ' '-                 else return $ horizCat is-      lineImgs <- mapM mkLine markupLines-      return $ emptyResult & imageL .~ vertCat lineImgs
src/Brick/Themes.hs view
@@ -6,8 +6,6 @@ -- | Support for representing attribute themes and loading and saving -- theme customizations in INI-style files. ----- The file format is as follows:--- -- Customization files are INI-style files with two sections, both -- optional: @"default"@ and @"other"@. --@@ -30,13 +28,14 @@ -- (without quotes) or a comma-delimited list of one or more of the -- following values (e.g. @"[bold,underline]"@) indicating that all -- of the specified styles be used. Valid styles are @standout@,--- @underline@, @reverseVideo@, @blink@, @dim@, @italic@, and @bold@.+-- @underline@, @reverseVideo@, @blink@, @dim@, @italic@,+-- @strikethrough@, and @bold@. -- -- The @other@ section specifies for each attribute name in the theme -- the same @fg@, @bg@, and @style@ settings as for the default -- attribute. Furthermore, if an attribute name has multiple components, -- the fields in the INI file should use periods as delimiters. For--- example, if a theme has an attribute name (@"foo" <> "bar"@), then+-- example, if a theme has an attribute name (@attrName "foo" <> attrName "bar"@), then -- the file may specify three fields: -- --  * @foo.bar.fg@ - a color specification@@ -49,7 +48,7 @@ -- -- Attribute names with multiple components (e.g. @attr1 <> attr2@) can -- be referenced in customization files by separating the names with--- a dot. For example, the attribute name @"list" <> "selected"@ can be+-- a dot. For example, the attribute name @attrName "list" <> attrName "selected"@ can be -- referenced by using the string "list.selected". module Brick.Themes   ( CustomAttr(..)@@ -251,6 +250,7 @@ allStyles =     [ ("standout", standout)     , ("underline", underline)+    , ("strikethrough", strikethrough)     , ("reversevideo", reverseVideo)     , ("blink", blink)     , ("dim", dim)@@ -403,7 +403,7 @@ attrToCustom :: Attr -> CustomAttr attrToCustom a =     CustomAttr { customFg    = Just $ attrForeColor a-               , customBg    = Just $ attrForeColor a+               , customBg    = Just $ attrBackColor a                , customStyle = case attrStyle a of                    SetTo s -> Just s                    _       -> Nothing
src/Brick/Types.hs view
@@ -1,7 +1,5 @@ -- | Basic types used by this library.-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Brick.Types   ( -- * The Widget type@@ -21,22 +19,34 @@   , vpSize   , vpTop   , vpLeft+  , vpContentSize+  , VScrollBarOrientation(..)+  , HScrollBarOrientation(..)+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , ClickableScrollbarElement(..) -  -- * Event-handling types-  , EventM(..)-  , Next+  -- * Event-handling types and functions+  , EventM   , BrickEvent(..)-  , handleEventLensed+  , nestEventM+  , nestEventM'    -- * Rendering infrastructure   , RenderM   , getContext    -- ** The rendering context-  , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)+  , Context(ctxAttrName, availWidth, availHeight, windowWidth, windowHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)   , attrL   , availWidthL   , availHeightL+  , windowWidthL+  , windowHeightL+  , ctxVScrollBarOrientationL+  , ctxVScrollBarRendererL+  , ctxHScrollBarOrientationL+  , ctxHScrollBarRendererL   , ctxAttrMapL   , ctxAttrNameL   , ctxBorderStyleL@@ -61,6 +71,7 @@    -- * Making lenses   , suffixLenses+  , suffixLensesWith    -- * Dynamic borders   , bordersL@@ -73,106 +84,75 @@    -- * Miscellaneous   , Size(..)-  , Padding(..)   , Direction(..)    -- * Renderer internals (for benchmarking)   , RenderState++  -- * Re-exports for convenience+  , get+  , gets+  , put+  , modify+  , zoom   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-import Data.Monoid (Monoid(..))-#endif--import Lens.Micro (_1, _2, to, (^.), (&), (.~), Lens')+import Lens.Micro (_1, _2, to, (^.)) import Lens.Micro.Type (Getting)-import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)+import Lens.Micro.Mtl (zoom) #if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail) #endif-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader+import Control.Monad.State.Strict+import Control.Monad.Reader import Graphics.Vty (Attr)-import Control.Monad.IO.Class  import Brick.Types.TH import Brick.Types.Internal+import Brick.Types.EventM import Brick.AttrMap (AttrName, attrMapLookup) --- | The type of padding.-data Padding = Pad Int-             -- ^ Pad by the specified number of rows or columns.-             | Max-             -- ^ Pad up to the number of available rows or columns.---- | A convenience function for handling events intended for values--- that are targets of lenses in your application state. This function--- obtains the target value of the specified lens, invokes 'handleEvent'--- on it, and stores the resulting transformed value back in the state--- using the lens.-handleEventLensed :: a-                  -- ^ The state value.-                  -> Lens' a b-                  -- ^ The lens to use to extract and store the target-                  -- of the event.-                  -> (e -> b -> EventM n b)-                  -- ^ The event handler.-                  -> e-                  -- ^ The event to handle.-                  -> EventM n a-handleEventLensed v target handleEvent ev = do-    newB <- handleEvent ev (v^.target)-    return $ v & target .~ newB---- | The monad in which event handlers run. Although it may be tempting--- to dig into the reader value yourself, just use--- 'Brick.Main.lookupViewport'.-newtype EventM n a =-    EventM { runEventM :: ReaderT (EventRO n) (StateT (EventState n) IO) a-           }-           deriving ( Functor, Applicative, Monad, MonadIO-                    , MonadThrow, MonadCatch, MonadMask, MonadFail-                    )---- | 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-           }---- | The type of the rendering monad. This monad is used by the--- library's rendering routines to manage rendering state and--- communicate rendering parameters to widgets' rendering functions.-type RenderM n a = ReaderT Context (State (RenderState n)) a+-- | Given a state value and an 'EventM' that mutates that state, run+-- the specified action and return resulting modified state.+nestEventM' :: a+           -- ^ The initial state to use in the nested action.+            -> EventM n a b+            -- ^ The action to run.+            -> EventM n s a+nestEventM' s act = fst <$> nestEventM s act --- | Get the current rendering context.-getContext :: RenderM n Context-getContext = ask+-- | Given a state value and an 'EventM' that mutates that state, run+-- the specified action and return both the resulting modified state and+-- the result of the action itself.+nestEventM :: a+           -- ^ The initial state to use in the nested action.+           -> EventM n a b+           -- ^ The action to run.+           -> EventM n s (a, b)+nestEventM s' act = do+    ro <- EventM ask+    es <- EventM $ lift $ lift get+    vtyCtx <- getVtyContext+    let stInner = ES { nextAction = Continue+                     , esScrollRequests = esScrollRequests es+                     , cacheInvalidateRequests = cacheInvalidateRequests es+                     , requestedVisibleNames = requestedVisibleNames es+                     , vtyContext = vtyCtx+                     }+    ((actResult, newSt), stInnerFinal) <- liftIO $ runStateT (runStateT (runReaderT (runEventM act) ro) s') stInner -suffixLenses ''Context+    EventM $ lift $ lift $ modify $+        \st -> st { nextAction = nextAction stInnerFinal+                  , esScrollRequests = esScrollRequests stInnerFinal+                  , cacheInvalidateRequests = cacheInvalidateRequests stInnerFinal+                  , requestedVisibleNames = requestedVisibleNames stInnerFinal+                  , vtyContext = vtyContext stInnerFinal+                  }+    return (newSt, actResult)  -- | The rendering context's current drawing attribute.-attrL :: forall r. Getting r Context Attr+attrL :: forall r n. Getting r (Context n) Attr attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL))  instance TerminalLocation (CursorLocation n) where
src/Brick/Types/Common.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE CPP #-} module Brick.Types.Common   ( Location(..)   , locL@@ -16,10 +17,14 @@ import GHC.Generics import Control.DeepSeq import Lens.Micro (_1, _2)+#if MIN_VERSION_microlens(0,5,0)+import Lens.Micro.FieldN (Field1, Field2)+#else import Lens.Micro.Internal (Field1, Field2)+#endif  -- | A terminal screen location.-data Location = Location { loc :: (Int, Int)+data Location = Location { loc :: !(Int, Int)                          -- ^ (Column, Row)                          }                 deriving (Show, Eq, Ord, Read, Generic, NFData)@@ -43,7 +48,7 @@     mempty = origin     mappend = (Sem.<>) -data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }+data Edges a = Edges { eTop, eBottom, eLeft, eRight :: !a }     deriving (Eq, Ord, Read, Show, Functor, Generic, NFData)  suffixLenses ''Edges
+ src/Brick/Types/EventM.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Brick.Types.EventM+  ( EventM(..)+  , getVtyContext+  )+where++import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif+import Control.Monad.Reader+import Control.Monad.State.Strict+import Lens.Micro.Mtl+import Lens.Micro.Mtl.Internal++import Brick.Types.Internal++-- | The monad in which event handlers run.+newtype EventM n s a =+    EventM { runEventM :: ReaderT (EventRO n) (StateT s (StateT (EventState n) IO)) a+           }+           deriving ( Functor, Applicative, Monad, MonadIO+                    , MonadThrow, MonadCatch, MonadMask+#if !MIN_VERSION_base(4,13,0)+                    , MonadFail+#endif+                    )++instance MonadState s (EventM n s) where+    get = EventM $ lift get+    put = EventM . lift . put++getVtyContext :: EventM n s VtyContext+getVtyContext = EventM $ lift $ lift $ gets vtyContext++type instance Zoomed (EventM n s) = Zoomed (StateT s (StateT (EventState n) IO))++instance Zoom (EventM n s) (EventM n t) s t where+    zoom l (EventM m) = EventM (zoom l m)
src/Brick/Types/Internal.hs view
@@ -19,10 +19,36 @@   , CursorLocation(..)   , cursorLocationL   , cursorLocationNameL+  , cursorLocationVisibleL+  , VScrollBarOrientation(..)+  , HScrollBarOrientation(..)+  , VScrollbarRenderer(..)+  , HScrollbarRenderer(..)+  , ClickableScrollbarElement(..)   , Context(..)+  , ctxAttrMapL+  , ctxAttrNameL+  , ctxBorderStyleL+  , ctxDynBordersL+  , ctxVScrollBarOrientationL+  , ctxVScrollBarRendererL+  , ctxHScrollBarOrientationL+  , ctxHScrollBarRendererL+  , ctxVScrollBarShowHandlesL+  , ctxHScrollBarShowHandlesL+  , ctxVScrollBarClickableConstrL+  , ctxHScrollBarClickableConstrL+  , availWidthL+  , availHeightL+  , windowWidthL+  , windowHeightL++  , Size(..)+   , EventState(..)+  , VtyContext(..)   , EventRO(..)-  , Next(..)+  , NextAction(..)   , Result(..)   , Extent(..)   , Edges(..)@@ -33,15 +59,22 @@   , dbStyleL, dbAttrL, dbSegmentsL   , CacheInvalidateRequest(..)   , BrickEvent(..)+  , RenderM+  , getContext+  , lookupReportedExtent+  , Widget(..)    , rsScrollRequestsL   , viewportMapL   , clickableNamesL+  , reportedExtentsL   , renderCacheL   , observedNamesL+  , requestedVisibleNames_L   , vpSize   , vpLeft   , vpTop+  , vpContentSize   , imageL   , cursorsL   , extentsL@@ -51,11 +84,11 @@   ) where -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif-+import Control.Concurrent (ThreadId)+import Control.Monad.Reader+import Control.Monad.State.Strict import Lens.Micro (_1, _2, Lens')+import Lens.Micro.Mtl (use) import Lens.Micro.TH (makeLenses) import qualified Data.Set as S import qualified Data.Map as M@@ -70,68 +103,195 @@ import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) -data ScrollRequest = HScrollBy Int-                   | HScrollPage Direction+data ScrollRequest = HScrollBy !Int+                   | HScrollPage !Direction                    | HScrollToBeginning                    | HScrollToEnd-                   | VScrollBy Int-                   | VScrollPage Direction+                   | VScrollBy !Int+                   | VScrollPage !Direction                    | VScrollToBeginning                    | VScrollToEnd-                   | SetTop Int-                   | SetLeft Int+                   | SetTop !Int+                   | SetLeft !Int                    deriving (Read, Show, Generic, NFData) +-- | Widget size policies. These policies communicate how a widget uses+-- space when being rendered. These policies influence rendering order+-- and space allocation in the box layout algorithm for 'hBox' and+-- 'vBox'.+data Size = Fixed+          -- ^ Widgets advertising this size policy should take up the+          -- same amount of space no matter how much they are given,+          -- i.e. their size depends on their contents alone rather than+          -- on the size of the rendering area.+          | Greedy+          -- ^ Widgets advertising this size policy must take up all the+          -- space they are given.+          deriving (Show, Eq, Ord)++-- | The type of widgets.+data Widget n =+    Widget { hSize :: !Size+           -- ^ This widget's horizontal growth policy+           , vSize :: !Size+           -- ^ This widget's vertical growth policy+           , render :: RenderM n (Result n)+           -- ^ This widget's rendering function+           }++data RenderState n =+    RS { viewportMap :: !(M.Map n Viewport)+       , rsScrollRequests :: ![(n, ScrollRequest)]+       , observedNames :: !(S.Set n)+       , renderCache :: !(M.Map n ([n], Result n))+       , clickableNames :: ![n]+       , requestedVisibleNames_ :: !(S.Set n)+       , reportedExtents :: !(M.Map n (Extent n))+       } deriving (Read, Show, Generic, NFData)++-- | The type of the rendering monad. This monad is used by the+-- library's rendering routines to manage rendering state and+-- communicate rendering parameters to widgets' rendering functions.+type RenderM n a = ReaderT (Context n) (State (RenderState n)) a++-- | Get the current rendering context.+getContext :: RenderM n (Context n)+getContext = ask++-- | Orientations for vertical scroll bars.+data VScrollBarOrientation = OnLeft | OnRight+                           deriving (Show, Eq)++-- | Orientations for horizontal scroll bars.+data HScrollBarOrientation = OnBottom | OnTop+                           deriving (Show, Eq)++-- | A vertical scroll bar renderer.+data VScrollbarRenderer n =+    VScrollbarRenderer { renderVScrollbar :: Widget n+                       -- ^ How to render the body of the scroll bar.+                       -- This should provide a widget that expands in+                       -- whatever direction(s) this renderer will be+                       -- used for. So, for example, this widget would+                       -- need to be one that expands vertically such as+                       -- @fill@. The same goes for the trough widget.+                       , renderVScrollbarTrough :: Widget n+                       -- ^ How to render the "trough" of the scroll bar+                       -- (the area to either side of the scroll bar+                       -- body). This should expand as described in the+                       -- documentation for the scroll bar field.+                       , renderVScrollbarHandleBefore :: Widget n+                       -- ^ How to render the handle that appears at+                       -- the top or left of the scrollbar. The result+                       -- will be allowed to be at most one row high.+                       , renderVScrollbarHandleAfter :: Widget n+                       -- ^ How to render the handle that appears at the+                       -- bottom or right of the scrollbar. The result+                       -- will be allowed to be at most one row high.+                       , scrollbarWidthAllocation :: Int+                       -- ^ The number of columns that will be allocated+                       -- to the scroll bar. This determines how much+                       -- space the widgets of the scroll bar elements+                       -- can take up. If they use less than this+                       -- amount, padding will be applied between the+                       -- scroll bar and the viewport contents.+                       }++-- | A horizontal scroll bar renderer.+data HScrollbarRenderer n =+    HScrollbarRenderer { renderHScrollbar :: Widget n+                       -- ^ How to render the body of the scroll bar.+                       -- This should provide a widget that expands+                       -- in whatever direction(s) this renderer will+                       -- be used for. So, for example, this widget+                       -- would need to be one that expands horizontally+                       -- such as @fill@. The same goes for the trough+                       -- widget.+                       , renderHScrollbarTrough :: Widget n+                       -- ^ How to render the "trough" of the scroll bar+                       -- (the area to either side of the scroll bar+                       -- body). This should expand as described in the+                       -- documentation for the scroll bar field.+                       , renderHScrollbarHandleBefore :: Widget n+                       -- ^ How to render the handle that appears at the+                       -- top or left of the scrollbar. The result will+                       -- be allowed to be at most one column wide.+                       , renderHScrollbarHandleAfter :: Widget n+                       -- ^ How to render the handle that appears at the+                       -- bottom or right of the scrollbar. The result+                       -- will be allowed to be at most one column wide.+                       , scrollbarHeightAllocation :: Int+                       -- ^ The number of rows that will be allocated to+                       -- the scroll bar. This determines how much space+                       -- the widgets of the scroll bar elements can+                       -- take up. If they use less than this amount,+                       -- padding will be applied between the scroll bar+                       -- and the viewport contents.+                       }+ data VisibilityRequest =-    VR { vrPosition :: Location-       , vrSize :: DisplayRegion+    VR { vrPosition :: !Location+       , vrSize :: !DisplayRegion        }        deriving (Show, Eq, 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, Read, Generic, NFData)  -- | The type of viewports that indicates the direction(s) in which a -- viewport is scrollable.-data ViewportType = Vertical-                  -- ^ Viewports of this type are scrollable only vertically.-                  | Horizontal-                  -- ^ Viewports of this type are scrollable only horizontally.-                  | Both-                  -- ^ Viewports of this type are scrollable vertically and horizontally.-                  deriving (Show, Eq)+data ViewportType =+    Vertical+    -- ^ Viewports of this type are scrollable only vertically.+    | Horizontal+    -- ^ Viewports of this type are scrollable only horizontally.+    | Both+    -- ^ Viewports of this type are scrollable vertically and horizontally.+    deriving (Show, Eq)  data CacheInvalidateRequest n =     InvalidateSingle n     | InvalidateEntire     deriving (Ord, Eq) -data EventState n = ES { esScrollRequests :: [(n, ScrollRequest)]-                       , cacheInvalidateRequests :: S.Set (CacheInvalidateRequest n)-                       }+data EventState n =+    ES { esScrollRequests :: ![(n, ScrollRequest)]+       , cacheInvalidateRequests :: !(S.Set (CacheInvalidateRequest n))+       , requestedVisibleNames :: !(S.Set n)+       , nextAction :: !NextAction+       , vtyContext :: VtyContext+       } +data VtyContext =+    VtyContext { vtyContextBuilder :: !(IO Vty)+               , vtyContextHandle :: !Vty+               , vtyContextThread :: !ThreadId+               , vtyContextPutEvent :: Event -> IO ()+               }+ -- | An extent of a named area: its size, location, and origin.-data Extent n = Extent { extentName      :: n-                       , extentUpperLeft :: Location-                       , extentSize      :: (Int, Int)-                       , extentOffset    :: Location+data Extent n = Extent { extentName      :: !n+                       , extentUpperLeft :: !Location+                       , extentSize      :: !(Int, Int)                        }                        deriving (Show, Read, Generic, NFData)  -- | The type of actions to take upon completion of an event handler.-data Next a = Continue a-            | SuspendAndResume (IO a)-            | Halt a-            deriving Functor+data NextAction =+    Continue+    | ContinueWithoutRedraw+    | Halt  -- | Scrolling direction. data Direction = Up@@ -162,52 +322,50 @@                    -- ^ The location                    , cursorLocationName :: !(Maybe n)                    -- ^ The name of the widget associated with the location+                   , cursorLocationVisible :: !Bool+                   -- ^ Whether the cursor should actually be visible                    }                    deriving (Read, Show, Generic, NFData)  -- | A border character has four segments, one extending in each direction -- (horizontally and vertically) from the center of the character. data BorderSegment = BorderSegment-    { bsAccept :: Bool+    { bsAccept :: !Bool     -- ^ Would this segment be willing to be drawn if a neighbor wanted to     -- connect to it?-    , bsOffer :: Bool+    , bsOffer :: !Bool     -- ^ Does this segment want to connect to its neighbor?-    , bsDraw :: Bool+    , bsDraw :: !Bool     -- ^ Should this segment be represented visually?     } deriving (Eq, Ord, Read, Show, Generic, NFData) -suffixLenses ''BorderSegment- -- | Information about how to redraw a dynamic border character when it abuts -- another dynamic border character. data DynBorder = DynBorder-    { dbStyle :: BorderStyle+    { dbStyle :: !BorderStyle     -- ^ The 'Char's to use when redrawing the border. Also used to filter     -- connections: only dynamic borders with equal 'BorderStyle's will connect     -- to each other.-    , dbAttr :: Attr+    , dbAttr :: !Attr     -- ^ What 'Attr' to use to redraw the border character. Also used to filter     -- connections: only dynamic borders with equal 'Attr's will connect to     -- each other.-    , dbSegments :: Edges BorderSegment+    , dbSegments :: !(Edges BorderSegment)     } deriving (Eq, Read, Show, Generic, NFData) -suffixLenses ''DynBorder- -- | The type of result returned by a widget's rendering function. The -- result provides the image, cursor positions, and visibility requests -- that resulted from the rendering process. data Result n =-    Result { image :: Image+    Result { image :: !Image            -- ^ The final rendered image for a widget-           , cursors :: [CursorLocation n]+           , cursors :: ![CursorLocation n]            -- ^ The list of reported cursor positions for the            -- application to choose from-           , visibilityRequests :: [VisibilityRequest]+           , visibilityRequests :: ![VisibilityRequest]            -- ^ The list of visibility requests made by widgets rendered            -- while rendering this one (used by viewports)-           , extents :: [Extent n]+           , extents :: ![Extent n]            -- Programmer's note: we don't try to maintain the invariant that            -- the size of the borders closely matches the size of the 'image'            -- field. Most widgets don't need to care about borders, and so they@@ -220,61 +378,88 @@            -- If you're writing a widget, this should make it easier for you to            -- do so; but beware this lack of invariant if you are consuming            -- widgets.-           , borders :: BorderMap DynBorder+           , borders :: !(BorderMap DynBorder)            -- ^ Places where we may rewrite the edge of the image when            -- placing this widget next to another one.            }            deriving (Show, Read, Generic, NFData) -suffixLenses ''Result- emptyResult :: Result n-emptyResult = Result emptyImage [] [] [] BM.empty+emptyResult =+    Result { image = emptyImage+           , cursors = []+           , visibilityRequests = []+           , extents = []+           , borders = BM.empty+           }  -- | The type of events.-data BrickEvent n e = VtyEvent Event+data BrickEvent n e = VtyEvent !Event                     -- ^ The event was a Vty event.-                    | AppEvent e+                    | AppEvent !e                     -- ^ The event was an application event.-                    | MouseDown n Button [Modifier] Location+                    | MouseDown !n !Button ![Modifier] !Location                     -- ^ A mouse-down event on the specified region was                     -- received. The 'n' value is the resource name of                     -- the clicked widget (see 'clickable').-                    | MouseUp n (Maybe Button) Location+                    | MouseUp !n !(Maybe Button) !Location                     -- ^ A mouse-up event on the specified region was                     -- received. The 'n' value is the resource name of                     -- the clicked widget (see 'clickable').                     deriving (Show, Eq, Ord) -data RenderState n =-    RS { viewportMap :: M.Map n Viewport-       , rsScrollRequests :: [(n, ScrollRequest)]-       , observedNames :: !(S.Set n)-       , renderCache :: M.Map n (Result n)-       , clickableNames :: [n]-       } deriving (Read, Show, Generic, NFData)--data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport-                         , eventVtyHandle :: Vty-                         , latestExtents :: [Extent n]-                         , oldState :: RenderState n+data EventRO n = EventRO { eventViewportMap :: !(M.Map n Viewport)+                         , latestExtents :: ![Extent n]+                         , oldState :: !(RenderState n)                          } +-- | Clickable elements of a scroll bar.+data ClickableScrollbarElement =+    SBHandleBefore+    -- ^ The handle at the beginning (left/top) of the scroll bar.+    | SBHandleAfter+    -- ^ The handle at the end (right/bottom) of the scroll bar.+    | SBBar+    -- ^ The scroll bar itself.+    | SBTroughBefore+    -- ^ The trough before the scroll bar.+    | SBTroughAfter+    -- ^ The trough after the scroll bar.+    deriving (Eq, Show, Ord)+ -- | The rendering context. This tells widgets how to render: how much -- space they have in which to render, which attribute they should use -- to render, which bordering style should be used, and the attribute map -- available for rendering.-data Context =-    Context { ctxAttrName :: AttrName-            , availWidth :: Int-            , availHeight :: Int-            , ctxBorderStyle :: BorderStyle-            , ctxAttrMap :: AttrMap-            , ctxDynBorders :: Bool+data Context n =+    Context { ctxAttrName :: !AttrName+            , availWidth :: !Int+            , availHeight :: !Int+            , windowWidth :: !Int+            , windowHeight :: !Int+            , ctxBorderStyle :: !BorderStyle+            , ctxAttrMap :: !AttrMap+            , ctxDynBorders :: !Bool+            , ctxVScrollBarOrientation :: !(Maybe VScrollBarOrientation)+            , ctxVScrollBarRenderer :: !(Maybe (VScrollbarRenderer n))+            , ctxHScrollBarOrientation :: !(Maybe HScrollBarOrientation)+            , ctxHScrollBarRenderer :: !(Maybe (HScrollbarRenderer n))+            , ctxVScrollBarShowHandles :: !Bool+            , ctxHScrollBarShowHandles :: !Bool+            , ctxVScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n))+            , ctxHScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n))             }-            deriving Show  suffixLenses ''RenderState suffixLenses ''VisibilityRequest suffixLenses ''CursorLocation+suffixLenses ''Context+suffixLenses ''DynBorder+suffixLenses ''Result+suffixLenses ''BorderSegment makeLenses ''Viewport++lookupReportedExtent :: (Ord n) => n -> RenderM n (Maybe (Extent n))+lookupReportedExtent n = do+    m <- lift $ use reportedExtentsL+    return $ M.lookup n m
src/Brick/Types/TH.hs view
@@ -1,5 +1,6 @@ module Brick.Types.TH   ( suffixLenses+  , suffixLensesWith   ) where @@ -7,13 +8,18 @@ import qualified Language.Haskell.TH.Lib as TH  import Lens.Micro ((&), (.~))-import Lens.Micro.TH (DefName(..), makeLensesWith, lensRules, lensField)+import Lens.Micro.TH (DefName(..), LensRules, makeLensesWith, lensRules, lensField)  -- | A template haskell function to build lenses for a record type. This--- function differs from the 'Control.Lens.makeLenses' function in that+-- function differs from the 'Lens.Micro.TH.makeLenses' function in that -- it does not require the record fields to be prefixed with underscores -- and it adds an "L" suffix to lens names to make it clear that they -- are lenses. suffixLenses :: TH.Name -> TH.DecsQ-suffixLenses = makeLensesWith $-  lensRules & lensField .~ (\_ _ name -> [TopName $ TH.mkName $ TH.nameBase name ++ "L"])+suffixLenses = suffixLensesWith "L" lensRules++-- | A more general version of 'suffixLenses' that allows customization+-- of the lens-building rules and allows customization of the suffix.+suffixLensesWith :: String -> LensRules -> TH.Name -> TH.DecsQ+suffixLensesWith suffix rs = makeLensesWith $+    rs & lensField .~ (\_ _ name -> [TopName $ TH.mkName $ TH.nameBase name ++ suffix])
src/Brick/Util.hs view
@@ -4,6 +4,7 @@   , on   , fg   , bg+  , style   , clOffset   ) where@@ -52,9 +53,14 @@ fg = (defAttr `withForeColor`)  -- | Create an attribute from the specified background color (the--- background color is the "default").+-- foreground color is the "default"). bg :: Color -> Attr bg = (defAttr `withBackColor`)++-- | Create an attribute from the specified style (the colors are the+-- "default").+style :: Style -> Attr+style = (defAttr `withStyle`)  -- | Add a 'Location' offset to the specified 'CursorLocation'. clOffset :: CursorLocation n -> Location -> CursorLocation n
src/Brick/Widgets/Border.hs view
@@ -20,16 +20,17 @@    -- * Attribute names   , borderAttr+  , hBorderAttr+  , vBorderAttr    -- * Utility   , joinableBorder   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>)) #endif- import Lens.Micro ((^.), (&), (.~), to) import Graphics.Vty (imageHeight, imageWidth) @@ -43,8 +44,16 @@  -- | The top-level border attribute name. borderAttr :: AttrName-borderAttr = "border"+borderAttr = attrName "border" +-- | The horizontal border attribute name. Inherits from 'borderAttr'.+hBorderAttr :: AttrName+hBorderAttr = borderAttr <> attrName "horizontal"++-- | The vertical border attribute name. Inherits from 'borderAttr'.+vBorderAttr :: AttrName+vBorderAttr = borderAttr <> attrName "vertical"+ -- | Draw the specified border element using the active border style -- using 'borderAttr'. --@@ -99,7 +108,8 @@              $ vLimit (middleResult^.imageL.to imageHeight + 2)              $ total --- | A horizontal border.  Fills all horizontal space.+-- | A horizontal border. Fills all horizontal space. Draws using+-- 'hBorderAttr'. hBorder :: Widget n hBorder =     withAttr borderAttr $ Widget Greedy Fixed $ do@@ -109,7 +119,8 @@       db <- dynBorderFromDirections (Edges False False True True)       let dynBorders = BM.insertH mempty (Run w db)                      $ BM.emptyCoordinates (Edges 0 0 0 (w-1))-      setDynBorders dynBorders $ render $ vLimit 1 $ fill (bsHorizontal bs)+      setDynBorders dynBorders $ render $ withAttr hBorderAttr+                               $ vLimit 1 $ fill (bsHorizontal bs)  -- | A horizontal border with a label placed in the center of the -- border. Fills all horizontal space.@@ -121,7 +132,8 @@       res <- render $ vLimit 1 label       render $ hBox [hBorder, Widget Fixed Fixed (return res), hBorder] --- | A vertical border.  Fills all vertical space.+-- | A vertical border. Fills all vertical space. Draws using+-- 'vBorderAttr'. vBorder :: Widget n vBorder =     withAttr borderAttr $ Widget Fixed Greedy $ do@@ -131,7 +143,8 @@       db <- dynBorderFromDirections (Edges True True False False)       let dynBorders = BM.insertV mempty (Run h db)                      $ BM.emptyCoordinates (Edges 0 (h-1) 0 0)-      setDynBorders dynBorders $ render $ hLimit 1 $ fill (bsVertical bs)+      setDynBorders dynBorders $ render $ withAttr vBorderAttr+                               $ hLimit 1 $ fill (bsVertical bs)  -- | Initialize a 'DynBorder'. It will be 'bsDraw'n and 'bsOffer'ing -- in the given directions to begin with, and accept join offers from
src/Brick/Widgets/Border/Style.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} -- | This module provides styles for borders as used in terminal
src/Brick/Widgets/Center.hs view
@@ -60,7 +60,7 @@            c <- getContext            let rWidth = result^.imageL.to imageWidth                rHeight = result^.imageL.to imageHeight-               remainder = max 0 $ c^.availWidthL - (leftPaddingAmount * 2)+               remainder = max 0 $ c^.availWidthL - (rWidth + (leftPaddingAmount * 2))                leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2                rightPaddingAmount = max 0 $ leftPaddingAmount + remainder                leftPadding = charFill (c^.attrL) ch leftPaddingAmount rHeight
src/Brick/Widgets/Core.hs view
@@ -4,1135 +4,1847 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}--- | This module provides the core widget combinators and rendering--- routines. Everything this library does is in terms of these basic--- primitives.-module Brick.Widgets.Core-  ( -- * Basic rendering primitives-    TextWidth(..)-  , emptyWidget-  , raw-  , txt-  , txtWrap-  , txtWrapWith-  , str-  , strWrap-  , strWrapWith-  , fill-  , hyperlink--  -- * Padding-  , padLeft-  , padRight-  , padTop-  , padBottom-  , padLeftRight-  , padTopBottom-  , padAll--  -- * Box layout-  , (<=>)-  , (<+>)-  , hBox-  , vBox--  -- * Limits-  , hLimit-  , hLimitPercent-  , vLimit-  , vLimitPercent-  , setAvailableSize--  -- * Attribute management-  , withDefAttr-  , modifyDefAttr-  , withAttr-  , forceAttr-  , overrideAttr-  , updateAttrMap--  -- * Border style management-  , withBorderStyle-  , joinBorders-  , separateBorders-  , freezeBorders--  -- * Cursor placement-  , showCursor--  -- * Naming-  , Named(..)--  -- * Translation-  , translateBy--  -- * Cropping-  , cropLeftBy-  , cropRightBy-  , cropTopBy-  , cropBottomBy--  -- * Extent reporting-  , reportExtent-  , clickable--  -- * Scrollable viewports-  , viewport-  , visible-  , visibleRegion-  , unsafeLookupViewport-  , cached--  -- ** Adding offsets to cursor positions and visibility requests-  , addResultOffset--  -- ** Cropping results-  , cropToContext-  )-where--#if !(MIN_VERSION_base(4,11,0))-import Data.Monoid ((<>))-#endif--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-import Data.Monoid ((<>), mempty)-#endif--import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens')-import Lens.Micro.Mtl (use, (%=))-import Control.Monad ((>=>),when)-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Class (lift)-import qualified Data.Foldable as F-import qualified Data.Text as T-import qualified Data.DList as DL-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.IMap as I-import qualified Data.Function as DF-import Data.List (sortBy, partition)-import qualified Graphics.Vty as V-import Control.DeepSeq--import Text.Wrap (wrapTextToLines, WrapSettings, defaultWrapSettings)--import Brick.Types-import Brick.Types.Internal-import Brick.Widgets.Border.Style-import Brick.Util (clOffset, clamp)-import Brick.AttrMap-import Brick.Widgets.Internal-import qualified Brick.BorderMap as BM---- | The class of text types that have widths measured in terminal--- columns. NEVER use 'length' etc. to measure the length of a string if--- you need to compute how much screen space it will occupy; always use--- 'textWidth'.-class TextWidth a where-    textWidth :: a -> Int--instance TextWidth T.Text where-    textWidth = V.wcswidth . T.unpack--instance (F.Foldable f) => TextWidth (f Char) where-    textWidth = V.wcswidth . F.toList---- | The class of types that store interface element names.-class Named a n where-    -- | Get the name of the specified value.-    getName :: a -> n---- | When rendering the specified widget, use the specified border style--- for any border rendering.-withBorderStyle :: BorderStyle -> Widget n -> Widget n-withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p)---- | When rendering the specified widget, create borders that respond--- dynamically to their neighbors to form seamless connections.-joinBorders :: Widget n -> Widget n-joinBorders p = Widget (hSize p) (vSize p) $ withReaderT (& ctxDynBordersL .~ True) (render p)---- | When rendering the specified widget, use static borders. This--- may be marginally faster, but will introduce a small gap between--- neighboring orthogonal borders.------ This is the default for backwards compatibility.-separateBorders :: Widget n -> Widget n-separateBorders p = Widget (hSize p) (vSize p) $ withReaderT (&ctxDynBordersL .~ False) (render p)---- | After the specified widget has been rendered, freeze its borders. A--- frozen border will not be affected by neighbors, nor will it affect--- neighbors. Compared to 'separateBorders', 'freezeBorders' will not--- affect whether borders connect internally to a widget (whereas--- 'separateBorders' prevents them from connecting).------ Frozen borders cannot be thawed.-freezeBorders :: Widget n -> Widget n-freezeBorders p = Widget (hSize p) (vSize p) $ (bordersL .~ BM.empty) <$> render p---- | The empty widget.-emptyWidget :: Widget n-emptyWidget = raw V.emptyImage---- | Add an offset to all cursor locations, visbility requests, and--- extents in the specified rendering result. This function is critical--- for maintaining correctness in the rendering results as they are--- processed successively by box layouts and other wrapping combinators,--- since calls to this function result in converting from widget-local--- coordinates to (ultimately) terminal-global ones so they can be--- used by other combinators. You should call this any time you render--- something and then translate it or otherwise offset it from its--- original origin.-addResultOffset :: Location -> Result n -> Result n-addResultOffset off = addCursorOffset off .-                      addVisibilityOffset off .-                      addExtentOffset off .-                      addDynBorderOffset off--addVisibilityOffset :: Location -> Result n -> Result n-addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)--addExtentOffset :: Location -> Result n -> Result n-addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz o) -> Extent n (off <> l) sz o)--addDynBorderOffset :: Location -> Result n -> Result n-addDynBorderOffset off r = r & bordersL %~ BM.translate off---- | Render the specified widget and record its rendering extent using--- the specified name (see also 'lookupExtent').-reportExtent :: n -> Widget n -> Widget n-reportExtent n p =-    Widget (hSize p) (vSize p) $ do-        result <- render p-        let ext = Extent n (Location (0, 0)) sz (Location (0, 0))-            sz = ( result^.imageL.to V.imageWidth-                 , result^.imageL.to V.imageHeight-                 )-        return $ result & extentsL %~ (ext:)---- | Request mouse click events on the specified widget.-clickable :: n -> Widget n -> Widget n-clickable n p =-    Widget (hSize p) (vSize p) $ do-        clickableNamesL %= (n:)-        render $ reportExtent n p--addCursorOffset :: Location -> Result n -> Result n-addCursorOffset off r =-    let onlyVisible = filter isVisible-        isVisible l = l^.locationColumnL >= 0 && l^.locationRowL >= 0-    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)--unrestricted :: Int-unrestricted = 100000---- | Take a substring capable of fitting into the number of specified--- columns. This function takes character column widths into--- consideration.-takeColumns :: Int -> String -> String-takeColumns _ "" = ""-takeColumns numCols (c:cs) =-    let w = V.safeWcwidth c-    in if w == numCols-       then [c]-       else if w < numCols-            then c : takeColumns (numCols - w) cs-            else ""---- | Make a widget from a string, but wrap the words in the input's--- lines at the available width using the default wrapping settings. The--- input string should not contain escapes.------ 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 escapes.------ Unlike 'str', this is greedy horizontally.-strWrapWith :: WrapSettings -> String -> Widget n-strWrapWith settings t = txtWrapWith settings $ T.pack t--safeTextWidth :: T.Text -> Int-safeTextWidth = V.safeWcswidth . T.unpack---- | Make a widget from text, but wrap the words in the input's lines at--- the available width using the default wrapping settings. The input--- text should not contain escapes.------ 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 escapes.------ 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 $ safeTextWidth <$> multiple-                  padding = V.charFill (c^.attrL) ' ' (c^.availWidthL - maxLength) (length lineImgs)-                  lineImgs = lineImg <$> multiple-                  lineImg lStr = V.text' (c^.attrL)-                                   (lStr <> T.replicate (maxLength - safeTextWidth lStr) " ")-              in return $ emptyResult & imageL .~ (V.horizCat [V.vertCat lineImgs, padding])---- | Build a widget from a 'String'. Breaks newlines up and space-pads--- short lines out to the length of the longest line.------ The input string must not contain tab characters. If it does,--- interface corruption will result since the terminal will likely--- render it as taking up more than a single column. The caller should--- replace tabs with the appropriate number of spaces as desired. The--- reinput string should not contain escapes.-str :: String -> Widget n-str s =-    Widget Fixed Fixed $ do-      c <- getContext-      let theLines = fixEmpty <$> (dropUnused . lines) s-          fixEmpty :: String -> String-          fixEmpty [] = " "-          fixEmpty l = l-          dropUnused l = takeColumns (availWidth c) <$> take (availHeight c) l-      case force theLines of-          [] -> return emptyResult-          [one] -> return $ emptyResult & imageL .~ (V.string (c^.attrL) one)-          multiple ->-              let maxLength = maximum $ V.safeWcswidth <$> multiple-                  lineImgs = lineImg <$> multiple-                  lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - V.safeWcswidth lStr) ' ')-              in return $ emptyResult & imageL .~ (V.vertCat lineImgs)---- | Build a widget from a 'T.Text' value. Behaves the same as 'str'--- when the input contains multiple lines.------ The input string must not contain tab characters. If it does,--- interface corruption will result since the terminal will likely--- render it as taking up more than a single column. The caller should--- replace tabs with the appropriate number of spaces as desired. The--- reinput text should not contain escapes.-txt :: T.Text -> Widget n-txt = str . T.unpack---- | Hyperlink the given widget to the specified URL. Not all terminal--- emulators support this. In those that don't, this should have no--- discernible effect.-hyperlink :: T.Text -> Widget n -> Widget n-hyperlink url p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        let attr = attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL) `V.withURL` url-        withReaderT (& ctxAttrMapL %~ setDefaultAttr attr) (render p)---- | Pad the specified widget on the left. If max padding is used, this--- grows greedily horizontally; otherwise it defers to the padded--- widget.-padLeft :: Padding -> Widget n -> Widget n-padLeft padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (hLimit i, hSize p)-    in Widget sz (vSize p) $ do-        c <- getContext-        let lim = case padding of-              Max -> c^.availWidthL-              Pad i -> c^.availWidthL - i-        result <- render $ hLimit lim p-        render $ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') <+>-                 (Widget Fixed Fixed $ return result)---- | Pad the specified widget on the right. If max padding is used,--- this grows greedily horizontally; otherwise it defers to the padded--- widget.-padRight :: Padding -> Widget n -> Widget n-padRight padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (hLimit i, hSize p)-    in Widget sz (vSize p) $ do-        c <- getContext-        let lim = case padding of-              Max -> c^.availWidthL-              Pad i -> c^.availWidthL - i-        result <- render $ hLimit lim p-        render $ (Widget Fixed Fixed $ return result) <+>-                 (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ')---- | Pad the specified widget on the top. If max padding is used, this--- grows greedily vertically; otherwise it defers to the padded widget.-padTop :: Padding -> Widget n -> Widget n-padTop padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (vLimit i, vSize p)-    in Widget (hSize p) sz $ do-        c <- getContext-        let lim = case padding of-              Max -> c^.availHeightL-              Pad i -> c^.availHeightL - i-        result <- render $ vLimit lim p-        render $ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') <=>-                 (Widget Fixed Fixed $ return result)---- | Pad the specified widget on the bottom. If max padding is used,--- this grows greedily vertically; otherwise it defers to the padded--- widget.-padBottom :: Padding -> Widget n -> Widget n-padBottom padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (vLimit i, vSize p)-    in Widget (hSize p) sz $ do-        c <- getContext-        let lim = case padding of-              Max -> c^.availHeightL-              Pad i -> c^.availHeightL - i-        result <- render $ vLimit lim p-        render $ (Widget Fixed Fixed $ return result) <=>-                 (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ')---- | Pad a widget on the left and right. Defers to the padded widget for--- growth policy.-padLeftRight :: Int -> Widget n -> Widget n-padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w---- | Pad a widget on the top and bottom. Defers to the padded widget for--- growth policy.-padTopBottom :: Int -> Widget n -> Widget n-padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w---- | Pad a widget on all sides. Defers to the padded widget for growth--- policy.-padAll :: Int -> Widget n -> Widget n-padAll v w = padLeftRight v $ padTopBottom v w---- | Fill all available space with the specified character. Grows both--- horizontally and vertically.-fill :: Char -> Widget n-fill ch =-    Widget Greedy Greedy $ do-      c <- getContext-      return $ emptyResult & imageL .~ (V.charFill (c^.attrL) ch (c^.availWidthL) (c^.availHeightL))---- | Vertical box layout: put the specified widgets one above the other--- in the specified order (uppermost first). Defers growth policies to--- the growth policies of the contained widgets (if any are greedy, so--- is the box).-{-# 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).-{-# 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 Int-                , contextSecondary :: Lens' Context Int-                , imagePrimary :: V.Image -> Int-                , imageSecondary :: V.Image -> Int-                , limitPrimary :: Int -> Widget n -> Widget n-                , limitSecondary :: Int -> Widget n -> Widget n-                , primaryWidgetSize :: Widget n -> Size-                , concatenatePrimary :: [V.Image] -> V.Image-                , concatenateSecondary :: [V.Image] -> V.Image-                , locationFromOffset :: Int -> Location-                , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image-                , loPrimary :: forall a. Lens' (Edges a) a -- lo: towards smaller coordinates in that dimension-                , hiPrimary :: forall a. Lens' (Edges a) a -- hi: towards larger  coordinates in that dimension-                , loSecondary :: forall a. Lens' (Edges a) a-                , hiSecondary :: forall a. Lens' (Edges a) a-                , locationFromPrimarySecondary :: Int -> Int -> Location-                , splitLoPrimary :: Int -> V.Image -> V.Image-                , splitHiPrimary :: Int -> V.Image -> V.Image-                , splitLoSecondary :: Int -> V.Image -> V.Image-                , splitHiSecondary :: Int -> V.Image -> V.Image-                , lookupPrimary :: Int -> BM.BorderMap DynBorder -> I.IMap DynBorder-                , insertSecondary :: Location -> I.Run DynBorder -> BM.BorderMap DynBorder -> BM.BorderMap DynBorder-                }--vBoxRenderer :: BoxRenderer n-vBoxRenderer =-    BoxRenderer { contextPrimary = availHeightL-                , contextSecondary = availWidthL-                , imagePrimary = V.imageHeight-                , imageSecondary = V.imageWidth-                , limitPrimary = vLimit-                , limitSecondary = hLimit-                , primaryWidgetSize = vSize-                , concatenatePrimary = V.vertCat-                , concatenateSecondary = V.horizCat-                , locationFromOffset = Location . (0 ,)-                , padImageSecondary = \amt img a ->-                    let p = V.charFill a ' ' amt (V.imageHeight img)-                    in V.horizCat [img, p]-                , loPrimary = eTopL-                , hiPrimary = eBottomL-                , loSecondary = eLeftL-                , hiSecondary = eRightL-                , locationFromPrimarySecondary = \r c -> Location (c, r)-                , splitLoPrimary = V.cropBottom-                , splitHiPrimary = \n img -> V.cropTop (V.imageHeight img-n) img-                , splitLoSecondary = V.cropRight-                , splitHiSecondary = \n img -> V.cropLeft (V.imageWidth img-n) img-                , lookupPrimary = BM.lookupRow-                , insertSecondary = BM.insertH-                }--hBoxRenderer :: BoxRenderer n-hBoxRenderer =-    BoxRenderer { contextPrimary = availWidthL-                , contextSecondary = availHeightL-                , imagePrimary = V.imageWidth-                , imageSecondary = V.imageHeight-                , limitPrimary = hLimit-                , limitSecondary = vLimit-                , primaryWidgetSize = hSize-                , concatenatePrimary = V.horizCat-                , concatenateSecondary = V.vertCat-                , locationFromOffset = Location . (, 0)-                , padImageSecondary = \amt img a ->-                    let p = V.charFill a ' ' (V.imageWidth img) amt-                    in V.vertCat [img, p]-                , loPrimary = eLeftL-                , hiPrimary = eRightL-                , loSecondary = eTopL-                , hiSecondary = eBottomL-                , locationFromPrimarySecondary = \c r -> Location (c, r)-                , splitLoPrimary = V.cropRight-                , splitHiPrimary = \n img -> V.cropLeft (V.imageWidth img-n) img-                , splitLoSecondary = V.cropBottom-                , splitHiSecondary = \n img -> V.cropTop (V.imageHeight img-n) img-                , lookupPrimary = BM.lookupCol-                , insertSecondary = BM.insertV-                }---- | Render a series of widgets in a box layout in the order given.------ The growth policy of a box layout is the most unrestricted of the--- growth policies of the widgets it contains, so to determine the hSize--- and vSize of the box we just take the maximum (using the Ord instance--- for Size) of all of the widgets to be rendered in the box.------ Then the box layout algorithm proceeds as follows. We'll use--- the vertical case to concretely describe the algorithm, but the--- horizontal case can be envisioned just by exchanging all--- "vertical"/"horizontal" and "rows"/"columns", etc., in the--- description.------ The growth policies of the child widgets determine the order in which--- they are rendered, i.e., the order in which space in the box is--- allocated to widgets as the algorithm proceeds. This is because order--- matters: if we render greedy widgets first, there will be no space--- left for non-greedy ones.------ So we render all widgets with size 'Fixed' in the vertical dimension--- first. Each is rendered with as much room as the overall box has, but--- we assume that they will not be greedy and use it all. If they do,--- maybe it's because the terminal is small and there just isn't enough--- room to render everything.------ Then the remaining height is distributed evenly amongst all remaining--- (greedy) widgets and they are rendered in sub-boxes that are as high--- as this even slice of rows and as wide as the box is permitted to be.--- We only do this step at all if rendering the non-greedy widgets left--- us any space, i.e., if there were any rows left.------ After rendering the non-greedy and then greedy widgets, their images--- are sorted so that they are stored in the order the original widgets--- were given. All cursor locations and visibility requests in each--- sub-widget are translated according to the position of the sub-widget--- in the box.------ All images are padded to be as wide as the widest sub-widget to--- prevent attribute over-runs. Without this step the attribute used by--- a sub-widget may continue on in an undesirable fashion until it hits--- something with a different attribute. To prevent this and to behave--- in the least surprising way, we pad the image on the right with--- whitespace using the context's current attribute.------ Finally, the padded images are concatenated together vertically and--- returned along with the translated cursor positions and visibility--- requests.-renderBox :: BoxRenderer n -> [Widget n] -> Widget n-renderBox br ws =-    Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do-      c <- getContext--      let pairsIndexed = zip [(0::Int)..] ws-          (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed)-                        pairsIndexed--      let availPrimary = c^.(contextPrimary br)-          availSecondary = c^.(contextSecondary br)--          renderHis _ prev [] = return $ DL.toList prev-          renderHis remainingPrimary prev ((i, prim):rest) = do-              result <- render $ limitPrimary br remainingPrimary-                               $ limitSecondary br availSecondary-                               $ cropToContext prim-              renderHis (remainingPrimary - (result^.imageL.(to $ imagePrimary br)))-                        (DL.snoc prev (i, result)) rest--      renderedHis <- renderHis availPrimary DL.empty his--      renderedLows <- case lows of-          [] -> return []-          ls -> do-              let remainingPrimary = c^.(contextPrimary br) --                                     (sum $ (^._2.imageL.(to $ imagePrimary br)) <$> renderedHis)-                  primaryPerLow = remainingPrimary `div` length ls-                  rest = remainingPrimary - (primaryPerLow * length ls)-                  secondaryPerLow = c^.(contextSecondary br)-                  primaries = replicate rest (primaryPerLow + 1) <>-                              replicate (length ls - rest) primaryPerLow--              let renderLow ((i, prim), pri) =-                      (i,) <$> (render $ limitPrimary br pri-                                       $ limitSecondary br secondaryPerLow-                                       $ cropToContext prim)--              if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return []--      let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows-          allResults = snd <$> rendered-          allImages = (^.imageL) <$> allResults-          allPrimaries = imagePrimary br <$> allImages-          allTranslatedResults = (flip map) (zip [0..] allResults) $ \(i, result) ->-              let off = locationFromOffset br offPrimary-                  offPrimary = sum $ take i allPrimaries-              in addResultOffset off result-          -- Determine the secondary dimension value to pad to. In a-          -- vertical box we want all images to be the same width to-          -- avoid attribute over-runs or blank spaces with the wrong-          -- attribute. In a horizontal box we want all images to have-          -- the same height for the same reason.-          maxSecondary = maximum $ imageSecondary br <$> allImages-          padImage img = padImageSecondary br (maxSecondary - imageSecondary br img)-                         img (c^.attrL)-          (imageRewrites, newBorders) = catAllBorders br (borders <$> allTranslatedResults)-          rewrittenImages = zipWith (rewriteImage br) imageRewrites allImages-          paddedImages = padImage <$> rewrittenImages--      cropResultToContext $ Result (concatenatePrimary br paddedImages)-                            (concat $ cursors <$> allTranslatedResults)-                            (concat $ visibilityRequests <$> allTranslatedResults)-                            (concat $ extents <$> allTranslatedResults)-                            newBorders--catDynBorder-    :: Lens' (Edges BorderSegment) BorderSegment-    -> Lens' (Edges BorderSegment) BorderSegment-    -> DynBorder-    -> DynBorder-    -> Maybe DynBorder-catDynBorder towardsA towardsB a b-    -- Currently, we check if the 'BorderStyle's are exactly the same. In the-    -- future, it might be nice to relax this restriction. For example, if a-    -- horizontal border is being rewritten to 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 synch with the border information.------ The input borders are assumed to be disjoint. This property is not checked.-catBorders-    :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image)-    => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border)-catBorders br r l = if lCoord + 1 == rCoord-    then ((lRe, rRe), lr')-    else ((I.empty, I.empty), lr)-    where-    lr     = BM.expand (BM.coordinates r) l `BM.unsafeUnion`-             BM.expand (BM.coordinates l) r-    lr'    = id-           . mergeIMap lCoord lIMap'-           . mergeIMap rCoord rIMap'-           $ lr-    lCoord = BM.coordinates l ^. hiPrimary br-    rCoord = BM.coordinates r ^. loPrimary br-    lIMap  = lookupPrimary br lCoord l-    rIMap  = lookupPrimary br rCoord r-    lIMap' = catDynBorders (loPrimary br) (hiPrimary br) lIMap rIMap-    rIMap' = catDynBorders (hiPrimary br) (loPrimary br) rIMap lIMap-    lRe    = renderDynBorder <$> lIMap'-    rRe    = renderDynBorder <$> rIMap'-    mergeIMap p imap bm = F.foldl'-        (\bm' (s,v) -> insertSecondary br (locationFromPrimarySecondary br p s) v bm')-        bm-        (I.unsafeToAscList imap)---- | Given a direction to concatenate borders in, and the border information--- itself (which list is assumed to be already shifted so that borders do not--- overlap and are strictly increasing in the primary direction), produce: a--- list of rewrites for the lo and hi directions of each border, respectively,--- and the borders describing the fully concatenated object.-catAllBorders ::-    BoxRenderer n ->-    [BM.BorderMap DynBorder] ->-    ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder)-catAllBorders _ [] = ([], BM.empty)-catAllBorders br (bm:bms) = (zip ([I.empty]++los) (his++[I.empty]), bm') where-    (rewrites, bm') = runState (traverse (state . catBorders br) bms) bm-    (his, los) = unzip rewrites--rewriteEdge ::-    (Int -> V.Image -> V.Image) ->-    (Int -> V.Image -> V.Image) ->-    ([V.Image] -> V.Image) ->-    I.IMap V.Image -> V.Image -> V.Image-rewriteEdge splitLo splitHi combine = (combine .) . go . offsets 0 . I.unsafeToAscList where--    -- convert absolute positions into relative ones-    offsets _ [] = []-    offsets n ((n', r):nrs) = (n'-n, r) : offsets (n'+I.len r) nrs--    go [] old = [old]-    -- TODO: might be nice to construct this image with fill rather than-    -- replicate+char-    go ((lo, I.Run len new):nrs) old-        =  [splitLo lo old]-        ++ replicate len new-        ++ go nrs (splitHi (lo+len) old)--rewriteImage :: BoxRenderer n -> (I.IMap V.Image, I.IMap V.Image) -> V.Image -> V.Image-rewriteImage br (loRewrite, hiRewrite) old = rewriteHi . rewriteLo $ old where-    size = imagePrimary br old-    go = rewriteEdge (splitLoSecondary br) (splitHiSecondary br) (concatenateSecondary br)-    rewriteLo img-        | I.null loRewrite = img-        | otherwise = concatenatePrimary br-            [ go loRewrite (splitLoPrimary br 1 img)-            , splitHiPrimary br 1 img-            ]-    rewriteHi img-        | I.null hiRewrite = img-        | otherwise = concatenatePrimary br-            [ splitLoPrimary br (size-1) img-            , go hiRewrite (splitHiPrimary br (size-1) img)-            ]---- | Limit the space available to the specified widget to the specified--- number of columns. This is important for constraining the horizontal--- growth of otherwise-greedy widgets. This is non-greedy horizontally--- and defers to the limited widget vertically.-hLimit :: Int -> Widget n -> Widget n-hLimit w p =-    Widget Fixed (vSize p) $-      withReaderT (availWidthL %~ (min w)) $ render $ cropToContext p---- | Limit the space available to the specified widget to the specified--- 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 =-    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 =-    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 =-    Widget (vSize 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 =-    Widget Fixed Fixed $-      withReaderT (\c -> c & availHeightL .~ h & availWidthL .~ w) $-        render $ cropToContext p---- | When drawing the specified widget, set the current attribute used--- for drawing to the one with the specified name. Note that the widget--- may use further calls to 'withAttr' to override this; if you really--- want to prevent that, use 'forceAttr'. Attributes used this way still--- get merged hierarchically and still fall back to the attribute map's--- default attribute. If you want to change the default attribute, use--- 'withDefAttr'.-withAttr :: AttrName -> Widget n -> Widget n-withAttr an p =-    Widget (hSize p) (vSize p) $-      withReaderT (& ctxAttrNameL .~ an) (render p)---- | Update the attribute map while rendering the specified widget: set--- its new default attribute to the one that we get by looking up the--- specified attribute name in the map and then modifying it with the--- specified function.-modifyDefAttr :: (V.Attr -> V.Attr) -> Widget n -> Widget n-modifyDefAttr f p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL %~ (setDefaultAttr (f $ getDefaultAttr (c^.ctxAttrMapL)))) (render p)---- | Update the attribute map while rendering the specified widget: set--- its new default attribute to the one that we get by looking up the--- specified attribute name in the map.-withDefAttr :: AttrName -> Widget n -> Widget n-withDefAttr an p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL %~ (setDefaultAttr (attrMapLookup an (c^.ctxAttrMapL)))) (render p)---- | When rendering the specified widget, update the attribute map with--- the specified transformation.-updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n-updateAttrMap f p =-    Widget (hSize p) (vSize p) $-        withReaderT (& ctxAttrMapL %~ f) (render p)---- | When rendering the specified widget, force all attribute lookups--- in the attribute map to use the value currently assigned to the--- specified attribute name.-forceAttr :: AttrName -> Widget n -> Widget n-forceAttr an p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)---- | Override the lookup of 'targetName' to return the attribute value--- associated with 'fromName' when rendering the specified widget.--- See also 'mapAttrName'.-overrideAttr :: AttrName -> AttrName -> Widget n -> Widget n-overrideAttr targetName fromName =-    updateAttrMap (mapAttrName fromName targetName)---- | Build a widget directly from a raw Vty image.-raw :: V.Image -> Widget n-raw img = Widget Fixed Fixed $ return $ emptyResult & imageL .~ img---- | Translate the specified widget by the specified offset amount.--- Defers to the translated widget for growth policy.-translateBy :: Location -> Widget n -> Widget n-translateBy off p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ addResultOffset off-             $ result & imageL %~ (V.translate (off^.locationColumnL) (off^.locationRowL))---- | Crop the specified widget on the left by the specified number of--- columns. Defers to the cropped widget for growth policy.-cropLeftBy :: Int -> Widget n -> Widget n-cropLeftBy cols p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageWidth (result^.imageL) - cols-          cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img-      return $ addResultOffset (Location (-1 * cols, 0))-             $ result & imageL %~ cropped---- | Crop the specified widget on the right by the specified number of--- columns. Defers to the cropped widget for growth policy.-cropRightBy :: Int -> Widget n -> Widget n-cropRightBy cols p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageWidth (result^.imageL) - cols-          cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img-      return $ result & imageL %~ cropped---- | Crop the specified widget on the top by the specified number of--- rows. Defers to the cropped widget for growth policy.-cropTopBy :: Int -> Widget n -> Widget n-cropTopBy rows p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageHeight (result^.imageL) - rows-          cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img-      return $ addResultOffset (Location (0, -1 * rows))-             $ result & imageL %~ cropped---- | Crop the specified widget on the bottom by the specified number of--- rows. Defers to the cropped widget for growth policy.-cropBottomBy :: Int -> Widget n -> Widget n-cropBottomBy rows p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageHeight (result^.imageL) - rows-          cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img-      return $ result & imageL %~ cropped---- | When rendering the specified widget, also register a cursor--- positioning request using the specified name and location.-showCursor :: n -> Location -> Widget n -> Widget n-showCursor n cloc p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ result & cursorsL %~ (CursorLocation cloc (Just n):)--hRelease :: Widget n -> Maybe (Widget n)-hRelease p =-    case hSize p of-        Fixed -> Just $ Widget Greedy (vSize p) $-                        withReaderT (& availWidthL .~ unrestricted) (render p)-        Greedy -> Nothing--vRelease :: Widget n -> Maybe (Widget n)-vRelease p =-    case vSize p of-        Fixed -> Just $ Widget (hSize p) Greedy $-                        withReaderT (& availHeightL .~ unrestricted) (render p)-        Greedy -> Nothing---- | Render the specified widget. If the widget has an entry in the--- rendering cache using the specified name as the cache key, use the--- rendered version from the cache instead. If not, render the widget--- and update the cache.------ See also 'invalidateCacheEntry'.-cached :: (Ord n) => n -> Widget n -> Widget n-cached n w =-    Widget (hSize w) (vSize w) $ do-        result <- cacheLookup n-        case result of-            Just prevResult -> return prevResult-            Nothing  -> do-                wResult <- render w-                cacheUpdate n wResult-                return wResult--cacheLookup :: (Ord n) => n -> RenderM n (Maybe (Result n))-cacheLookup n = do-    cache <- lift $ gets (^.renderCacheL)-    return $ M.lookup n cache--cacheUpdate :: (Ord n) => n -> Result n -> RenderM n ()-cacheUpdate n r = lift $ modify (& renderCacheL %~ M.insert n r)---- | Render the specified widget in a named viewport with the--- specified type. This permits widgets to be scrolled without being--- scrolling-aware. To make the most use of viewports, the specified--- widget should use the 'visible' combinator to make a "visibility--- request". This viewport combinator will then translate the resulting--- rendering to make the requested region visible. In addition, the--- 'Brick.Main.EventM' monad provides primitives to scroll viewports--- created by this function if 'visible' is not what you want.------ If a viewport receives more than one visibility request, then the--- visibility requests are merged with the inner visibility request--- taking preference. If a viewport receives more than one scrolling--- request from 'Brick.Main.EventM', all are honored in the order in--- which they are received.-viewport :: (Ord n, Show n)-         => n-         -- ^ The name of the viewport (must be unique and stable for-         -- reliable behavior)-         -> ViewportType-         -- ^ The type of viewport (indicates the permitted scrolling-         -- direction)-         -> Widget n-         -- ^ The widget to be rendered in the scrollable viewport-         -> Widget n-viewport vpname typ p =-    clickable vpname $ Widget Greedy Greedy $ do-      -- 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.-      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 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)-      let release = case typ of-            Vertical -> vRelease-            Horizontal -> hRelease-            Both -> vRelease >=> hRelease-          released = case release p of-            Just w -> w-            Nothing -> case typ of-                Vertical -> error $ "tried to embed an infinite-height " <>-                                    "widget in vertical viewport " <> (show vpname)-                Horizontal -> error $ "tried to embed an infinite-width " <>-                                      "widget in horizontal viewport " <> (show vpname)-                Both -> error $ "tried to embed an infinite-width or " <>-                                "infinite-height widget in 'Both' type " <>-                                "viewport " <> (show vpname)--      initialResult <- render released--      -- If the rendering state includes any scrolling requests for this-      -- viewport, apply those-      reqs <- lift $ gets $ (^.rsScrollRequestsL)-      let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs-      when (not $ null relevantRequests) $ do-          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-          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.-      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--      -- Return the translated result with the visibility requests-      -- discarded-      let translatedSize = ( translated^.imageL.to V.imageWidth-                           , translated^.imageL.to V.imageHeight-                           )-      case translatedSize of-          (0, 0) -> do-              let spaceFill = V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL)-              return $ translated & imageL .~ spaceFill-                                  & visibilityRequestsL .~ mempty-                                  & extentsL .~ mempty-          _ -> render $ cropToContext-                      $ padBottom Max-                      $ padRight Max-                      $ Widget Fixed Fixed-                      $ return $ translated & visibilityRequestsL .~ mempty+{-# 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
src/Brick/Widgets/Dialog.hs view
@@ -5,21 +5,25 @@ -- dialog title, if any, as well as its body and buttons. -- -- Note that this dialog is really for simple use cases where you want--- to get the user's answer to a question, such as "Would you like--- to save changes before quitting?" If you require something more--- sophisticated, you'll need to build it yourself. You might also--- consider seeing the 'Brick.Forms' module for help with input--- management, and see the implementation of this module to see how to--- reproduce a dialog-style UI.+-- to get the user's answer to a question, such as "Would you like to+-- save changes before quitting?" As is typical in such cases, we assume+-- that this dialog box is used modally, meaning that while it is open+-- it is has exclusive input focus until it is closed.+--+-- If you require something more sophisticated, you'll need to build it+-- yourself. You might also consider seeing the 'Brick.Forms' module for+-- help with input management and see the implementation of this module+-- to see how to reproduce a dialog-style UI. module Brick.Widgets.Dialog   ( Dialog   , dialogTitle   , dialogButtons-  , dialogSelectedIndex   , dialogWidth   -- * Construction and rendering   , dialog   , renderDialog+  , getDialogFocus+  , setDialogFocus   -- * Handling events   , handleDialogEvent   -- * Getting a dialog's current value@@ -30,24 +34,20 @@   , buttonSelectedAttr   -- * Lenses   , dialogButtonsL-  , dialogSelectedIndexL   , dialogWidthL   , dialogTitleL   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- import Lens.Micro+import Lens.Micro.Mtl ((%=)) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif-import Data.List (intersperse)+import Data.List (intersperse, find) import Graphics.Vty.Input (Event(..), Key(..)) -import Brick.Util (clamp)+import Brick.Focus import Brick.Types import Brick.Widgets.Core import Brick.Widgets.Center@@ -63,71 +63,91 @@ -- -- * Tab or Right Arrow: select the next button -- * Shift-tab or Left Arrow: select the previous button-data Dialog a =-    Dialog { dialogTitle :: Maybe String+data Dialog a n =+    Dialog { dialogTitle :: Maybe (Widget n)            -- ^ The dialog title-           , dialogButtons :: [(String, a)]-           -- ^ The dialog button labels and values-           , dialogSelectedIndex :: Maybe Int-           -- ^ The currently selected dialog button index (if any)+           , dialogButtons :: [(String, n, a)]+           -- ^ The dialog buttons' labels, resource names, and values            , dialogWidth :: Int            -- ^ The maximum width of the dialog+           , dialogFocus :: FocusRing n+           -- ^ The focus ring for the dialog's buttons            }  suffixLenses ''Dialog -handleDialogEvent :: Event -> Dialog a -> EventM n (Dialog a)-handleDialogEvent ev d =-    return $ case ev of-        EvKey (KChar '\t') [] -> nextButtonBy 1 True d-        EvKey KBackTab [] -> nextButtonBy (-1) True d-        EvKey KRight [] -> nextButtonBy 1 False d-        EvKey KLeft [] -> nextButtonBy (-1) False d-        _ -> d+handleDialogEvent :: Event -> EventM n (Dialog a n) ()+handleDialogEvent ev = do+    case ev of+        EvKey (KChar '\t') [] -> dialogFocusL %= focusNext+        EvKey KRight []       -> dialogFocusL %= focusNext+        EvKey KBackTab []     -> dialogFocusL %= focusPrev+        EvKey KLeft []        -> dialogFocusL %= focusPrev+        _ -> return () +-- | Set the focused button of a dialog.+setDialogFocus :: (Eq n) => n -> Dialog a n -> Dialog a n+setDialogFocus n d = d { dialogFocus = focusSetCurrent n $ dialogFocus d }++-- | Get the focused button of a dialog.+getDialogFocus :: Dialog a n -> Maybe n+getDialogFocus = focusGetCurrent . dialogFocus+ -- | Create a dialog.-dialog :: Maybe String+dialog :: (Eq n)+       => Maybe (Widget n)        -- ^ The dialog title-       -> Maybe (Int, [(String, a)])-       -- ^ The currently-selected button index (starting at zero) and-       -- the button labels and values to use+       -> Maybe (n, [(String, n, a)])+       -- ^ The currently-selected button resource name and the button+       -- labels, resource names, and values to use for each button,+       -- respectively        -> Int        -- ^ The maximum width of the dialog-       -> Dialog a+       -> Dialog a n dialog title buttonData w =-    let (buttons, idx) = case buttonData of-          Nothing -> ([], Nothing)-          Just (_, []) -> ([], Nothing)-          Just (i, bs) -> (bs, Just $ clamp 0 (length bs - 1) i)-    in Dialog title buttons idx w+    let (r, buttons) = case buttonData of+            Nothing ->+                (focusRing [], [])+            Just (focName, entries) ->+                let ns = (\(_, n, _) -> n) <$> entries+                in (focusSetCurrent focName $ focusRing ns, entries)+    in Dialog title buttons w r  -- | The default attribute of the dialog dialogAttr :: AttrName-dialogAttr = "dialog"+dialogAttr = attrName "dialog"  -- | The default attribute for all dialog buttons buttonAttr :: AttrName-buttonAttr = "button"+buttonAttr = attrName "button"  -- | The attribute for the selected dialog button (extends 'dialogAttr') buttonSelectedAttr :: AttrName-buttonSelectedAttr = buttonAttr <> "selected"+buttonSelectedAttr = buttonAttr <> attrName "selected"  -- | Render a dialog with the specified body widget. This renders the -- dialog as a layer, which makes this suitable as a top-level layer in -- your rendering function to be rendered on top of the rest of your -- interface.-renderDialog :: Dialog a -> Widget n -> Widget n+renderDialog :: (Ord n) => Dialog a n -> Widget n -> Widget n renderDialog d body =     let buttonPadding = str "   "-        mkButton (i, (s, _)) = let att = if Just i == d^.dialogSelectedIndexL-                                         then buttonSelectedAttr-                                         else buttonAttr-                               in withAttr att $ str $ "  " <> s <> "  "+        foc = focusGetCurrent $ dialogFocus d+        mkButton (s, n, _) =+            let att = if Just n == foc+                      then buttonSelectedAttr+                      else buttonAttr+                csr = if Just n == foc+                      then putCursor n (Location (1,0))+                      else id+            in csr $+               clickable n $+               withAttr att $+               str $ "  " <> s <> "  "         buttons = hBox $ intersperse buttonPadding $-                         mkButton <$> (zip [0..] (d^.dialogButtonsL))+                         mkButton <$> (d^.dialogButtonsL) -        doBorder = maybe border borderWithLabel (str <$> d^.dialogTitleL)+        doBorder = maybe border borderWithLabel (d^.dialogTitleL)     in centerLayer $        withDefAttr dialogAttr $        hLimit (d^.dialogWidthL) $@@ -136,24 +156,12 @@             , hCenter buttons             ] -nextButtonBy :: Int -> Bool -> Dialog a -> Dialog a-nextButtonBy amt wrapCycle d =-    let numButtons = length $ d^.dialogButtonsL-    in if numButtons == 0 then d-       else case d^.dialogSelectedIndexL of-           Nothing -> d & dialogSelectedIndexL .~ (Just 0)-           Just i -> d & dialogSelectedIndexL .~ (Just newIndex)-               where-                   addedIndex = i + amt-                   newIndex = if wrapCycle-                              then addedIndex `mod` numButtons-                              else max 0 $ min addedIndex $ numButtons - 1---- | Obtain the value associated with the dialog's currently-selected--- button, if any. This function is probably what you want when someone--- presses 'Enter' in a dialog.-dialogSelection :: Dialog a -> Maybe a-dialogSelection d =-    case d^.dialogSelectedIndexL of-        Nothing -> Nothing-        Just i -> Just $ ((d^.dialogButtonsL) !! i)^._2+-- | Obtain the resource name and value associated with the dialog's+-- currently-selected button, if any. The result of this function is+-- probably what you want when someone presses 'Enter' in a dialog.+dialogSelection :: (Eq n) => Dialog a n -> Maybe (n, a)+dialogSelection d = do+    n' <- focusGetCurrent $ dialogFocus d+    let matches (_, n, _) = n == n'+    (_, n, a) <- find matches (d^.dialogButtonsL)+    return (n, a)
src/Brick/Widgets/Edit.hs view
@@ -25,6 +25,7 @@   , editorText   -- * Reading editor contents   , getEditContents+  , getCursorPosition   -- * Handling events   , handleEditorEvent   -- * Editing text@@ -52,6 +53,8 @@ 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@@ -59,12 +62,21 @@  -- | Editor state.  Editors support the following events by default: ----- * Ctrl-a: go to beginning of line--- * Ctrl-e: go to end of line+-- * Mouse clicks: change cursor position+-- * Meta-<: go to beginning of file+-- * Meta->: go to end of file+-- * Ctrl-a, Home: go to beginning of line+-- * Ctrl-e, End: go to end of line -- * Ctrl-d, Del: delete character at cursor position+-- * Meta-d: delete word at cursor position -- * Backspace: delete character prior to cursor position -- * Ctrl-k: delete all from cursor to end of line -- * Ctrl-u: delete all from cursor to beginning of line+-- * Ctrl-t: transpose character before cursor with the one at cursor position+-- * Meta-b: move one word to the left+-- * Ctrl-b: move one character to the left+-- * Meta-f: move one word to the right+-- * Ctrl-f: move one character to the right -- * Arrow keys: move cursor -- * Enter: break the current line at the cursor position -- * Paste: Bracketed Pastes from the terminal will be pasted, provided@@ -105,40 +117,59 @@ instance DecodeUtf8 String where     decodeUtf8 bs = T.unpack <$> decodeUtf8 bs -handleEditorEvent :: (DecodeUtf8 t, Eq t, Monoid t) => Event -> Editor t n -> EventM n (Editor t n)-handleEditorEvent e ed =-        let f = case e 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 'k') [MCtrl] -> Z.killToEOL-                  EvKey (KChar 'u') [MCtrl] -> Z.killToBOL-                  EvKey KEnter [] -> Z.breakLine-                  EvKey KDel [] -> Z.deleteChar-                  EvKey (KChar c) [] | c /= '\t' -> Z.insertChar c-                  EvKey KUp [] -> Z.moveUp-                  EvKey KDown [] -> Z.moveDown-                  EvKey KLeft [] -> Z.moveLeft-                  EvKey KRight [] -> Z.moveRight-                  EvKey KBS [] -> Z.deletePrevChar-                  _ -> id-        in return $ applyEdit f ed+handleEditorEvent :: (Eq n, DecodeUtf8 t, Eq t, Z.GenericTextZipper t)+                  => BrickEvent n e+                  -> EventM n (Editor t n) ()+handleEditorEvent e = do+    ed <- get+    let f = case e of+              VtyEvent ev ->+                  handleVtyEvent ev+              MouseDown n _ _ (Location pos) | n == getName ed ->+                  Z.moveCursorClosest (swap pos)+              _ -> id+        handleVtyEvent ev = case ev of+            EvPaste bs -> case decodeUtf8 bs of+                Left _ -> id+                Right t -> Z.insertMany t+            EvKey (KChar 'a') [MCtrl] -> Z.gotoBOL+            EvKey (KChar 'e') [MCtrl] -> Z.gotoEOL+            EvKey (KChar 'd') [MCtrl] -> Z.deleteChar+            EvKey (KChar 'd') [MMeta] -> Z.deleteWord+            EvKey (KChar 'k') [MCtrl] -> Z.killToEOL+            EvKey (KChar 'u') [MCtrl] -> Z.killToBOL+            EvKey KEnter [] -> Z.breakLine+            EvKey KDel [] -> Z.deleteChar+            EvKey (KChar c) [] | c /= '\t' -> Z.insertChar c+            EvKey KUp [] -> Z.moveUp+            EvKey KDown [] -> Z.moveDown+            EvKey KLeft [] -> Z.moveLeft+            EvKey KRight [] -> Z.moveRight+            EvKey (KChar 'b') [MCtrl] -> Z.moveLeft+            EvKey (KChar 'f') [MCtrl] -> Z.moveRight+            EvKey (KChar 'b') [MMeta] -> Z.moveWordLeft+            EvKey (KChar 'f') [MMeta] -> Z.moveWordRight+            EvKey KBS [] -> Z.deletePrevChar+            EvKey (KChar 't') [MCtrl] -> Z.transposeChars+            EvKey KHome [] -> Z.gotoBOL+            EvKey KEnd [] -> Z.gotoEOL+            EvKey (KChar '<') [MMeta] -> Z.gotoBOF+            EvKey (KChar '>') [MMeta] -> Z.gotoEOF+            _ -> id+    put $ applyEdit f ed  -- | Construct an editor over 'Text' values editorText :: n-       -- ^ The editor's name (must be unique)-       -> Maybe Int-       -- ^ The limit on the number of lines in the editor ('Nothing'-       -- means no limit)-       -> T.Text-       -- ^ The initial content-       -> Editor T.Text n+           -- ^ The editor's name (must be unique)+           -> Maybe Int+           -- ^ The limit on the number of lines in the editor ('Nothing'+           -- means no limit)+           -> T.Text+           -- ^ The initial content+           -> Editor T.Text n editorText = editor --- | Construct an editor over 'String' values+-- | Construct an editor over generic text values editor :: Z.GenericTextZipper a        => n        -- ^ The editor's name (must be unique)@@ -150,28 +181,34 @@        -> Editor a n editor name limit s = Editor (Z.textZipper (Z.lines s) limit) name --- | Apply an editing operation to the editor's contents. Bear in mind--- that you should only apply zipper operations that operate on the--- current line; the editor will only ever render the first line of--- text.+-- | Apply an editing operation to the editor's contents.+--+-- This is subject to the restrictions of the underlying text zipper;+-- for example, if the underlying zipper has a line limit configured,+-- any edits applied here will be ignored if they edit text outside+-- the line limit. applyEdit :: (Z.TextZipper t -> Z.TextZipper t)-          -- ^ The 'Data.Text.Zipper' editing transformation to apply+          -- ^ The 'Z.TextZipper' editing transformation to apply           -> Editor t n           -> Editor t n applyEdit f e = e & editContentsL %~ f  -- | The attribute assigned to the editor when it does not have focus. editAttr :: AttrName-editAttr = "edit"+editAttr = attrName "edit"  -- | The attribute assigned to the editor when it has focus. Extends -- 'editAttr'. editFocusedAttr :: AttrName-editFocusedAttr = editAttr <> "focused"+editFocusedAttr = editAttr <> attrName "focused"  -- | Get the contents of the editor. getEditContents :: Monoid t => Editor t n -> [t] getEditContents e = Z.getText $ e^.editContentsL++-- | Get the cursor position of the editor (row, column).+getCursorPosition :: Editor t n -> (Int, Int)+getCursorPosition e = Z.cursorPosition $ e^.editContentsL  -- | Turn an editor state value into a widget. This uses the editor's -- name for its scrollable viewport handle and the name is also used to
src/Brick/Widgets/FileBrowser.hs view
@@ -3,7 +3,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}--- | This module provids a file browser widget that allows users to+{-# 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@.@@ -65,8 +67,23 @@   , updateFileBrowserSearch   , setFileBrowserEntryFilter +  -- * Actions+  , actionFileBrowserBeginSearch+  , actionFileBrowserSelectEnter+  , actionFileBrowserSelectCurrent+  , actionFileBrowserToggleCurrent+  , actionFileBrowserListPageUp+  , actionFileBrowserListPageDown+  , actionFileBrowserListHalfPageUp+  , actionFileBrowserListHalfPageDown+  , actionFileBrowserListTop+  , actionFileBrowserListBottom+  , actionFileBrowserListNext+  , actionFileBrowserListPrev+   -- * Handling events   , handleFileBrowserEvent+  , maybeSelectCurrentEntry    -- * Rendering   , renderFileBrowser@@ -97,7 +114,6 @@   , fileExtensionMatch    -- * Lenses-  , fileBrowserEntryFilterL   , fileBrowserSelectableL   , fileInfoFilenameL   , fileInfoSanitizedFilenameL@@ -107,6 +123,17 @@   , fileStatusSizeL   , fileStatusFileTypeL +  -- * Getters+  , fileBrowserEntryFilterG+  , fileBrowserWorkingDirectoryG+  , fileBrowserEntriesG+  , fileBrowserLatestResultsG+  , fileBrowserSelectedFilesG+  , fileBrowserNameG+  , fileBrowserSearchStringG+  , fileBrowserExceptionG+  , fileBrowserSelectableG+   -- * Miscellaneous   , prettyFileSize @@ -117,9 +144,10 @@ where  import qualified Control.Exception as E-import Control.Monad (forM)+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@@ -127,19 +155,21 @@ import Data.Monoid #endif import Data.Int (Int64)-import Data.List (sortBy, isSuffixOf)+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.Posix.Files as U-import qualified System.Posix.Types as U+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)+import Brick.AttrMap (AttrName, attrName) import Brick.Widgets.Core import Brick.Widgets.List @@ -173,6 +203,9 @@                 -- change the selection function.                 } +instance Named (FileBrowser n) n where+    getName = getName . fileBrowserEntries+ -- | File status information. data FileStatus =     FileStatus { fileStatusSize :: Int64@@ -224,6 +257,7 @@     deriving (Read, Show, Eq)  suffixLenses ''FileBrowser+suffixLensesWith "G" (lensRules & generateUpdateableOptics .~ False) ''FileBrowser suffixLenses ''FileInfo suffixLenses ''FileStatus @@ -248,8 +282,8 @@                -- executable's current working directory.                -> IO (FileBrowser n) newFileBrowser selPredicate name mCwd = do-    initialCwd <- case mCwd of-        Just path -> return path+    initialCwd <- FP.normalise <$> case mCwd of+        Just path -> return $ removeTrailingSlash path         Nothing -> D.getCurrentDirectory      let b = FileBrowser { fileBrowserWorkingDirectory = initialCwd@@ -265,6 +299,22 @@      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@@ -286,10 +336,7 @@ selectDirectories i =     case fileInfoFileType i of         Just Directory -> True-        Just SymbolicLink ->-            case fileInfoLinkTargetType i of-                Just Directory -> True-                _ -> False+        Just SymbolicLink -> fileInfoLinkTargetType i == Just Directory         _ -> False  -- | Set the filtering function used to determine which entries in@@ -297,6 +344,12 @@ -- 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@@ -324,10 +377,10 @@             Left (_::E.IOException) -> entries             Right parent -> parent : entries -    let b' = setEntries allEntries b-    return $ b' & fileBrowserWorkingDirectoryL .~ path-                & fileBrowserExceptionL .~ exc-                & fileBrowserSelectedFilesL .~ mempty+    return $ setEntries allEntries b+                 & fileBrowserWorkingDirectoryL .~ path+                 & fileBrowserExceptionL .~ exc+                 & fileBrowserSelectedFilesL .~ mempty  parentOf :: FilePath -> IO FileInfo parentOf path = getFileInfo ".." $ FP.takeDirectory path@@ -454,7 +507,7 @@ 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)))+                            (\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@@ -539,123 +592,199 @@ -- -- Events handled regardless of mode: ----- * @Enter@, @Space@: set the file browser's selected entry---   ('fileBrowserSelection') for use by the calling application,---   subject to 'fileBrowserSelectable'.--- * @Ctrl-n@: select the next entry--- * @Ctrl-p@: select the previous entry--- * 'List' navigation keys+-- * @Ctrl-b@: 'actionFileBrowserListPageUp'+-- * @Ctrl-f@: 'actionFileBrowserListPageDown'+-- * @Ctrl-d@: 'actionFileBrowserListHalfPageDown'+-- * @Ctrl-u@: 'actionFileBrowserListHalfPageUp'+-- * @Ctrl-n@: 'actionFileBrowserListNext'+-- * @Ctrl-p@: 'actionFileBrowserListPrev' -- -- Events handled only in normal mode: ----- * @/@: enter search 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-handleFileBrowserEvent :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)-handleFileBrowserEvent e b =++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 b-    else handleFileBrowserEventNormal e b+        then handleFileBrowserEventSearching e+        else handleFileBrowserEventNormal e  safeInit :: T.Text -> T.Text safeInit t | T.length t == 0 = t            | otherwise = T.init t -handleFileBrowserEventSearching :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)-handleFileBrowserEventSearching e b =+handleFileBrowserEventSearching :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventSearching e =     case e of         Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl] ->-            return $ updateFileBrowserSearch (const Nothing) b+            modify $ updateFileBrowserSearch (const Nothing)         Vty.EvKey Vty.KEsc [] ->-            return $ updateFileBrowserSearch (const Nothing) b+            modify $ updateFileBrowserSearch (const Nothing)         Vty.EvKey Vty.KBS [] ->-            return $ updateFileBrowserSearch (fmap safeInit) b-        Vty.EvKey Vty.KEnter [] ->-            updateFileBrowserSearch (const Nothing) <$>-                maybeSelectCurrentEntry b+            modify $ updateFileBrowserSearch (fmap safeInit)+        Vty.EvKey Vty.KEnter [] -> do+            maybeSelectCurrentEntry+            modify $ updateFileBrowserSearch (const Nothing)         Vty.EvKey (Vty.KChar c) [] ->-            return $ updateFileBrowserSearch (fmap (flip T.snoc c)) b+            modify $ updateFileBrowserSearch (fmap (flip T.snoc c))         _ ->-            handleFileBrowserEventCommon e b+            handleFileBrowserEventCommon e -handleFileBrowserEventNormal :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)-handleFileBrowserEventNormal e b =+handleFileBrowserEventNormal :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventNormal e =     case e of         Vty.EvKey (Vty.KChar '/') [] ->             -- Begin file search-            return $ updateFileBrowserSearch (const $ Just "") b+            actionFileBrowserBeginSearch         Vty.EvKey Vty.KEnter [] ->             -- Select file or enter directory-            maybeSelectCurrentEntry b+            actionFileBrowserSelectEnter         Vty.EvKey (Vty.KChar ' ') [] ->-            -- Select entry-            selectCurrentEntry b+            -- Toggle selected status of current entry+            actionFileBrowserToggleCurrent         _ ->-            handleFileBrowserEventCommon e b+            handleFileBrowserEventCommon e -handleFileBrowserEventCommon :: (Ord n) => Vty.Event -> FileBrowser n -> EventM n (FileBrowser n)-handleFileBrowserEventCommon e b =+handleFileBrowserEventCommon :: (Ord n) => Vty.Event -> EventM n (FileBrowser n) ()+handleFileBrowserEventCommon e =     case e of-        Vty.EvKey (Vty.KChar 'b') [Vty.MCtrl] -> do-            let old = b ^. fileBrowserEntriesL-            new <- listMovePageUp old-            return $ b & fileBrowserEntriesL .~ new-        Vty.EvKey (Vty.KChar 'f') [Vty.MCtrl] -> do-            let old = b ^. fileBrowserEntriesL-            new <- listMovePageDown old-            return $ b & fileBrowserEntriesL .~ new-        Vty.EvKey (Vty.KChar 'd') [Vty.MCtrl] -> do-            let old = b ^. fileBrowserEntriesL-            new <- listMoveByPages (0.5::Double) old-            return $ b & fileBrowserEntriesL .~ new-        Vty.EvKey (Vty.KChar 'u') [Vty.MCtrl] -> do-            let old = b ^. fileBrowserEntriesL-            new <- listMoveByPages (-0.5::Double) old-            return $ b & fileBrowserEntriesL .~ new+        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') [] ->-            return $ b & fileBrowserEntriesL %~ listMoveTo 0-        Vty.EvKey (Vty.KChar 'G') [] -> do-            let sz = length (listElements $ b^.fileBrowserEntriesL)-            return $ b & fileBrowserEntriesL %~ listMoveTo (sz - 1)+            actionFileBrowserListTop+        Vty.EvKey (Vty.KChar 'G') [] ->+            actionFileBrowserListBottom         Vty.EvKey (Vty.KChar 'j') [] ->-            return $ b & fileBrowserEntriesL %~ listMoveBy 1+            actionFileBrowserListNext         Vty.EvKey (Vty.KChar 'k') [] ->-            return $ b & fileBrowserEntriesL %~ listMoveBy (-1)+            actionFileBrowserListPrev         Vty.EvKey (Vty.KChar 'n') [Vty.MCtrl] ->-            return $ b & fileBrowserEntriesL %~ listMoveBy 1+            actionFileBrowserListNext         Vty.EvKey (Vty.KChar 'p') [Vty.MCtrl] ->-            return $ b & fileBrowserEntriesL %~ listMoveBy (-1)+            actionFileBrowserListPrev         _ ->-            handleEventLensed b fileBrowserEntriesL handleListEvent e+            zoom fileBrowserEntriesL $ handleListEvent e -maybeSelectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n)-maybeSelectCurrentEntry b =-    case fileBrowserCursor b of-        Nothing -> return b-        Just entry ->-            if fileBrowserSelectable b entry-            then return $ b & fileBrowserSelectedFilesL %~ Set.insert (fileInfoFilename entry)-            else case fileInfoFileType entry of-                Just Directory ->-                    liftIO $ setWorkingDirectory (fileInfoFilePath entry) b-                Just SymbolicLink ->-                    case fileInfoLinkTargetType entry of-                        Just Directory -> do-                            liftIO $ setWorkingDirectory (fileInfoFilePath entry) b-                        _ ->-                            return b-                _ ->-                    return b+toggleSelected :: FileInfo -> EventM n (FileBrowser n) ()+toggleSelected e = do+    sel <- fileBrowserIsSelected e+    if sel+       then fileBrowserRemoveSelected e+       else fileBrowserAddSelected e -selectCurrentEntry :: FileBrowser n -> EventM n (FileBrowser n)-selectCurrentEntry b =-    case fileBrowserCursor b of-        Nothing -> return b-        Just e -> return $ b & fileBrowserSelectedFilesL %~ Set.insert (fileInfoFilename 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@@ -674,7 +803,7 @@                   -- ^ The browser to render.                   -> Widget n renderFileBrowser foc b =-    let maxFilenameLength = maximum $ (length . fileInfoFilename) <$> (b^.fileBrowserEntriesL)+    let maxFilenameLength = maximum $ length . fileInfoFilename <$> (b^.fileBrowserEntriesL)         cwdHeader = padRight Max $                     str $ sanitizeFilename $ fileBrowserWorkingDirectory b         selInfo = case listSelectedElement (b^.fileBrowserEntriesL) of@@ -698,7 +827,7 @@                                         then ", " <> prettyFileSize (fileStatusSize stat)                                         else ""                         in fileTypeLabel (fileStatusFileType stat) <> maybeSize-            in txt $ (T.pack $ fileInfoSanitizedFilename i) <> ": " <> label+            in txt $ T.pack (fileInfoSanitizedFilename i) <> ": " <> label          maybeSearchInfo = case b^.fileBrowserSearchStringL of             Nothing -> emptyWidget@@ -708,14 +837,14 @@      in withDefAttr fileBrowserAttr $        vBox [ withDefAttr fileBrowserCurrentDirectoryAttr cwdHeader-            , renderList (renderFileInfo foc maxFilenameLength (b^.fileBrowserSelectedFilesL))+            , renderList (renderFileInfo foc maxFilenameLength (b^.fileBrowserSelectedFilesL) (b^.fileBrowserNameL))                          foc (b^.fileBrowserEntriesL)             , maybeSearchInfo             , withDefAttr fileBrowserSelectionInfoAttr selInfo             ] -renderFileInfo :: Bool -> Int -> Set.Set String -> Bool -> FileInfo -> Widget n-renderFileInfo foc maxLen selFiles listSel info =+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)@@ -727,6 +856,7 @@         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 "")@@ -750,49 +880,49 @@  -- | The base attribute for all file browser attributes. fileBrowserAttr :: AttrName-fileBrowserAttr = "fileBrowser"+fileBrowserAttr = attrName "fileBrowser"  -- | The attribute used for the current directory displayed at the top -- of the browser. fileBrowserCurrentDirectoryAttr :: AttrName-fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> "currentDirectory"+fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> attrName "currentDirectory"  -- | The attribute used for the entry information displayed at the -- bottom of the browser. fileBrowserSelectionInfoAttr :: AttrName-fileBrowserSelectionInfoAttr = fileBrowserAttr <> "selectionInfo"+fileBrowserSelectionInfoAttr = fileBrowserAttr <> attrName "selectionInfo"  -- | The attribute used to render directory entries. fileBrowserDirectoryAttr :: AttrName-fileBrowserDirectoryAttr = fileBrowserAttr <> "directory"+fileBrowserDirectoryAttr = fileBrowserAttr <> attrName "directory"  -- | The attribute used to render block device entries. fileBrowserBlockDeviceAttr :: AttrName-fileBrowserBlockDeviceAttr = fileBrowserAttr <> "block"+fileBrowserBlockDeviceAttr = fileBrowserAttr <> attrName "block"  -- | The attribute used to render regular file entries. fileBrowserRegularFileAttr :: AttrName-fileBrowserRegularFileAttr = fileBrowserAttr <> "regular"+fileBrowserRegularFileAttr = fileBrowserAttr <> attrName "regular"  -- | The attribute used to render character device entries. fileBrowserCharacterDeviceAttr :: AttrName-fileBrowserCharacterDeviceAttr = fileBrowserAttr <> "char"+fileBrowserCharacterDeviceAttr = fileBrowserAttr <> attrName "char"  -- | The attribute used to render named pipe entries. fileBrowserNamedPipeAttr :: AttrName-fileBrowserNamedPipeAttr = fileBrowserAttr <> "pipe"+fileBrowserNamedPipeAttr = fileBrowserAttr <> attrName "pipe"  -- | The attribute used to render symbolic link entries. fileBrowserSymbolicLinkAttr :: AttrName-fileBrowserSymbolicLinkAttr = fileBrowserAttr <> "symlink"+fileBrowserSymbolicLinkAttr = fileBrowserAttr <> attrName "symlink"  -- | The attribute used to render Unix socket entries. fileBrowserUnixSocketAttr :: AttrName-fileBrowserUnixSocketAttr = fileBrowserAttr <> "unixSocket"+fileBrowserUnixSocketAttr = fileBrowserAttr <> attrName "unixSocket"  -- | The attribute used for selected entries in the file browser. fileBrowserSelectedAttr :: AttrName-fileBrowserSelectedAttr = fileBrowserAttr <> "selected"+fileBrowserSelectedAttr = fileBrowserAttr <> attrName "selected"  -- | A file type filter for use with 'setFileBrowserEntryFilter'. This -- filter permits entries whose file types are in the specified list.
src/Brick/Widgets/Internal.hs view
@@ -4,17 +4,18 @@   , cropToContext   , cropResultToContext   , renderDynBorder+  , renderWidget   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif--import Lens.Micro ((^.), (&), (%~))-import Control.Monad.Trans.State.Lazy-import Control.Monad.Trans.Reader-import Data.Maybe (catMaybes)+import Lens.Micro ((^.), (&), (%~), (.~))+import Lens.Micro.Mtl ((%=))+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Reader+import Data.Maybe (fromMaybe, mapMaybe)+import qualified Data.Map as M+import qualified Data.Set as S import qualified Graphics.Vty as V  import Brick.Types@@ -24,24 +25,58 @@ import Brick.BorderMap (BorderMap) import qualified Brick.BorderMap as BM -renderFinal :: AttrMap+renderFinal :: (Ord n)+            => AttrMap             -> [Widget n]             -> V.DisplayRegion             -> ([CursorLocation n] -> Maybe (CursorLocation n))             -> RenderState n             -> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n])-renderFinal aMap layerRenders sz chooseCursor rs = (newRS, picWithBg, theCursor, concat layerExtents)+renderFinal aMap layerRenders (w, h) chooseCursor rs =+    (newRS, picWithBg, theCursor, concat layerExtents)     where-        (layerResults, !newRS) = flip runState rs $ sequence $+        -- Reset various fields from the last rendering state so they+        -- don't accumulate or affect this rendering.+        resetRs = rs & reportedExtentsL .~ mempty+                     & observedNamesL .~ mempty+                     & clickableNamesL .~ mempty++        (layerResults, !newRS) = flip runState resetRs $ sequence $             (\p -> runReaderT p ctx) <$>-            (render <$> cropToContext <$> layerRenders)-        ctx = Context mempty (fst sz) (snd sz) defaultBorderStyle aMap False-        pic = V.picForLayers $ uncurry V.resize sz <$> (^.imageL) <$> layerResults+            (\layerWidget -> do+                result <- render $ cropToContext layerWidget+                forM_ (result^.extentsL) $ \e ->+                    reportedExtentsL %= M.insert (extentName e) e+                return result+                ) <$> reverse layerRenders++        ctx = Context { ctxAttrName = mempty+                      , availWidth = w+                      , availHeight = h+                      , windowWidth = w+                      , windowHeight = h+                      , ctxBorderStyle = defaultBorderStyle+                      , ctxAttrMap = aMap+                      , ctxDynBorders = False+                      , ctxVScrollBarOrientation = Nothing+                      , ctxVScrollBarRenderer = Nothing+                      , ctxHScrollBarOrientation = Nothing+                      , ctxHScrollBarRenderer = Nothing+                      , ctxHScrollBarShowHandles = False+                      , ctxVScrollBarShowHandles = False+                      , ctxHScrollBarClickableConstr = Nothing+                      , ctxVScrollBarClickableConstr = Nothing+                      }++        layersTopmostFirst = reverse layerResults+        pic = V.picForLayers $ V.resize w h <$> (^.imageL) <$> layersTopmostFirst+         -- picWithBg is a workaround for runaway attributes.         -- See https://github.com/coreyoconnor/vty/issues/95         picWithBg = pic { V.picBackground = V.Background ' ' V.defAttr }-        layerCursors = (^.cursorsL) <$> layerResults-        layerExtents = reverse $ (^.extentsL) <$> layerResults++        layerCursors = (^.cursorsL) <$> layersTopmostFirst+        layerExtents = reverse $ (^.extentsL) <$> layersTopmostFirst         theCursor = chooseCursor $ concat layerCursors  -- | After rendering the specified widget, crop its result image to the@@ -58,11 +93,11 @@                     & extentsL %~ cropExtents c                     & bordersL %~ cropBorders c -cropImage :: Context -> V.Image -> V.Image+cropImage :: Context n -> V.Image -> V.Image cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL) -cropCursors :: Context -> [CursorLocation n] -> [CursorLocation n]-cropCursors ctx cs = catMaybes $ cropCursor <$> cs+cropCursors :: Context n -> [CursorLocation n] -> [CursorLocation n]+cropCursors ctx cs = mapMaybe cropCursor cs     where         -- A cursor location is removed if it is not within the region         -- described by the context.@@ -75,42 +110,36 @@                , c^.cursorLocationL.locationColumnL >= ctx^.availWidthL                ] -cropExtents :: Context -> [Extent n] -> [Extent n]-cropExtents ctx es = catMaybes $ cropExtent <$> es+cropExtents :: Context n -> [Extent n] -> [Extent n]+cropExtents ctx es = mapMaybe cropExtent es     where-        -- An extent is cropped in places where it is not within the-        -- region described by the context.-        ---        -- If its entirety is outside the context region, it is dropped.-        ---        -- Otherwise its size and upper left corner are adjusted so that-        -- they are contained within the context region.-        cropExtent (Extent n (Location (c, r)) (w, h) (Location (oC, oR))) =-            -- First, clamp the upper-left corner to at least (0, 0).-            let c' = max c 0-                r' = max r 0-                -- Compute deltas for the offset since if the upper-left-                -- corner moved, so should the offset.-                dc = c' - c-                dr = r' - r-                -- Then, determine the new lower-right corner based on-                -- the clamped corner.-                endCol = c' + w-                endRow = r' + h-                -- Then clamp the lower-right corner based on the-                -- context-                endCol' = min (ctx^.availWidthL) endCol-                endRow' = min (ctx^.availHeightL) endRow-                -- Then compute the new width and height from the-                -- clamped lower-right corner.-                w' = endCol' - c'-                h' = endRow' - r'-                e = Extent n (Location (c', r')) (w', h') (Location (oC + dc, oR + dr))-            in if w' < 0 || h' < 0-               then Nothing-               else Just e+        cropExtent (Extent n (Location (c, r)) (w, h)) =+            -- Clamp the original extent's UL corner to the context.+            --+            -- Clamp the original extent's LR corner to the context.+            --+            -- Keep the modified extent (i.e. with clamped corners)+            -- only if the resulting extent has non-zero size in both+            -- dimensions.+            let nonEmpty = nonEmptyH && nonEmptyV+                nonEmptyH = newWidth > 0+                nonEmptyV = newHeight > 0+                newWidth = newEndCol - newStartCol+                newHeight = newEndRow - newStartRow+                (newStartCol, newStartRow) = clampCorner (c, r)+                (newEndCol, newEndRow) = clampCorner (c + w, r + h)+                clampCorner (cols, rows) =+                    ( clampRange (ctx^.availWidthL) cols+                    , clampRange (ctx^.availHeightL) rows+                    )+                clampRange bound val =+                    min bound $ max 0 val+                newExtent = Extent n (Location (newStartCol, newStartRow)) (newWidth, newHeight)+            in if nonEmpty+               then Just newExtent+               else Nothing -cropBorders :: Context -> BorderMap DynBorder -> BorderMap DynBorder+cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder cropBorders ctx = BM.crop Edges     { eTop = 0     , eBottom = availHeight ctx - 1@@ -119,17 +148,52 @@     }  renderDynBorder :: DynBorder -> V.Image-renderDynBorder db = V.char (dbAttr db) . ($dbStyle db) $ case bsDraw <$> dbSegments db of-    --    top   bot   left  right-    Edges False False False False -> const ' ' -- dunno lol (but should never happen, so who cares)-    Edges False False _     _     -> bsHorizontal-    Edges _     _     False False -> bsVertical-    Edges False True  False True  -> bsCornerTL-    Edges False True  True  False -> bsCornerTR-    Edges True  False False True  -> bsCornerBL-    Edges True  False True  False -> bsCornerBR-    Edges False True  True  True  -> bsIntersectT-    Edges True  False True  True  -> bsIntersectB-    Edges True  True  False True  -> bsIntersectL-    Edges True  True  True  False -> bsIntersectR-    Edges True  True  True  True  -> bsIntersectFull+renderDynBorder db = V.char (dbAttr db) $ getBorderChar $ dbStyle db+    where+        getBorderChar = case bsDraw <$> dbSegments db of+            --    top   bot   left  right+            Edges False False False False -> const ' '+            Edges False False _     _     -> bsHorizontal+            Edges _     _     False False -> bsVertical+            Edges False True  False True  -> bsCornerTL+            Edges False True  True  False -> bsCornerTR+            Edges True  False False True  -> bsCornerBL+            Edges True  False True  False -> bsCornerBR+            Edges False True  True  True  -> bsIntersectT+            Edges True  False True  True  -> bsIntersectB+            Edges True  True  False True  -> bsIntersectL+            Edges True  True  True  False -> bsIntersectR+            Edges True  True  True  True  -> bsIntersectFull++-- | This function provides a simplified interface to rendering a list+-- of 'Widget's as a 'V.Picture' outside of the context of an 'App'.+-- This can be useful in a testing setting but isn't intended to be used+-- for normal application rendering. The API is deliberately narrower+-- than the main interactive API and is not yet stable. Use at your own+-- risk.+--+-- Consult the [Vty library documentation](https://hackage.haskell.org/package/vty)+-- for details on how to output the resulting 'V.Picture'.+renderWidget :: (Ord n)+             => Maybe AttrMap+             -- ^ Optional attribute map used to render. If omitted,+             -- an empty attribute map with the terminal's default+             -- attribute will be used.+             -> [Widget n]+             -- ^ The widget layers to render, topmost first.+             -> V.DisplayRegion+             -- ^ The size of the display region in which to render the+             -- layers.+             -> V.Picture+renderWidget mAttrMap layerRenders region = pic+    where+        initialRS = RS { viewportMap = M.empty+                       , rsScrollRequests = []+                       , observedNames = S.empty+                       , renderCache = mempty+                       , clickableNames = []+                       , requestedVisibleNames_ = S.empty+                       , reportedExtents = mempty+                       }+        am = fromMaybe (attrMap V.defAttr []) mAttrMap+        (_, pic, _, _) = renderFinal am layerRenders region (const Nothing) initialRS
src/Brick/Widgets/List.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable#-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}@@ -37,6 +35,7 @@   , listSelectedL   , listNameL   , listItemHeightL+  , listSelectedElementL    -- * Accessors   , listElements@@ -55,6 +54,8 @@   , listMoveByPages   , listMovePageUp   , listMovePageDown+  , listMoveToBeginning+  , listMoveToEnd   , listInsert   , listRemove   , listReplace@@ -62,6 +63,9 @@   , listReverse   , listModify +  -- * Querying a list+  , listFindFirst+   -- * Attributes   , listAttr   , listSelectedAttr@@ -75,20 +79,18 @@  import Prelude hiding (reverse, splitAt) -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), (<*>), pure)-import Data.Foldable (Foldable, find, toList)-import Data.Traversable (Traversable)-#else+import Control.Applicative ((<|>)) import Data.Foldable (find, toList)-#endif-import Control.Monad.Trans.State (evalState, get, put)+import Control.Monad.State (evalState) -import Lens.Micro ((^.), (^?), (&), (.~), (%~), _2, _head, set)+import Lens.Micro (Traversal', (^.), (^?), (&), (.~), (%~), _2, set) import Data.Functor (($>)) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Maybe (fromMaybe)-import Data.Semigroup (Semigroup, (<>), sconcat)+#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@@ -193,22 +195,21 @@ -- * Go to last element (End) handleListEvent :: (Foldable t, Splittable t, Ord n)                 => Event-                -> GenericList n t e-                -> EventM n (GenericList n t e)-handleListEvent e theList =+                -> EventM n (GenericList n t e) ()+handleListEvent e =     case e of-        EvKey KUp [] -> return $ listMoveUp theList-        EvKey KDown [] -> return $ listMoveDown theList-        EvKey KHome [] -> return $ listMoveTo 0 theList-        EvKey KEnd [] -> return $ listMoveTo (length $ listElements theList) theList-        EvKey KPageDown [] -> listMovePageDown theList-        EvKey KPageUp [] -> listMovePageUp theList-        _ -> return theList+        EvKey KUp [] -> modify listMoveUp+        EvKey KDown [] -> modify listMoveDown+        EvKey KHome [] -> modify listMoveToBeginning+        EvKey KEnd [] -> modify listMoveToEnd+        EvKey KPageDown [] -> listMovePageDown+        EvKey KPageUp [] -> listMovePageUp+        _ -> return ()  -- | Enable list movement with the vi keys with a fallback handler if--- none match. Use 'handleListEventVi' 'handleListEvent' in place of--- 'handleListEvent' to add the vi keys bindings to the standard ones.--- Movements handled include:+-- 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)@@ -219,37 +220,48 @@ -- * Go to first element (g) -- * Go to last element (G) handleListEventVi :: (Foldable t, Splittable t, Ord n)-                  => (Event -> GenericList n t e -> EventM n (GenericList n t e))+                  => (Event -> EventM n (GenericList n t e) ())                   -- ^ Fallback event handler to use if none of the vi keys                   -- match.                   -> Event-                  -> GenericList n t e-                  -> EventM n (GenericList n t e)-handleListEventVi fallback e theList =+                  -> EventM n (GenericList n t e) ()+handleListEventVi fallback e =     case e of-        EvKey (KChar 'k') [] -> return $ listMoveUp theList-        EvKey (KChar 'j') [] -> return $ listMoveDown theList-        EvKey (KChar 'g') [] -> return $ listMoveTo 0 theList-        EvKey (KChar 'G') [] -> return $ listMoveTo (length $ listElements theList) theList-        EvKey (KChar 'f') [MCtrl] -> listMovePageDown theList-        EvKey (KChar 'b') [MCtrl] -> listMovePageUp theList-        EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double) theList-        EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double) theList-        _ -> fallback e theList+        EvKey (KChar 'k') []      -> modify listMoveUp+        EvKey (KChar 'j') []      -> modify listMoveDown+        EvKey (KChar 'g') []      -> modify listMoveToBeginning+        EvKey (KChar 'G') []      -> modify listMoveToEnd+        EvKey (KChar 'f') [MCtrl] -> listMovePageDown+        EvKey (KChar 'b') [MCtrl] -> listMovePageUp+        EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double)+        EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double)+        _                         -> fallback e +-- | Move the list selection to the first element in the list.+listMoveToBeginning :: (Foldable t, Splittable t)+                    => GenericList n t e+                    -> GenericList n t e+listMoveToBeginning = listMoveTo 0++-- | Move the list selection to the last element in the list.+listMoveToEnd :: (Foldable t, Splittable t)+              => GenericList n t e+              -> GenericList n t e+listMoveToEnd l = listMoveTo (max 0 $ length (listElements l) - 1) l+ -- | The top-level attribute used for the entire list. listAttr :: AttrName-listAttr = "list"+listAttr = attrName "list"  -- | The attribute used only for the currently-selected list item when -- the list does not have focus. Extends 'listAttr'. listSelectedAttr :: AttrName-listSelectedAttr = listAttr <> "selected"+listSelectedAttr = listAttr <> attrName "selected"  -- | The attribute used only for the currently-selected list item when -- the list has focus. Extends 'listSelectedAttr'. listSelectedFocusedAttr :: AttrName-listSelectedFocusedAttr = listSelectedAttr <> "focused"+listSelectedFocusedAttr = listSelectedAttr <> attrName "focused"  -- | Construct a list in terms of container 't' with element type 'e'. list :: (Foldable t)@@ -462,8 +474,7 @@  -- | Move the list selected index up by one page. listMovePageUp :: (Foldable t, Splittable t, Ord n)-               => GenericList n t e-               -> EventM n (GenericList n t e)+               => EventM n (GenericList n t e) () listMovePageUp = listMoveByPages (-1::Double)  -- | Move the list selected index down by one. (Moves the cursor down,@@ -475,23 +486,22 @@  -- | Move the list selected index down by one page. listMovePageDown :: (Foldable t, Splittable t, Ord n)-                 => GenericList n t e-                 -> EventM n (GenericList n t e)+                 => EventM n (GenericList n t e) () listMovePageDown = listMoveByPages (1::Double)  -- | Move the list selected index by some (fractional) number of pages. listMoveByPages :: (Foldable t, Splittable t, Ord n, RealFrac m)                 => m-                -> GenericList n t e-                -> EventM n (GenericList n t e)-listMoveByPages pages theList = do+                -> EventM n (GenericList n t e) ()+listMoveByPages pages = do+    theList <- get     v <- lookupViewport (theList^.listNameL)     case v of-        Nothing -> return theList+        Nothing -> return ()         Just vp -> do             let nElems = round $ pages * fromIntegral (vp^.vpSize._2) /                                  fromIntegral (theList^.listItemHeightL)-            return $ listMoveBy nElems theList+            modify $ listMoveBy nElems  -- | Move the list selected index. --@@ -527,7 +537,7 @@ -- 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 evalutes+-- If @pos < 0@, indexes from the end of the list (which evaluates -- 'length' of the list). -- -- Complexity: same as 'splitAt' for the container type.@@ -571,11 +581,26 @@                   -> GenericList n t e listMoveToElement e = listFindBy (== e) . set listSelectedL Nothing --- | Set the selected index to the next element matching the--- predicate.  If there is no selected element, the search starts at--- the beginning.  If no matching element is found, leave the list--- unmodified.+-- | Find the first element in the list that satisfies the specified+-- predicate. If such an element is found, return the resulting index+-- and element. --+-- /O(n)/.+listFindFirst :: (Semigroup (t e), Splittable t, Traversable t)+              => (e -> Bool)+              -> GenericList n t e+              -> Maybe (Int, e)+listFindFirst f l =+    listSelectedElement $+    listFindBy f $+    set listSelectedL Nothing l++-- | Starting from the currently-selected position, attempt to find+-- and select the next element matching the predicate. If there are no+-- matches for the remainder of the list or if the list has no selection+-- at all, the search starts at the beginning. If no matching element is+-- found anywhere in the list, leave the list unmodified.+-- -- /O(n)/.  Only evaluates as much of the container as needed. listFindBy :: (Foldable t, Splittable t)            => (e -> Bool)@@ -583,10 +608,34 @@            -> GenericList n t e listFindBy test l =     let start = maybe 0 (+1) (l ^. listSelectedL)-        (_, t) = splitAt start (l ^. listElementsL)-        result = find (test . snd) . zip [0..] . toList $ t-    in maybe id (set listSelectedL . Just . (start +) . fst) result l+        (h, t) = splitAt start (l ^. listElementsL)+        tailResult = find (test . snd) . zip [start..] . toList $ t+        headResult = find (test . snd) . zip [0..] . toList $ h+        result = tailResult <|> headResult+    in maybe id (set listSelectedL . Just . fst) result l +-- | Traversal that targets the selected element, if any.+--+-- Complexity: depends on usage as well as the list's container type.+--+-- @+-- listSelectedElementL for 'List': O(1) -- preview, fold+--                                O(n) -- set, modify, traverse+-- listSelectedElementL for 'Seq.Seq': O(log(min(i, n - i)))  -- all operations+-- @+--+listSelectedElementL :: (Splittable t, Traversable t, Semigroup (t e))+                     => Traversal' (GenericList n t e) e+listSelectedElementL f l =+    case l ^. listSelectedL of+        Nothing -> pure l+        Just i -> listElementsL go l+            where+                go l' = let (left, rest) = splitAt i l'+                            -- middle contains the target element (if any)+                            (middle, right) = splitAt 1 rest+                        in (\m -> left <> m <> right) <$> (traverse f middle)+ -- | Return a list's selected element, if any. -- -- Only evaluates as much of the container as needed.@@ -597,13 +646,11 @@ -- listSelectedElement for 'List': O(1) -- listSelectedElement for 'Seq.Seq': O(log(min(i, n - i))) -- @-listSelectedElement :: (Splittable t, Foldable t)+listSelectedElement :: (Splittable t, Traversable t, Semigroup (t e))                     => GenericList n t e                     -> Maybe (Int, e)-listSelectedElement l = do-    sel <- l^.listSelectedL-    let (_, xs) = splitAt sel (l ^. listElementsL)-    (sel,) <$> toList xs ^? _head+listSelectedElement l =+    (,) <$> l^.listSelectedL <*> l^?listSelectedElementL  -- | Remove all elements from the list and clear the selection. --@@ -632,11 +679,16 @@ -- -- Complexity: same as 'traverse' for the container type (typically -- /O(n)/).-listModify :: (Traversable t)+--+-- Complexity: same as 'listSelectedElementL' for the list's container type.+--+-- @+-- listModify for 'List': O(n)+-- listModify for 'Seq.Seq': O(log(min(i, n - i)))+-- @+--+listModify :: (Traversable t, Splittable t, Semigroup (t e))            => (e -> e)            -> GenericList n t e            -> GenericList n t e-listModify f l =-    case l ^. listSelectedL of-        Nothing -> l-        Just j -> l & listElementsL %~ imap (\i e -> if i == j then f e else e)+listModify f = listSelectedElementL %~ f
src/Brick/Widgets/ProgressBar.hs view
@@ -3,6 +3,7 @@ -- | This module provides a progress bar widget. module Brick.Widgets.ProgressBar   ( progressBar+  , customProgressBar   -- * Attributes   , progressCompleteAttr   , progressIncompleteAttr@@ -22,11 +23,11 @@  -- | The attribute of the completed portion of the progress bar. progressCompleteAttr :: AttrName-progressCompleteAttr = "progressComplete"+progressCompleteAttr = attrName "progressComplete"  -- | The attribute of the incomplete portion of the progress bar. progressIncompleteAttr :: AttrName-progressIncompleteAttr = "progressIncomplete"+progressIncompleteAttr = attrName "progressIncomplete"  -- | Draw a progress bar with the specified (optional) label and -- progress value. This fills available horizontal space and is one row@@ -37,18 +38,47 @@             -> Float             -- ^ The progress value. Should be between 0 and 1 inclusive.             -> Widget n-progressBar mLabel progress =+progressBar = customProgressBar ' ' ' '++-- | Draw a progress bar with the specified (optional) label,+-- progress value and custom characters to fill the progress.+-- This fills available horizontal space and is one row high.+-- Please be aware of using wide characters in Brick,+-- see [Wide Character Support and the TextWidth class](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst#wide-character-support-and-the-textwidth-class)+customProgressBar :: Char+                  -- ^ Character to fill the completed part.+                  -> Char+                  -- ^ Character to fill the incomplete part.+                  -> Maybe String+                  -- ^ The label. If specified, this is shown in the center of+                  -- the progress bar.+                  -> Float+                  -- ^ The progress value. Should be between 0 and 1 inclusive.+                  -> Widget n+customProgressBar completeChar incompleteChar mLabel progress =     Widget Greedy Fixed $ do         c <- getContext         let barWidth = c^.availWidthL             label = fromMaybe "" mLabel             labelWidth = safeWcswidth label             spacesWidth = barWidth - labelWidth-            leftPart = replicate (spacesWidth `div` 2) ' '-            rightPart = replicate (barWidth - (labelWidth + length leftPart)) ' '+            leftWidth = spacesWidth `div` 2+            rightWidth = barWidth - labelWidth - leftWidth+            completeWidth = round $ progress * toEnum barWidth++            leftCompleteWidth = min leftWidth completeWidth+            leftIncompleteWidth = leftWidth - leftCompleteWidth+            leftPart = replicate leftCompleteWidth completeChar ++ replicate leftIncompleteWidth incompleteChar+            rightCompleteWidth = max 0 (completeWidth - labelWidth - leftWidth)+            rightIncompleteWidth = rightWidth - rightCompleteWidth+            rightPart = replicate rightCompleteWidth completeChar ++ replicate rightIncompleteWidth incompleteChar+             fullBar = leftPart <> label <> rightPart-            completeWidth = round $ progress * toEnum (length fullBar)-            completePart = take completeWidth fullBar-            incompletePart = drop completeWidth fullBar+            adjustedCompleteWidth = if completeWidth == length fullBar && progress < 1.0+                                    then completeWidth - 1+                                    else if completeWidth == 0 && progress > 0.0+                                         then 1+                                         else completeWidth+            (completePart, incompletePart) = splitAt adjustedCompleteWidth fullBar         render $ (withAttr progressCompleteAttr $ str completePart) <+>                  (withAttr progressIncompleteAttr $ str incompletePart)
+ src/Brick/Widgets/Table.hs view
@@ -0,0 +1,389 @@+{-# LANGUAGE MultiWayIf #-}+-- | This module provides a table widget that can draw other widgets+-- in a table layout, draw borders between rows and columns, and allow+-- configuration of row and column alignment. To get started, see+-- 'table'.+module Brick.Widgets.Table+  (+  -- * Types+    Table+  , ColumnAlignment(..)+  , RowAlignment(..)+  , TableException(..)++  -- * Construction+  , table++  -- * Configuration+  , alignLeft+  , alignRight+  , alignCenter+  , alignTop+  , alignMiddle+  , alignBottom+  , setColAlignment+  , setRowAlignment+  , setDefaultColAlignment+  , setDefaultRowAlignment+  , surroundingBorder+  , rowBorders+  , columnBorders++  -- * Rendering+  , renderTable++  -- * Low-level API+  , RenderedTableCells(..)+  , BorderConfiguration(..)+  , tableCellLayout+  , addBorders+  , alignColumns+  )+where++import Control.Monad (forM)+import qualified Control.Exception as E+import Data.List (transpose, intersperse, nub)+import qualified Data.Map as M+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid ((<>))+#endif+import Graphics.Vty (imageHeight, imageWidth, charFill)+import Lens.Micro ((^.))++import Brick.Types+import Brick.Widgets.Core+import Brick.Widgets.Center+import Brick.Widgets.Border++-- | Column alignment modes. Use these modes with the alignment+-- functions in this module to configure column alignment behavior.+data ColumnAlignment =+    AlignLeft+    -- ^ Align all cells to the left.+    | AlignCenter+    -- ^ Center the content horizontally in all cells in the column.+    | AlignRight+    -- ^ Align all cells to the right.+    deriving (Eq, Show, Read)++-- | Row alignment modes. Use these modes with the alignment functions+-- in this module to configure row alignment behavior.+data RowAlignment =+    AlignTop+    -- ^ Align all cells to the top.+    | AlignMiddle+    -- ^ Center the content vertically in all cells in the row.+    | AlignBottom+    -- ^ Align all cells to the bottom.+    deriving (Eq, Show, Read)++-- | A table creation exception.+data TableException =+    TEUnequalRowSizes+    -- ^ Rows did not all have the same number of cells.+    | TEInvalidCellSizePolicy+    -- ^ Some cells in the table did not use the 'Fixed' size policy for+    -- both horizontal and vertical sizing.+    deriving (Eq, Show, Read)++instance E.Exception TableException where++-- | A table data structure for widgets of type 'Widget' @n@. Create a+-- table with 'table'.+data Table n =+    Table { columnAlignments :: M.Map Int ColumnAlignment+          , rowAlignments :: M.Map Int RowAlignment+          , tableRows :: [[Widget n]]+          , defaultColumnAlignment :: ColumnAlignment+          , defaultRowAlignment :: RowAlignment+          , tableBorderConfiguration :: BorderConfiguration+          }++-- | A border configuration for a table.+data BorderConfiguration =+    BorderConfiguration { drawSurroundingBorder :: Bool+                        , drawRowBorders :: Bool+                        , drawColumnBorders :: Bool+                        }++-- | Construct a new table.+--+-- The argument is the list of rows with the topmost row first, with+-- each element of the argument list being the contents of the cells in+-- in each column of the respective row, with the leftmost cell first.+--+-- Each row's height is determined by the height of the tallest cell+-- in that row, and each column's width is determined by the width of+-- the widest cell in that column. This means that control over row+-- and column dimensions is a matter of controlling the size of the+-- individual cells, such as by wrapping cell contents in padding,+-- 'fill' and 'hLimit' or 'vLimit', etc. This also means that it is not+-- necessary to explicitly set the width of most table cells because+-- the table will determine the per-row and per-column dimensions by+-- looking at the largest cell contents. In particular, this means+-- that the table's alignment logic only has an effect when a given+-- cell's contents are smaller than the maximum for its row and column,+-- thus giving the table some way to pad the contents to result in the+-- desired alignment.+--+-- By default:+--+-- * All columns are left-aligned. Use the alignment functions in this+-- module to change that behavior.+-- * All rows are top-aligned. Use the alignment functions in this+-- module to change that behavior.+-- * The table will draw borders between columns, between rows, and+-- around the outside of the table. Border-drawing behavior can be+-- configured with the API in this module. Note that tables always draw+-- with 'joinBorders' enabled. If a cell's contents has smart borders+-- but you don't want those borders to connect to the surrounding table+-- borders, wrap the cell's contents with 'freezeBorders'.+--+-- All cells of all rows MUST use the 'Fixed' growth policy for both+-- horizontal and vertical growth. If the argument list contains any+-- cells that use the 'Greedy' policy, this function will raise a+-- 'TableException'.+--+-- All rows MUST have the same number of cells. If not, this function+-- will raise a 'TableException'.+table :: [[Widget n]] -> Table n+table rows =+    if | not allFixed      -> E.throw TEInvalidCellSizePolicy+       | not allSameLength -> E.throw TEUnequalRowSizes+       | otherwise         -> t+    where+        allSameLength = length (nub (length <$> rows)) <= 1+        allFixed = all fixedRow rows+        fixedRow = all fixedCell+        fixedCell w = hSize w == Fixed && vSize w == Fixed+        t = Table { columnAlignments = mempty+                  , rowAlignments = mempty+                  , tableRows = rows+                  , defaultColumnAlignment = AlignLeft+                  , defaultRowAlignment = AlignTop+                  , tableBorderConfiguration =+                      BorderConfiguration { drawSurroundingBorder = True+                                          , drawRowBorders = True+                                          , drawColumnBorders = True+                                          }+                  }++-- | Configure whether the table draws a border on its exterior.+surroundingBorder :: Bool -> Table n -> Table n+surroundingBorder b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawSurroundingBorder = b } }++-- | Configure whether the table draws borders between its rows.+rowBorders :: Bool -> Table n -> Table n+rowBorders b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawRowBorders = b } }++-- | Configure whether the table draws borders between its columns.+columnBorders :: Bool -> Table n -> Table n+columnBorders b t =+    t { tableBorderConfiguration = (tableBorderConfiguration t) { drawColumnBorders = b } }++-- | Align the specified column to the right. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignRight :: Int -> Table n -> Table n+alignRight = setColAlignment AlignRight++-- | Align the specified column to the left. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignLeft :: Int -> Table n -> Table n+alignLeft = setColAlignment AlignLeft++-- | Align the specified column to center. The argument is the column+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignCenter :: Int -> Table n -> Table n+alignCenter = setColAlignment AlignCenter++-- | Align the specified row to the top. The argument is the row index,+-- starting with zero. Silently does nothing if the index is out of+-- range.+alignTop :: Int -> Table n -> Table n+alignTop = setRowAlignment AlignTop++-- | Align the specified row to the middle. The argument is the row+-- index, starting with zero. Silently does nothing if the index is out+-- of range.+alignMiddle :: Int -> Table n -> Table n+alignMiddle = setRowAlignment AlignMiddle++-- | Align the specified row to bottom. The argument is the row index,+-- starting with zero. Silently does nothing if the index is out of+-- range.+alignBottom :: Int -> Table n -> Table n+alignBottom = setRowAlignment AlignBottom++-- | Set the alignment for the specified column index (starting at+-- zero). Silently does nothing if the index is out of range.+setColAlignment :: ColumnAlignment -> Int -> Table n -> Table n+setColAlignment a col t =+    t { columnAlignments = M.insert col a (columnAlignments t) }++-- | Set the alignment for the specified row index (starting at+-- zero). Silently does nothing if the index is out of range.+setRowAlignment :: RowAlignment -> Int -> Table n -> Table n+setRowAlignment a row t =+    t { rowAlignments = M.insert row a (rowAlignments t) }++-- | Set the default column alignment for columns with no explicitly+-- configured alignment.+setDefaultColAlignment :: ColumnAlignment -> Table n -> Table n+setDefaultColAlignment a t =+    t { defaultColumnAlignment = a }++-- | Set the default row alignment for rows with no explicitly+-- configured alignment.+setDefaultRowAlignment :: RowAlignment -> Table n -> Table n+setDefaultRowAlignment a t =+    t { defaultRowAlignment = a }++-- | Render the table.+renderTable :: Table n -> Widget n+renderTable t =+    joinBorders $+    Widget Fixed Fixed $ do+        tableCellLayout t >>= addBorders >>= render++-- | The result of performing table cell intermediate rendering and+-- layout.+data RenderedTableCells n =+    RenderedTableCells { renderedTableRows :: [[Widget n]]+                       -- ^ The table's cells in row-major order.+                       , renderedTableColumnWidths :: [Int]+                       -- ^ The widths of the table's columns.+                       , renderedTableRowHeights :: [Int]+                       -- ^ The heights of the table's rows.+                       , borderConfiguration :: BorderConfiguration+                       -- ^ The border configuration to use.+                       }++-- | Augment rendered table cells with borders according to the+-- border configuration accompanying the cells.+addBorders :: RenderedTableCells n -> RenderM n (Widget n)+addBorders r = do+    let cfg = borderConfiguration r+        rows = renderedTableRows r+        rowHeights = renderedTableRowHeights r+        colWidths = renderedTableColumnWidths r++        contentWidth = sum colWidths+        contentHeight = sum rowHeights++        hBorderLength = contentWidth + if drawColumnBorders cfg+                                       then max (length colWidths - 1) 0+                                       else 0+        vBorderHeight = contentHeight + if drawRowBorders cfg+                                        then max (length rowHeights - 1) 0+                                        else 0+        horizBorder = hLimit hBorderLength hBorder+        vertBorder = vLimit vBorderHeight vBorder++        leftBorder =+            vBox [topLeftCorner, vertBorder, bottomLeftCorner]+        rightBorder =+            vBox [topRightCorner, vertBorder, bottomRightCorner]++        maybeWrap check f =+            if check cfg then f else id+        addSurroundingBorder b =+            leftBorder <+> (horizBorder <=> b <=> horizBorder) <+> rightBorder+        addRowBorders =+            intersperse horizBorder++        rowsWithColumnBorders = (\(h, row) -> hBox $ maybeColumnBorders h row) <$> zip rowHeights rows+        maybeColumnBorders height = maybeIntersperse cfg drawColumnBorders (vLimit height vBorder)+        body = vBox $+               maybeWrap drawRowBorders addRowBorders rowsWithColumnBorders++    return $ maybeWrap drawSurroundingBorder addSurroundingBorder body++tableCellLayout :: Table n -> RenderM n (RenderedTableCells n)+tableCellLayout t = do+    ctx <- getContext+    cellResults <- forM (tableRows t) $ mapM render++    let rowHeights = rowHeight <$> cellResults+        colWidths = colWidth <$> transpose cellResults+        numRows = length rowHeights+        numCols = if length cellResults >= 1+                     then length (cellResults !! 0)+                     else 0+        allRowAligns = (\i -> M.findWithDefault (defaultRowAlignment t) i (rowAlignments t)) <$>+                       [0..numRows - 1]+        allColAligns = (\i -> M.findWithDefault (defaultColumnAlignment t) i (columnAlignments t)) <$>+                       [0..numCols - 1]+        rowHeight = maximum . fmap (imageHeight . image)+        colWidth = maximum . fmap (imageWidth . image)++        toW = Widget Fixed Fixed . return+        fillEmptyCell w h result =+            if imageWidth (image result) == 0 && imageHeight (image result) == 0+            then result { image = charFill (ctx^.attrL) ' ' w h }+            else result+        mkRow (vAlign, height, rowCells) =+            let paddedCells = flip map (zip3 allColAligns colWidths rowCells) $ \(hAlign, width, cell) ->+                    applyColAlignment width hAlign $+                    applyRowAlignment height vAlign $+                    toW $+                    fillEmptyCell width height cell+            in paddedCells++    let rows = mkRow <$> zip3 allRowAligns rowHeights cellResults++    return $ RenderedTableCells { renderedTableRows = rows+                                , renderedTableColumnWidths = colWidths+                                , renderedTableRowHeights = rowHeights+                                , borderConfiguration = tableBorderConfiguration t+                                }++maybeIntersperse :: BorderConfiguration -> (BorderConfiguration -> Bool) -> Widget n -> [Widget n] -> [Widget n]+maybeIntersperse cfg f v | f cfg = intersperse v+                         | otherwise = id++topLeftCorner :: Widget n+topLeftCorner = joinableBorder $ Edges False True False True++topRightCorner :: Widget n+topRightCorner = joinableBorder $ Edges False True True False++bottomLeftCorner :: Widget n+bottomLeftCorner = joinableBorder $ Edges True False False True++bottomRightCorner :: Widget n+bottomRightCorner = joinableBorder $ Edges True False True False++-- | Given a "table row" of widgets, align each one according to the+-- list of specified column alignments in columns of the specified+-- widths.+alignColumns :: [ColumnAlignment]+             -- ^ The column alignments to use for each widget,+             -- respectively.+             -> [Int]+             -- ^ The width of each column in terminal columns,+             -- respectively.+             -> [Widget n]+             -- ^ The column cells to align.+             -> [Widget n]+alignColumns as widths cells =+    (\(w, a, c) -> applyColAlignment w a c) <$> zip3 widths as cells++applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n+applyColAlignment width align w =+    hLimit width $ case align of+        AlignLeft   -> padRight Max w+        AlignCenter -> hCenter w+        AlignRight  -> padLeft Max w++applyRowAlignment :: Int -> RowAlignment -> Widget n -> Widget n+applyRowAlignment rHeight align w =+    vLimit rHeight $ case align of+        AlignTop    -> padBottom Max w+        AlignMiddle -> vCenter w+        AlignBottom -> padTop Max w
− src/Data/Text/Markup.hs 
@@ -1,90 +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-  , isEmpty-  , (@@)-  )-where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-import Data.Monoid-#endif--import qualified Data.Semigroup as Sem-import Data.String (IsString(..))-import qualified Data.Text as T---- | Markup with metadata type 'a' assigned to each character.-data Markup a = Markup [(Char, a)]-              deriving Show--instance Sem.Semigroup (Markup a) where-    (Markup t1) <> (Markup t2) = Markup (t1 `mappend` t2)--instance Monoid (Markup a) where-    mempty = Markup mempty-    mappend = (Sem.<>)--instance (Monoid a) => IsString (Markup a) where-    fromString = fromText . T.pack---- | Build a piece of markup; assign the specified metadata to every--- character in the specified text.-(@@) :: T.Text -> a -> Markup a-t @@ val = Markup [(c, val) | c <- T.unpack t]---- | Build markup from text with the default metadata.-fromText :: (Monoid a) => T.Text -> Markup a-fromText = (@@ mempty)---- | Extract the text from markup, discarding the markup metadata.-toText :: (Eq a) => Markup a -> T.Text-toText = T.concat . (fst <$>) . concat . markupToList---- | Test whether the markup is empty.-isEmpty :: Markup a -> Bool-isEmpty (Markup ls) = null ls---- | Set the metadata for a range of character positions in a piece of--- markup. This is useful for, e.g., syntax highlighting.-markupSet :: (Eq a) => (Int, Int) -> a -> Markup a -> Markup a-markupSet (start, len) val m@(Markup l) = if start < 0 || start + len > length l-                                          then m-                                          else newM-    where-        newM = Markup $ theHead ++ theNewEntries ++ theTail-        (theHead, theLongTail) = splitAt start l-        (theOldEntries, theTail) = splitAt len theLongTail-        theNewEntries = zip (fst <$> theOldEntries) (repeat val)---- | Convert markup to a list of lines. Each line is represented by a--- list of pairs in which each pair contains the longest subsequence of--- characters having the same metadata.-markupToList :: (Eq a) => Markup a -> [[(T.Text, a)]]-markupToList (Markup thePairs) = toList <$> toLines [] [] thePairs-    where-        toLines ls cur [] = ls ++ [cur]-        toLines ls cur ((ch, val):rest)-            | ch == '\n' = toLines (ls ++ [cur]) [] rest-            | otherwise = toLines ls (cur ++ [(ch, val)]) rest--        toList [] = []-        toList ((ch, val):rest) = (T.pack $ ch : (fst <$> matching), val) : toList remaining-            where-                (matching, remaining) = break (\(_, v) -> v /= val) rest---- | Convert a list of text and metadata pairs into markup.-fromList :: [(T.Text, a)] -> Markup a-fromList pairs = Markup $ concatMap (\(t, val) -> [(c, val) | c <- T.unpack t]) pairs
tests/List.hs view
@@ -1,14 +1,13 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeSynonymInstances #-}- module List-  (-    main-  ) where+  ( main+  )+where  import Prelude hiding (reverse, splitAt) @@ -18,7 +17,9 @@ import Data.Maybe (isNothing) import Data.Monoid (Endo(..)) import Data.Proxy+#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup((<>)))+#endif  import qualified Data.Sequence as Seq import qualified Data.Vector as V@@ -29,57 +30,56 @@ import Brick.Widgets.List  instance (Arbitrary n, Arbitrary a) => Arbitrary (List n a) where-  arbitrary = list <$> arbitrary <*> (V.fromList <$> arbitrary) <*> pure 1-+    arbitrary = list <$> arbitrary <*> (V.fromList <$> arbitrary) <*> pure 1  -- List move operations that never modify the underlying list-data ListMoveOp a-  = MoveUp-  | MoveDown-  | MoveBy Int-  | MoveTo Int-  | MoveToElement a-  | FindElement a-  deriving (Show)+data ListMoveOp a =+    MoveUp+    | MoveDown+    | MoveBy Int+    | MoveTo Int+    | MoveToElement a+    | FindElement a+    deriving (Show)  instance Arbitrary a => Arbitrary (ListMoveOp a) where-  arbitrary = oneof-    [ pure MoveUp-    , pure MoveDown-    , MoveBy <$> arbitrary-    , MoveTo <$> arbitrary-    , MoveToElement <$> arbitrary-    , FindElement <$> arbitrary-    ]+    arbitrary =+        oneof [ pure MoveUp+              , pure MoveDown+              , MoveBy <$> arbitrary+              , MoveTo <$> arbitrary+              , MoveToElement <$> arbitrary+              , FindElement <$> arbitrary+              ]  -- List operations.  We don't have "page"-based movement operations -- because these depend on render context (i.e. effect in EventM)-data ListOp a-  = Insert Int a-  | Remove Int-  | Replace Int [a]-  | Clear-  | Reverse-  | ListMoveOp (ListMoveOp a)-  deriving (Show)+data ListOp a =+    Insert Int a+    | Remove Int+    | Replace Int [a]+    | Clear+    | Reverse+    | ListMoveOp (ListMoveOp a)+    deriving (Show)  instance Arbitrary a => Arbitrary (ListOp a) where-  arbitrary = frequency-    [ (1, Insert <$> arbitrary <*> arbitrary)-    , (1, Remove <$> arbitrary)-    , (1, Replace <$> arbitrary <*> arbitrary)-    , (1, pure Clear)-    , (1, pure Reverse)-    , (6, arbitrary)-    ]+    arbitrary =+        frequency [ (1, Insert <$> arbitrary <*> arbitrary)+                  , (1, Remove <$> arbitrary)+                  , (1, Replace <$> arbitrary <*> arbitrary)+                  , (1, pure Clear)+                  , (1, pure Reverse)+                  , (6, arbitrary)+                  ]  -- Turn a ListOp into a List endomorphism op :: Eq a => ListOp a -> List n a -> List n a op (Insert i a) = listInsert i a op (Remove i) = listRemove i op (Replace i xs) =-  -- avoid setting index to Nothing-  listReplace (V.fromList xs) (Just i)+    -- avoid setting index to Nothing+    listReplace (V.fromList xs) (Just i) op Clear = listClear op Reverse = listReverse op (ListMoveOp mo) = moveOp mo@@ -93,63 +93,61 @@ moveOp (MoveToElement a) = listMoveToElement a moveOp (FindElement a) = listFindBy (== a) -applyListOps-  :: (Foldable t)-  => (op a -> List n a -> List n a) -> t (op a) -> List n a -> List n a+applyListOps :: (Foldable t)+             => (op a -> List n a -> List n a)+             -> t (op a)+             -> List n a+             -> List n a applyListOps f = appEndo . foldMap (Endo . f) - -- | Initial selection is always 0 (or Nothing for empty list) prop_initialSelection :: [a] -> Bool prop_initialSelection xs =-  list () (V.fromList xs) 1 ^. listSelectedL ==-    if null xs then Nothing else Just 0+    list () (V.fromList xs) 1 ^. listSelectedL ==+        if null xs then Nothing else Just 0  -- list operations keep the selected index in bounds-prop_listOpsMaintainSelectedValid-  :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_listOpsMaintainSelectedValid :: (Eq a)+                                  => [ListOp a]+                                  -> List n a+                                  -> Bool prop_listOpsMaintainSelectedValid ops l =-  let l' = applyListOps op ops l-  in-    case l' ^. listSelectedL of-      -- either there is no selection and list is empty-      Nothing -> null l'-      -- or the selected index is valid-      Just i -> i >= 0 && i < length l'+    let l' = applyListOps op ops l+    in case l' ^. listSelectedL of+        -- either there is no selection and list is empty+        Nothing -> null l'+        -- or the selected index is valid+        Just i -> i >= 0 && i < length l'  -- reversing a list keeps the selected element the same-prop_reverseMaintainsSelectedElement-  :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_reverseMaintainsSelectedElement :: (Eq a)+                                     => [ListOp a]+                                     -> List n a+                                     -> Bool prop_reverseMaintainsSelectedElement ops l =-  let     -- apply some random list ops to (probably) set a selected element-    l' = applyListOps op ops l-    l'' = listReverse l'-  in-    fmap snd (listSelectedElement l') == fmap snd (listSelectedElement l'')+    let l' = applyListOps op ops l+        l'' = listReverse l'+    in fmap snd (listSelectedElement l') == fmap snd (listSelectedElement l'')  -- reversing maintains size of list prop_reverseMaintainsSizeOfList :: List n a -> Bool prop_reverseMaintainsSizeOfList l =-  length l == length (listReverse l)+    length l == length (listReverse l)  -- an inserted element may always be found at the given index -- (when target index is clamped to 0 <= n <= len) prop_insert :: (Eq a) => Int -> a -> List n a -> Bool prop_insert i a l =-  let-    l' = listInsert i a l-    i' = clamp 0 (length l) i-  in-    listSelectedElement (listMoveTo i' l') == Just (i', a)+    let l' = listInsert i a l+        i' = clamp 0 (length l) i+    in listSelectedElement (listMoveTo i' l') == Just (i', a)  -- inserting anywhere always increases size of list by 1 prop_insertSize :: (Eq a) => Int -> a -> List n a -> Bool prop_insertSize i a l =-  let-    l' = listInsert i a l-  in-    length l' == length l + 1+    let l' = listInsert i a l+    in length l' == length l + 1  -- inserting an element and moving to it always succeeds and -- the selected element is the one we inserted.@@ -160,11 +158,9 @@ -- prop_insertMoveTo :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool prop_insertMoveTo ops l i a =-  let-    l' = listInsert i a (applyListOps op ops l)-    sel = listSelectedElement (listMoveToElement a l')-  in-    fmap snd sel == Just a+    let l' = listInsert i a (applyListOps op ops l)+        sel = listSelectedElement (listMoveToElement a l')+    in fmap snd sel == Just a  -- inserting an element and repeatedly seeking it always -- reaches the element we inserted, at the index where we@@ -172,57 +168,38 @@ -- prop_insertFindBy :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool prop_insertFindBy ops l i a =-  let-    l' = applyListOps op ops l-    l'' = set listSelectedL Nothing . listInsert i a $ l'-    seeks = converging ((==) `on` (^. listSelectedL)) (listFindBy (== a)) l''-    i' = clamp 0 (length l') i -- we can't have inserted past len-  in-    (find ((== Just i') . (^. listSelectedL)) seeks >>= listSelectedElement)-    == Just (i', a)---- Find will never decrease the selected index.  Note that we don't--- need to handle the 'Nothing' case because ∀a. Nothing < Just a.-prop_findByNonDecreasing :: (Eq a) => [ListOp a] -> List n a -> a -> Bool-prop_findByNonDecreasing ops l a =-  let-    l' = applyListOps op ops l-    l'' = listFindBy (== a) l'-  in-    l' ^. listSelectedL <= l'' ^. listSelectedL+    let l' = applyListOps op ops l+        l'' = set listSelectedL Nothing . listInsert i a $ l'+        seeks = converging ((==) `on` (^. listSelectedL)) (listFindBy (== a)) l''+        i' = clamp 0 (length l') i -- we can't have inserted past len+    in (find ((== Just i') . (^. listSelectedL)) seeks >>= listSelectedElement) == Just (i', a)  -- inserting then deleting always yields a list with the original elems prop_insertRemove :: (Eq a) => Int -> a -> List n a -> Bool prop_insertRemove i a l =-  let-    i' = clamp 0 (length l) i-    l' = listInsert i' a l -- pre-clamped-    l'' = listRemove i' l'-  in-    l'' ^. listElementsL == l ^. listElementsL+    let i' = clamp 0 (length l) i+        l' = listInsert i' a l -- pre-clamped+        l'' = listRemove i' l'+    in l'' ^. listElementsL == l ^. listElementsL  -- deleting in-bounds always reduces size of list by 1 -- deleting out-of-bounds never changes list size prop_remove :: Int -> List n a -> Bool prop_remove i l =-  let-    len = length l-    i' = clamp 0 (len - 1) i-    test-      | len > 0 && i == i' = (== len - 1)  -- i is in bounds-      | otherwise = (== len)               -- i is out of bounds-  in-    test (length (listRemove i l))+    let len = length l+        i' = clamp 0 (len - 1) i+        test+            | len > 0 && i == i' = (== len - 1)  -- i is in bounds+            | otherwise = (== len)               -- i is out of bounds+    in test (length (listRemove i l))  -- deleting an element and re-inserting it at same position -- gives the original list elements prop_removeInsert :: (Eq a) => Int -> List n a -> Bool prop_removeInsert i l =-  let-    sel = listSelectedElement (listMoveTo i l)-    l' = maybe id (\(i', a) -> listInsert i' a . listRemove i') sel l-  in-    l' ^. listElementsL == l ^. listElementsL+    let sel = listSelectedElement (listMoveTo i l)+        l' = maybe id (\(i', a) -> listInsert i' a . listRemove i') sel l+    in l' ^. listElementsL == l ^. listElementsL  -- Apply @f@ until @test a (f a) == True@, then return @a@. converge :: (a -> a -> Bool) -> (a -> a) -> a -> a@@ -232,64 +209,57 @@ -- intermediate and final values as a list. converging :: (a -> a -> Bool) -> (a -> a) -> a -> [a] converging test f a-  | test a (f a) = [a]-  | otherwise = a : converging test f (f a)+    | test a (f a) = [a]+    | otherwise = a : converging test f (f a)  -- listMoveUp always reaches 0 (or list is empty) prop_moveUp :: (Eq a) => [ListOp a] -> List n a -> Bool prop_moveUp ops l =-  let-    l' = applyListOps op ops l-    l'' = converge ((==) `on` (^. listSelectedL)) listMoveUp l'-    len = length l''-  in-    maybe (len == 0) (== 0) (l'' ^. listSelectedL)+    let l' = applyListOps op ops l+        l'' = converge ((==) `on` (^. listSelectedL)) listMoveUp l'+        len = length l''+    in maybe (len == 0) (== 0) (l'' ^. listSelectedL)  -- listMoveDown always reaches end of list (or list is empty) prop_moveDown :: (Eq a) => [ListOp a] -> List n a -> Bool prop_moveDown ops l =-  let-    l' = applyListOps op ops l-    l'' = converge ((==) `on` (^. listSelectedL)) listMoveDown l'-    len = length l''-  in-    maybe (len == 0) (== len - 1) (l'' ^. listSelectedL)+    let l' = applyListOps op ops l+        l'' = converge ((==) `on` (^. listSelectedL)) listMoveDown l'+        len = length l''+    in maybe (len == 0) (== len - 1) (l'' ^. listSelectedL)  -- move ops never change the list prop_moveOpsNeverChangeList :: (Eq a) => [ListMoveOp a] -> List n a -> Bool prop_moveOpsNeverChangeList ops l =-  let-    l' = applyListOps moveOp ops l-  in-    l' ^. listElementsL == l ^. listElementsL+    let l' = applyListOps moveOp ops l+    in l' ^. listElementsL == l ^. listElementsL  -- If the list is empty, empty selection is used. -- Otherwise, if the specified selected index is not in list bounds, -- zero is used instead.-prop_replaceSetIndex-  :: (Eq a)-  => [ListOp a] -> List n a -> [a] -> Int -> Bool+prop_replaceSetIndex :: (Eq a)+                     => [ListOp a]+                     -> List n a+                     -> [a]+                     -> Int+                     -> Bool prop_replaceSetIndex ops l xs i =-  let-    v = V.fromList xs-    l' = applyListOps op ops l-    l'' = listReplace v (Just i) l'-    i' = clamp 0 (length v - 1) i-    inBounds = i == i'-  in-    l'' ^. listSelectedL == case (null v, inBounds) of-      (True, _) -> Nothing-      (False, True) -> Just i-      (False, False) -> Just 0+    let v = V.fromList xs+        l' = applyListOps op ops l+        l'' = listReplace v (Just i) l'+        i' = clamp 0 (length v - 1) i+        inBounds = i == i'+    in l'' ^. listSelectedL == case (null v, inBounds) of+        (True, _) -> Nothing+        (False, True) -> Just i+        (False, False) -> Just 0  -- Replacing with no index always clears the index prop_replaceNoIndex :: (Eq a) => [ListOp a] -> List n a -> [a] -> Bool prop_replaceNoIndex ops l xs =-  let-    v = V.fromList xs-    l' = applyListOps op ops l-  in-    isNothing (listReplace v Nothing l' ^. listSelectedL)+    let v = V.fromList xs+        l' = applyListOps op ops l+    in isNothing (listReplace v Nothing l' ^. listSelectedL)  -- | Move the list selected index. If the index is `Just x`, adjust by the -- specified amount; if it is `Nothing` (i.e. there is no selection) and the@@ -297,26 +267,19 @@ -- `Just (length - 1)` (last element). Subject to validation. prop_moveByWhenNoSelection :: List n a -> Int -> Property prop_moveByWhenNoSelection l amt =-  let-    l' = l & listSelectedL .~ Nothing-    len = length l-    expected = if amt > 0 then 0 else len - 1-  in-    len > 0 ==> listMoveBy amt l' ^. listSelectedL == Just expected-+    let l' = l & listSelectedL .~ Nothing+        len = length l+        expected = if amt > 0 then 0 else len - 1+    in len > 0 ==> listMoveBy amt l' ^. listSelectedL == Just expected  splitAtLength :: (Foldable t, Splittable t) => t a -> Int -> Bool splitAtLength l i =-  let-    len = length l-    (h, t) = splitAt i l-  in-    length h + length t == len-    && length h == clamp 0 len i+    let len = length l+        (h, t) = splitAt i l+    in length h + length t == len && length h == clamp 0 len i -splitAtAppend-  :: (Splittable t, Semigroup (t a), Eq (t a))-  => t a -> Int -> Bool+splitAtAppend :: (Splittable t, Semigroup (t a), Eq (t a))+              => t a -> Int -> Bool splitAtAppend l i = uncurry (<>) (splitAt i l) == l  prop_splitAtLength_Vector :: [a] -> Int -> Bool@@ -332,16 +295,14 @@ prop_splitAtAppend_Seq = splitAtAppend . Seq.fromList  -reverseSingleton-  :: forall t a. (Reversible t, Applicative t, Eq (t a))-  => Proxy t -> a -> Bool+reverseSingleton :: forall t a. (Reversible t, Applicative t, Eq (t a))+                 => Proxy t -> a -> Bool reverseSingleton _ a =-  let l = pure a :: t a-  in reverse l == l+    let l = pure a :: t a+    in reverse l == l -reverseAppend-  :: (Reversible t, Semigroup (t a), Eq (t a))-  => t a -> t a -> Bool+reverseAppend :: (Reversible t, Semigroup (t a), Eq (t a))+              => t a -> t a -> Bool reverseAppend l1 l2 =   reverse (l1 <> l2) == reverse l2 <> reverse l1 @@ -350,49 +311,63 @@  prop_reverseAppend_Vector :: (Eq a) => [a] -> [a] -> Bool prop_reverseAppend_Vector l1 l2 =-  reverseAppend (V.fromList l1) (V.fromList l2)+    reverseAppend (V.fromList l1) (V.fromList l2)  prop_reverseSingleton_Seq :: (Eq a) => a -> Bool prop_reverseSingleton_Seq = reverseSingleton (Proxy :: Proxy Seq.Seq)  prop_reverseAppend_Seq :: (Eq a) => [a] -> [a] -> Bool prop_reverseAppend_Seq l1 l2 =-  reverseAppend (Seq.fromList l1) (Seq.fromList l2)--+    reverseAppend (Seq.fromList l1) (Seq.fromList l2)  -- Laziness tests.  Here we create a custom container type -- that we use to ensure certain operations do not cause the--- whole container to be evaulated.+-- whole container to be evaluated. -- newtype L a = L [a]-  deriving (Functor, Foldable, Traversable)+            deriving (Functor, Foldable, Traversable, Semigroup)  instance Splittable L where-  splitAt i (L xs) = over both L (Data.List.splitAt i xs)+    splitAt i (L xs) = over both L (Data.List.splitAt i xs)  -- moveBy positive amount does not evaluate 'length' prop_moveByPosLazy :: Bool prop_moveByPosLazy =-  let-    v = L (1:2:3:4:undefined) :: L Int-    l = list () v 1-    l' = listMoveBy 1 l-  in-    l' ^. listSelectedL == Just 1+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1+        l' = listMoveBy 1 l+    in l' ^. listSelectedL == Just 1  -- listFindBy is lazy prop_findByLazy :: Bool prop_findByLazy =-  let-    v = L (1:2:3:4:undefined) :: L Int-    l = list () v 1 & listSelectedL .~ Nothing-    l' = listFindBy even l-    l'' = listFindBy even l'-  in-    l' ^. listSelectedL == Just 1-    && l'' ^. listSelectedL == Just 3+    let v = L (1:2:3:4:undefined) :: L Int+        l = list () v 1 & listSelectedL .~ Nothing+        l' = listFindBy even l+        l'' = listFindBy even l'+    in l' ^. listSelectedL == Just 1 &&+       l'' ^. listSelectedL == Just 3 +prop_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 []
tests/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -13,6 +14,7 @@ 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@@ -60,16 +62,16 @@ prop_compare l r = compare l r == compare (lower l) (lower r)  prop_applicativeIdentity :: I -> Bool-prop_applicativeIdentity v = (pure id <*> v) == v+prop_applicativeIdentity v = (id <$> v) == v  prop_applicativeComposition :: IMap (O -> O) -> IMap (O -> O) -> IMap O -> Bool-prop_applicativeComposition u v w = (pure (.) <*> u <*> v <*> w) == (u <*> (v <*> w))+prop_applicativeComposition u v w = ((.) <$> u <*> v <*> w) == (u <*> (v <*> w))  prop_applicativeHomomorphism :: (O -> O) -> O -> Bool-prop_applicativeHomomorphism f x = (pure f <*> pure x :: I) == pure (f x)+prop_applicativeHomomorphism f x = (f <$> pure x :: I) == pure (f x)  prop_applicativeInterchange :: IMap (O -> O) -> O -> Bool-prop_applicativeInterchange u y = (u <*> pure y) == (pure ($ y) <*> u)+prop_applicativeInterchange u y = (u <*> pure y) == (($ y) <$> u)  prop_empty :: Bool prop_empty = lower (IMap.empty :: I) == IntMap.empty@@ -111,5 +113,5 @@  main :: IO () main =-  (all id <$> sequenceA [$quickCheckAll, List.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