From c794550c88f27e990d59805aa26cd80c7d9b0ac1 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 4 Aug 2022 14:41:38 -0700 Subject: [PATCH 01/27] Remove Sam Tay's tutorial to reduce maintenance burden --- README.md | 1 - brick.cabal | 1 - docs/samtay-tutorial.md | 546 ---------------------------------------- 3 files changed, 548 deletions(-) delete mode 100644 docs/samtay-tutorial.md diff --git a/README.md b/README.md index a3503e0..e28e0da 100644 --- a/README.md +++ b/README.md @@ -119,7 +119,6 @@ Documentation Documentation for `brick` comes in a variety of forms: * [The official brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst) -* [Samuel Tay's brick tutorial](https://github.com/jtdaugherty/brick/blob/master/docs/samtay-tutorial.md) * Haddock (all modules) * [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs) ([Screenshots](https://github.com/jtdaugherty/brick/blob/master/docs/programs-screenshots.md)) * [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md) diff --git a/brick.cabal b/brick.cabal index 16f2221..945621a 100644 --- a/brick.cabal +++ b/brick.cabal @@ -42,7 +42,6 @@ tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC extra-doc-files: README.md, docs/guide.rst, - docs/samtay-tutorial.md, docs/snake-demo.gif, CHANGELOG.md, docs/programs-screenshots.md, diff --git a/docs/samtay-tutorial.md b/docs/samtay-tutorial.md deleted file mode 100644 index 0b3ac30..0000000 --- a/docs/samtay-tutorial.md +++ /dev/null @@ -1,546 +0,0 @@ - -# Brick Tutorial by Samuel Tay - -This tutorial was written by Samuel Tay, Copyright 2017 -(https://github.com/samtay, https://samtay.github.io/). It is provided -as part of the brick distribution with permission. - -## Introduction - -I'm going to give a short introduction to -[brick](https://hackage.haskell.org/package/brick), a Haskell library -for building terminal user interfaces. So far I've used `brick` to -implement [Conway's Game of Life](https://github.com/samtay/conway) and -a [Tetris clone](https://github.com/samtay/tetris). I'll explain the -basics, walk through an example [snake](https://github.com/samtay/snake) -application, and then explain some more complicated scenarios. - -The first thing I'll say is that this package has some of the most -impressive documentation and resources, which makes it easy to figure -out pretty much anything you need to do. I'll try to make this useful, -but I imagine if you're reading this then it is mostly being used as a -reference in addition to the existing resources: - -1. [Demo programs](https://github.com/jtdaugherty/brick/tree/master/programs) -(clone down to explore the code and run them locally) -2. [User guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst) -3. [Haddock docs](https://hackage.haskell.org/package/brick) -4. [Google group](https://groups.google.com/forum/#!forum/brick-users) - -### The basic idea - -`brick` is very declarative. Once your base application logic is in -place, the interface is generally built by two functions: drawing and -handling events. The drawing function - -```haskell -appDraw :: s -> [Widget n] -``` - -takes your app state `s` and produces the visuals `[Widget n]`. The -handler - -```haskell -appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s) -``` - -takes your app state, an event (e.g. user presses the `'m'` key), and -produces the resulting app state. *That's pretty much it.* - -## `snake` - -We're going to build the [classic -snake](https://en.wikipedia.org/wiki/Snake_(video_game)) game that you -might recall from arcades or the first cell phones. The full source code -is [here](https://github.com/samtay/snake). This is the end product: - -![](snake-demo.gif) - -### Structure of the app - -The library makes it easy to separate the concerns of your application -and the interface; I like to have a module with all of the core business -logic that exports the core state of the app and functions for modifying -it, and then have an interface module that just handles the setup, -drawing, and handling events. So let's just use the `simple` stack -template and add two modules - -``` -├── LICENSE -├── README.md -├── Setup.hs -├── snake.cabal -├── src -│   ├── Main.hs -│   ├── Snake.hs -│   └── UI.hs -└── stack.yaml -``` - -and our dependencies to `test.cabal` - -```yaml -executable snake - hs-source-dirs: src - main-is: Main.hs - ghc-options: -threaded - exposed-modules: Snake - , UI - default-language: Haskell2010 - build-depends: base >= 4.7 && < 5 - , brick - , containers - , linear - , microlens - , microlens-th - , random -``` - -### `Snake` - -Since this tutorial is about `brick`, I'll elide most of the -implementation details of the actual game, but here are some of the key -types and scaffolding: - -```haskell -{-# LANGUAGE TemplateHaskell, FlexibleContexts #-} -module Snake where - -import Control.Applicative ((<|>)) -import Control.Monad (guard) -import Data.Maybe (fromMaybe) - -import Data.Sequence (Seq, ViewL(..), ViewR(..), (<|)) -import qualified Data.Sequence as S -import Lens.Micro.TH (makeLenses) -import Lens.Micro ((&), (.~), (%~), (^.)) -import Linear.V2 (V2(..), _x, _y) -import System.Random (Random(..), newStdGen) - --- Types - -data Game = Game - { _snake :: Snake -- ^ snake as a sequence of points in R2 - , _dir :: Direction -- ^ direction - , _food :: Coord -- ^ location of the food - , _foods :: Stream Coord -- ^ infinite list of random food locations - , _dead :: Bool -- ^ game over flag - , _paused :: Bool -- ^ paused flag - , _score :: Int -- ^ score - , _frozen :: Bool -- ^ freeze to disallow duplicate turns - } deriving (Show) - -type Coord = V2 Int -type Snake = Seq Coord - -data Stream a = a :| Stream a - deriving (Show) - -data Direction - = North - | South - | East - | West - deriving (Eq, Show) -``` - -All of this is pretty self-explanatory, with the possible exception -of lenses if you haven't seen them. At first glance they may seem -complicated (and the underlying theory arguably is), but using them as -getters and setters is very straightforward. So, if you are following -along because you are writing a terminal app like this, I'd recommend -using them, but they are not required to use `brick`. - -Here are the core functions for playing the game: - -```haskell --- | Step forward in time -step :: Game -> Game -step g = fromMaybe g $ do - guard (not $ g ^. paused || g ^. dead) - let g' = g & frozen .~ False - return . fromMaybe (move g') $ die g' <|> eatFood g' - --- | Possibly die if next head position is disallowed -die :: Game -> Maybe Game - --- | Possibly eat food if next head position is food -eatFood :: Game -> Maybe Game - --- | Move snake along in a marquee fashion -move :: Game -> Game - --- | Turn game direction (only turns orthogonally) --- --- Implicitly unpauses yet freezes game -turn :: Direction -> Game -> Game - --- | Initialize a paused game with random food location -initGame :: IO Game -``` - -### `UI` - -To start, we need to determine what our `App s e n` type parameters are. -This will completely describe the interface application and be passed -to one of the library's `main` style functions for execution. Note that -`s` is the app state, `e` is an event type, and `n` is a resource name. -The `e` is abstracted so that we can provide custom events. The `n` -is usually a custom sum type called `Name` which allows us to *name* -particular viewports. This is important so that we can keep track of -where the user currently has *focus*, such as typing in one of two -textboxes; however, for this simple snake game we don't need to worry -about that. - -In simpler cases, the state `s` can directly coincide with a core -datatype such as our `Snake.Game`. In many cases however, it will be -necessary to wrap the core state within the ui state `s` to keep track -of things that are interface specific (more on this later). - -Let's write out our app definition and leave some undefined functions: - -```haskell -{-# LANGUAGE OverloadedStrings #-} -module UI where - -import Control.Monad (forever, void) -import Control.Monad.IO.Class (liftIO) -import Control.Concurrent (threadDelay, forkIO) -import Data.Maybe (fromMaybe) - -import Snake - -import Brick - ( App(..), AttrMap, BrickEvent(..), EventM, Next, Widget - , customMain, neverShowCursor - , continue, halt - , hLimit, vLimit, vBox, hBox - , padRight, padLeft, padTop, padAll, Padding(..) - , withBorderStyle - , str - , attrMap, withAttr, emptyWidget, AttrName, on, fg - , (<+>) - ) -import Brick.BChan (newBChan, writeBChan) -import qualified Brick.Widgets.Border as B -import qualified Brick.Widgets.Border.Style as BS -import qualified Brick.Widgets.Center as C -import qualified Graphics.Vty as V -import Data.Sequence (Seq) -import qualified Data.Sequence as S -import Linear.V2 (V2(..)) -import Lens.Micro ((^.)) - --- Types - --- | Ticks mark passing of time --- --- This is our custom event that will be constantly fed into the app. -data Tick = Tick - --- | Named resources --- --- Not currently used, but will be easier to refactor --- if we call this "Name" now. -type Name = () - -data Cell = Snake | Food | Empty - --- App definition - -app :: App Game Tick Name -app = App { appDraw = drawUI - , appChooseCursor = neverShowCursor - , appHandleEvent = handleEvent - , appStartEvent = return - , appAttrMap = const theMap - } - -main :: IO () -main = undefined - --- Handling events - -handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game) -handleEvent = undefined - --- Drawing - -drawUI :: Game -> [Widget Name] -drawUI = undefined - -theMap :: AttrMap -theMap = undefined -``` - -#### Custom Events - -So far I've only used `brick` to make games which need to be redrawn -as time passes, with or without user input. This requires using -`Brick.customMain` with that `Tick` event type, and opening a forked -process to `forever` feed that event type into the channel. Since this -is a common scenario, there is a `Brick.BChan` module that makes this -pretty quick: - -```haskell -main :: IO () -main = do - chan <- newBChan 10 - forkIO $ forever $ do - writeBChan chan Tick - threadDelay 100000 -- decides how fast your game moves - g <- initGame - let buildVty = V.mkVty V.defaultConfig - initialVty <- buildVty - void $ customMain initialVty buildVty (Just chan) app g -``` - -We do need to import `Vty.Graphics` since `customMain` allows us -to specify a custom `IO Vty.Graphics.Vty` handle, but we're only -customizing the existence of the event channel `BChan Tick`. The app -is now bootstrapped, and all we need to do is implement `handleEvent`, -`drawUI`, and `theMap` (handles styling). - -#### Handling events - -Handling events is largely straightforward, and can be very clean when -your underlying application logic is taken care of in a core module. All -we do is essentially map events to the proper state modifiers. - -```haskell -handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game) -handleEvent g (AppEvent Tick) = continue $ step g -handleEvent g (VtyEvent (V.EvKey V.KUp [])) = continue $ turn North g -handleEvent g (VtyEvent (V.EvKey V.KDown [])) = continue $ turn South g -handleEvent g (VtyEvent (V.EvKey V.KRight [])) = continue $ turn East g -handleEvent g (VtyEvent (V.EvKey V.KLeft [])) = continue $ turn West g -handleEvent g (VtyEvent (V.EvKey (V.KChar 'k') [])) = continue $ turn North g -handleEvent g (VtyEvent (V.EvKey (V.KChar 'j') [])) = continue $ turn South g -handleEvent g (VtyEvent (V.EvKey (V.KChar 'l') [])) = continue $ turn East g -handleEvent g (VtyEvent (V.EvKey (V.KChar 'h') [])) = continue $ turn West g -handleEvent g (VtyEvent (V.EvKey (V.KChar 'r') [])) = liftIO (initGame) >>= continue -handleEvent g (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt g -handleEvent g (VtyEvent (V.EvKey V.KEsc [])) = halt g -handleEvent g _ = continue g -``` - -It's probably obvious, but `continue` will continue execution with -the supplied state value, which is then drawn. We can also `halt` to -stop execution, which will essentially finish the evaluation of our -`customMain` and result in `IO Game`, where the resulting game is the -last value that we supplied to `halt`. - -#### Drawing - -Drawing is fairly simple as well but can require a good amount of code -to position things how you want them. I like to break up the visual -space into regions with drawing functions for each one. - -```haskell -drawUI :: Game -> [Widget Name] -drawUI g = - [ C.center $ padRight (Pad 2) (drawStats g) <+> drawGrid g ] - -drawStats :: Game -> Widget Name -drawStats = undefined - -drawGrid :: Game -> Widget Name -drawGrid = undefined -``` - -This will center the overall interface (`C.center`), put the stats and -grid widgets horizontally side by side (`<+>`), and separate them by a -2-character width (`padRight (Pad 2)`). - -Let's move forward with the stats column: - -```haskell -drawStats :: Game -> Widget Name -drawStats g = hLimit 11 - $ vBox [ drawScore (g ^. score) - , padTop (Pad 2) $ drawGameOver (g ^. dead) - ] - -drawScore :: Int -> Widget Name -drawScore n = withBorderStyle BS.unicodeBold - $ B.borderWithLabel (str "Score") - $ C.hCenter - $ padAll 1 - $ str $ show n - -drawGameOver :: Bool -> Widget Name -drawGameOver dead = - if dead - then withAttr gameOverAttr $ C.hCenter $ str "GAME OVER" - else emptyWidget - -gameOverAttr :: AttrName -gameOverAttr = "gameOver" -``` - -I'm throwing in that `hLimit 11` to prevent the widget greediness caused -by the outer `C.center`. I'm also using `vBox` to show some other -options of aligning widgets; `vBox` and `hBox` align a list of widgets -vertically and horizontally, respectfully. They can be thought of as -folds over the binary `<=>` and `<+>` operations. - -The score is straightforward, but it is the first border in -this tutorial. Borders are well documented in the [border -demo](https://github.com/jtdaugherty/brick/blob/master/programs/BorderDemo.hs) -and the Haddocks for that matter. - -We also only show the "game over" widget if the game is actually over. -In that case, we are rendering the string widget with the `gameOverAttr` -attribute name. Attribute names are basically type safe *names* that -we can assign to widgets to apply predetermined styles, similar to -assigning a class name to a div in HTML and defining the CSS styles for -that class elsewhere. - -Attribute names implement `IsString`, so they are easy to construct with -the `OverloadedStrings` pragma. - -Now for the main event: - -```haskell -drawGrid :: Game -> Widget Name -drawGrid g = withBorderStyle BS.unicodeBold - $ B.borderWithLabel (str "Snake") - $ vBox rows - where - rows = [hBox $ cellsInRow r | r <- [height-1,height-2..0]] - cellsInRow y = [drawCoord (V2 x y) | x <- [0..width-1]] - drawCoord = drawCell . cellAt - cellAt c - | c `elem` g ^. snake = Snake - | c == g ^. food = Food - | otherwise = Empty - -drawCell :: Cell -> Widget Name -drawCell Snake = withAttr snakeAttr cw -drawCell Food = withAttr foodAttr cw -drawCell Empty = withAttr emptyAttr cw - -cw :: Widget Name -cw = str " " - -snakeAttr, foodAttr, emptyAttr :: AttrName -snakeAttr = "snakeAttr" -foodAttr = "foodAttr" -emptyAttr = "emptyAttr" - -``` - -There's actually nothing new here! We've already covered all the -`brick` functions necessary to draw the grid. My approach to grids is -to render a square cell widget `cw` with different colors depending -on the cell state. The easiest way to draw a colored square is to -stick two characters side by side. If we assign an attribute with a -matching foreground and background, then it doesn't matter what the two -characters are (provided that they aren't some crazy Unicode characters -that might render to an unexpected size). However, if we want empty -cells to render with the same color as the user's default background -color, then spaces are a good choice. - -Finally, we'll define the attribute map: - -```haskell -theMap :: AttrMap -theMap = attrMap V.defAttr - [ (snakeAttr, V.blue `on` V.blue) - , (foodAttr, V.red `on` V.red) - , (gameOverAttr, fg V.red `V.withStyle` V.bold) - ] -``` - -Again, styles aren't terribly complicated, but it -will be one area where you might have to look in the -[vty](http://hackage.haskell.org/package/vty) package (specifically -[Graphics.Vty.Attributes](http://hackage.haskell.org/package/vty-5.15.1/docs/Graphics-Vty-Attributes.html)) to find what you need. - -Another thing to mention is that the attributes form a hierarchy and -can be combined in a parent-child relationship via `mappend`. I haven't -actually used this feature, but it does sound quite handy. For a more -detailed discussion see the -[Brick.AttrMap](https://hackage.haskell.org/package/brick-0.18/docs/Brick-AttrMap.html) haddocks. - -## Variable speed - -One difficult problem I encountered was implementing a variable speed in -the GoL. I could have just used the same approach above with the minimum -thread delay (corresponding to the maximum speed) and counted `Tick` -events, only issuing an actual `step` in the game when the modular count -of `Tick`s reached an amount corresponding to the current game speed, -but that's kind of an ugly approach. - -Instead, I reached out to the author and he advised me to use a `TVar` -within the app state. I had never used `TVar`, but it's pretty easy! - -```haskell -main :: IO () -main = do - chan <- newBChan 10 - tv <- atomically $ newTVar (spToInt initialSpeed) - forkIO $ forever $ do - writeBChan chan Tick - int <- atomically $ readTVar tv - threadDelay int - let buildVty = V.mkVty V.defaultConfig - initialVty <- buildVty - customMain initialVty buildVty (Just chan) app (initialGame tv) - >>= printResult -``` - -The `tv <- atomically $ newTVar (value :: a)` creates a new mutable -reference to a value of type `a`, i.e. `TVar a`, and returns it in `IO`. -In this case `value` is an `Int` which represents the delay between game -steps. Then in the forked process, we read the delay from the `TVar` -reference and use that to space out the calls to `writeBChan chan Tick`. - -I store that same `tv :: TVar Int` in the brick app state, so that the -user can change the speed: - -```haskell -handleEvent :: Game -> BrickEvent Name Tick -> EventM Name (Next Game) -handleEvent g (VtyEvent (V.EvKey V.KRight [V.MCtrl])) = handleSpeed g (+) -handleEvent g (VtyEvent (V.EvKey V.KLeft [V.MCtrl])) = handleSpeed g (-) - -handleSpeed :: Game -> (Float -> Float -> Float) -> EventM n (Next Game) -handleSpeed g (+/-) = do - let newSp = validS $ (g ^. speed) +/- speedInc - liftIO $ atomically $ writeTVar (g ^. interval) (spToInt newSp) - continue $ g & speed .~ newSp - --- where - --- | Speed increments = 0.01 gives 100 discrete speed settings -speedInc :: Float -speedInc = 0.01 - --- | Game state -data Game = Game - { _board :: Board -- ^ Board state - , _time :: Int -- ^ Time elapsed - , _paused :: Bool -- ^ Playing vs. paused - , _speed :: Float -- ^ Speed in [0..1] - , _interval :: TVar Int -- ^ Interval kept in TVar - , _focus :: F.FocusRing Name -- ^ Keeps track of grid focus - , _selected :: Cell -- ^ Keeps track of cell focus - } -``` - -## Conclusion - -`brick` let's you build TUIs very quickly. I was able to write `snake` -along with this tutorial within a few hours. More complicated interfaces -can be tougher, but if you can successfully separate the interface and -core functionality, you'll have an easier time tacking on the frontend. - -Lastly, let me remind you to look in the -[demo programs](https://github.com/jtdaugherty/brick/tree/master/programs) -to figure stuff out, as *many* scenarios are covered throughout them. - -## Links -* [brick](https://hackage.haskell.org/package/brick) -* [snake](https://github.com/samtay/snake) -* [tetris](https://github.com/samtay/tetris) -* [conway](https://github.com/samtay/conway) From 202965d1432c63582d3f0362a8773d68e644c0cc Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 4 Aug 2022 14:49:17 -0700 Subject: [PATCH 02/27] guide: typo --- docs/guide.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index c3d7b5b..dcad89d 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -68,8 +68,8 @@ Conventions 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 From 9b8b901a21c3c5ab08ab4731943ef30218c7956f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 4 Aug 2022 17:52:37 -0700 Subject: [PATCH 03/27] guide: update for EventM changes --- docs/guide.rst | 284 ++++++++++++++++++++++++++++--------------------- 1 file changed, 165 insertions(+), 119 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index dcad89d..f53fde6 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -108,8 +108,8 @@ various functions: 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 } @@ -209,107 +209,153 @@ the application state as a result of an event: .. code:: haskell - appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s) + appHandleEvent :: BrickEvent n e -> EventM n s () -The first parameter of type ``s`` is your application's state at the -time the event arrives. ``appHandleEvent`` is responsible for deciding -how to change the state based on the event and then return it. +``appHandleEvent`` is responsible for deciding how to change the state +based on the event. The single parameter to the event handler is the +event to be handled. Its type variables ``n`` and ``e`` correspond +to the *resource name type* and *event type* of your application, +respectively, and must match the corresponding types in ``App`` and +``EventM``. -The second parameter of type ``BrickEvent n e`` is the event itself. -The type variables ``n`` and ``e`` correspond to the *resource name -type* and *event type* of your application, respectively, and must match -the corresponding types in ``App`` and ``EventM``. +The ``EventM`` monad is parameterized on the *resource name type* +``n`` and your application's state type ``s``. The ``EventM`` monad +is a state monad over ``s``, so one way to access and modify your +application's state in an event handler is to use the ``MonadState`` +type class and associated operations from the ``mtl`` package. The +recommended approach, however, is to use the lens operations from the +``microlens-mtl`` package with lenses to perform concise state updates. +We'll cover this topic in more detail in `Event Handlers for Widget +State`_. -The return value type ``Next s`` value describes what should happen -after the event handler is finished. We have four choices: +Once the event handler has performed any relevant state updates, it can +also indicate what should happen once the event handler has finished +executing. By default, after an event handler has completed, Brick will +redraw the screen with the application state (by calling ``appDraw``) +and wait for the next input event. However, there are two other options: -* ``Brick.Main.continue s``: continue executing the event loop with the - specified application state ``s`` as the next value. Commonly this is - where you'd modify the state based on the event and return it. -* ``Brick.Main.continueWithoutRedraw s``: continue executing the event - loop with the specified application state ``s`` as the next value, but - unlike ``continue``, do not redraw the screen using the new state. - This is a faster version of ``continue`` since it doesn't redraw the - screen; it just leaves up the previous screen contents. This function - is only useful when you know that your state change won't cause - anything on the screen to change. When in doubt, use ``continue``. -* ``Brick.Main.halt s``: halt the event loop and return the final - application state value ``s``. This state value is returned to the - caller of ``defaultMain`` or ``customMain`` where it can be used prior - to finally exiting ``main``. -* ``Brick.Main.suspendAndResume act``: suspend the ``brick`` event loop - and execute the specified ``IO`` action ``act``. The action ``act`` - must be of type ``IO s``, so when it executes it must return the next - application state. When ``suspendAndResume`` is used, the ``brick`` - event loop is shut down and the terminal state is restored to its - state when the ``brick`` event loop began execution. When it finishes - executing, the event loop will be resumed using the returned state - value. This is useful for situations where your program needs to - suspend your interface and execute some other program that needs to - gain control of the terminal (such as an external editor). +* ``Brick.Main.halt``: halt the event loop. The application state as it + exists after the event handler completes is returned to the caller + of ``defaultMain`` or ``customMain``. +* ``Brick.Main.continueWithoutRedraw``: continue executing the event + loop, but do not redraw the screen using the new state before waiting + for another input event. This is faster than the default continue + behavior since it doesn't redraw the screen; it just leaves up the + previous screen contents. This function is only useful when you know + that your event handler's state change(s) won't cause anything on + the screen to change. Use this only when you are certain that no + redraw of the screen is needed *and* when you are trying to address a + performance problem. (See also `The Rendering Cache`_ for details on + how to detail with rendering performance issues.) -The ``EventM`` monad is the event-handling monad. This monad is a -transformer around ``IO`` so you are free to do I/O in this monad by -using ``liftIO``. Beyond I/O, this monad is used to make scrolling -requests to the renderer (see `Viewports`_) and obtain named extents -(see `Extents`_). Keep in mind that time spent blocking in your event -handler is time during which your UI is unresponsive, so consider this -when deciding whether to have background threads do work instead of -inlining the work in the event handler. +The ``EventM`` monad is a transformer around ``IO`` so I/O is possible +in this monad by using ``liftIO``. Keep in mind, however, that event +handlers should execute as quickly as possible to avoid introducing +screen redraw latency. Consider using background threads to work +asynchronously when it would otherwise cause redraw latency. -Widget Event Handlers -********************* +Beyond I/O, ``EventM`` is used to make scrolling requests to the +renderer (see `Viewports`_), obtain named extents (see `Extents`_), and +other duties. -Event handlers are responsible for transforming the application state. -While you can use ordinary methods to do this such as pattern matching -and pure function calls, some widget state types such as the ones -provided by the ``Brick.Widgets.List`` and ``Brick.Widgets.Edit`` -modules provide their own widget-specific event-handling functions. -For example, ``Brick.Widgets.Edit`` provides ``handleEditorEvent`` and -``Brick.Widgets.List`` provides ``handleListEvent``. +Event Handlers for Widget 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 states specific to widget types 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: + +* The editor state of type ``Editor t n``: this stores the editor's + contents, cursor position, etc. +* The editor's drawing function, ``renderEditor``: this is responsible + for drawing the editor in the UI. +* The editor's event handler, ``handleEditorEvent``: this is responsible + for updating the editor's contents and cursor position in response to + key events. + +To use the built-in editor, the application must: + +* Embed an ``Editor t n`` somewhere in the application state ``s``, +* Render the editor's state at the appropriate place in ``appDraw`` with + ``renderEditor``, and +* Dispatch events to the editor in the ``appHandleEvent`` with + ``handleEditorEvent``. + +An example application state using an editor might look like this: .. code:: haskell - data Name = Edit1 - type MyState = Editor String Name - - myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState) - myEvent s (VtyEvent e) = continue =<< handleEditorEvent e s - -This pattern works well enough when your application state has an -event handler as shown in the ``Edit`` example above, but it can -become unpleasant if the value on which you want to invoke a handler -is embedded deeply within your application state. If you have chosen -to generate lenses for your application state fields, you can use the -convenience function ``handleEventLensed`` by specifying your state, a -lens, and the event: - -.. code:: haskell - - data Name = Edit1 - data MyState = MyState { _theEdit :: Editor String Name - } + data MyState = MyState { _editor :: Editor Text n } makeLenses ''MyState - myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState) - myEvent s (VtyEvent e) = continue =<< handleEventLensed s theEdit handleEditorEvent e +This declares the ``MyState`` type with an ``Editor`` contained within +it and uses Template Haskell to generate a lens, ``editor``, to allow us +to easily update the editor state in our event handler. -You might consider that preferable to the desugared version: +To dispatch events to the ``editor`` we'd start by writing the +application event handler: .. code:: haskell - myEvent :: MyState -> BrickEvent n e -> EventM Name (Next MyState) - myEvent s (VtyEvent e) = do - newVal <- handleEditorEvent e (s^.theEdit) - continue $ s & theEdit .~ newVal + handleEvent :: BrickEvent n e -> EventM n MyState () + handleEvent e = do + ... + +But there's a problem: ``handleEditorEvent``'s type indicates that it +can only run over a state of type ``Editor t n``, but our handler runs +on ``MyState``. Specifically, ``handleEditorEvent`` has this type: + +.. code:: haskell + + handleEditorEvent :: BrickEvent n e -> EventM n (Editor t n) () + +This means that to use ``handleEditorEvent``, it must be composed +into the application's event handler, but since the state types ``s`` +and ``Editor t n`` do not match, we need a way to compose these event +handlers. There are two ways to do this: + +* Use ``Lens.Micro.Mtl.zoom`` from the ``microlens-mtl`` package + (re-exported by ``Brick.Types`` for convenience). This function is + required when you want to change the state type to a field embedded in + your application state using a lens. For example: + +.. code:: haskell + + handleEvent :: BrickEvent n e -> EventM n MyState () + handleEvent e = do + zoom editor $ handleEditorEvent e + +* Use ``Brick.Types.nestEventM``: this function lets you provide a state + value and run ``EventM`` using that state. The following + ``nestEventM`` example is equivalent to the ``zoom`` example above: + +.. code:: haskell + + import Lens.Micro (_1) + import Lens.Micro.Mtl (use, (.=)) + + handleEvent :: BrickEvent n e -> EventM n MyState () + handleEvent e = do + editorState <- use editor + (newEditorState, ()) <- nestEventM editorState $ do + handleEditorEvent e + editor .= newEditorState + +The ``zoom`` function, together with lenses for your application state's +fields, is by far the best way to manage your state in ``EventM``. As +you can see from the examples above, the ``zoom`` approach avoids a lot +of boilerplate. The ``nestEventM`` approach is provided in cases where +the state that you need to mutate is not easily accessed by ``zoom``. + +Finally, if you prefer to avoid the use of lenses, you can always use +the ``MonadState`` API to get, put, and modify your state. Keep in +mind that the ``MonadState`` approach will still require the use of +``nestEventM`` when events scoped to widget states such as ``Editor`` +need to be handled. Using Your Own Event Type ************************* @@ -339,8 +385,8 @@ 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 @@ -403,13 +449,14 @@ type provides ``appStartEvent`` function for this purpose: .. 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 ----------------------------------- @@ -1057,7 +1104,7 @@ location in the terminal, and any modifier keys pressed. .. code:: haskell - handleEvent s (VtyEvent (EvMouseDown col row button mods) = ... + handleEvent (VtyEvent (EvMouseDown col row button mods) = ... Brick Mouse Events ------------------ @@ -1080,10 +1127,10 @@ The most direct way to do this is to check a specific extent: .. code:: haskell - handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do + handleEvent (VtyEvent (EvMouseDown col row _ _)) = do mExtent <- lookupExtent SomeExtent case mExtent of - Nothing -> continue s + Nothing -> return () Just e -> do if Brick.Main.clickedExtent (col, row) e then ... @@ -1096,7 +1143,7 @@ different layers? The next approach is to find all clicked extents: .. code:: haskell - handleEvent s (VtyEvent (EvMouseDown col row _ _)) = do + 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. @@ -1131,8 +1178,8 @@ offered by ``brick``. When rendering the interface we use border $ str "Click me" - handleEvent s (MouseDown MyButton button modifiers coords) = ... - handleEvent s (MouseUp MyButton button coords) = ... + 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 reporting @@ -1214,14 +1261,14 @@ functions for making scrolling requests: .. code:: haskell - hScrollPage :: Direction -> EventM n () - hScrollBy :: Int -> EventM n () - hScrollToBeginning :: EventM n () - hScrollToEnd :: EventM n () - vScrollPage :: Direction -> EventM n () - vScrollBy :: Int -> EventM n () - vScrollToBeginning :: EventM n () - vScrollToEnd :: EventM n () + 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 @@ -1237,11 +1284,10 @@ Using ``viewportScroll`` we can write an event handler that scrolls the .. 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 -------------------------------------------- @@ -1508,14 +1554,14 @@ attribute map are: 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 @@ -1782,7 +1828,7 @@ use the cache invalidation functions in ``EventM``: .. code:: haskell - handleEvent s ... = do + handleEvent ... = do -- Invalidate just a single cache entry: Brick.Main.invalidateCacheEntry ExpensiveThing From 5e7a6505a9c0a0723637b70252396e65ebee79ae Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 4 Aug 2022 18:27:32 -0700 Subject: [PATCH 04/27] guide: more edits --- docs/guide.rst | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index f53fde6..bf82fa1 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -74,10 +74,11 @@ programs. program, all lens interfaces have non-lens equivalents exported by the same module. In general, the "``L``" suffix on something tells you it is a lens; the name without the "``L``" suffix is the non-lens - version. You can get by without using ``brick``'s lens interface but - your life will probably be much more pleasant once your application - state becomes sufficiently complex if you use lenses to modify it (see - `appHandleEvent: Handling Events`_). + version. You can get by without using ``brick``'s lens interface + but your life will probably be much more pleasant if you use lenses + to modify your application state once it state becomes sufficiently + complex (see `appHandleEvent: Handling Events`_ and `Event Handlers + for Component State`_). - Attribute names: some modules export attribute names (see `How Attributes Work`_) associated with user interface elements. These tend to end in an "``Attr``" suffix (e.g. ``borderAttr``). In addition, @@ -225,7 +226,7 @@ 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 Widget +We'll cover this topic in more detail in `Event Handlers for Component State`_. Once the event handler has performed any relevant state updates, it can @@ -258,12 +259,12 @@ Beyond I/O, ``EventM`` is used to make scrolling requests to the renderer (see `Viewports`_), obtain named extents (see `Extents`_), and other duties. -Event Handlers for Widget State -******************************* +Event Handlers for Component State +********************************** The top-level ``appHandleEvent`` handler is responsible for managing the application state, but it also needs to be able to update the state -associated with states specific to widget types that come with Brick. +associated with UI components such as those that come with Brick. For example, consider an application that uses Brick's built-in text editor from ``Brick.Widgets.Edit``. The built-in editor is similar to From 9c45c99608563f38319d4750e43401a57ea7f8c3 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 10:45:36 -0700 Subject: [PATCH 05/27] guide: header formatting --- docs/guide.rst | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index bf82fa1..bbfdbb0 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -97,8 +97,8 @@ Compiling Brick Applications 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 @@ -159,8 +159,8 @@ To run an ``App``, we pass it to ``Brick.Main.defaultMain`` or 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 @@ -202,8 +202,8 @@ The most important module providing drawing functions is ``Brick.Widgets.Core``. Beyond that, any module in the ``Brick.Widgets`` namespace provides specific kinds of functionality. -appHandleEvent: Handling Events -------------------------------- +``appHandleEvent``: Handling Events +----------------------------------- The value of ``appHandleEvent`` is a function that decides how to modify the application state as a result of an event: @@ -438,8 +438,8 @@ bound for the event channel. In general, consider the performance of your event handler when choosing the channel capacity and design event producers so that they can block if the channel is full. -appStartEvent: Starting up --------------------------- +``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 @@ -459,8 +459,8 @@ 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 @@ -585,8 +585,8 @@ viewport), a unique name is assigned in each use. ui = (viewport Viewport1 Vertical $ str "Foo") <+> (viewport Viewport2 Vertical $ str "Bar") <+> -appAttrMap: Managing Attributes -------------------------------- +``appAttrMap``: Managing Attributes +----------------------------------- In ``brick`` we use an *attribute map* to assign attributes to elements of the interface. Rather than specifying specific attributes when @@ -966,8 +966,8 @@ Attributes`_. If the theme is further customized at runtime, any changes can be saved with ``Brick.Themes.saveCustomizations``. -Wide Character Support and the TextWidth class -============================================== +Wide Character Support and the ``TextWidth`` class +================================================== Brick attempts to support rendering wide characters in all widgets, and the brick editor supports entering and editing wide characters. From f2649e3b5da7f3dc4373d2863883594c037363e9 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 10:45:44 -0700 Subject: [PATCH 06/27] guide: update Extents section --- docs/guide.rst | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index bbfdbb0..5acb4ce 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1004,11 +1004,12 @@ 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 @@ -1027,15 +1028,14 @@ the renderer using a resource name: 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)) -> ... From 1e1843916f9af1e7593e1e178d8585cabeade990 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 10:53:39 -0700 Subject: [PATCH 07/27] guide: whitespace --- docs/guide.rst | 66 +++++++++++++++++++++++++------------------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index 5acb4ce..360820a 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -151,10 +151,10 @@ To run an ``App``, we pass it to ``Brick.Main.defaultMain`` or 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`_. @@ -517,9 +517,10 @@ resource name type ``n`` and would be able to pattern-match on .. code:: haskell - myApp = App { ... - , appChooseCursor = \_ -> showCursorNamed CustomName - } + myApp = + App { ... + , appChooseCursor = \_ -> showCursorNamed CustomName + } See the next section for more information on using names. @@ -570,9 +571,8 @@ we don't know which of the two uses of ``Viewport1`` will be affected: .. 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. @@ -1060,10 +1060,10 @@ to the Vty library handle in ``EventM`` (in e.g. ``appHandleEvent``): 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 @@ -1081,10 +1081,10 @@ To enable mouse mode, we need to get access to the Vty library handle in .. 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 @@ -1129,13 +1129,13 @@ The most direct way to do this is to check a specific extent: .. code:: haskell handleEvent (VtyEvent (EvMouseDown col row _ _)) = do - mExtent <- lookupExtent SomeExtent - case mExtent of - Nothing -> return () - Just e -> do - if Brick.Main.clickedExtent (col, row) e - then ... - else ... + 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 @@ -1145,9 +1145,9 @@ different layers? The next approach is to find all clicked extents: .. code:: haskell handleEvent (VtyEvent (EvMouseDown col row _ _)) = do - extents <- Brick.Main.findClickedExtents (col, row) - -- Then check to see if a specific extent is in the list, or just - -- take the first one in the list. + 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: @@ -1520,7 +1520,7 @@ control layout, or change attributes: .. 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 @@ -1830,11 +1830,11 @@ use the cache invalidation functions in ``EventM``: .. code:: haskell handleEvent ... = do - -- Invalidate just a single cache entry: - Brick.Main.invalidateCacheEntry ExpensiveThing + -- 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 =========================== From d9d62f4853c72a53382fdac46e414b3769e02957 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 13:52:43 -0700 Subject: [PATCH 08/27] guide: add material on custom keybindings --- docs/guide.rst | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) diff --git a/docs/guide.rst b/docs/guide.rst index 360820a..35a1d3c 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1608,6 +1608,79 @@ For more details on how to do this, see the Haddock documentation for the ``FormFieldState`` and ``FormField`` data types along with the implementations of the built-in form field types. +Customizable Keybindings +======================== + +Brick applications typically start out by explicitly checking incoming +events for specific keys in ``appHandleEvent``. While this works well +enough, it results in *tight coupling* between the input key events and +the event handlers that get run. As applications evolve, it becomes +important to decouple the input key events and their handlers to allow +the input keys to be customized by the user. That's where Brick's +customizable keybindings API comes in. + +The customizable keybindings API provides: + +* ``Brick.Keybindings.Parse``: parsing and loading user-provided + keybinding configuration files, +* ``Brick.Keybindings.Pretty``: pretty-printing keybinding strings 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. + +Brick provides a complete working example of the custom keybinding API +in ``programs/CustomKeybindingDemo.hs``. This section of the User +Guide describes the API at a high level. More detailed documentation +on how to use the API can be found in the module documentation for +``Brick.Keybindings.KeyDispatcher``. + +The following table compares Brick application design decisions and +runtime behaviors in a typical application compared to one that uses the +customizable keybindings API: + ++---------------------+------------------------+-------------------------+ +| **Approach** | **Before runtime** | **At runtime** | ++---------------------+------------------------+-------------------------+ +| Typical application | The application author | #. An input event | +| (no custom | decides which keys will| arrives when the user| +| keybindings): | trigger application | presses a key. | +| | behaviors. The event | #. The event handler | +| | handler is written to | pattern-mathces on | +| | pattern-match on | the input event to | +| | specific keys. | check for a match and| +| | | then runs the | +| | | corresponding | +| | | handler. | ++---------------------+------------------------+-------------------------+ +| Application with | The application author | #. A Vty input event | +| custom keybindings | specifies the possible | arrives when the user| +| API integrated: | *abstract events* that | presses a key. | +| | correspond to the | #. The input event is | +| | application's | provided to | +| | behaviors. The events | ``appHandleEvent``. | +| | are given default | #. ``appHandleEvent`` | +| | keybindings. The | passes the event on | +| | application provides | to a | +| | event handlers for the | ``KeyDispatcher``. | +| | abstract events, not | #. The key dispatcher | +| | specific keys. If | checks to see whether| +| | desired, the | the input key event | +| | application can load | maps to an abstract | +| | user-defined custom | event. | +| | keybindings from an INI| #. If the dispatcher | +| | file at startup to | finds a match, the | +| | override the | corresponding | +| | application's defaults.| abstract event's key | +| | | handler is run. | ++---------------------+------------------------+-------------------------+ + Joining Borders =============== From 84703cb41983786fa90007d14ce2d210aa6c0963 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 15:17:00 -0700 Subject: [PATCH 09/27] guide: update --- docs/guide.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index 35a1d3c..0c151aa 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1636,10 +1636,10 @@ The customizable keybindings API provides: dispatching incoming key events to them. Brick provides a complete working example of the custom keybinding API -in ``programs/CustomKeybindingDemo.hs``. This section of the User -Guide describes the API at a high level. More detailed documentation -on how to use the API can be found in the module documentation for -``Brick.Keybindings.KeyDispatcher``. +in ``programs/CustomKeybindingDemo.hs``. This section of the User Guide +describes the API at a high level. More detailed documentation on how to +use the API, including a step-by-step process for using it, can be found +in the module documentation for ``Brick.Keybindings.KeyDispatcher``. The following table compares Brick application design decisions and runtime behaviors in a typical application compared to one that uses the From c501330d79c22558c6e84be15052fdf0f2d014fd Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 15:17:40 -0700 Subject: [PATCH 10/27] guide: wording --- docs/guide.rst | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index 0c151aa..61ee79e 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1635,11 +1635,12 @@ The customizable keybindings API provides: * ``Brick.Keybindings.KeyDispatcher``: specifying handlers and dispatching incoming key events to them. -Brick provides a complete working example of the custom keybinding API -in ``programs/CustomKeybindingDemo.hs``. This section of the User Guide -describes the API at a high level. More detailed documentation on how to -use the API, including a step-by-step process for using it, can be found -in the module documentation for ``Brick.Keybindings.KeyDispatcher``. +This section of the User Guide describes the API at a high level, +but Brick also provides a complete working example of the custom +keybinding API in ``programs/CustomKeybindingDemo.hs`` and +provides detailed documentation on how to use the API, including a +step-by-step process for using it, in the module documentation for +``Brick.Keybindings.KeyDispatcher``. The following table compares Brick application design decisions and runtime behaviors in a typical application compared to one that uses the From 32c1aa4f2fee64bfc7c941729b7094f05b740307 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 15:23:34 -0700 Subject: [PATCH 11/27] guide: nit --- docs/guide.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index 61ee79e..ca24f7c 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1651,7 +1651,7 @@ customizable keybindings API: +---------------------+------------------------+-------------------------+ | Typical application | The application author | #. An input event | | (no custom | decides which keys will| arrives when the user| -| keybindings): | trigger application | presses a key. | +| keybindings) | trigger application | presses a key. | | | behaviors. The event | #. The event handler | | | handler is written to | pattern-mathces on | | | pattern-match on | the input event to | @@ -1662,7 +1662,7 @@ customizable keybindings API: +---------------------+------------------------+-------------------------+ | 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. | +| API integrated | *abstract events* that | presses a key. | | | correspond to the | #. The input event is | | | application's | provided to | | | behaviors. The events | ``appHandleEvent``. | From 2473b322080ff5df1a7d83f0fc74e19ddbc9007f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 15:26:28 -0700 Subject: [PATCH 12/27] guide: some clarifying edits for text width issues --- docs/guide.rst | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index ca24f7c..997d62d 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -989,17 +989,18 @@ to support wide characters in your application, this will not work: 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 -to compute the correct width. If you need to compute -the width of a single character, use ``Graphics.Text.wcwidth``. +The ``TextWidth`` type class uses Vty's character width routine to +compute the width by looking up the string's characdters in a Unicode +width table. If you need to compute the width of a single character, use +``Graphics.Text.wcwidth``. Extents ======= From 42ad28327db30c09bfa500cdc5637f3e829a7ac8 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 5 Aug 2022 16:08:32 -0700 Subject: [PATCH 13/27] guide: improve mouse click handling docs layout --- docs/guide.rst | 66 ++++++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 31 deletions(-) diff --git a/docs/guide.rst b/docs/guide.rst index 997d62d..61ec99a 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1116,14 +1116,47 @@ a higher-level mouse event interface that ties into the drawing language. The disadvantage to the low-level interface described above is that you still need to determine *what* was clicked, i.e., the part of the interface that was under the mouse cursor. There are two ways to do -this with ``brick``: with *extent checking* and *click reporting*. +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: @@ -1162,35 +1195,6 @@ the following properties: 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 (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 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 ========= From 946dbfe66151e83e4f9c2dcd0a3a33d3c8397a1e Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 14:24:19 -0700 Subject: [PATCH 14/27] guide: nit --- docs/guide.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/guide.rst b/docs/guide.rst index 61ec99a..aa3c995 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1628,7 +1628,7 @@ The customizable keybindings API provides: * ``Brick.Keybindings.Parse``: parsing and loading user-provided keybinding configuration files, -* ``Brick.Keybindings.Pretty``: pretty-printing keybinding strings and +* ``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, From 7adc8ba322139f3324a0aa052d0204610fc95a7a Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 14:50:33 -0700 Subject: [PATCH 15/27] Update changelog for 1.0 changes --- CHANGELOG.md | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index dc9bbac..b4b2071 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,61 @@ Brick changelog --------------- +1.0 +--- + +Version 1.0 of `brick` comes with some improvements that will require +you to update your programs. This document details the list of API +changes in 1.0 that are likely to introduce breakage and how to deal +with each one. + +* The event-handling monad `EventM` was improved and changed in some + substantial ways. + * The type has changed from `EventM n a` to `EventM n s a` and is now + an `mtl`-compatible state monad over `s`. + * The `Next` type was removed. + * Event handlers consequently 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 ()`. + * 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. + * `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`. + * State-specific event handlers like `handleListEvent` and + `handleEditorEvent` are now statically typed to be scoped to the + states they manage, so `zoom` from `microlens-mt`l must be used to + invoke them. `Brick.Types` re-exports `zoom` for convenience. +* 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 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, the Haddock for + `Brick.Keybindings.KeyDispatcher`, and the new demo program + `programs/CustomKeybindingDemo.hs` to get started. +* `Brick.Widgets.List` got `listSelectedElementL`, a traversal for + accessing the currently selected element of a list. (Thanks Fraser + Tweedale) + 0.73 ---- From bf565660f409a2b1843bbfb30c4835e28ff0c2df Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 14:54:27 -0700 Subject: [PATCH 16/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b4b2071..d6f45f3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,12 +13,24 @@ with each one. * The event-handling monad `EventM` was improved and changed in some substantial ways. * The type has changed from `EventM n a` to `EventM n s a` and is now - an `mtl`-compatible state monad over `s`. - * The `Next` type was removed. - * Event handlers consequently 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 ()`. + an `mtl`-compatible state monad over `s`. Some consequences of this + change 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 ()`. + * `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`. * 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. @@ -33,10 +45,6 @@ with each one. continue to run after `suspendAndResume` is called and before control is returned to `brick. * Brick now depends on `mtl` rather than `transformers`. - * State-specific event handlers like `handleListEvent` and - `handleEditorEvent` are now statically typed to be scoped to the - states they manage, so `zoom` from `microlens-mt`l must be used to - invoke them. `Brick.Types` re-exports `zoom` for convenience. * 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 that resulted in code From e3b86bdd843f862a6dead3940d32d937339339c1 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 14:55:06 -0700 Subject: [PATCH 17/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d6f45f3..2f362d8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,7 +18,9 @@ with each one. * 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 ()`. + BrickEvent n e -> EventM n s ()`. This also affected all of + Brick's built-in event handler functions for `List`, `Editor`, + etc. * `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. From 1754f92534fbdb8a2705db0c5193d4d8834bc7e4 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 14:56:32 -0700 Subject: [PATCH 18/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2f362d8..5f7edf7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -29,6 +29,9 @@ with each one. just the states they manage, so `zoom` from `microlens-mtl` must be used to invoke them. `Brick.Types` re-exports `zoom` for convenience. + * 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`. * `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 From 1c213413dabca6744d356aa2a291558abd628d2d Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 14:57:23 -0700 Subject: [PATCH 19/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5f7edf7..d52d737 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,7 +8,8 @@ Brick changelog Version 1.0 of `brick` comes with some improvements that will require you to update your programs. This document details the list of API changes in 1.0 that are likely to introduce breakage and how to deal -with each one. +with each one. You can also consult the demonstration programs to see +working examples of the new API. * The event-handling monad `EventM` was improved and changed in some substantial ways. From 138db04a0711a5fe76c862d9b70c5266bb01b8f6 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 14:57:49 -0700 Subject: [PATCH 20/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d52d737..397d777 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -53,13 +53,14 @@ working examples of the new API. * 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 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"`. + 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: From 30bb95011c3624b7cf05b137c30c0c928532dd51 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 15:00:13 -0700 Subject: [PATCH 21/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 397d777..22b5fb3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,10 +6,12 @@ Brick changelog --- Version 1.0 of `brick` comes with some improvements that will require -you to update your programs. This document details the list of API +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. +with each one. You can also consult the demonstration +programs to see orking examples of the new API. For those +interested in a bit of discussion on the changes, see [this +ticket](https://github.com/jtdaugherty/brick/issues/379). * The event-handling monad `EventM` was improved and changed in some substantial ways. @@ -65,9 +67,10 @@ working examples of the new API. Other changes in this release: * Brick now provides an optional API for user-defined keybindings - for applications. See the User Guide section, the Haddock for - `Brick.Keybindings.KeyDispatcher`, and the new demo program - `programs/CustomKeybindingDemo.hs` to get started. + 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) From 9e417de00afbb0003a6ba5b5ccb782d459b8acbe Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 15:01:29 -0700 Subject: [PATCH 22/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 22b5fb3..5f25f01 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,6 +24,10 @@ ticket](https://github.com/jtdaugherty/brick/issues/379). 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. From 8772f5cc379c772620628841c7ac271257453c7a Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 15:02:11 -0700 Subject: [PATCH 23/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5f25f01..3c4b14e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,8 +16,8 @@ ticket](https://github.com/jtdaugherty/brick/issues/379). * The event-handling monad `EventM` was improved and changed in some substantial ways. * 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 of this - change are: + 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 :: From 6a41ba821615a7bfa9737e55367026ee333e4164 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 15:02:49 -0700 Subject: [PATCH 24/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3c4b14e..d632621 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -35,14 +35,13 @@ ticket](https://github.com/jtdaugherty/brick/issues/379). `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. + 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`. - * `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`. * 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. From d168aef6bd8ae4b94e2d9ad00839cff46ab7ea5a Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 15:04:09 -0700 Subject: [PATCH 25/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d632621..99068ab 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,7 +14,9 @@ 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. + 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: From ee5cfd66dda2091de61773a7ecce04443206d656 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 15:05:00 -0700 Subject: [PATCH 26/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 99068ab..7019db8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -56,7 +56,7 @@ ticket](https://github.com/jtdaugherty/brick/issues/379). 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. + 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 From ce1ad6173bb36e9cf672a27230b48e8140b7321c Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Mon, 8 Aug 2022 15:28:13 -0700 Subject: [PATCH 27/27] CHANGELOG: 1.0 edits --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7019db8..ea299ff 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -47,7 +47,8 @@ ticket](https://github.com/jtdaugherty/brick/issues/379). * 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. + `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.