brick 0.6.4 → 0.7

raw patch · 32 files changed

+722/−509 lines, 32 filesdep +microlens-mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: microlens-mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +44/−0
• brick.cabal +6/−1
• docs/guide.rst +197/−131
• programs/AttrDemo.hs +2/−2
• programs/BorderDemo.hs +8/−5
• programs/CustomEventDemo.hs +3/−3
• programs/DialogDemo.hs +5/−5
• programs/EditDemo.hs +34/−38
• programs/HelloWorldDemo.hs +1/−1
• programs/LayerDemo.hs +5/−5
• programs/ListDemo.hs +8/−8
• programs/MarkupDemo.hs +2/−2
• programs/PaddingDemo.hs +2/−2
• programs/SuspendAndResumeDemo.hs +3/−3
• programs/ViewportScrollDemo.hs +20/−21
• programs/VisibilityDemo.hs +16/−20
• src/Brick/AttrMap.hs +4/−1
• src/Brick/Focus.hs +35/−9
• src/Brick/Main.hs +45/−41
• src/Brick/Markup.hs +2/−2
• src/Brick/Types.hs +20/−25
• src/Brick/Types/Internal.hs +13/−17
• src/Brick/Util.hs +1/−1
• src/Brick/Widgets/Border.hs +16/−12
• src/Brick/Widgets/Center.hs +7/−7
• src/Brick/Widgets/Core.hs +87/−57
• src/Brick/Widgets/Dialog.hs +17/−19
• src/Brick/Widgets/Edit.hs +36/−16
• src/Brick/Widgets/Internal.hs +9/−6
• src/Brick/Widgets/List.hs +69/−47
• src/Brick/Widgets/ProgressBar.hs +1/−1
• src/Data/Text/Markup.hs +4/−1

@@ -2,6 +2,49 @@ Brick changelog --------------- +0.7+---++NOTE: this release includes many API changes. Please see the "Widget+Names" section of the Brick User Guide for details on the fundamentals!++API changes:+ * The "Name" type was removed. In its place we now have a name type+   variable ("n") attached to many types (including EventM,+   CursorLocation, App, Editor, List, and FocusRing). This change makes+   it possible to:+   * Avoid runtime errors due to name typos+   * Achieve compile-time guarantees about name matching and usage+   * Force widget functions to be name-agnostic by being polymorphic+     in their name type+   * Clean up focus handling by making it possible to pattern-match+     on cursor location names+ * The EditDemo demonstration program was updated to use a FocusRing.+ * Added the "Named" type class to Brick.Widgets.Core for types that+   store names. This type class is used to streamline the Focus+   interface; see Brick.Focus.withFocusRing and EditDemo.hs.+ * The List and Editor types are now parameterized on names.+ * The List widget is now focus-aware; its rendering function now takes+   a boolean indicating whether it should be rendered with focus. The+   List uses the following attributes now:+   * When not focused, the cursor is rendered with listSelectedAttr.+   * When focused, the cursor is rendered with listSelectedFocusedAttr.+ * The Editor widget is now focus-aware; its rendering function now+   takes a boolean indicating whether it should be rendered with focus.+   The Editor uses the following attributes now:+   * When not focused, the widget is rendered with editAttr.+   * When focused, the widget is rendered with editFocusedAttr.+ * The Dialog's name type parameter, constructor parameter, and lens+   were removed.+ * The 'viewport' function was modified to raise a runtime exception if+   the widget name it receives is used more than once during the+   rendering of a single frame.++Miscellaneous:+ * Many modules now use conditional imports to silence redundancy+   warnings on GHCs with newer Preludes (e.g. including Monoid,+   Foldable, Traversable, Applicative, etc.)+ 0.6.4 ----- @@ -235,4 +278,5 @@  0.1 ---+ Initial release

@@ -1,5 +1,5 @@ name:                brick-version:             0.6.4+version:             0.7 synopsis:            A declarative terminal user interface library description:   Write terminal applications painlessly with 'brick'! You write an@@ -53,6 +53,7 @@ library   default-language:    Haskell2010   ghc-options:         -Wall -fno-warn-unused-do-bind -O3+  default-extensions:  CPP   hs-source-dirs:      src   exposed-modules:     Brick@@ -83,6 +84,7 @@                        containers,                        microlens >= 0.3.0.0,                        microlens-th,+                       microlens-mtl,                        vector,                        contravariant,                        text,@@ -111,6 +113,7 @@   hs-source-dirs:      programs   ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3   default-language:    Haskell2010+  default-extensions:  CPP   main-is:             ViewportScrollDemo.hs   build-depends:       base,                        brick,@@ -261,6 +264,7 @@                        vty >= 5.5.0,                        data-default,                        text,+                       vector,                        microlens >= 0.3.0.0,                        microlens-th @@ -269,6 +273,7 @@     Buildable: False   hs-source-dirs:      programs   ghc-options:         -threaded -Wall -fno-warn-unused-do-bind -O3+  default-extensions:  CPP   default-language:    Haskell2010   main-is:             BorderDemo.hs   build-depends:       base <= 5,

@@ -58,7 +58,7 @@  ``brick`` includes a large collection of feature-specific demonstration programs. These programs are not built by default but can be built by-passing the ``demos`` flag to `cabal install`, e.g.::+passing the ``demos`` flag to ``cabal install``, e.g.::     $ cabal install brick -f demos @@ -84,11 +84,12 @@   to end in an "``Attr``" suffix (e.g. ``borderAttr``). In addition,   hierarchical relationships between attributes are documented in   Haddock documentation.-- Use of qualified names: in this document, where sensible, I will use-  fully-qualified names whenever I mention something for the first time-  or whenever I use something that is not part of ``brick``. Use of-  names in this way is not intended to produce executable examples, but-  rather to guide you in writing your ``import`` statements.+- Use of qualified Haskell identifiers: in this document, where+  sensible, I will use fully-qualified identifiers whenever I mention+  something for the first time or whenever I use something that is+  not part of ``brick``. Use of qualified names is not intended to+  produce executable examples, but rather to guide you in writing your+  ``import`` statements.  The App Type ============@@ -99,38 +100,40 @@  .. code:: haskell -   data App s e =-       App { appDraw :: s -> [Widget]-           , appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation-           , appHandleEvent :: s -> e -> EventM (Next s)-           , appStartEvent :: s -> EventM s-           , appAttrMap :: s -> AttrMap+   data App s e n =+       App { appDraw         :: s -> [Widget n]+           , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)+           , appHandleEvent  :: s -> e -> EventM n (Next s)+           , appStartEvent   :: s -> EventM n s+           , appAttrMap      :: s -> AttrMap            , appLiftVtyEvent :: Event -> e            } -The ``App`` type is polymorphic over two types: your application state-type ``s`` and event type ``e``.--The application state type is the type of data that will evolve over the-course of the application's execution; we will provide the library with-its starting value and event handling will transform it as the program-executes.--The event type is the type of events that your event handler-(``appHandleEvent``) will handle. The underlying ``vty`` library-provides ``Graphics.Vty.Event`` and this forms the basis of all events-we will handle with ``brick`` applications. The-``Brick.Main.defaultMain`` function expects an ``App s Event`` since-this is a common case.+The ``App`` type is parameterized over three types. These type variables+will appear in the signatures of many library functions and types. They+are: -However, we often need to extend our notion of events beyond those-originating from the keyboard. Imagine an application with multiple-threads and network or disk I/O. Such an application will need to have-its own internal events to pass to the event handler as (for example)-network data arrives. To accommodate this we allow an ``App`` to use an-event type of your own design, so long as it provides a constructor for-``vty``'s ``Event`` type (``appLiftVtyEvent``). For more details, see-`Using Your Own Event Type`_.+- The **application state type** ``s``: the type of data that will+  evolve over the course of the application's execution. Your+  application will provide the library with its starting value and event+  handling will transform it as the program executes. When a ``brick``+  application exits, the final application state will be returned.+- The **event type** ``e``: the type of events that your event+  handler (``appHandleEvent``) will handle. The underlying ``vty``+  library provides ``Graphics.Vty.Event`` and this forms the basis+  of all events we will handle with ``brick`` applications. The+  ``Brick.Main.defaultMain`` function expects an ``App s Event n``+  since this is a common case. Applications with higher levels of+  sophistication will need to use their own events; in that case Vty's+  ``Event`` will need to be embedded in the custom event type. ``brick``+  does this by calling ``appLiftVtyEvent``. For more details, see `Using+  Your Own Event Type`_.+- The **widget name type** ``n``: during application execution we need a+  way to refer to widgets by name. Whether it's to distinguish two+  cursor position requests, make changes to a scrollable viewport, or+  any other situation where we need a unique handle to a given widget+  state, some data type is needed. ``brick`` applications require you to+  provide that type for ``n``.  For more details, see `Widget Names`_.  The various fields of ``App`` will be described in the sections below. @@ -191,7 +194,7 @@  .. code:: haskell -   appHandleEvent :: s -> e -> EventM (Next s)+   appHandleEvent :: s -> e -> EventM n (Next s)  The ``EventM`` monad is the event-handling monad. This monad is a transformer around ``IO``, so you are free to do I/O in this monad by@@ -222,68 +225,70 @@   suspend your interface and execute some other program that needs to   gain control of the terminal (such as an external editor). -The HandleEvent Type Class-**************************+Widget Event Handlers+*********************  Event handlers are responsible for transforming the application state. While you can use ordinary methods to do this such as pattern matching and pure function calls, some widget state types such as the ones provided by the ``Brick.Widgets.List`` and ``Brick.Widgets.Edit``-modules support another interface: the ``Brick.Types.HandleEvent`` type-class.--The ``HandleEvent`` type class has only one method:--.. code:: haskell--   handleEvent :: Event -> a -> EventM a--Instances of ``HandleEvent`` provide reasonable default behavior for-handling input events; for example, arrow keys change the ``List``-selection and input keys modify the text in ``Editor`` states.+modules provide their own widget-specific event-handling functions.+For example, ``Brick.Widgets.Edit`` provides ``handleEditorEvent`` and+``Brick.Widgets.List`` provides ``handleListEvent``. -Since ``handleEvent`` runs in ``EventM``, event handlers-written this way have access to rendering viewport states via-``Brick.Main.lookupViewport`` and the ``IO`` monad via ``liftIO``.+Since these event handlers run in ``EventM``, they have access to+rendering viewport states via ``Brick.Main.lookupViewport`` and the+``IO`` monad via ``liftIO``. -To use ``handleEvent`` in your program, invoke it on the relevant piece-of state in your event handler, e.g.,+To use these handlers in your program, invoke them on the relevant piece+of state in your application state. In the following example we use an+``Edit`` state from ``Brick.Widgets.Edit``:  .. code:: haskell -   myEvent :: s -> e -> EventM (Next s)-   myEvent s e = continue =<< handleEvent e s+   data Name = Edit1+   type MyState = Edit Name -This pattern works fine when your application state instances-``HandleEvent``, but it can become unpleasant if the value on which-you want to invoke ``handleEvent`` is embedded deeply within your-application state. If you have chosen to generate lenses for your-application state fields, you can use the convenience function+   myEvent :: MyState -> e -> EventM Name (Next MyState)+   myEvent s e = continue =<< handleEditorEvent e s++This pattern works fine 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 -   myEvent :: s -> e -> EventM (Next s)-   myEvent s e = continue =<< handleEventLensed s someLens e+   data Name = Edit1+   data MyState = MyState { _theEdit :: Edit Name+                          }+   makeLenses ''MyState -Compare that with the more verbose explicit version:+   myEvent :: MyState -> e -> EventM Name (Next MyState)+   myEvent s e = continue =<< handleEventLensed s theEdit handleEditorEvent e +You might consider that preferable to the desugared version:+ .. code:: haskell -   myEvent :: s -> e -> EventM (Next s)+   myEvent :: MyState -> e -> EventM Name (Next MyState)    myEvent s e = do-     newVal <- handleEvent e (s^.someLens)-     continue $ s & someLens .~ newVal+     newVal <- handleEditorEvent e (s^.theEdit)+     continue $ s & theEdit .~ newVal  Using Your Own Event Type *************************  Since we often need to communicate application-specific events beyond input events to the event handler, the ``App`` type is-polymorphic over the event type we want to handle. If we use-``Brick.Main.defaultMain`` to run our ``App``, we have to use-``Graphics.Vty.Event`` as our event type. But if our application has-other event-handling needs, we need to use our own event type.+polymorphic over the event type ``e`` that we want to handle. If we+use ``Brick.Main.defaultMain`` to run our ``App``, we have to use+``Graphics.Vty.Event`` as our event type since ``defaultMain`` is+provided as a convenience so that no extra event type is needed. But if+our application has other event-handling needs, we need to use our own+event type.  To do this, we first define an event type: @@ -316,11 +321,10 @@        finalState <- customMain (Graphics.Vty.mkVty Data.Default.def) eventChan app initialState        -- Use finalState and exit -Beyond just the application and its initial state, the ``customMain``-function lets us have control over how the ``vty`` library is-initialized and how ``brick`` gets custom events to give to our event-handler. ``customMain`` is the entry point into ``brick`` when you need-to use your own event type.+The ``customMain`` function lets us have control over how the ``vty``+library is initialized and how ``brick`` gets custom events to give to+our event handler. ``customMain`` is the entry point into ``brick`` when+you need to use your own event type.  Starting up: appStartEvent **************************@@ -334,10 +338,11 @@  .. code:: haskell -   appStartEvent :: s -> EventM s+   appStartEvent :: s -> EventM n s  This function takes the initial application state and returns it in ``EventM``, possibly changing it and possibly making viewport requests.+This function is invoked once and only once, at application startup. For more details, see `Viewports`_. You will probably just want to use ``return`` as the implementation of this function for most applications. @@ -356,7 +361,7 @@  .. code:: haskell -   appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation+   appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)  The event loop renders the interface and collects the ``Brick.Types.CursorLocation`` values produced by the rendering process@@ -365,13 +370,13 @@ is "focused," say) you can decide which of the locations to return or return ``Nothing`` if you do not want to show a cursor. -We decide which location to show by looking at the ``Brick.Types.Name``-value contained in the ``cursorLocationName`` field. The ``Name``-value associated with a cursor location will be the ``Name`` of the-``Widget`` that requested it; this is why constructors for widgets like-``Brick.Widgets.Edit.editor`` require a ``Name`` parameter. The ``Name``-lets us distinguish between many cursor-placing widgets of the same-type.+We decide which location to show by looking at the name value contained+in the ``cursorLocationName`` field. The name value associated+with a cursor location will be the name used to request the cursor+position, which is usually going to be the name you passed to the+widget's constructor. This is why constructors for widgets like+``Brick.Widgets.Edit.editor`` require a name parameter. The name lets us+distinguish between many cursor-placing widgets of the same type.  ``Brick.Main`` provides various convenience functions to make cursor selection easy in common cases:@@ -379,17 +384,22 @@ * ``neverShowCursor``: never show any cursor. * ``showFirstCursor``: always show the first cursor request given; good   for applications with only one cursor-placing widget.-* ``showCursorNamed``: show the cursor with the specified name or-  ``Nothing`` if it is not requested.+* ``showCursorNamed``: show the cursor with the specified name or show+  no cursor if the name was not associated with any requested cursor+  position.  Widgets request cursor placement by using the ``Brick.Widgets.Core.showCursor`` combinator. For example, this widget places a cursor on the first "``o``" in "``foo``" assocated with the-cursor name "``myCursor``":+cursor name "``myCursor``". The event handler for this application would+use ``MyName`` as its name type ``n`` and would be able to pattern-match+on ``CustomName`` to match cursor requests when this widget is rendered:  .. code:: haskell -   let w = showCursor (Name "myCursor") (Brick.Types.Location (1, 0))+   data MyName = CustomName++   let w = showCursor CustomName (Brick.Types.Location (1, 0))              (Brick.Widgets.Core.str "foobar")  appAttrMap: Managing Attributes@@ -444,6 +454,56 @@ the Haddock documentation for the ``Brick.AttrMap`` module. See also `How Attributes Work`_. +Widget Names+------------++We saw above in `appChooseCursor: Placing the Cursor`_ that names are+used to describe cursor locations. Names are also used to name viewports+(see `Viewports`_). Assigning names to viewports, cursors, and widgets+allows us to distinguish between events during execution. We need some+way to associate events with the widgets that generated them, and names+give us a mechanism.++You might be wondering why we don't just use ``String`` as the name type+instead of making the application developer supply a type. In fact,+``brick`` used to use ``String`` but there were several problems with+this approach:++- Since any widget could choose its own name by using any ``String``,+  name clashes could arise if two widgets used the same name. But those+  clashes would not be easy to observe.+- String names are not amenable to safe refactoring since an "invalid"+  name could be used and silently fail to cuause the desired behavior at+  runtime.+- String names are not amenable to compile-time checking when being+  matched; a custom type allows the user to do compile-time checking of+  e.g. ``case`` expressions checking names.+- Extension widgets were not forced to be polymorphic in their names,+  which breaks good abstraction boundaries if extension authors elect to+  choose their own widget names.++Although requiring the user to provide a custom name type means that+more work must be done to manage the set of possible names, this is work+that should have been done up front anyway: ``String`` names could be+allocated ad-hoc but never centrally managed, resulting in troulbesome+runtime problems.++A Note of Caution+*****************++**NOTE: Unique names for all named widgets are required to ensure+that the renderer correctly tracks widget states during application+execution.** If you assign the same name two, say, two viewports, they+will both use the same viewport scrolling state! So unless you want that+and know what you are doing, use a unique name for every widget that+needs one.++Your application must provide some type of name to be used to name+widgets that need names. For simple applications with only one such+widget, you may use ``()``, but if your application has more than one+named widget, you *must* provide a type capable of assigning a unique+name value to every named widget.+ How Widgets and Rendering Work ============================== @@ -622,33 +682,34 @@ * ``Vertical``: the viewport can only scroll vertically. * ``Both``: the viewport can scroll both horizontally and vertically. -The ``Brick.Widgets.Core.viewport`` combinator takes another widget and-embeds it in a named viewport. We name the viewport so that we can+The ``Brick.Widgets.Core.viewport`` combinator takes another widget+and embeds it in a named viewport. We name the viewport so that we can keep track of its scrolling state in the renderer, and so that you can make scrolling requests. The viewport's name is its handle for these-operations (see `Scrolling Viewports in Event Handlers`_). *The viewport-name must be unique across your interface.*+operations (see `Scrolling Viewports in Event Handlers`_ and `Widget+Names`_). **The viewport name must be unique across your application.**  For example, the following puts a string in a horizontally-scrollable viewport:  .. code:: haskell -   let w = viewport (Name "myViewport") Horizontal $ str "Hello, world!"+   -- Assuming that App uses 'Name' for its names:+   data Name = Viewport1+   let w = viewport Viewport1 Horizontal $ str "Hello, world!" -The above example is incomplete. A ``viewport`` specification means that-the widget in the viewport will be placed in a viewport window that is-``Greedy`` in both directions (see `Available Rendering Area`_). This-is suitable if we want the viewport size to be the size of the entire-terminal window, but if we want to embed this scrollable viewport-somewhere in our interface, we want to control its dimensions. To do so,-we use the limiting combinators (see `Limiting Rendering Area`_):+A ``viewport`` specification means that the widget in the viewport will+be placed in a viewport window that is ``Greedy`` in both directions+(see `Available Rendering Area`_). This is suitable if we want the+viewport size to be the size of the entire terminal window, but if+we want to limit the size of the viewport, we might use limiting+combinators (see `Limiting Rendering Area`_):  .. code:: haskell     let w = hLimit 5 $            vLimit 1 $-           viewport (Name "myViewport") Horizontal $ str "Hello, world!"+           viewport Viewport1 Horizontal $ str "Hello, world!"  Now the example produces a scrollable window one row high and five columns wide initially showing "Hello". The next two sections discuss@@ -659,11 +720,13 @@  The most direct way to scroll a viewport is to make *scrolling requests* in the ``EventM`` event-handling monad. Scrolling requests ask the-render to update the state of a viewport the next time the user-interface is rendered. Those state updates will be made with respect to-the *previous* viewport state. This approach is the best approach to use-to scroll widgets that have no notion of a cursor. For cursor-based-scrolling, see `Scrolling Viewports With Visibility Requests`_.+renderer to update the state of a viewport the next time the user+interface is rendered. Those state updates will be made with respect+to the *previous* viewport state, i.e., the state of the viewports as+of the end of the most recent rendering. This approach is the best+approach to use to scroll widgets that have no notion of a cursor.+For cursor-based scrolling, see `Scrolling Viewports With Visibility+Requests`_.  To make scrolling requests, we first create a ``Brick.Main.ViewportScroll`` from a viewport name with@@ -671,21 +734,23 @@  .. code:: haskell -   let vp = viewportScroll (Name "myViewport")+   -- Assuming that App uses 'Name' for its names:+   data Name = Viewport1+   let vp = viewportScroll Viewport1  The ``ViewportScroll`` record type contains a number of scrolling functions for making scrolling requests:  .. code:: haskell -   hScrollPage :: Direction -> EventM ()-   hScrollBy :: Int -> EventM ()-   hScrollToBeginning :: EventM ()-   hScrollToEnd :: EventM ()-   vScrollPage :: Direction -> EventM ()-   vScrollBy :: Int -> EventM ()-   vScrollToBeginning :: EventM ()-   vScrollToEnd :: EventM ()+   hScrollPage        :: Direction -> EventM n ()+   hScrollBy          :: Int       -> EventM n ()+   hScrollToBeginning ::              EventM n ()+   hScrollToEnd       ::              EventM n ()+   vScrollPage        :: Direction -> EventM n ()+   vScrollBy          :: Int       -> EventM n ()+   vScrollToBeginning ::              EventM n ()+   vScrollToEnd       ::              EventM n ()  In each case the scrolling function scrolls the viewport by the specified amount in the specified direction; functions prefixed with@@ -702,9 +767,9 @@  .. code:: haskell -   myHandler :: s -> e -> EventM (Next s)+   myHandler :: s -> e -> EventM n (Next s)    myHandler s e = do-       let vp = viewportScroll (Name "myViewport")+       let vp = viewportScroll Viewport1        hScrollBy vp 1        continue s @@ -722,7 +787,9 @@  .. code:: haskell -   let w = viewport (Name "myViewport") Horizontal $+   -- Assuming that App uses 'Name' for its names:+   data Name = Viewport1+   let w = viewport Viewport1 Horizontal $            (visible $ str "Hello," <+> (str " world!")  This example requests that the "``myViewport``" viewport be scrolled so@@ -741,8 +808,7 @@   scrollable *while being entirely scrolling-unaware*. * The ``Brick.Widgets.List`` widget uses a visibility request to make   its selected item visible regardless of its size, which makes-  the list widget both scrolling-unaware and also makes it support-  variable-height items for free.+  the list widget scrolling-unaware.  Viewport Restrictions ---------------------@@ -768,7 +834,7 @@  .. code:: haskell -   myWidget :: ... -> Widget+   myWidget :: ... -> Widget n    myWidget ... =        Widget Fixed Fixed $ do            ...@@ -780,15 +846,15 @@  .. code:: haskell -   render :: RenderM Result+   render :: RenderM n Result  which is a function returning a ``Brick.Types.Result``:  .. code:: haskell -    data Result =-        Result { image :: Graphics.Vty.Image-               , cursors :: [Brick.Types.CursorLocation]+    data Result n =+        Result { image              :: Graphics.Vty.Image+               , cursors            :: [Brick.Types.CursorLocation n]                , visibilityRequests :: [Brick.Types.VisibilityRequest]                } @@ -799,11 +865,11 @@ .. code:: haskell      data Context =-        Context { ctxAttrName :: AttrName-                , availWidth :: Int-                , availHeight :: Int+        Context { ctxAttrName    :: AttrName+                , availWidth     :: Int+                , availHeight    :: Int                 , ctxBorderStyle :: BorderStyle-                , ctxAttrMap :: AttrMap+                , ctxAttrMap     :: AttrMap                 }  and has lens fields exported as described in `Conventions`_.@@ -835,7 +901,7 @@  .. code:: haskell -   myFill :: Char -> Widget+   myFill :: Char -> Widget n    myFill ch =        Widget Greedy Greedy $ do            ctx <- getContext

@@ -20,7 +20,7 @@ import Brick.Util (on, fg) import Brick.AttrMap (attrMap, AttrMap) -ui :: Widget+ui :: Widget () ui =     vBox [ str "This text uses the global default attribute."          , withAttr "foundFull" $@@ -51,7 +51,7 @@     , ("general" <> "specific",   fg cyan)     ] -app :: App () Event+app :: App () Event () app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit

@@ -1,8 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Main where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))-import Data.Monoid+#endif++import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Graphics.Vty as V @@ -52,10 +55,10 @@                    , BS.bsVertical = '!'                    } -borderDemos :: [Widget]+borderDemos :: [Widget ()] borderDemos = mkBorderDemo <$> styles -mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget+mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget () mkBorderDemo (styleName, sty) =     withBorderStyle sty $     B.borderWithLabel (str "label") $@@ -75,7 +78,7 @@     , (B.brCornerAttr,       bg V.green)     ] -colorDemo :: Widget+colorDemo :: Widget () colorDemo =     updateAttrMap (A.applyAttrMappings borderMappings) $     B.borderWithLabel (str "title") $@@ -84,7 +87,7 @@     C.center $     str "colors!" -ui :: Widget+ui :: Widget () ui =     hBox borderDemos     <=> B.hBorder

@@ -37,14 +37,14 @@ data CustomEvent = VtyEvent V.Event                  | Counter -drawUI :: St -> [Widget]+drawUI :: St -> [Widget ()] drawUI st = [a]     where         a = (str $ "Last Vty event: " <> (show $ st^.stLastVtyEvent))             <=>             (str $ "Counter value is: " <> (show $ st^.stCounter)) -appEvent :: St -> CustomEvent -> EventM (Next St)+appEvent :: St -> CustomEvent -> EventM () (Next St) appEvent st e =     case e of         VtyEvent (V.EvKey V.KEsc []) -> halt st@@ -57,7 +57,7 @@        , _stCounter = 0        } -theApp :: App St CustomEvent+theApp :: App St CustomEvent () theApp =     App { appDraw = drawUI         , appChooseCursor = showFirstCursor

@@ -21,20 +21,20 @@ data Choice = Red | Blue | Green             deriving Show -drawUI :: D.Dialog Choice -> [Widget]+drawUI :: D.Dialog Choice -> [Widget ()] drawUI d = [ui]     where         ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." -appEvent :: D.Dialog Choice -> V.Event -> T.EventM (T.Next (D.Dialog Choice))+appEvent :: D.Dialog Choice -> V.Event -> T.EventM () (T.Next (D.Dialog Choice)) appEvent d ev =     case ev of         V.EvKey V.KEsc [] -> M.halt d         V.EvKey V.KEnter [] -> M.halt d-        _ -> M.continue =<< T.handleEvent ev d+        _ -> M.continue =<< D.handleDialogEvent ev d  initialState :: D.Dialog Choice-initialState = D.dialog "dialog" (Just "Title") (Just (0, choices)) 50+initialState = D.dialog (Just "Title") (Just (0, choices)) 50     where         choices = [ ("Red", Red)                   , ("Blue", Blue)@@ -48,7 +48,7 @@     , (D.buttonSelectedAttr, bg V.yellow)     ] -theApp :: M.App (D.Dialog Choice) V.Event+theApp :: M.App (D.Dialog Choice) V.Event () theApp =     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor

@@ -19,66 +19,62 @@ import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Edit as E import qualified Brick.AttrMap as A+import qualified Brick.Focus as F import Brick.Util (on) +data Name = Edit1+          | Edit2+          deriving (Ord, Show, Eq)+ data St =-    St { _currentEditor :: T.Name-       , _edit1 :: E.Editor-       , _edit2 :: E.Editor+    St { _focusRing :: F.FocusRing Name+       , _edit1 :: E.Editor Name+       , _edit2 :: E.Editor Name        }  makeLenses ''St -firstEditor :: T.Name-firstEditor = "edit1"--secondEditor :: T.Name-secondEditor = "edit2"--switchEditors :: St -> St-switchEditors st =-    let next = if st^.currentEditor == firstEditor-               then secondEditor else firstEditor-    in st & currentEditor .~ next--currentEditorL :: St -> Lens' St E.Editor-currentEditorL st =-    if st^.currentEditor == firstEditor-    then edit1-    else edit2--drawUI :: St -> [T.Widget]+drawUI :: St -> [T.Widget Name] drawUI st = [ui]     where-        ui = C.center $ (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 $ E.renderEditor $ st^.edit1)) <=>-                        str " " <=>-                        (str "Input 2 (limited to 2 lines): " <+> (hLimit 30 $ E.renderEditor $ st^.edit2)) <=>-                        str " " <=>-                        str "Press Tab to switch between editors, Esc to quit."+        e1 = F.withFocusRing (st^.focusRing) E.renderEditor (st^.edit1)+        e2 = F.withFocusRing (st^.focusRing) E.renderEditor (st^.edit2) -appEvent :: St -> V.Event -> T.EventM (T.Next St)+        ui = C.center $+            (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 e1)) <=>+            str " " <=>+            (str "Input 2 (limited to 2 lines): " <+> (hLimit 30 e2)) <=>+            str " " <=>+            str "Press Tab to switch between editors, Esc to quit."++appEvent :: St -> V.Event -> T.EventM Name (T.Next St) appEvent st ev =     case ev of         V.EvKey V.KEsc [] -> M.halt st-        V.EvKey (V.KChar '\t') [] -> M.continue $ switchEditors st-        V.EvKey V.KBackTab [] -> M.continue $ switchEditors st-        _ -> M.continue =<< T.handleEventLensed st (currentEditorL st) ev+        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+ initialState :: St initialState =-    St firstEditor-       (E.editor firstEditor (str . unlines) Nothing "")-       (E.editor secondEditor (str . unlines) (Just 2) "")+    St (F.focusRing [Edit1, Edit2])+       (E.editor Edit1 (str . unlines) Nothing "")+       (E.editor Edit2 (str . unlines) (Just 2) "")  theMap :: A.AttrMap theMap = A.attrMap V.defAttr-    [ (E.editAttr, V.white `on` V.blue)+    [ (E.editAttr,                   V.white `on` V.blue)+    , (E.editFocusedAttr,            V.black `on` V.yellow)     ] -appCursor :: St -> [T.CursorLocation] -> Maybe T.CursorLocation-appCursor st = M.showCursorNamed (st^.currentEditor)+appCursor :: St -> [T.CursorLocation Name] -> Maybe (T.CursorLocation Name)+appCursor = F.focusRingCursor (^.focusRing) -theApp :: M.App St V.Event+theApp :: M.App St V.Event Name theApp =     M.App { M.appDraw = drawUI           , M.appChooseCursor = appCursor

@@ -2,7 +2,7 @@  import Brick -ui :: Widget+ui :: Widget () ui = str "Hello, world!"  main :: IO ()

@@ -24,23 +24,23 @@  makeLenses ''St -drawUi :: St -> [Widget]+drawUi :: St -> [Widget ()] drawUi st =     [ topLayer st     , bottomLayer st     ] -topLayer :: St -> Widget+topLayer :: St -> Widget () topLayer st =     translateBy (st^.topLayerLocation) $     B.border $ str "Top layer\n(Arrow keys move)" -bottomLayer :: St -> Widget+bottomLayer :: St -> Widget () bottomLayer st =     translateBy (st^.bottomLayerLocation) $     B.border $ str "Bottom layer\n(Ctrl-arrow keys move)" -appEvent :: St -> V.Event -> T.EventM (T.Next St)+appEvent :: St -> V.Event -> T.EventM () (T.Next St) appEvent st (V.EvKey V.KDown [])  = M.continue $ st & topLayerLocation.rowL %~ (+ 1) appEvent st (V.EvKey V.KUp [])    = M.continue $ st & topLayerLocation.rowL %~ (subtract 1) appEvent st (V.EvKey V.KRight []) = M.continue $ st & topLayerLocation.columnL %~ (+ 1)@@ -54,7 +54,7 @@ appEvent st (V.EvKey V.KEsc []) = M.halt st appEvent st _ = M.continue st -app :: M.App St V.Event+app :: M.App St V.Event () app =     M.App { M.appDraw = drawUi           , M.appStartEvent = return

@@ -27,7 +27,7 @@   ) import Brick.Util (fg, on) -drawUI :: (Show a) => L.List a -> [Widget]+drawUI :: (Show a) => L.List () a -> [Widget ()] drawUI l = [ui]     where         label = str "Item " <+> cur <+> str " of " <+> total@@ -38,14 +38,14 @@         box = B.borderWithLabel label $               hLimit 25 $               vLimit 15 $-              L.renderList l listDrawElement+              L.renderList listDrawElement True l         ui = C.vCenter $ vBox [ C.hCenter box                               , str " "                               , C.hCenter $ str "Press +/- to add/remove list elements."                               , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List Char -> V.Event -> T.EventM (T.Next (L.List Char))+appEvent :: L.List () Char -> V.Event -> T.EventM () (T.Next (L.List () Char)) appEvent l e =     case e of         V.EvKey (V.KChar '+') [] ->@@ -60,20 +60,20 @@          V.EvKey V.KEsc [] -> M.halt l -        ev -> M.continue =<< T.handleEvent ev l+        ev -> M.continue =<< L.handleListEvent ev l     where       nextElement :: Vec.Vector Char -> Char       nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z']) -listDrawElement :: (Show a) => Bool -> a -> Widget+listDrawElement :: (Show a) => Bool -> a -> Widget () listDrawElement sel a =     let selStr s = if sel                    then withAttr customAttr (str $ "<" <> s <> ">")                    else str s     in C.hCenter $ str "Item " <+> (selStr $ show a) -initialState :: L.List Char-initialState = L.list (T.Name "list") (Vec.fromList ['a','b','c']) 1+initialState :: L.List () Char+initialState = L.list () (Vec.fromList ['a','b','c']) 1  customAttr :: A.AttrName customAttr = L.listSelectedAttr <> "custom"@@ -85,7 +85,7 @@     , (customAttr,            fg V.cyan)     ] -theApp :: M.App (L.List Char) V.Event+theApp :: M.App (L.List () Char) V.Event () theApp =     M.App { M.appDraw = drawUI           , M.appChooseCursor = M.showFirstCursor

@@ -19,7 +19,7 @@ import Brick.AttrMap (attrMap, AttrMap) import Data.Text.Markup ((@@)) -ui :: Widget+ui :: Widget () ui = (m1 <=> m2) <+> (padLeft (Pad 1) m3)     where         m1 = markup $ ("Hello" @@ fg V.blue) <> ", " <> ("world!" @@ fg V.red)@@ -32,7 +32,7 @@     , ("keyword2",      V.white `on` V.blue)     ] -app :: App () V.Event+app :: App () V.Event () app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit

@@ -24,7 +24,7 @@ import Brick.Widgets.Border as B import Brick.Widgets.Center as C -ui :: Widget+ui :: Widget () ui =     vBox [ hBox [ padLeft Max $ vCenter $ str "Left-padded"                 , B.vBorder@@ -46,7 +46,7 @@          , padAll 2 $ str "Padded by 2 on all sides"          ] -app :: App () V.Event+app :: App () V.Event () app =     App { appDraw = const [ui]         , appHandleEvent = resizeOrQuit

@@ -29,14 +29,14 @@  makeLenses ''St -drawUI :: St -> [Widget]+drawUI :: St -> [Widget ()] drawUI st = [ui]     where         ui = vBox [ str $ "External input: \"" <> st^.stExternalInput <> "\""                   , str "(Press Esc to quit or Space to ask for input)"                   ] -appEvent :: St -> V.Event -> EventM (Next St)+appEvent :: St -> V.Event -> EventM () (Next St) appEvent st e =     case e of         V.EvKey V.KEsc [] -> halt st@@ -51,7 +51,7 @@     St { _stExternalInput = ""        } -theApp :: App St V.Event+theApp :: App St V.Event () theApp =     App { appDraw = drawUI         , appChooseCursor = neverShowCursor

@@ -1,9 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module Main where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative+#endif+ import Control.Monad (void)-import Data.Monoid+import Data.Monoid ((<>)) import Data.Default import qualified Graphics.Vty as V @@ -24,42 +27,38 @@   , str   ) -vp1Name :: T.Name-vp1Name = "demo1"--vp2Name :: T.Name-vp2Name = "demo2"--vp3Name :: T.Name-vp3Name = "demo3"+data Name = VP1+          | VP2+          | VP3+          deriving (Ord, Show, Eq) -drawUi :: () -> [Widget]+drawUi :: () -> [Widget Name] drawUi = const [ui]     where         ui = C.center $ B.border $ hLimit 60 $ vLimit 21 $              vBox [ pair, B.hBorder, singleton ]-        singleton = viewport vp3Name Both $+        singleton = viewport VP3 Both $                     vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."                          : (str <$> [ "Line " <> show i | i <- [2..25::Int] ])-        pair = hBox [ viewport vp1Name Vertical $+        pair = hBox [ viewport VP1 Vertical $                       vBox $ str "Press up and down arrow keys" :                              str "to scroll this viewport." :                              (str <$> [ "Line " <> (show i) | i <- [3..50::Int] ])                     , B.vBorder-                    , viewport vp2Name Horizontal $+                    , viewport VP2 Horizontal $                       str "Press left and right arrow keys to scroll this viewport."                     ] -vp1Scroll :: M.ViewportScroll-vp1Scroll = M.viewportScroll vp1Name+vp1Scroll :: M.ViewportScroll Name+vp1Scroll = M.viewportScroll VP1 -vp2Scroll :: M.ViewportScroll-vp2Scroll = M.viewportScroll vp2Name+vp2Scroll :: M.ViewportScroll Name+vp2Scroll = M.viewportScroll VP2 -vp3Scroll :: M.ViewportScroll-vp3Scroll = M.viewportScroll vp3Name+vp3Scroll :: M.ViewportScroll Name+vp3Scroll = M.viewportScroll VP3 -appEvent :: () -> V.Event -> T.EventM (T.Next ())+appEvent :: () -> V.Event -> T.EventM Name (T.Next ()) appEvent _ (V.EvKey V.KDown  [V.MCtrl]) = M.vScrollBy vp3Scroll 1 >> M.continue () appEvent _ (V.EvKey V.KUp    [V.MCtrl]) = M.vScrollBy vp3Scroll (-1) >> M.continue () appEvent _ (V.EvKey V.KRight [V.MCtrl]) = M.hScrollBy vp3Scroll 1 >> M.continue ()@@ -71,7 +70,7 @@ appEvent _ (V.EvKey V.KEsc []) = M.halt () appEvent _ _ = M.continue () -app :: M.App () V.Event+app :: M.App () V.Event Name app =     M.App { M.appDraw = drawUi           , M.appStartEvent = return

@@ -37,28 +37,24 @@  makeLenses ''St -vp1Name :: T.Name-vp1Name = "demo1"+data Name = VP1+          | VP2+          | VP3+          deriving (Show, Ord, Eq)  vp1Size :: Int vp1Size = 15 -vp2Name :: T.Name-vp2Name = "demo2"- vp2Size :: Int vp2Size = 15 -vp3Name :: T.Name-vp3Name = "demo3"- vp3Size :: (Int, Int) vp3Size = (25, 25)  selectedAttr :: AttrName selectedAttr = "selected" -drawUi :: St -> [Widget]+drawUi :: St -> [Widget Name] drawUi st = [ui]     where         ui = C.center $ hLimit 60 $ vLimit 30 $@@ -67,7 +63,7 @@                           "- Left/right arrow keys scroll the top-right viewport\n" <>                           "- Ctrl-arrow keys move the bottom viewport"                   ]-        singleton = viewport vp3Name Both $+        singleton = viewport VP3 Both $                     vBox $ do                          i <- [1..vp3Size^._1]                          let row = do@@ -79,14 +75,14 @@                          return $ hBox row          pair = hBox [ vp1, B.vBorder, vp2 ]-        vp1 = viewport vp1Name Vertical $+        vp1 = viewport VP1 Vertical $                   vBox $ do                       i <- [1..vp1Size]                       let mkItem = if i == st^.vp1Index                                    then withAttr selectedAttr . visible                                    else id                       return $ mkItem $ str $ "Item " <> show i-        vp2 = viewport vp2Name Horizontal $+        vp2 = viewport VP2 Horizontal $                   hBox $ do                       i <- [1..vp2Size]                       let mkItem = if i == st^.vp2Index@@ -94,16 +90,16 @@                                    else id                       return $ mkItem $ str $ "Item " <> show i <> " " -vp1Scroll :: M.ViewportScroll-vp1Scroll = M.viewportScroll vp1Name+vp1Scroll :: M.ViewportScroll Name+vp1Scroll = M.viewportScroll VP1 -vp2Scroll :: M.ViewportScroll-vp2Scroll = M.viewportScroll vp2Name+vp2Scroll :: M.ViewportScroll Name+vp2Scroll = M.viewportScroll VP2 -vp3Scroll :: M.ViewportScroll-vp3Scroll = M.viewportScroll vp3Name+vp3Scroll :: M.ViewportScroll Name+vp3Scroll = M.viewportScroll VP3 -appEvent :: St -> V.Event -> T.EventM (T.Next St)+appEvent :: St -> V.Event -> T.EventM Name (T.Next St) appEvent st (V.EvKey V.KDown  [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1) appEvent st (V.EvKey V.KUp    [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1 appEvent st (V.EvKey V.KRight [V.MCtrl]) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1)@@ -120,7 +116,7 @@     [ (selectedAttr, V.black `on` V.yellow)     ] -app :: M.App St V.Event+app :: M.App St V.Event Name app =     M.App { M.appDraw = drawUi           , M.appStartEvent = return

@@ -38,9 +38,12 @@   ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))-import qualified Data.Map as M import Data.Monoid+#endif++import qualified Data.Map as M import Data.Maybe (catMaybes) import Data.List (inits) import Data.String (IsString(..))

@@ -11,6 +11,7 @@   , focusPrev   , focusGetCurrent   , focusRingCursor+  , withFocusRing   ) where @@ -18,47 +19,72 @@ import Data.Maybe (listToMaybe)  import Brick.Types+import Brick.Widgets.Core (Named(..))  -- | A focus ring containing a sequence of widget names to focus and a -- currently-focused widget name.-data FocusRing = FocusRingEmpty-               | FocusRingNonempty ![Name] !Int+data FocusRing n = FocusRingEmpty+                 | FocusRingNonempty ![n] !Int  -- | Construct a focus ring from the list of names.-focusRing :: [Name] -> FocusRing+focusRing :: [n] -> FocusRing n focusRing [] = FocusRingEmpty focusRing names = FocusRingNonempty names 0  -- | Advance focus to the next widget in the ring.-focusNext :: FocusRing -> FocusRing+focusNext :: FocusRing n -> FocusRing n focusNext FocusRingEmpty = FocusRingEmpty+focusNext fr@(FocusRingNonempty [_] _) = fr focusNext (FocusRingNonempty ns i) = FocusRingNonempty ns i'     where         i' = (i + 1) `mod` (length ns)  -- | Advance focus to the previous widget in the ring.-focusPrev :: FocusRing -> FocusRing+focusPrev :: FocusRing n -> FocusRing n focusPrev FocusRingEmpty = FocusRingEmpty+focusPrev fr@(FocusRingNonempty [_] _) = fr focusPrev (FocusRingNonempty ns i) = FocusRingNonempty ns i'     where         i' = (i + (length ns) - 1) `mod` (length ns) +-- | This function is a convenience function to look up a widget state+-- value's name in a focus ring and set its focus setting according to+-- the focus ring's state. This function determines whether a given+-- widget state value is the focus of the ring and passes the resulting+-- boolean to a rendering function, along with the state value (a), to+-- produce whatever comes next (b).+--+-- Focus-aware widgets have rendering functions that should be+-- usable with this combinator; see 'Brick.Widgets.List.List' and+-- 'Brick.Widgets.Edit.Edit'.+withFocusRing :: (Eq n, Named a n)+              => FocusRing n+              -- ^ The focus ring to use as the source of focus state.+              -> (Bool -> a -> b)+              -- ^ A function that takes a value and its focus state.+              -> a+              -- ^ The wiget 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 widget name from the ring. If the ring is -- emtpy, return 'Nothing'.-focusGetCurrent :: FocusRing -> Maybe Name+focusGetCurrent :: FocusRing n -> Maybe n focusGetCurrent FocusRingEmpty = Nothing focusGetCurrent (FocusRingNonempty ns i) = Just $ ns !! i  -- | Cursor selection convenience function for use as an -- 'Brick.Main.appChooseCursor' value.-focusRingCursor :: (a -> FocusRing)+focusRingCursor :: (Eq n)+                => (a -> FocusRing n)                 -- ^ The function used to get the focus ring out of your                 -- application state.                 -> a                 -- ^ Your application state.-                -> [CursorLocation]+                -> [CursorLocation n]                 -- ^ The list of available cursor positions.-                -> Maybe CursorLocation+                -> Maybe (CursorLocation n)                 -- ^ The cursor position, if any, that matches the name                 -- currently focused by the 'FocusRing'. focusRingCursor getRing st ls =

@@ -31,7 +31,7 @@ where  import Control.Exception (finally)-import Lens.Micro ((^.))+import Lens.Micro ((^.), (&), (.~)) import Control.Monad (forever) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State@@ -40,6 +40,7 @@ import Data.Default import Data.Maybe (listToMaybe) import qualified Data.Map as M+import qualified Data.Set as S import Graphics.Vty   ( Vty   , Picture(..)@@ -53,23 +54,26 @@   , mkVty   ) -import Brick.Types (Viewport, Direction, Widget, rowL, columnL, CursorLocation(..), cursorLocationNameL, Name(..), EventM(..))-import Brick.Types.Internal (ScrollRequest(..), RenderState(..), Next(..))+import Brick.Types (Viewport, Direction, Widget, rowL, columnL, CursorLocation(..), cursorLocationNameL, EventM(..))+import Brick.Types.Internal (ScrollRequest(..), RenderState(..), observedNamesL, Next(..)) import Brick.Widgets.Internal (renderFinal) import Brick.AttrMap  -- | The library application abstraction. Your application's operations -- are represented here and passed to one of the various main functions -- in this module. An application is in terms of an application state--- type 's' and an application event type 'e'. In the simplest case 'e' is--- vty's 'Event' type, but you may define your own event type, permitted--- that it has a constructor for wrapping Vty events, so that Vty events--- can be handled by your event loop.-data App s e =-    App { appDraw :: s -> [Widget]+-- type 's', an application event type 'e', and a name type 'n'. In the+-- simplest case 'e' is vty's 'Event' type, but you may define your own+-- event type, permitted that it has a constructor for wrapping Vty+-- events, so that Vty events can be handled by your event loop. The+-- state type is the type of application state to be provided by you and+-- iteratively modified by event handlers. The name type is the type of+-- names you can assign to viewports and widgets.+data App s e n =+    App { appDraw :: s -> [Widget n]         -- ^ This function turns your application state into a list of         -- widget layers. The layers are listed topmost first.-        , appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation+        , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)         -- ^ This function chooses which of the zero or more cursor         -- locations reported by the rendering process should be         -- selected as the one to use to place the cursor. If this@@ -77,12 +81,12 @@         -- is that many widgets may request a cursor placement but your         -- application state is what you probably want to use to decide         -- which one wins.-        , appHandleEvent :: s -> e -> EventM (Next s)+        , appHandleEvent :: s -> 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 s+        , appStartEvent :: s -> 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.@@ -97,7 +101,7 @@ -- | The default main entry point which takes an application and an -- initial state and returns the final state returned by a 'halt' -- operation.-defaultMain :: App s Event+defaultMain :: App s Event n             -- ^ The application.             -> s             -- ^ The initial application state.@@ -109,7 +113,7 @@ -- | A simple main entry point which takes a widget and renders it. This -- event loop terminates when the user presses any key, but terminal -- resize events cause redraws.-simpleMain :: Widget+simpleMain :: Widget n            -- ^ The widget to draw.            -> IO () simpleMain w =@@ -127,19 +131,19 @@ -- a halt. This is a convenience function useful as an 'appHandleEvent' -- value for simple applications using the 'Event' type that do not need -- to get more sophisticated user input.-resizeOrQuit :: s -> Event -> EventM (Next s)+resizeOrQuit :: s -> Event -> EventM n (Next s) resizeOrQuit s (EvResize _ _) = continue s resizeOrQuit s _ = halt s -data InternalNext a = InternalSuspendAndResume RenderState (IO a)-                    | InternalHalt a+data InternalNext n a = InternalSuspendAndResume (RenderState n) (IO a)+                      | InternalHalt a -runWithNewVty :: IO Vty -> Chan e -> App s e -> RenderState -> s -> IO (InternalNext s)+runWithNewVty :: IO Vty -> Chan e -> App s e n -> RenderState n -> s -> IO (InternalNext n s) runWithNewVty buildVty chan app initialRS initialSt =     withVty buildVty $ \vty -> do         pid <- forkIO $ supplyVtyEvents vty (appLiftVtyEvent app) chan         let runInner rs st = do-              (result, newRS) <- runVty vty chan app st rs+              (result, newRS) <- runVty vty chan app st (rs & observedNamesL .~ S.empty)               case result of                   SuspendAndResume act -> do                       killThread pid@@ -160,7 +164,7 @@            -- ^ An event channel for sending custom events to the event            -- loop (you write to this channel, the event loop reads from            -- it).-           -> App s e+           -> App s e n            -- ^ The application.            -> s            -- ^ The initial application state.@@ -175,7 +179,7 @@                     run newRS newAppState      (st, initialScrollReqs) <- runStateT (runReaderT (runEventM (appStartEvent app initialAppState)) M.empty) []-    let initialRS = RS M.empty initialScrollReqs+    let initialRS = RS M.empty initialScrollReqs S.empty     run initialRS st  supplyVtyEvents :: Vty -> (Event -> e) -> Chan e -> IO ()@@ -184,7 +188,7 @@         e <- nextEvent vty         writeChan chan $ mkEvent e -runVty :: Vty -> Chan e -> App s e -> s -> RenderState -> IO (Next s, RenderState)+runVty :: Vty -> Chan e -> App s e n -> s -> RenderState n -> IO (Next s, RenderState n) runVty vty chan app appState rs = do     firstRS <- renderApp vty app appState rs     e <- readChan chan@@ -196,7 +200,7 @@ -- no such state could be found, either because the name was invalid -- or because no rendering has occurred (e.g. in an 'appStartEvent' -- handler).-lookupViewport :: Name -> EventM (Maybe Viewport)+lookupViewport :: (Ord n) => n -> EventM n (Maybe Viewport) lookupViewport = EventM . asks . M.lookup  withVty :: IO Vty -> (Vty -> IO a) -> IO a@@ -204,7 +208,7 @@     vty <- buildVty     useVty vty `finally` shutdown vty -renderApp :: Vty -> App s e -> s -> RenderState -> IO RenderState+renderApp :: Vty -> App s e n -> s -> RenderState n -> IO (RenderState n) renderApp vty app appState rs = do     sz <- displayBounds $ outputIface vty     let (newRS, pic, theCursor) = renderFinal (appAttrMap app appState)@@ -224,56 +228,56 @@ -- process. This is a convenience function useful as an -- 'appChooseCursor' value when a simple application has no need to -- position the cursor.-neverShowCursor :: s -> [CursorLocation] -> Maybe CursorLocation+neverShowCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) neverShowCursor = const $ const Nothing  -- | Always show the first cursor, if any, returned by the rendering -- process. This is a convenience function useful as an -- 'appChooseCursor' value when a simple program has zero or more -- widgets that advertise a cursor position.-showFirstCursor :: s -> [CursorLocation] -> Maybe CursorLocation+showFirstCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n) showFirstCursor = const listToMaybe  -- | Show the cursor with the specified name, if such a cursor location -- has been reported.-showCursorNamed :: Name -> [CursorLocation] -> Maybe CursorLocation+showCursorNamed :: (Eq n) => n -> [CursorLocation n] -> Maybe (CursorLocation n) showCursorNamed name locs =     let matches loc = loc^.cursorLocationNameL == Just name     in listToMaybe $ filter matches locs  -- | A viewport scrolling handle for managing the scroll state of -- viewports.-data ViewportScroll =-    ViewportScroll { viewportName :: Name+data ViewportScroll n =+    ViewportScroll { viewportName :: n                    -- ^ The name of the viewport to be controlled by                    -- this scrolling handle.-                   , hScrollPage :: Direction -> EventM ()+                   , hScrollPage :: Direction -> EventM n ()                    -- ^ Scroll the viewport horizontally by one page in                    -- the specified direction.-                   , hScrollBy :: Int -> EventM ()+                   , hScrollBy :: Int -> EventM n ()                    -- ^ Scroll the viewport horizontally by the                    -- specified number of rows or columns depending on                    -- the orientation of the viewport.-                   , hScrollToBeginning :: EventM ()+                   , hScrollToBeginning :: EventM n ()                    -- ^ Scroll horizontally to the beginning of the                    -- viewport.-                   , hScrollToEnd :: EventM ()+                   , hScrollToEnd :: EventM n ()                    -- ^ Scroll horizontally to the end of the viewport.-                   , vScrollPage :: Direction -> EventM ()+                   , vScrollPage :: Direction -> EventM n ()                    -- ^ Scroll the viewport vertically by one page in                    -- the specified direction.-                   , vScrollBy :: Int -> EventM ()+                   , vScrollBy :: Int -> EventM n ()                    -- ^ Scroll the viewport vertically by the specified                    -- number of rows or columns depending on the                    -- orientation of the viewport.-                   , vScrollToBeginning :: EventM ()+                   , vScrollToBeginning :: EventM n ()                    -- ^ Scroll vertically to the beginning of the viewport.-                   , vScrollToEnd :: EventM ()+                   , vScrollToEnd :: EventM n ()                    -- ^ Scroll vertically to the end of the viewport.                    }  -- | Build a viewport scroller for the viewport with the specified name.-viewportScroll :: Name -> ViewportScroll+viewportScroll :: n -> ViewportScroll n viewportScroll n =     ViewportScroll { viewportName = n                    , hScrollPage = \dir -> EventM $ lift $ modify ((n, HScrollPage dir) :)@@ -288,17 +292,17 @@  -- | Continue running the event loop with the specified application -- state.-continue :: s -> EventM (Next s)+continue :: s -> EventM n (Next s) continue = return . Continue  -- | Halt the event loop and return the specified application state as -- the final state value.-halt :: s -> EventM (Next s)+halt :: s -> EventM n (Next s) halt = return . Halt  -- | Suspend the event loop, save the terminal state, and run the -- specified action. When it returns an application state value, restore -- the terminal state, redraw the application from the new state, and -- resume the event loop.-suspendAndResume :: IO s -> EventM (Next s)+suspendAndResume :: IO s -> EventM n (Next s) suspendAndResume = return . SuspendAndResume

@@ -26,7 +26,7 @@ -- rendering monad.  You probably won't need to instance this. class GetAttr a where     -- | Where to get the attribute for this attribute metadata.-    getAttr :: a -> RenderM Attr+    getAttr :: a -> RenderM n Attr  instance GetAttr Attr where     getAttr a = do@@ -44,7 +44,7 @@ (@?) = (@@)  -- | Build a widget from markup.-markup :: (Eq a, GetAttr a) => Markup a -> Widget+markup :: (Eq a, GetAttr a) => Markup a -> Widget n markup m =     Widget Fixed Fixed $ do       let markupLines = markupToList m

@@ -25,7 +25,6 @@   -- * Event-handling types   , EventM(..)   , Next-  , HandleEvent(..)   , handleEventLensed    -- * Rendering infrastructure@@ -62,21 +61,21 @@   , Size(..)   , Padding(..)   , Direction(..)-  , Name(..)    ) 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.Type (Getting)-import Data.Monoid (Monoid(..)) import Control.Monad.Trans.State.Lazy import Control.Monad.Trans.Reader-import Control.Monad.Trans.Class (lift) import Graphics.Vty (Event, Image, emptyImage, Attr) import Data.Default (Default(..))-import Data.Functor.Contravariant import qualified Data.Map as M import Control.Monad.IO.Class @@ -90,34 +89,30 @@              | Max              -- ^ Pad up to the number of available rows or columns. --- | The class of types that provide some basic event-handling.-class HandleEvent a where-    -- | Handle a Vty event-    handleEvent :: Event -> a -> EventM a- -- | A convenience function for handling events intended for values -- that are targets of lenses in your application state. This function -- obtains the target value of the specified lens, invokes 'handleEvent' -- on it, and stores the resulting transformed value back in the state -- using the lens.-handleEventLensed :: (HandleEvent b)-                  => a+handleEventLensed :: a                   -- ^ The state value.                   -> Lens' a b                   -- ^ The lens to use to extract and store the target                   -- of the event.+                  -> (Event -> b -> EventM n b)+                  -- ^ The event handler.                   -> Event                   -- ^ The event to handle.-                  -> EventM a-handleEventLensed v target ev = do+                  -> 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 a =-    EventM { runEventM :: ReaderT (M.Map Name Viewport) (StateT EventState IO) a+newtype EventM n a =+    EventM { runEventM :: ReaderT (M.Map n Viewport) (StateT (EventState n) IO) a            }            deriving (Functor, Applicative, Monad, MonadIO) @@ -133,27 +128,27 @@           deriving (Show, Eq, Ord)  -- | The type of widgets.-data Widget =+data Widget n =     Widget { hSize :: Size            -- ^ This widget's horizontal growth policy            , vSize :: Size            -- ^ This widget's vertical growth policy-           , render :: RenderM Result+           , 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 a = ReaderT Context (State RenderState) a+type RenderM n a = ReaderT Context (State (RenderState n)) a  -- | The type of result returned by a widget's rendering function. The -- result provides the image, cursor positions, and visibility requests -- that resulted from the rendering process.-data Result =+data Result n =     Result { image :: Image            -- ^ The final rendered image for a widget-           , cursors :: [CursorLocation]+           , cursors :: [CursorLocation n]            -- ^ The list of reported cursor positions for the            -- application to choose from            , visibilityRequests :: [VisibilityRequest]@@ -162,11 +157,11 @@            }            deriving Show -instance Default Result where+instance Default (Result n) where     def = Result emptyImage [] []  -- | Get the current rendering context.-getContext :: RenderM Context+getContext :: RenderM n Context getContext = ask  suffixLenses ''Context@@ -176,7 +171,7 @@ attrL :: forall r. Getting r Context Attr attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL)) -instance TerminalLocation CursorLocation where+instance TerminalLocation (CursorLocation n) where     columnL = cursorLocationL._1     column = column . cursorLocation     rowL = cursorLocationL._2@@ -184,7 +179,7 @@  -- | Given an attribute name, obtain the attribute for the attribute -- name by consulting the context's attribute map.-lookupAttrName :: AttrName -> RenderM Attr+lookupAttrName :: AttrName -> RenderM n Attr lookupAttrName n = do     c <- getContext     return $ attrMapLookup n (c^.ctxAttrMapL)

@@ -6,7 +6,6 @@   , VisibilityRequest(..)   , vrPositionL   , vrSizeL-  , Name(..)   , Location(..)   , locL   , origin@@ -24,17 +23,21 @@    , scrollRequestsL   , viewportMapL+  , observedNamesL   , vpSize   , vpLeft   , vpTop   ) where +#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif+ import Lens.Micro (_1, _2, Lens') import Lens.Micro.TH (makeLenses) import Lens.Micro.Internal (Field1, Field2)-import Data.String-import Data.Monoid+import qualified Data.Set as S import qualified Data.Map as M import Graphics.Vty (DisplayRegion) @@ -42,17 +45,10 @@ import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) --- | Names of things. Used to name cursor locations, widgets, and--- viewports.-newtype Name = Name String-             deriving (Eq, Show, Ord)--instance IsString Name where-    fromString = Name--data RenderState =-    RS { viewportMap :: M.Map Name Viewport-       , scrollRequests :: [(Name, ScrollRequest)]+data RenderState n =+    RS { viewportMap :: M.Map n Viewport+       , scrollRequests :: [(n, ScrollRequest)]+       , observedNames :: !(S.Set n)        }  data ScrollRequest = HScrollBy Int@@ -92,7 +88,7 @@                   -- ^ Viewports of this type are scrollable vertically and horizontally.                   deriving Show -type EventState = [(Name, ScrollRequest)]+type EventState n = [(n, ScrollRequest)]  -- | The type of actions to take upon completion of an event handler. data Next a = Continue a@@ -144,10 +140,10 @@     mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)  -- | A cursor location.  These are returned by the rendering process.-data CursorLocation =+data CursorLocation n =     CursorLocation { cursorLocation :: !Location                    -- ^ The location-                   , cursorLocationName :: !(Maybe Name)+                   , cursorLocationName :: !(Maybe n)                    -- ^ The name of the widget associated with the location                    }                    deriving Show

@@ -55,5 +55,5 @@ bg = (defAttr `withBackColor`)  -- | Add a 'Location' offset to the specified 'CursorLocation'.-clOffset :: CursorLocation -> Location -> CursorLocation+clOffset :: CursorLocation n -> Location -> CursorLocation n clOffset cl off = cl & cursorLocationL %~ (<> off)

@@ -30,9 +30,13 @@   ) where +import Data.Monoid ((<>))++#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))+#endif+ import Lens.Micro ((^.), to)-import Data.Monoid ((<>)) import Graphics.Vty (imageHeight, imageWidth)  import Brick.AttrMap@@ -75,26 +79,26 @@  -- | Draw the specified border element using the active border style -- using 'borderAttr'.-borderElem :: (BorderStyle -> Char) -> Widget+borderElem :: (BorderStyle -> Char) -> Widget n borderElem f =     Widget Fixed Fixed $ do       bs <- ctxBorderStyle <$> getContext       render $ withAttr borderAttr $ str [f bs]  -- | Put a border around the specified widget.-border :: Widget -> Widget+border :: Widget n -> Widget n border = border_ Nothing  -- | Put a border around the specified widget with the specified label -- widget placed in the middle of the top horizontal border.-borderWithLabel :: Widget+borderWithLabel :: Widget n                 -- ^ The label widget-                -> Widget+                -> Widget n                 -- ^ The widget to put a border around-                -> Widget+                -> Widget n borderWithLabel label = border_ (Just label) -border_ :: Maybe Widget -> Widget -> Widget+border_ :: Maybe (Widget n) -> Widget n -> Widget n border_ label wrapped =     Widget (hSize wrapped) (vSize wrapped) $ do       bs <- ctxBorderStyle <$> getContext@@ -118,17 +122,17 @@              $ total  -- | A horizontal border.  Fills all horizontal space.-hBorder :: Widget+hBorder :: Widget n hBorder = hBorder_ Nothing  -- | A horizontal border with a label placed in the center of the -- border. Fills all horizontal space.-hBorderWithLabel :: Widget+hBorderWithLabel :: Widget n                  -- ^ The label widget-                 -> Widget+                 -> Widget n hBorderWithLabel label = hBorder_ (Just label) -hBorder_ :: Maybe Widget -> Widget+hBorder_ :: Maybe (Widget n) -> Widget n hBorder_ label =     Widget Greedy Fixed $ do       bs <- ctxBorderStyle <$> getContext@@ -136,7 +140,7 @@       render $ vLimit 1 $ withAttr hBorderAttr $ hCenterWith (Just $ bsHorizontal bs) msg  -- | A vertical border.  Fills all vertical space.-vBorder :: Widget+vBorder :: Widget n vBorder =     Widget Fixed Greedy $ do       bs <- ctxBorderStyle <$> getContext

@@ -23,13 +23,13 @@  -- | Center the specified widget horizontally. Consumes all available -- horizontal space.-hCenter :: Widget -> Widget+hCenter :: Widget n -> Widget n hCenter = hCenterWith Nothing  -- | Center the specified widget horizontally. Consumes all available -- horizontal space. Uses the specified character to fill in the space -- to either side of the centered widget (defaults to space).-hCenterWith :: Maybe Char -> Widget -> Widget+hCenterWith :: Maybe Char -> Widget n -> Widget n hCenterWith mChar p =     let ch = fromMaybe ' ' mChar     in Widget Greedy (vSize p) $ do@@ -53,13 +53,13 @@                       $ result & imageL .~ paddedImage  -- | Center a widget vertically.  Consumes all vertical space.-vCenter :: Widget -> Widget+vCenter :: Widget n -> Widget n vCenter = vCenterWith Nothing  -- | Center a widget vertically. Consumes all vertical space. Uses the -- specified character to fill in the space above and below the centered -- widget (defaults to space).-vCenterWith :: Maybe Char -> Widget -> Widget+vCenterWith :: Maybe Char -> Widget n -> Widget n vCenterWith mChar p =     let ch = fromMaybe ' ' mChar     in Widget (hSize p) Greedy $ do@@ -84,18 +84,18 @@  -- | Center a widget both vertically and horizontally. Consumes all -- available vertical and horizontal space.-center :: Widget -> Widget+center :: Widget n -> Widget n center = centerWith Nothing  -- | Center a widget both vertically and horizontally. Consumes all -- available vertical and horizontal space. Uses the specified character -- to fill in the space around the centered widget (defaults to space).-centerWith :: Maybe Char -> Widget -> Widget+centerWith :: Maybe Char -> Widget n -> Widget n centerWith c = vCenterWith c . hCenterWith c  -- | Center the widget horizontally and vertically about the specified -- origin.-centerAbout :: Location -> Widget -> Widget+centerAbout :: Location -> Widget n -> Widget n centerAbout l p =     Widget Greedy Greedy $ do       -- Compute translation offset so that loc is in the middle of the

@@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE MultiParamTypeClasses #-} -- | This module provides the core widget combinators and rendering -- routines. Everything this library does is in terms of these basic -- primitives.@@ -42,6 +43,9 @@   -- * Cursor placement   , showCursor +  -- * Naming+  , Named(..)+   -- * Translation   , translateBy @@ -65,16 +69,23 @@   ) where +#if MIN_VERSION_base(4,8,0)+import Data.Monoid ((<>))+#else import Control.Applicative+import Data.Monoid ((<>), mempty)+#endif+ import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, ix, Lens')+import Lens.Micro.Mtl (use, (%=)) import Control.Monad ((>=>),when) import Control.Monad.Trans.State.Lazy import Control.Monad.Trans.Reader import Control.Monad.Trans.Class (lift) import qualified Data.Text as T import Data.Default-import Data.Monoid ((<>), mempty) import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Function as DF import Data.List (sortBy, partition) import qualified Graphics.Vty as V@@ -87,13 +98,18 @@ import Brick.AttrMap import Brick.Widgets.Internal +-- | 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 -> Widget+withBorderStyle :: BorderStyle -> Widget n -> Widget n withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p)  -- | The empty widget.-emptyWidget :: Widget+emptyWidget :: Widget n emptyWidget = raw V.emptyImage  -- | Add an offset to all cursor locations and visbility requests@@ -105,13 +121,13 @@ -- by other combinators. You should call this any time you render -- something and then translate it or otherwise offset it from its -- original origin.-addResultOffset :: Location -> Result -> Result+addResultOffset :: Location -> Result n -> Result n addResultOffset off = addCursorOffset off . addVisibilityOffset off -addVisibilityOffset :: Location -> Result -> Result+addVisibilityOffset :: Location -> Result n -> Result n addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>) -addCursorOffset :: Location -> Result -> Result+addCursorOffset :: Location -> Result n -> Result n addCursorOffset off r =     let onlyVisible = filter isVisible         isVisible l = l^.columnL >= 0 && l^.rowL >= 0@@ -122,7 +138,7 @@  -- | Build a widget from a 'String'. Breaks newlines up and space-pads -- short lines out to the length of the longest line.-str :: String -> Widget+str :: String -> Widget n str s =     Widget Fixed Fixed $ do       c <- getContext@@ -141,13 +157,13 @@  -- | Build a widget from a one-line 'T.Text' value. Behaves the same as -- 'str'.-txt :: T.Text -> Widget+txt :: T.Text -> Widget n txt = str . T.unpack  -- | Pad the specified widget on the left. If max padding is used, this -- grows greedily horizontally; otherwise it defers to the padded -- widget.-padLeft :: Padding -> Widget -> Widget+padLeft :: Padding -> Widget n -> Widget n padLeft padding p =     let (f, sz) = case padding of           Max -> (id, Greedy)@@ -164,7 +180,7 @@ -- | Pad the specified widget on the right. If max padding is used, -- this grows greedily horizontally; otherwise it defers to the padded -- widget.-padRight :: Padding -> Widget -> Widget+padRight :: Padding -> Widget n -> Widget n padRight padding p =     let (f, sz) = case padding of           Max -> (id, Greedy)@@ -180,7 +196,7 @@  -- | Pad the specified widget on the top. If max padding is used, this -- grows greedily vertically; otherwise it defers to the padded widget.-padTop :: Padding -> Widget -> Widget+padTop :: Padding -> Widget n -> Widget n padTop padding p =     let (f, sz) = case padding of           Max -> (id, Greedy)@@ -197,7 +213,7 @@ -- | Pad the specified widget on the bottom. If max padding is used, -- this grows greedily vertically; otherwise it defers to the padded -- widget.-padBottom :: Padding -> Widget -> Widget+padBottom :: Padding -> Widget n -> Widget n padBottom padding p =     let (f, sz) = case padding of           Max -> (id, Greedy)@@ -213,22 +229,22 @@  -- | Pad a widget on the left and right. Defers to the padded widget for -- growth policy.-padLeftRight :: Int -> Widget -> Widget+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 -> Widget+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 -> Widget+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+fill :: Char -> Widget n fill ch =     Widget Greedy Greedy $ do       c <- getContext@@ -238,7 +254,7 @@ -- in the specified order (uppermost first). Defers growth policies to -- the growth policies of the contained widgets (if any are greedy, so -- is the box).-vBox :: [Widget] -> Widget+vBox :: [Widget n] -> Widget n vBox [] = emptyWidget vBox pairs = renderBox vBoxRenderer pairs @@ -246,7 +262,7 @@ -- in the specified order (leftmost first). Defers growth policies to -- the growth policies of the contained widgets (if any are greedy, so -- is the box).-hBox :: [Widget] -> Widget+hBox :: [Widget n] -> Widget n hBox [] = emptyWidget hBox pairs = renderBox hBoxRenderer pairs @@ -260,20 +276,20 @@ -- 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 =+data BoxRenderer n =     BoxRenderer { contextPrimary :: Lens' Context Int                 , contextSecondary :: Lens' Context Int                 , imagePrimary :: V.Image -> Int                 , imageSecondary :: V.Image -> Int-                , limitPrimary :: Int -> Widget -> Widget-                , limitSecondary :: Int -> Widget -> Widget-                , primaryWidgetSize :: Widget -> Size+                , limitPrimary :: Int -> Widget n -> Widget n+                , limitSecondary :: Int -> Widget n -> Widget n+                , primaryWidgetSize :: Widget n -> Size                 , concatenatePrimary :: [V.Image] -> V.Image                 , locationFromOffset :: Int -> Location                 , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image                 } -vBoxRenderer :: BoxRenderer+vBoxRenderer :: BoxRenderer n vBoxRenderer =     BoxRenderer { contextPrimary = availHeightL                 , contextSecondary = availWidthL@@ -289,7 +305,7 @@                     in V.horizCat [img, p]                 } -hBoxRenderer :: BoxRenderer+hBoxRenderer :: BoxRenderer n hBoxRenderer =     BoxRenderer { contextPrimary = availWidthL                 , contextSecondary = availHeightL@@ -352,7 +368,7 @@ -- Finally, the padded images are concatenated together vertically and -- returned along with the translated cursor positions and visibility -- requests.-renderBox :: BoxRenderer -> [Widget] -> Widget+renderBox :: BoxRenderer n -> [Widget n] -> Widget n renderBox br ws =     Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do       c <- getContext@@ -413,7 +429,7 @@ -- number of columns. This is important for constraining the horizontal -- growth of otherwise-greedy widgets. This is non-greedy horizontally -- and defers to the limited widget vertically.-hLimit :: Int -> Widget -> Widget+hLimit :: Int -> Widget n -> Widget n hLimit w p =     Widget Fixed (vSize p) $       withReaderT (& availWidthL .~ w) $ render $ cropToContext p@@ -422,7 +438,7 @@ -- number of rows. This is important for constraining the vertical -- growth of otherwise-greedy widgets. This is non-greedy vertically and -- defers to the limited widget horizontally.-vLimit :: Int -> Widget -> Widget+vLimit :: Int -> Widget n -> Widget n vLimit h p =     Widget (hSize p) Fixed $       withReaderT (& availHeightL .~ h) $ render $ cropToContext p@@ -434,7 +450,7 @@ -- get merged hierarchically and still fall back to the attribute map's -- default attribute. If you want to change the default attribute, use -- 'withDefAttr'.-withAttr :: AttrName -> Widget -> Widget+withAttr :: AttrName -> Widget n -> Widget n withAttr an p =     Widget (hSize p) (vSize p) $       withReaderT (& ctxAttrNameL .~ an) (render p)@@ -442,7 +458,7 @@ -- | Update the attribute map while rendering the specified widget: set -- its new default attribute to the one that we get by looking up the -- specified attribute name in the map.-withDefAttr :: AttrName -> Widget -> Widget+withDefAttr :: AttrName -> Widget n -> Widget n withDefAttr an p =     Widget (hSize p) (vSize p) $ do         c <- getContext@@ -450,7 +466,7 @@  -- | When rendering the specified widget, update the attribute map with -- the specified transformation.-updateAttrMap :: (AttrMap -> AttrMap) -> Widget -> Widget+updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n updateAttrMap f p =     Widget (hSize p) (vSize p) $         withReaderT (& ctxAttrMapL %~ f) (render p)@@ -458,19 +474,19 @@ -- | When rendering the specified widget, force all attribute lookups -- in the attribute map to use the value currently assigned to the -- specified attribute name.-forceAttr :: AttrName -> Widget -> Widget+forceAttr :: 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)  -- | Build a widget directly from a raw Vty image.-raw :: V.Image -> Widget+raw :: V.Image -> Widget n raw img = Widget Fixed Fixed $ return $ def & imageL .~ img  -- | Translate the specified widget by the specified offset amount. -- Defers to the translated width for growth policy.-translateBy :: Location -> Widget -> Widget+translateBy :: Location -> Widget n -> Widget n translateBy off p =     Widget (hSize p) (vSize p) $ do       result <- render p@@ -479,7 +495,7 @@  -- | Crop the specified widget on the left by the specified number of -- columns. Defers to the translated width for growth policy.-cropLeftBy :: Int -> Widget -> Widget+cropLeftBy :: Int -> Widget n -> Widget n cropLeftBy cols p =     Widget (hSize p) (vSize p) $ do       result <- render p@@ -490,7 +506,7 @@  -- | Crop the specified widget on the right by the specified number of -- columns. Defers to the translated width for growth policy.-cropRightBy :: Int -> Widget -> Widget+cropRightBy :: Int -> Widget n -> Widget n cropRightBy cols p =     Widget (hSize p) (vSize p) $ do       result <- render p@@ -500,7 +516,7 @@  -- | Crop the specified widget on the top by the specified number of -- rows. Defers to the translated width for growth policy.-cropTopBy :: Int -> Widget -> Widget+cropTopBy :: Int -> Widget n -> Widget n cropTopBy rows p =     Widget (hSize p) (vSize p) $ do       result <- render p@@ -511,7 +527,7 @@  -- | Crop the specified widget on the bottom by the specified number of -- rows. Defers to the translated width for growth policy.-cropBottomBy :: Int -> Widget -> Widget+cropBottomBy :: Int -> Widget n -> Widget n cropBottomBy rows p =     Widget (hSize p) (vSize p) $ do       result <- render p@@ -521,19 +537,19 @@  -- | When rendering the specified widget, also register a cursor -- positioning request using the specified name and location.-showCursor :: Name -> Location -> Widget -> Widget+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 -> Maybe Widget+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 -> Maybe Widget+vRelease :: Widget n -> Maybe (Widget n) vRelease p =     case vSize p of         Fixed -> Just $ Widget (hSize p) Greedy $ withReaderT (& availHeightL .~ unrestricted) (render p)@@ -553,15 +569,16 @@ -- 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 :: Name+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+         -> Widget n          -- ^ The widget to be rendered in the scrollable viewport-         -> Widget+         -> Widget n viewport vpname typ p =     Widget Greedy Greedy $ do       -- First, update the viewport size.@@ -571,23 +588,36 @@           doInsert (Just vp) = Just $ vp & vpSize .~ newSize           doInsert Nothing = Just newVp +      let observeName :: (Ord n, Show n) => n -> RenderM n ()+          observeName n = do+              observed <- use observedNamesL+              case S.member n observed of+                  False -> observedNamesL %= S.insert n+                  True -> error $ "Error: while rendering the interface, the name " <> show n <>+                                  " was seen more than once. You should ensure that all of the widgets " <>+                                  "in each interface have unique name values. This means either " <>+                                  "using a different name type or adding constructors to your " <>+                                  "existing one and using those to name your widgets.  For more " <>+                                  "information, see the \"Widget Names\" section of the Brick User Guide."++      observeName vpname+       lift $ modify (& viewportMapL %~ (M.alter doInsert vpname))        -- Then render the sub-rendering with the rendering layout       -- constraint released (but raise an exception if we are asked to       -- render an infinitely-sized widget in the viewport's scrolling       -- dimension)-      let Name vpn = vpname-          release = case typ of+      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 vpn)-                Horizontal -> error $ "tried to embed an infinite-width widget in horizontal viewport " <> (show vpn)-                Both -> error $ "tried to embed an infinite-width or infinite-height widget in 'Both' type viewport " <> (show vpn)+                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 @@ -666,7 +696,7 @@ -- is because viewports are updated during rendering and the one you are -- interested in may not have been rendered yet. So if you want to use -- this, be sure you know what you are doing.-unsafeLookupViewport :: Name -> RenderM (Maybe Viewport)+unsafeLookupViewport :: (Ord n) => n -> RenderM n (Maybe Viewport) unsafeLookupViewport name = lift $ gets (M.lookup name . (^.viewportMapL))  scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport@@ -732,7 +762,7 @@ -- deal with the details of scrolling state management. -- -- This does nothing if not rendered in a viewport.-visible :: Widget -> Widget+visible :: Widget n -> Widget n visible p =     Widget (hSize p) (vSize p) $ do       result <- render p@@ -751,7 +781,7 @@ -- relative to the specified widget's upper-left corner of (0, 0). -- -- This does nothing if not rendered in a viewport.-visibleRegion :: Location -> V.DisplayRegion -> Widget -> Widget+visibleRegion :: Location -> V.DisplayRegion -> Widget n -> Widget n visibleRegion vrloc sz p =     Widget (hSize p) (vSize p) $ do       result <- render p@@ -764,19 +794,19 @@ -- | Horizontal box layout: put the specified widgets next to each other -- in the specified order. Defers growth policies to the growth policies -- of both widgets.  This operator is a binary version of 'hBox'.-(<+>) :: Widget+(<+>) :: Widget n       -- ^ Left-      -> Widget+      -> Widget n       -- ^ Right-      -> Widget+      -> Widget n (<+>) a b = hBox [a, b]  -- | Vertical box layout: put the specified widgets one above the other -- in the specified order. Defers growth policies to the growth policies -- of both widgets.  This operator is a binary version of 'vBox'.-(<=>) :: Widget+(<=>) :: Widget n       -- ^ Top-      -> Widget+      -> Widget n       -- ^ Bottom-      -> Widget+      -> Widget n (<=>) a b = vBox [a, b]

@@ -5,13 +5,14 @@ module Brick.Widgets.Dialog   ( Dialog   , dialogTitle-  , dialogName   , dialogButtons   , dialogSelectedIndex   , dialogWidth   -- * Construction and rendering   , dialog   , renderDialog+  -- * Handling events+  , handleDialogEvent   -- * Getting a dialog's current value   , dialogSelection   -- * Attributes@@ -19,7 +20,6 @@   , buttonAttr   , buttonSelectedAttr   -- * Lenses-  , dialogNameL   , dialogButtonsL   , dialogSelectedIndexL   , dialogWidthL@@ -27,8 +27,11 @@   ) where -import Lens.Micro+#if !MIN_VERSION_base(4,8,0) import Control.Applicative+#endif++import Lens.Micro import Data.Monoid import Data.List (intersperse) import Graphics.Vty.Input (Event(..), Key(..))@@ -51,9 +54,7 @@ -- * Tab: selecte the next button -- * Shift-tab: select the previous button data Dialog a =-    Dialog { dialogName :: Name-           -- ^ The dialog name-           , dialogTitle :: Maybe String+    Dialog { dialogTitle :: Maybe String            -- ^ The dialog title            , dialogButtons :: [(String, a)]            -- ^ The dialog button labels and values@@ -65,18 +66,15 @@  suffixLenses ''Dialog -instance HandleEvent (Dialog a) where-    handleEvent ev d =-        case ev of-            EvKey (KChar '\t') [] -> return $ nextButtonBy 1 d-            EvKey KBackTab [] -> return $ nextButtonBy (-1) d-            _ -> return d+handleDialogEvent :: Event -> Dialog a -> EventM n (Dialog a)+handleDialogEvent ev d =+    return $ case ev of+        EvKey (KChar '\t') [] -> nextButtonBy 1 d+        EvKey KBackTab [] -> nextButtonBy (-1) d+        _ -> d  -- | Create a dialog.-dialog :: Name-       -- ^ The dialog name, provided so that you can use this as a-       -- basis for viewport names in the dialog if desired-       -> Maybe String+dialog :: Maybe String        -- ^ The dialog title        -> Maybe (Int, [(String, a)])        -- ^ The currently-selected button index (starting at zero) and@@ -84,12 +82,12 @@        -> Int        -- ^ The maximum width of the dialog        -> Dialog a-dialog name title buttonData w =+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 name title buttons idx w+    in Dialog title buttons idx w  -- | The default attribute of the dialog dialogAttr :: AttrName@@ -104,7 +102,7 @@ buttonSelectedAttr = buttonAttr <> "selected"  -- | Render a dialog with the specified body widget.-renderDialog :: Dialog a -> Widget -> Widget+renderDialog :: Dialog a -> Widget n -> Widget n renderDialog d body =     let buttonPadding = str "   "         mkButton (i, (s, _)) = let att = if Just i == d^.dialogSelectedIndexL

@@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} -- | This module provides a basic text editor widget. You'll need to -- embed an 'Editor' in your application state and transform it with -- 'handleEvent' when relevant events arrive. To get the contents@@ -15,6 +17,8 @@   , editor   -- * Reading editor contents   , getEditContents+  -- * Handling events+  , handleEditorEvent   -- * Editing text   , applyEdit   -- * Lenses for working with editors@@ -24,9 +28,11 @@   , renderEditor   -- * Attributes   , editAttr+  , editFocusedAttr   ) where +import Data.Monoid import Lens.Micro import Graphics.Vty (Event(..), Key(..), Modifier(..)) @@ -45,19 +51,22 @@ -- * Ctrl-k: delete all from cursor to end of line -- * Arrow keys: move cursor -- * Enter: break the current line at the cursor position-data Editor =+data Editor n =     Editor { editContents :: Z.TextZipper String            -- ^ The contents of the editor-           , editDrawContents :: [String] -> Widget+           , editDrawContents :: [String] -> Widget n            -- ^ The function the editor uses to draw its contents-           , editorName :: Name+           , editorName :: n            -- ^ The name of the editor            }  suffixLenses ''Editor -instance HandleEvent Editor where-    handleEvent e ed =+instance Named (Editor n) n where+    getName = editorName++handleEditorEvent :: Event -> Editor n -> EventM n (Editor n)+handleEditorEvent e ed =         let f = case e of                   EvKey (KChar 'a') [MCtrl] -> Z.gotoBOL                   EvKey (KChar 'e') [MCtrl] -> Z.gotoEOL@@ -75,16 +84,16 @@         in return $ applyEdit f ed  -- | Construct an editor.-editor :: Name+editor :: n        -- ^ The editor's name (must be unique)-       -> ([String] -> Widget)+       -> ([String] -> Widget n)        -- ^ The content rendering function        -> Maybe Int        -- ^ The limit on the number of lines in the editor ('Nothing'        -- means no limit)        -> String        -- ^ The initial content-       -> Editor+       -> Editor n editor name draw limit s = Editor (Z.stringZipper (lines s) limit) draw name  -- | Apply an editing operation to the editor's contents. Bear in mind@@ -93,30 +102,41 @@ -- text. applyEdit :: (Z.TextZipper String -> Z.TextZipper String)           -- ^ The 'Data.Text.Zipper' editing transformation to apply-          -> Editor-          -> Editor+          -> Editor n+          -> Editor n applyEdit f e = e & editContentsL %~ f --- | The attribute assigned to the editor+-- | The attribute assigned to the editor when it does not have focus. editAttr :: AttrName editAttr = "edit" +-- | The attribute assigned to the editor when it has focus. Extends+-- 'editAttr'.+editFocusedAttr :: AttrName+editFocusedAttr = editAttr <> "focused"+ -- | Get the contents of the editor.-getEditContents :: Editor -> [String]+getEditContents :: Editor n -> [String] getEditContents e = Z.getText $ e^.editContentsL  -- | Turn an editor state value into a widget-renderEditor :: Editor -> Widget-renderEditor e =+renderEditor :: (Ord n, Show n)+             => Bool+             -- ^ Whether the editor has focus. It will report a cursor+             -- position if and only if it has focus.+             -> Editor n+             -- ^ The editor.+             -> Widget n+renderEditor foc e =     let cp = Z.cursorPosition $ e^.editContentsL         cursorLoc = Location (cp^._2, cp^._1)         limit = case e^.editContentsL.to Z.getLineLimit of             Nothing -> id             Just lim -> vLimit lim-    in withAttr editAttr $+    in withAttr (if foc then editFocusedAttr else editAttr) $        limit $        viewport (e^.editorNameL) Both $-       showCursor (e^.editorNameL) cursorLoc $+       (if foc then showCursor (e^.editorNameL) cursorLoc else id) $        visibleRegion cursorLoc (1, 1) $        e^.editDrawContentsL $        getEditContents e

@@ -6,7 +6,10 @@   ) 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@@ -18,11 +21,11 @@ import Brick.AttrMap  renderFinal :: AttrMap-            -> [Widget]+            -> [Widget n]             -> V.DisplayRegion-            -> ([CursorLocation] -> Maybe CursorLocation)-            -> RenderState-            -> (RenderState, V.Picture, Maybe CursorLocation)+            -> ([CursorLocation n] -> Maybe (CursorLocation n))+            -> RenderState n+            -> (RenderState n, V.Picture, Maybe (CursorLocation n)) renderFinal aMap layerRenders sz chooseCursor rs = (newRS, pic, theCursor)     where         (layerResults, !newRS) = flip runState rs $ sequence $@@ -35,11 +38,11 @@  -- | After rendering the specified widget, crop its result image to the -- dimensions in the rendering context.-cropToContext :: Widget -> Widget+cropToContext :: Widget n -> Widget n cropToContext p =     Widget (hSize p) (vSize p) (render p >>= cropResultToContext) -cropResultToContext :: Result -> RenderM Result+cropResultToContext :: Result n -> RenderM n (Result n) cropResultToContext result = do     c <- getContext     return $ result & imageL %~ (V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL))

@@ -4,6 +4,8 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable#-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-} -- | This module provides a scrollable list type and functions for -- manipulating and rendering it. module Brick.Widgets.List@@ -15,6 +17,9 @@   -- * Rendering a list   , renderList +  -- * Handling events+  , handleListEvent+   -- * Lenses   , listElementsL   , listSelectedL@@ -36,13 +41,17 @@   -- * Attributes   , listAttr   , listSelectedAttr+  , listSelectedFocusedAttr   ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>),(<*>),pure)-import Lens.Micro ((^.), (&), (.~), (%~), _2) import Data.Foldable (Foldable) import Data.Traversable (Traversable)+#endif++import Lens.Micro ((^.), (&), (.~), (%~), _2) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Graphics.Vty (Event(..), Key(..))@@ -62,71 +71,81 @@ --   at a time (based on the number of items shown) -- * Home/end keys: move cursor of selected item to beginning or end of --   list-data List e =+data List n e =     List { listElements :: !(V.Vector e)          , listSelected :: !(Maybe Int)-         , listName :: Name+         , listName :: n          , listItemHeight :: Int          } deriving (Functor, Foldable, Traversable)  suffixLenses ''List -instance HandleEvent (List e) where-    handleEvent e theList = f-        where-            f = case e of-                  EvKey KUp [] -> return $ listMoveUp theList-                  EvKey KDown [] -> return $ listMoveDown theList-                  EvKey KHome [] -> return $ listMoveTo 0 theList-                  EvKey KEnd [] -> return $ listMoveTo (V.length $ listElements theList) theList-                  EvKey KPageDown [] -> do-                      v <- lookupViewport (theList^.listNameL)-                      case v of-                          Nothing -> return theList-                          Just vp -> return $ listMoveBy (vp^.vpSize._2 `div` theList^.listItemHeightL) theList-                  EvKey KPageUp [] -> do-                      v <- lookupViewport (theList^.listNameL)-                      case v of-                          Nothing -> return theList-                          Just vp -> return $ listMoveBy (negate $ vp^.vpSize._2 `div` theList^.listItemHeightL) theList-                  _ -> return theList+instance Named (List n e) n where+    getName = listName +handleListEvent :: (Show n, Ord n) => Event -> List n e -> EventM n (List n e)+handleListEvent e theList =+    case e of+        EvKey KUp [] -> return $ listMoveUp theList+        EvKey KDown [] -> return $ listMoveDown theList+        EvKey KHome [] -> return $ listMoveTo 0 theList+        EvKey KEnd [] -> return $ listMoveTo (V.length $ listElements theList) theList+        EvKey KPageDown [] -> do+            v <- lookupViewport (theList^.listNameL)+            case v of+                Nothing -> return theList+                Just vp -> return $ listMoveBy (vp^.vpSize._2 `div` theList^.listItemHeightL) theList+        EvKey KPageUp [] -> do+            v <- lookupViewport (theList^.listNameL)+            case v of+                Nothing -> return theList+                Just vp -> return $ listMoveBy (negate $ vp^.vpSize._2 `div` theList^.listItemHeightL) theList+        _ -> return theList+ -- | The top-level attribute used for the entire list. listAttr :: AttrName listAttr = "list" --- | The attribute used only for the currently-selected list item.--- Extends 'listAttr'.+-- | The attribute used only for the currently-selected list item when+-- the list does not have focus. Extends 'listAttr'. listSelectedAttr :: AttrName listSelectedAttr = listAttr <> "selected" +-- | The attribute used only for the currently-selected list item when+-- the list has focus. Extends 'listSelectedAttr'.+listSelectedFocusedAttr :: AttrName+listSelectedFocusedAttr = listSelectedAttr <> "focused"+ -- | Construct a list in terms of an element type 'e'.-list :: Name+list :: n      -- ^ The list name (must be unique)      -> V.Vector e      -- ^ The initial list contents      -> Int      -- ^ The list item height in rows (all list item widgets must be      -- this high)-     -> List e+     -> List n e list name es h =     let selIndex = if V.null es then Nothing else Just 0     in List es selIndex name h  -- | Turn a list state value into a widget given an item drawing -- function.-renderList :: List e-           -- ^ The List to be rendered-           -> (Bool -> e -> Widget)+renderList :: (Ord n, Show n)+           => (Bool -> e -> Widget n)            -- ^ Rendering function, True for the selected element-           -> Widget+           -> Bool+           -- ^ Whether the list has focus+           -> List n e+           -- ^ The List to be rendered+           -> Widget n            -- ^ rendered widget-renderList l drawElem =+renderList drawElem foc l =     withDefAttr listAttr $-    drawListElements l drawElem+    drawListElements foc l drawElem -drawListElements :: List e -> (Bool -> e -> Widget) -> Widget-drawListElements l drawElem =+drawListElements :: (Ord n, Show n) => Bool -> List n e -> (Bool -> e -> Widget n) -> Widget n+drawListElements foc l drawElem =     Widget Greedy Greedy $ do         c <- getContext @@ -157,8 +176,11 @@             drawnElements = flip V.imap es $ \i e ->                 let isSelected = Just (i + start) == l^.listSelectedL                     elemWidget = drawElem isSelected e+                    selItemAttr = if foc+                                  then withDefAttr listSelectedFocusedAttr+                                  else withDefAttr listSelectedAttr                     makeVisible = if isSelected-                                  then visible . withDefAttr listSelectedAttr+                                  then visible . selItemAttr                                   else id                 in makeVisible elemWidget @@ -171,8 +193,8 @@            -- ^ The position at which to insert (0 <= i <= size)            -> e            -- ^ The element to insert-           -> List e-           -> List e+           -> List n e+           -> List n e listInsert pos e l =     let safePos = clamp 0 (V.length es) pos         es = l^.listElementsL@@ -188,8 +210,8 @@ -- | Remove an element from a list at the specified position. listRemove :: Int            -- ^ The position at which to remove an element (0 <= i < size)-           -> List e-           -> List e+           -> List n e+           -> List n e listRemove pos l | V.null (l^.listElementsL) = l                  | pos /= clamp 0 (V.length (l^.listElementsL) - 1) pos = l                  | otherwise =@@ -208,7 +230,7 @@ -- | Replace the contents of a list with a new set of elements and -- update the new selected index. If the specified selected index (via -- 'Just') is not in the list bounds, zero is used instead.-listReplace :: V.Vector e -> Maybe Int -> List e -> List e+listReplace :: V.Vector e -> Maybe Int -> List n e -> List n e listReplace es idx l =     let newSel = clamp 0 (V.length es - 1) <$> idx     in l & listSelectedL .~ newSel@@ -216,24 +238,24 @@  -- | Move the list selected index up by one. (Moves the cursor up, -- subtracts one from the index.)-listMoveUp :: List e -> List e+listMoveUp :: List n e -> List n e listMoveUp = listMoveBy (-1)  -- | Move the list selected index down by one. (Moves the cursor down, -- adds one to the index.)-listMoveDown :: List e -> List e+listMoveDown :: List n e -> List n e listMoveDown = listMoveBy 1  -- | Move the list selected index by the specified amount, subject to -- validation.-listMoveBy :: Int -> List e -> List e+listMoveBy :: Int -> List n e -> List n e listMoveBy amt l =     let newSel = clamp 0 (V.length (l^.listElementsL) - 1) <$> (amt +) <$> (l^.listSelectedL)     in l & listSelectedL .~ newSel  -- | Set the selected index for a list to the specified index, subject -- to validation.-listMoveTo :: Int -> List e -> List e+listMoveTo :: Int -> List n e -> List n e listMoveTo pos l =     let len = V.length (l^.listElementsL)         newSel = clamp 0 (len - 1) $ if pos < 0 then len - pos else pos@@ -242,18 +264,18 @@                             else Nothing  -- | Return a list's selected element, if any.-listSelectedElement :: List e -> Maybe (Int, e)+listSelectedElement :: List n e -> Maybe (Int, e) listSelectedElement l = do   sel <- l^.listSelectedL   return (sel, (l^.listElementsL) V.! sel)  -- | Remove all elements from the list and clear the selection.-listClear :: List e -> List e+listClear :: List n e -> List n e listClear l = l & listElementsL .~ V.empty & listSelectedL .~ Nothing  -- | Reverse the list.  The element selected before the reversal will -- again be the selected one.-listReverse :: List e -> List e+listReverse :: List n e -> List n e listReverse theList = theList & listElementsL %~ V.reverse & listSelectedL .~ newSel   where n = V.length (listElements theList)         newSel = (-) <$> pure (n-1) <*> listSelected theList

@@ -32,7 +32,7 @@             -- the progress bar.             -> Float             -- ^ The progress value. Should be between 0 and 1 inclusive.-            -> Widget+            -> Widget n progressBar mLabel progress =     Widget Greedy Fixed $ do         c <- getContext

@@ -16,9 +16,12 @@   ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))-import Data.Default (Default, def) import Data.Monoid+#endif++import Data.Default (Default, def) import Data.String (IsString(..)) import qualified Data.Text as T