brick 0.1 → 0.2

raw patch · 30 files changed

+1373/−1122 lines, 30 filesdep +deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

API changes (from Hackage documentation)

Files

• CHANGELOG.md +62/−0
• README.md +3/−3
• brick.cabal +8/−5
• docs/guide.rst +61/−8
• programs/AttrDemo.hs +21/−18
• programs/BorderDemo.hs +11/−8
• programs/CustomEventDemo.hs +6/−4
• programs/DialogDemo.hs +6/−4
• programs/EditDemo.hs +9/−10
• programs/HelloWorldDemo.hs +2/−4
• programs/LayerDemo.hs +8/−5
• programs/ListDemo.hs +17/−14
• programs/MarkupDemo.hs +4/−2
• programs/PaddingDemo.hs +13/−10
• programs/SuspendAndResumeDemo.hs +7/−4
• programs/ViewportScrollDemo.hs +11/−9
• programs/VisibilityDemo.hs +5/−3
• src/Brick.hs +16/−0
• src/Brick/Main.hs +24/−25
• src/Brick/Markup.hs +1/−1
• src/Brick/Types.hs +147/−54
• src/Brick/Types/Internal.hs +166/−0
• src/Brick/Util.hs +1/−1
• src/Brick/Widgets/Border.hs +1/−0
• src/Brick/Widgets/Core.hs +663/−34
• src/Brick/Widgets/Dialog.hs +4/−4
• src/Brick/Widgets/Edit.hs +4/−4
• src/Brick/Widgets/Internal.hs +10/−842
• src/Brick/Widgets/List.hs +81/−46
• src/Brick/Widgets/ProgressBar.hs +1/−0

@@ -2,6 +2,68 @@ Brick changelog --------------- +0.2+---++API changes:+* Added top-level `Brick` module that re-exports the most important+  modules in the library.+* List:+  * Now instead of passing the item-drawing function to the `list` state+    constructor, it is passed to `renderList`+  * `renderList` now takes the row height of the list's item widgets.+    The list item-drawing function must respect this in order for+    scrolling to work properly. This change made it possible to optimize+    the list so that it only draws widgets visible in the viewport+    rather than rendering all of the list's items (even the ones+    off-screen). But to do this we must be able to tell in advance+    how high each one is, so we require this parameter. In addition+    this change means that lists no longer support items of different+    heights.+  * The list now uses Data.Vector instead of [a] to store items; this+    permits efficient slicing so we can do the optimized rendering+    described above.+* The `HandleEvent` type class `handleEvent` method now runs in+  `EventM`. This permits event-handling code implemented in terms of+  `HandleEvent` to do get access to viewport state and to run IO code,+  making it just as powerful as code in the top-level `EventM` handler.+* Many types were moved from `Brick.Widgets.Core` and `Brick.Main` to+  `Brick.Types`, making the former module merely a home for `Widget`+  constructors and combinators.+* The `IsString` instance for `Widget` was removed; this might be+  reinstated later, but this package provides enough `IsString`+  instances that things can get confusing.+* `EventM` is now reader monad over the most recent rendering pass's+  viewport state, in addition to being a state monad over viewport+  requests for the renderer. Added the `lookupViewport` function to+  provide access to the most recent viewport state. Exported the+  `Viewport` type and lenses.+* Now that `handleEvent` is now an `EventM` action, composition with+  `continue` et al got a little messier when using lenses to+  update the application state. To help with this, there is now+  `handleEventLensed`.++Bugfixes:+* Lists now perform well with 10 items or a million (see above; fixes+  #7, thanks Simon Michael)+* Added more haddock notes to `Brick.Widgets.Core` about growth+  policies.+* Forced evaluation of render states to address a space leak in the+  renderer (fixes #14, thanks Sebastian Reuße <seb@wirrsal.net>)+* str: only reference string content that can be shown (eliminates a+  space leak, fixes #14, thanks Sebastian Reuße <seb@wirrsal.net>)++Misc:+* Added a makefile for the user guide.+* List: added support for Home and End keys (thanks Simon Michael)+* Viewports: when rendering viewports, scroll requests from `EventM` are+  processed before visibility requests from the rendering process; this+  reverses this previous order of operations but permits user-supplied+  event handlers to reset viewports when desired.++Package changes:+* Added `deepseq` dependency+ 0.1 --- Initial release

@@ -70,10 +70,10 @@  Your documentation options, in recommended order, are: -* [FAQ](FAQ.md)-* [The brick user guide](docs/guide.rst)+* [FAQ](https://github.com/jtdaugherty/brick/blob/master/FAQ.md)+* [The brick user guide](https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst) * Haddock (all modules)-* [Demo programs](programs)+* [Demo programs](https://github.com/jtdaugherty/brick/blob/master/programs)  Status ------

@@ -1,5 +1,5 @@ name:                brick-version:             0.1+version:             0.2 synopsis:            A declarative terminal user interface library description:   Write terminal applications painlessly with 'brick'! You write an@@ -8,8 +8,7 @@   .   > module Main where   >-  > import Brick.Main (simpleMain)-  > import Brick.Widgets.Core (Widget, str)+  > import Brick   >   > ui :: Widget   > ui = str "Hello, world!"@@ -56,6 +55,7 @@   ghc-options:         -Wall -fno-warn-unused-do-bind -O3   hs-source-dirs:      src   exposed-modules:+    Brick     Brick.AttrMap     Brick.Focus     Brick.Main@@ -73,6 +73,7 @@     Data.Text.Markup   other-modules:     Brick.Types.TH+    Brick.Types.Internal     Brick.Widgets.Internal    build-depends:       base <= 5,@@ -86,7 +87,8 @@                        contravariant,                        text,                        text-zipper >= 0.2.1,-                       template-haskell+                       template-haskell,+                       deepseq >= 1.3 && < 1.5  executable brick-visibility-demo   if !flag(demos)@@ -212,7 +214,8 @@                        vty >= 5.3.1,                        data-default,                        text,-                       lens+                       lens,+                       vector  executable brick-custom-event-demo   if !flag(demos)

@@ -222,6 +222,59 @@   suspend your interface and execute some other program that needs to   gain control of the terminal (such as an external editor). +The HandleEvent Type Class+**************************++Event handlers are responsible for transforming the application state.+While you can use ordinary methods to do this such as pattern matching+and pure function calls, some widget state types such as the ones+provided by the ``Brick.Widgets.List`` and ``Brick.Widgets.Edit``+modules support another interface: the ``Brick.Types.HandleEvent`` type+class.++The ``HandleEvent`` type class has only one method:++.. code:: haskell++   handleEvent :: Event -> a -> EventM a++Instances of ``HandleEvent`` provide reasonable default behavior for+handling input events; for example, arrow keys change the ``List``+selection and input keys modify the text in ``Editor`` states.++Since ``handleEvent`` runs in ``EventM``, event handlers+written this way have access to rendering viewport states via+``Brick.Main.lookupViewport`` and the ``IO`` monad via ``liftIO``.++To use ``handleEvent`` in your program, invoke it on the relevant piece+of state in your event handler, e.g.,++.. code:: haskell++   myEvent :: s -> e -> EventM (Next s)+   myEvent s e = continue =<< handleEvent e s++This pattern works fine when your application state instances+``HandleEvent``, but it can become unpleasant if the value on which+you want to invoke ``handleEvent`` is embedded deeply within your+application state. If you have chosen to generate lenses for your+application state fields, you can use the convenience function+``handleEventLensed`` by specifying your state, a lens, and the event:++.. code:: haskell++   myEvent :: s -> e -> EventM (Next s)+   myEvent s e = continue =<< handleEventLensed s someLens e++Compare that with the more verbose explicit version:++.. code:: haskell++   myEvent :: s -> e -> EventM (Next s)+   myEvent s e = do+     newVal <- handleEvent e (s^.someLens)+     continue $ s & someLens .~ newVal+ Using Your Own Event Type ************************* @@ -419,8 +472,8 @@  How widgets use space when rendered is described in two pieces of information in each ``Widget``: the widget's horizontal and vertical-growth policies. These fields have type ``Brick.Widgets.Core.Size`` and-can have the values ``Fixed`` and ``Greedy``.+growth policies. These fields have type ``Brick.Types.Size`` and can+have the values ``Fixed`` and ``Greedy``.  A widget advertising a ``Fixed`` size in a given dimension is a widget that will always consume the same number of rows or columns no@@ -562,8 +615,8 @@ =========  A *viewport* is a scrollable window onto another widget. Viewports have-a *scrolling direction* of type ``Brick.Widgets.Core.ViewportType``-which can be one of:+a *scrolling direction* of type ``Brick.Types.ViewportType`` which can+be one of:  * ``Horizontal``: the viewport can only scroll horizontally. * ``Vertical``: the viewport can only scroll vertically.@@ -729,18 +782,18 @@     render :: RenderM Result -which is a function returning a ``Brick.Widgets.Core.Result``:+which is a function returning a ``Brick.Types.Result``:  .. code:: haskell      data Result =         Result { image :: Graphics.Vty.Image                , cursors :: [Brick.Types.CursorLocation]-               , visibilityRequests :: [Brick.Widgets.Core.VisibilityRequest]+               , visibilityRequests :: [Brick.Types.VisibilityRequest]                }  The ``RenderM`` monad gives us access to the rendering context (see `How-Widgets and Rendering Work`_) via the ``Brick.Widgets.Core.getContext``+Widgets and Rendering Work`_) via the ``Brick.Types.getContext`` function. The context type is:  .. code:: haskell@@ -774,7 +827,7 @@ determine how much space your widget has to render.  To perform an attribute lookup in the attribute map for the context's-current attribute, use ``Brick.Widgets.Core.attrL``.+current attribute, use ``Brick.Types.attrL``.  For example, to build a widget that always fills the available width and height with a fill character using the current attribute, we could

@@ -8,33 +8,36 @@   )  import Brick.Main-import Brick.Widgets.Core+import Brick.Types   ( Widget-  , (<=>)+  )+import Brick.Widgets.Core+  ( (<=>)   , withAttr   , vBox+  , str   ) import Brick.Util (on, fg) import Brick.AttrMap (attrMap, AttrMap)  ui :: Widget ui =-    vBox [ "This text uses the global default attribute."-         , withAttr "foundFull"-           "Specifying an attribute name means we look it up in the attribute tree."-         , withAttr "foundFgOnly"-           ("When we find a value, we merge it with its parent in the attribute"-           <=> "name tree all the way to the root (the global default).")-         , withAttr "missing"-           "A missing attribute name just resumes the search at its parent."-         , withAttr ("general" <> "specific")-           "In this way we build complete attribute values by using an inheritance scheme."-         , withAttr "foundFull"-           "You can override everything ..."-         , withAttr "foundFgOnly"-           "... or only you want to change and inherit the rest."-         , "Attribute names are assembled with the Monoid append operation to indicate"-         , "hierarchy levels, e.g. \"window\" <> \"title\"."+    vBox [ str "This text uses the global default attribute."+         , withAttr "foundFull" $+           str "Specifying an attribute name means we look it up in the attribute tree."+         , (withAttr "foundFgOnly" $+           str ("When we find a value, we merge it with its parent in the attribute")+           <=> str "name tree all the way to the root (the global default).")+         , withAttr "missing" $+           str "A missing attribute name just resumes the search at its parent."+         , withAttr ("general" <> "specific") $+           str "In this way we build complete attribute values by using an inheritance scheme."+         , withAttr "foundFull" $+           str "You can override everything ..."+         , withAttr "foundFgOnly" $+           str "... or only you want to change and inherit the rest."+         , str "Attribute names are assembled with the Monoid append operation to indicate"+         , str "hierarchy levels, e.g. \"window\" <> \"title\"."          ]  globalDefault :: Attr

@@ -9,9 +9,11 @@ import qualified Brick.Main as M import Brick.Util (fg, bg, on) import qualified Brick.AttrMap as A-import Brick.Widgets.Core+import Brick.Types   ( Widget-  , (<=>)+  )+import Brick.Widgets.Core+  ( (<=>)   , (<+>)   , vLimit   , hLimit@@ -19,6 +21,7 @@   , updateAttrMap   , withBorderStyle   , txt+  , str   ) import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B@@ -55,7 +58,7 @@ mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget mkBorderDemo (styleName, sty) =     withBorderStyle sty $-    B.borderWithLabel "label" $+    B.borderWithLabel (str "label") $     vLimit 5 $     C.vCenter $     txt $ "  " <> styleName <> " style  "@@ -75,21 +78,21 @@ colorDemo :: Widget colorDemo =     updateAttrMap (A.applyAttrMappings borderMappings) $-    B.borderWithLabel "title" $+    B.borderWithLabel (str "title") $     hLimit 20 $     vLimit 5 $     C.center $-    "colors!"+    str "colors!"  ui :: Widget ui =     hBox borderDemos     <=> B.hBorder     <=> colorDemo-    <=> B.hBorderWithLabel "horizontal border label"-    <=> (C.center "Left of vertical border"+    <=> B.hBorderWithLabel (str "horizontal border label")+    <=> (C.center (str "Left of vertical border")          <+> B.vBorder-         <+> C.center "Right of vertical border")+         <+> C.center (str "Right of vertical border"))  main :: IO () main = M.simpleMain ui

@@ -11,16 +11,18 @@  import Brick.Main   ( App(..)-  , Next-  , EventM   , showFirstCursor   , customMain   , continue   , halt   )-import Brick.Widgets.Core+import Brick.Types   ( Widget-  , (<=>)+  , Next+  , EventM+  )+import Brick.Widgets.Core+  ( (<=>)   , str   ) 

@@ -5,9 +5,11 @@ import qualified Graphics.Vty as V  import qualified Brick.Main as M-import Brick.Widgets.Core+import Brick.Types   ( Widget-  , padAll+  )+import Brick.Widgets.Core+  ( padAll   , str   ) import qualified Brick.Widgets.Dialog as D@@ -24,12 +26,12 @@     where         ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." -appEvent :: D.Dialog Choice -> V.Event -> M.EventM (M.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 =<< T.handleEvent ev d  initialState :: D.Dialog Choice initialState = D.dialog "dialog" (Just "Title") (Just (0, choices)) 50

@@ -9,8 +9,7 @@ import qualified Brick.Main as M import qualified Brick.Types as T import Brick.Widgets.Core-  ( Widget-  , (<+>)+  ( (<+>)   , (<=>)   , hLimit   , vLimit@@ -47,21 +46,21 @@     then edit1     else edit2 -drawUI :: St -> [Widget]+drawUI :: St -> [T.Widget] drawUI st = [ui]     where-        ui = C.center $ ("Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 $ E.renderEditor $ st^.edit1)) <=>-                        " " <=>-                        ("Input 2 (limited to 2 lines): " <+> (hLimit 30 $ E.renderEditor $ st^.edit2)) <=>-                        " " <=>-                        "Press Tab to switch between editors, Esc to quit."+        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." -appEvent :: St -> V.Event -> M.EventM (M.Next St)+appEvent :: St -> V.Event -> T.EventM (T.Next St) appEvent st ev =     case ev of         V.EvKey V.KEsc [] -> M.halt st         V.EvKey (V.KChar '\t') [] -> M.continue $ switchEditors st-        _ -> M.continue $ st & currentEditorL st %~ T.handleEvent ev+        _ -> M.continue =<< T.handleEventLensed st (currentEditorL st) ev  initialState :: St initialState =

@@ -1,11 +1,9 @@-{-# LANGUAGE OverloadedStrings #-} module Main where -import Brick.Main (simpleMain)-import Brick.Widgets.Core (Widget)+import Brick  ui :: Widget-ui = "Hello, world!"+ui = str "Hello, world!"  main :: IO () main = simpleMain ui

@@ -11,10 +11,13 @@ import Brick.Types (rowL, columnL) import qualified Brick.Main as M import qualified Brick.Widgets.Border as B-import Brick.Widgets.Core+import Brick.Types   ( Widget-  , translateBy   )+import Brick.Widgets.Core+  ( translateBy+  , str+  )  data St =     St { _topLayerLocation :: T.Location@@ -32,14 +35,14 @@ topLayer :: St -> Widget topLayer st =     translateBy (st^.topLayerLocation) $-    B.border "Top layer\n(Arrow keys move)"+    B.border $ str "Top layer\n(Arrow keys move)"  bottomLayer :: St -> Widget bottomLayer st =     translateBy (st^.bottomLayerLocation) $-    B.border "Bottom layer\n(Ctrl-arrow keys move)"+    B.border $ str "Bottom layer\n(Ctrl-arrow keys move)" -appEvent :: St -> V.Event -> M.EventM (M.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)

@@ -12,9 +12,12 @@ import qualified Brick.Widgets.List as L import qualified Brick.Widgets.Center as C import qualified Brick.AttrMap as A-import Brick.Widgets.Core+import qualified Data.Vector as V+import Brick.Types   ( Widget-  , (<+>)+  )+import Brick.Widgets.Core+  ( (<+>)   , str   , vLimit   , hLimit@@ -26,26 +29,26 @@ drawUI :: L.List Int -> [Widget] drawUI l = [ui]     where-        label = "Item " <+> cur <+> " of " <+> total+        label = str "Item " <+> cur <+> str " of " <+> total         cur = case l^.(L.listSelectedL) of-                Nothing -> "-"+                Nothing -> str "-"                 Just i -> str (show (i + 1))-        total = str $ show $ length $ l^.(L.listElementsL)+        total = str $ show $ V.length $ l^.(L.listElementsL)         box = B.borderWithLabel label $               hLimit 25 $               vLimit 15 $-              L.renderList l+              L.renderList l listDrawElement         ui = C.vCenter $ vBox [ C.hCenter box-                              , " "-                              , C.hCenter "Press +/- to add/remove list elements."-                              , C.hCenter "Press Esc to exit."+                              , str " "+                              , C.hCenter $ str "Press +/- to add/remove list elements."+                              , C.hCenter $ str "Press Esc to exit."                               ] -appEvent :: L.List Int -> V.Event -> M.EventM (M.Next (L.List Int))+appEvent :: L.List Int -> V.Event -> T.EventM (T.Next (L.List Int)) appEvent l e =     case e of         V.EvKey (V.KChar '+') [] ->-            let el = length $ l^.(L.listElementsL)+            let el = V.length $ l^.(L.listElementsL)             in M.continue $ L.listInsert el el l          V.EvKey (V.KChar '-') [] ->@@ -55,17 +58,17 @@          V.EvKey V.KEsc [] -> M.halt l -        ev -> M.continue $ T.handleEvent ev l+        ev -> M.continue =<< T.handleEvent ev l  listDrawElement :: Bool -> Int -> Widget listDrawElement sel i =     let selStr s = if sel                    then withAttr customAttr (str $ "<" <> s <> ">")                    else str s-    in C.hCenter $ "Item " <+> (selStr $ show i)+    in C.hCenter $ str "Item " <+> (selStr $ show i)  initialState :: L.List Int-initialState = L.list (T.Name "list") listDrawElement [0, 1, 2]+initialState = L.list (T.Name "list") (V.fromList [0, 1, 2]) 1  customAttr :: A.AttrName customAttr = L.listSelectedAttr <> "custom"

@@ -5,9 +5,11 @@ import qualified Graphics.Vty as V  import Brick.Main (App(..), defaultMain, resizeOrQuit, neverShowCursor)-import Brick.Widgets.Core+import Brick.Types   ( Widget-  , (<=>)+  )+import Brick.Widgets.Core+  ( (<=>)   ) import Brick.Util (on, fg) import Brick.Markup (markup, (@?))

@@ -5,11 +5,14 @@ import qualified Graphics.Vty as V  import Brick.Main (App(..), neverShowCursor, resizeOrQuit, defaultMain)-import Brick.Widgets.Core+import Brick.Types   ( Widget-  , vBox-  , hBox   , Padding(..)+  )+import Brick.Widgets.Core+  ( vBox+  , hBox+  , str   , padAll   , padLeft   , padRight@@ -23,24 +26,24 @@  ui :: Widget ui =-    vBox [ hBox [ padLeft Max $ vCenter "Left-padded"+    vBox [ hBox [ padLeft Max $ vCenter $ str "Left-padded"                 , B.vBorder-                , padRight Max $ vCenter "Right-padded"+                , padRight Max $ vCenter $ str "Right-padded"                 ]          , B.hBorder-         , hBox [ padTop Max $ hCenter "Top-padded"+         , hBox [ padTop Max $ hCenter $ str "Top-padded"                 , B.vBorder-                , padBottom Max $ hCenter "Bottom-padded"+                , padBottom Max $ hCenter $ str "Bottom-padded"                 ]          , B.hBorder-         , hBox [ padLeftRight 2 "Padded by 2 on left/right"+         , hBox [ padLeftRight 2 $ str "Padded by 2 on left/right"                 , B.vBorder-                , vBox [ padTopBottom 1 "Padded by 1 on top/bottom"+                , vBox [ padTopBottom 1 $ str "Padded by 1 on top/bottom"                        , B.hBorder                        ]                 ]          , B.hBorder-         , padAll 2 "Padded by 2 on all sides"+         , padAll 2 $ str "Padded by 2 on all sides"          ]  app :: App () V.Event

@@ -11,11 +11,14 @@ import Brick.Main   ( App(..), neverShowCursor, defaultMain   , suspendAndResume, halt, continue-  , EventM, Next   )-import Brick.Widgets.Core+import Brick.Types   ( Widget-  , vBox+  , EventM+  , Next+  )+import Brick.Widgets.Core+  ( vBox   , str   ) @@ -29,7 +32,7 @@ drawUI st = [ui]     where         ui = vBox [ str $ "External input: \"" <> st^.stExternalInput <> "\""-                  , "(Press Esc to quit or Space to ask for input)"+                  , str "(Press Esc to quit or Space to ask for input)"                   ]  appEvent :: St -> V.Event -> EventM (Next St)

@@ -1,5 +1,5 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-} module Main where  import Control.Applicative@@ -12,10 +12,12 @@ import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B-import Brick.Widgets.Core+import Brick.Types   ( Widget   , ViewportType(Horizontal, Vertical, Both)-  , hLimit+  )+import Brick.Widgets.Core+  ( hLimit   , vLimit   , hBox   , vBox@@ -38,15 +40,15 @@         ui = C.center $ B.border $ hLimit 60 $ vLimit 21 $              vBox [ pair, B.hBorder, singleton ]         singleton = viewport vp3Name Both $-                    vBox $ "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."+                    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 $-                      vBox $ "Press up and down arrow keys" :-                             "to scroll this viewport." :+                      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-                      "Press left and right arrow keys to scroll this viewport."+                    , viewport vp2Name Horizontal $+                      str "Press left and right arrow keys to scroll this viewport."                     ]  vp1Scroll :: M.ViewportScroll@@ -58,7 +60,7 @@ vp3Scroll :: M.ViewportScroll vp3Scroll = M.viewportScroll vp3Name -appEvent :: () -> V.Event -> M.EventM (M.Next ())+appEvent :: () -> V.Event -> T.EventM (T.Next ()) appEvent _ (V.EvKey V.KDown  [V.MCtrl]) = M.vScrollBy vp3Scroll 1 >> M.continue () appEvent _ (V.EvKey V.KUp    [V.MCtrl]) = M.vScrollBy vp3Scroll (-1) >> M.continue () appEvent _ (V.EvKey V.KRight [V.MCtrl]) = M.hScrollBy vp3Scroll 1 >> M.continue ()

@@ -13,10 +13,12 @@ import qualified Brick.Widgets.Border as B import Brick.AttrMap (AttrMap, AttrName, attrMap) import Brick.Util (on)-import Brick.Widgets.Core+import Brick.Types   ( Widget   , ViewportType(Horizontal, Vertical, Both)-  , withAttr+  )+import Brick.Widgets.Core+  ( withAttr   , hLimit   , vLimit   , hBox@@ -100,7 +102,7 @@ vp3Scroll :: M.ViewportScroll vp3Scroll = M.viewportScroll vp3Name -appEvent :: St -> V.Event -> M.EventM (M.Next St)+appEvent :: St -> V.Event -> T.EventM (T.Next St) appEvent st (V.EvKey V.KDown  [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1) appEvent st (V.EvKey V.KUp    [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1 appEvent st (V.EvKey V.KRight [V.MCtrl]) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1)

@@ -0,0 +1,16 @@+-- | This module is provided as a convenience to import the most+-- important parts of the API all at once.+module Brick+  ( module Brick.Main+  , module Brick.Types+  , module Brick.Widgets.Core+  , module Brick.AttrMap+  , module Brick.Util+  )+where++import Brick.Main+import Brick.Types+import Brick.Widgets.Core+import Brick.AttrMap+import Brick.Util

@@ -6,11 +6,10 @@   , resizeOrQuit    -- * Event handler functions-  , EventM-  , Next   , continue   , halt   , suspendAndResume+  , lookupViewport    -- ** Viewport scrolling   , viewportScroll@@ -34,7 +33,9 @@ import Control.Exception (finally) import Control.Lens ((^.)) import Control.Monad (forever)+import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State+import Control.Monad.Trans.Reader import Control.Concurrent (forkIO, Chan, newChan, readChan, writeChan, killThread) import Data.Default import Data.Maybe (listToMaybe)@@ -52,16 +53,11 @@   , mkVty   ) -import Brick.Widgets.Core (Widget)-import Brick.Widgets.Internal (renderFinal, RenderState(..), ScrollRequest(..), Direction(..))-import Brick.Types (rowL, columnL, CursorLocation(..), cursorLocationNameL, Name(..))+import Brick.Types (Viewport, Direction, Widget, rowL, columnL, CursorLocation(..), cursorLocationNameL, Name(..), EventM)+import Brick.Types.Internal (ScrollRequest(..), RenderState(..), Next(..))+import Brick.Widgets.Internal (renderFinal) import Brick.AttrMap --- | The type of actions to take in an event handler.-data Next a = Continue a-            | SuspendAndResume (IO a)-            | Halt a- -- | 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@@ -98,11 +94,6 @@         -- 'Event', this is just 'id'.         } --- | The monad in which event handlers run.-type EventM a = StateT EventState IO a--type EventState = [(Name, ScrollRequest)]- -- | The default main entry point which takes an application and an -- initial state and returns the final state returned by a 'halt' -- operation.@@ -183,7 +174,7 @@                     newAppState <- action                     run newRS newAppState -    (st, initialScrollReqs) <- runStateT (appStartEvent app initialAppState) []+    (st, initialScrollReqs) <- runStateT (runReaderT (appStartEvent app initialAppState) M.empty) []     let initialRS = RS M.empty initialScrollReqs     run initialRS st @@ -197,9 +188,17 @@ runVty vty chan app appState rs = do     firstRS <- renderApp vty app appState rs     e <- readChan chan-    (next, scrollReqs) <- runStateT (appHandleEvent app appState e) []+    (next, scrollReqs) <- runStateT (runReaderT (appHandleEvent app appState e) (viewportMap rs)) []     return (next, firstRS { scrollRequests = scrollReqs }) +-- | Given a viewport name, get the viewport's size and offset+-- information from the most recent rendering. Returns 'Nothing' if+-- no such state could be found, either because the name was invalid+-- or because no rendering has occurred (e.g. in an 'appStartEvent'+-- handler).+lookupViewport :: Name -> EventM (Maybe Viewport)+lookupViewport = asks . M.lookup+ withVty :: IO Vty -> (Vty -> IO a) -> IO a withVty buildVty useVty = do     vty <- buildVty@@ -277,14 +276,14 @@ viewportScroll :: Name -> ViewportScroll viewportScroll n =     ViewportScroll { viewportName = n-                   , hScrollPage = \dir -> modify ((n, HScrollPage dir) :)-                   , hScrollBy = \i -> modify ((n, HScrollBy i) :)-                   , hScrollToBeginning = modify ((n, HScrollToBeginning) :)-                   , hScrollToEnd = modify ((n, HScrollToEnd) :)-                   , vScrollPage = \dir -> modify ((n, HScrollPage dir) :)-                   , vScrollBy = \i -> modify ((n, VScrollBy i) :)-                   , vScrollToBeginning = modify ((n, VScrollToBeginning) :)-                   , vScrollToEnd = modify ((n, VScrollToEnd) :)+                   , hScrollPage = \dir -> lift $ modify ((n, HScrollPage dir) :)+                   , hScrollBy = \i -> lift $ modify ((n, HScrollBy i) :)+                   , hScrollToBeginning = lift $ modify ((n, HScrollToBeginning) :)+                   , hScrollToEnd = lift $ modify ((n, HScrollToEnd) :)+                   , vScrollPage = \dir -> lift $ modify ((n, HScrollPage dir) :)+                   , vScrollBy = \i -> lift $ modify ((n, VScrollBy i) :)+                   , vScrollToBeginning = lift $ modify ((n, VScrollToBeginning) :)+                   , vScrollToEnd = lift $ modify ((n, VScrollToEnd) :)                    }  -- | Continue running the event loop with the specified application

@@ -19,8 +19,8 @@  import Graphics.Vty (Attr, horizCat, string) -import Brick.Widgets.Core import Brick.AttrMap+import Brick.Types  -- | A type class for types that provide access to an attribute in the -- rendering monad.  You probably won't need to instance this.

@@ -1,81 +1,172 @@ -- | Basic types used by this library. {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Brick.Types-  ( Location(..)+  ( -- * The Widget type+    Widget(..)++    -- * Location types and lenses+  , Location(..)   , locL   , TerminalLocation(..)   , CursorLocation(..)   , cursorLocationL   , cursorLocationNameL++  -- * Viewports+  , Viewport(..)+  , ViewportType(..)+  , vpSize+  , vpTop+  , vpLeft++  -- * Event-handling types+  , EventM+  , Next   , HandleEvent(..)-  , Name(..)+  , handleEventLensed++  -- * Rendering infrastructure+  , RenderM+  , getContext++  -- ** The rendering context+  , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap)+  , attrL+  , availWidthL+  , availHeightL+  , ctxAttrMapL+  , ctxAttrNameL+  , ctxBorderStyleL++  -- ** Rendering results+  , Result(..)+  , lookupAttrName++  -- ** Rendering result lenses+  , imageL+  , cursorsL+  , visibilityRequestsL++  -- ** Visibility requests+  , VisibilityRequest(..)+  , vrPositionL+  , vrSizeL++  -- * Making lenses   , suffixLenses++  -- * Miscellaneous+  , Size(..)+  , Padding(..)+  , Direction(..)+  , Name(..)+   ) where -import Control.Lens-import Data.String+import Control.Lens (_1, _2, to, (^.), (&), (.~), Lens') import Data.Monoid (Monoid(..))-import Graphics.Vty (Event)+import Control.Monad.Trans.State.Lazy+import Control.Monad.Trans.Reader+import Graphics.Vty (Event, Image, emptyImage, Attr)+import Data.Default (Default(..))+import Data.Functor.Contravariant+import qualified Data.Map as M  import Brick.Types.TH+import Brick.Types.Internal+import Brick.AttrMap (AttrName, attrMapLookup) --- | A terminal screen location.-data Location = Location { loc :: (Int, Int)-                         -- ^ (Column, Row)-                         }-                deriving Show+-- | The type of padding.+data Padding = Pad Int+             -- ^ Pad by the specified number of rows or columns.+             | Max+             -- ^ Pad up to the number of available rows or columns. -suffixLenses ''Location+-- | The class of types that provide some basic event-handling.+class HandleEvent a where+    -- | Handle a Vty event+    handleEvent :: Event -> a -> EventM a -instance Field1 Location Location Int Int where-    _1 = locL._1+-- | A convenience function for handling events intended for values+-- that are targets of lenses in your application state. This function+-- obtains the target value of the specified lens, invokes 'handleEvent'+-- on it, and stores the resulting transformed value back in the state+-- using the lens.+handleEventLensed :: (HandleEvent b)+                  => a+                  -- ^ The state value.+                  -> Lens' a b+                  -- ^ The lens to use to extract and store the target+                  -- of the event.+                  -> Event+                  -- ^ The event to handle.+                  -> EventM a+handleEventLensed v target ev = do+    newB <- handleEvent ev (v^.target)+    return $ v & target .~ newB -instance Field2 Location Location Int Int where-    _2 = locL._2+-- | The monad in which event handlers run. Although it may be tempting+-- to dig into the reader value yourself, just use+-- 'Brick.Main.lookupViewport'.+type EventM a = ReaderT (M.Map Name Viewport) (StateT EventState IO) a --- | The class of types that behave like terminal locations.-class TerminalLocation a where-    -- | Get the column out of the value-    columnL :: Lens' a Int-    column :: a -> Int-    -- | Get the row out of the value-    rowL :: Lens' a Int-    row :: a -> Int+-- | Widget growth policies. These policies communicate to layout+-- algorithms how a widget uses space when being rendered. These+-- policies influence rendering order and space allocation in the box+-- layout algorithm.+data Size = Fixed+          -- ^ Fixed widgets take up the same amount of space no matter+          -- how much they are given (non-greedy).+          | Greedy+          -- ^ Greedy widgets take up all the space they are given.+          deriving (Show, Eq, Ord) -instance TerminalLocation Location where-    columnL = _1-    column (Location t) = fst t-    rowL = _2-    row (Location t) = snd t+-- | The type of widgets.+data Widget =+    Widget { hSize :: Size+           -- ^ This widget's horizontal growth policy+           , vSize :: Size+           -- ^ This widget's vertical growth policy+           , render :: RenderM Result+           -- ^ This widget's rendering function+           } --- | Names of things. Used to name cursor locations, widgets, and--- viewports.-newtype Name = Name String-             deriving (Eq, Show, Ord)+-- | 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 -instance IsString Name where-    fromString = Name+-- | The type of result returned by a widget's rendering function. The+-- result provides the image, cursor positions, and visibility requests+-- that resulted from the rendering process.+data Result =+    Result { image :: Image+           -- ^ The final rendered image for a widget+           , cursors :: [CursorLocation]+           -- ^ The list of reported cursor positions for the+           -- application to choose from+           , visibilityRequests :: [VisibilityRequest]+           -- ^ The list of visibility requests made by widgets rendered+           -- while rendering this one (used by viewports)+           }+           deriving Show --- | The origin (upper-left corner).-origin :: Location-origin = Location (0, 0)+instance Default Result where+    def = Result emptyImage [] [] -instance Monoid Location where-    mempty = origin-    mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)+-- | Get the current rendering context.+getContext :: RenderM Context+getContext = ask --- | A cursor location.  These are returned by the rendering process.-data CursorLocation =-    CursorLocation { cursorLocation :: !Location-                   -- ^ The location-                   , cursorLocationName :: !(Maybe Name)-                   -- ^ The name of the widget associated with the location-                   }-                   deriving Show+suffixLenses ''Context+suffixLenses ''Result -suffixLenses ''CursorLocation+-- | The rendering context's current drawing attribute.+attrL :: (Contravariant f, Functor f) => (Attr -> f Attr) -> Context -> f Context+attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL))  instance TerminalLocation CursorLocation where     columnL = cursorLocationL._1@@ -83,7 +174,9 @@     rowL = cursorLocationL._2     row = row . cursorLocation --- | The class of types that provide some basic event-handling.-class HandleEvent a where-    -- | Handle a Vty event-    handleEvent :: Event -> a -> a+-- | Given an attribute name, obtain the attribute for the attribute+-- name by consulting the context's attribute map.+lookupAttrName :: AttrName -> RenderM Attr+lookupAttrName n = do+    c <- getContext+    return $ attrMapLookup n (c^.ctxAttrMapL)

@@ -0,0 +1,166 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Brick.Types.Internal+  ( ScrollRequest(..)+  , VisibilityRequest(..)+  , vrPositionL+  , vrSizeL+  , Name(..)+  , Location(..)+  , locL+  , origin+  , TerminalLocation(..)+  , Viewport(..)+  , ViewportType(..)+  , RenderState(..)+  , Direction(..)+  , CursorLocation(..)+  , cursorLocationL+  , cursorLocationNameL+  , Context(..)+  , EventState+  , Next(..)++  , scrollRequestsL+  , viewportMapL+  , vpSize+  , vpLeft+  , vpTop+  )+where++import Control.Lens (Field1, Field2, _1, _2, Lens', makeLenses)+import Data.String+import Data.Monoid+import qualified Data.Map as M+import Graphics.Vty (DisplayRegion)++import Brick.Types.TH+import Brick.AttrMap (AttrName, AttrMap)+import Brick.Widgets.Border.Style (BorderStyle)++-- | Names of things. Used to name cursor locations, widgets, and+-- viewports.+newtype Name = Name String+             deriving (Eq, Show, Ord)++instance IsString Name where+    fromString = Name++data RenderState =+    RS { viewportMap :: M.Map Name Viewport+       , scrollRequests :: [(Name, ScrollRequest)]+       }++data ScrollRequest = HScrollBy Int+                   | HScrollPage Direction+                   | HScrollToBeginning+                   | HScrollToEnd+                   | VScrollBy Int+                   | VScrollPage Direction+                   | VScrollToBeginning+                   | VScrollToEnd++data VisibilityRequest =+    VR { vrPosition :: Location+       , vrSize :: DisplayRegion+       }+       deriving Show++-- | Describes the state of a viewport as it appears as its most recent+-- rendering.+data Viewport =+    VP { _vpLeft :: Int+       -- ^ The column offset of left side of the viewport.+       , _vpTop :: Int+       -- ^ The row offset of the top of the viewport.+       , _vpSize :: DisplayRegion+       -- ^ The size of the viewport.+       }+       deriving Show++-- | The type of viewports that indicates the direction(s) in which a+-- viewport is scrollable.+data ViewportType = Vertical+                  -- ^ Viewports of this type are scrollable only vertically.+                  | Horizontal+                  -- ^ Viewports of this type are scrollable only horizontally.+                  | Both+                  -- ^ Viewports of this type are scrollable vertically and horizontally.+                  deriving Show++type EventState = [(Name, ScrollRequest)]++-- | The type of actions to take upon completion of an event handler.+data Next a = Continue a+            | SuspendAndResume (IO a)+            | Halt a++-- | Scrolling direction.+data Direction = Up+               -- ^ Up/left+               | Down+               -- ^ Down/right++-- | A terminal screen location.+data Location = Location { loc :: (Int, Int)+                         -- ^ (Column, Row)+                         }+                deriving Show++suffixLenses ''Location++instance Field1 Location Location Int Int where+    _1 = locL._1++instance Field2 Location Location Int Int where+    _2 = locL._2++-- | The class of types that behave like terminal locations.+class TerminalLocation a where+    -- | Get the column out of the value+    columnL :: Lens' a Int+    column :: a -> Int+    -- | Get the row out of the value+    rowL :: Lens' a Int+    row :: a -> Int++instance TerminalLocation Location where+    columnL = _1+    column (Location t) = fst t+    rowL = _2+    row (Location t) = snd t++-- | The origin (upper-left corner).+origin :: Location+origin = Location (0, 0)++instance Monoid Location where+    mempty = origin+    mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)++-- | A cursor location.  These are returned by the rendering process.+data CursorLocation =+    CursorLocation { cursorLocation :: !Location+                   -- ^ The location+                   , cursorLocationName :: !(Maybe Name)+                   -- ^ The name of the widget associated with the location+                   }+                   deriving Show++-- | The rendering context. This tells widgets how to render: how much+-- space they have in which to render, which attribute they should use+-- to render, which bordring style should be used, and the attribute map+-- available for rendering.+data Context =+    Context { ctxAttrName :: AttrName+            , availWidth :: Int+            , availHeight :: Int+            , ctxBorderStyle :: BorderStyle+            , ctxAttrMap :: AttrMap+            }++suffixLenses ''RenderState+suffixLenses ''VisibilityRequest+suffixLenses ''CursorLocation+makeLenses ''Viewport

@@ -12,7 +12,7 @@ import Data.Monoid ((<>)) import Graphics.Vty -import Brick.Types (Location(..), CursorLocation(..), cursorLocationL)+import Brick.Types.Internal (Location(..), CursorLocation(..), cursorLocationL)  -- | Given a minimum value and a maximum value, clamp a value to that -- range (values less than the minimum map to the minimum and values

@@ -36,6 +36,7 @@ import Graphics.Vty (imageHeight, imageWidth)  import Brick.AttrMap+import Brick.Types import Brick.Widgets.Core import Brick.Widgets.Center (hCenterWith) import Brick.Widgets.Border.Style (BorderStyle(..))

@@ -1,19 +1,17 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-} -- | This module provides the core widget combinators and rendering -- routines. Everything this library does is in terms of these basic -- primitives. module Brick.Widgets.Core-  ( Widget(..)-  , Size(..)--  -- * Basic rendering primitives-  , emptyWidget+  ( -- * Basic rendering primitives+    emptyWidget   , raw   , txt   , str   , fill    -- * Padding-  , Padding(..)   , padLeft   , padRight   , padTop@@ -54,43 +52,674 @@   , cropBottomBy    -- * Scrollable viewports-  , ViewportType(..)   , viewport   , visible   , visibleRegion -  -- * Rendering infrastructure-  , RenderM-  , getContext-  , lookupAttrName--  -- ** The rendering context-  , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap)-  , attrL-  , availWidthL-  , availHeightL-  , ctxAttrMapL-  , ctxAttrNameL-  , ctxBorderStyleL--  -- ** Rendering results-  , Result(..)-  -- ** Result lenses-  , imageL-  , cursorsL-  , visibilityRequestsL-  -- ** Visibility requests-  , VisibilityRequest(..)-  , vrPositionL-  , vrSizeL   -- ** Adding offsets to cursor positions and visibility requests   , addResultOffset+   -- ** Cropping results   , cropToContext--  -- * Misc-  , Direction(..)   ) where +import Control.Applicative+import Control.Lens ((^.), (.~), (&), (%~), to, _1, _2, each, to, ix)+import Control.Monad (when)+import Control.Monad.Trans.State.Lazy+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Class (lift)+import qualified Data.Text as T+import Data.Default+import Data.Monoid ((<>), mempty)+import qualified Data.Map as M+import qualified Data.Function as DF+import Data.List (sortBy, partition)+import Control.Lens (Lens')+import qualified Graphics.Vty as V+import Control.DeepSeq++import Brick.Types+import Brick.Types.Internal+import Brick.Widgets.Border.Style+import Brick.Util (clOffset, clamp)+import Brick.AttrMap import Brick.Widgets.Internal++-- | When rendering the specified widget, use the specified border style+-- for any border rendering.+withBorderStyle :: BorderStyle -> Widget -> Widget+withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p)++-- | The empty widget.+emptyWidget :: Widget+emptyWidget = raw V.emptyImage++-- | Add an offset to all cursor locations and visbility requests+-- in the specified rendering result. This function is critical for+-- maintaining correctness in the rendering results as they are+-- processed successively by box layouts and other wrapping combinators,+-- since calls to this function result in converting from widget-local+-- coordinates to (ultimately) terminal-global ones so they can be used+-- by other combinators. You should call this any time you render+-- something and then translate it or otherwise offset it from its+-- original origin.+addResultOffset :: Location -> Result -> Result+addResultOffset off = addCursorOffset off . addVisibilityOffset off++addVisibilityOffset :: Location -> Result -> Result+addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)++addCursorOffset :: Location -> Result -> Result+addCursorOffset off r =+    let onlyVisible = filter isVisible+        isVisible l = l^.columnL >= 0 && l^.rowL >= 0+    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)++unrestricted :: Int+unrestricted = 100000++-- | Build a widget from a 'String'. Breaks newlines up and space-pads+-- short lines out to the length of the longest line.+str :: String -> Widget+str s =+    Widget Fixed Fixed $ do+      c <- getContext+      let theLines = fixEmpty <$> (dropUnused . lines) s+          fixEmpty [] = " "+          fixEmpty l = l+          dropUnused l = take (availWidth c) <$> take (availHeight c) l+      case force theLines of+          [] -> return def+          [one] -> return $ def & imageL .~ (V.string (c^.attrL) one)+          multiple ->+              let maxLength = maximum $ length <$> multiple+                  lineImgs = lineImg <$> multiple+                  lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - length lStr) ' ')+              in return $ def & imageL .~ (V.vertCat lineImgs)++-- | Build a widget from a one-line 'T.Text' value. Behaves the same as+-- 'str'.+txt :: T.Text -> Widget+txt = str . T.unpack++-- | Pad the specified widget on the left. If max padding is used, this+-- grows greedily horizontally; otherwise it defers to the padded+-- widget.+padLeft :: Padding -> Widget -> Widget+padLeft padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (hLimit i, hSize p)+    in Widget sz (vSize p) $ do+        result <- render p+        render $ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') <+>+                 (Widget Fixed Fixed $ return result)++-- | Pad the specified widget on the right. If max padding is used,+-- this grows greedily horizontally; otherwise it defers to the padded+-- widget.+padRight :: Padding -> Widget -> Widget+padRight padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (hLimit i, hSize p)+    in Widget sz (vSize p) $ do+        result <- render p+        render $ (Widget Fixed Fixed $ return result) <+>+                 (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ')++-- | Pad the specified widget on the top. If max padding is used, this+-- grows greedily vertically; otherwise it defers to the padded widget.+padTop :: Padding -> Widget -> Widget+padTop padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (vLimit i, vSize p)+    in Widget (hSize p) sz $ do+        result <- render p+        render $ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') <=>+                 (Widget Fixed Fixed $ return result)++-- | Pad the specified widget on the bottom. If max padding is used,+-- this grows greedily vertically; otherwise it defers to the padded+-- widget.+padBottom :: Padding -> Widget -> Widget+padBottom padding p =+    let (f, sz) = case padding of+          Max -> (id, Greedy)+          Pad i -> (vLimit i, vSize p)+    in Widget (hSize p) sz $ do+        result <- render p+        render $ (Widget Fixed Fixed $ return result) <=>+                 (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ')++-- | Pad a widget on the left and right. Defers to the padded widget for+-- growth policy.+padLeftRight :: Int -> Widget -> Widget+padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w++-- | Pad a widget on the top and bottom. Defers to the padded widget for+-- growth policy.+padTopBottom :: Int -> Widget -> Widget+padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w++-- | Pad a widget on all sides. Defers to the padded widget for growth+-- policy.+padAll :: Int -> Widget -> Widget+padAll v w = padLeftRight v $ padTopBottom v w++-- | Fill all available space with the specified character. Grows both+-- horizontally and vertically.+fill :: Char -> Widget+fill ch =+    Widget Greedy Greedy $ do+      c <- getContext+      return $ def & imageL .~ (V.charFill (c^.attrL) ch (c^.availWidthL) (c^.availHeightL))++-- | Vertical box layout: put the specified widgets one above the other+-- in the specified order (uppermost first). Defers growth policies to+-- the growth policies of the contained widgets (if any are greedy, so+-- is the box).+vBox :: [Widget] -> Widget+vBox [] = emptyWidget+vBox pairs = renderBox vBoxRenderer pairs++-- | Horizontal box layout: put the specified widgets next to each other+-- in the specified order (leftmost first). Defers growth policies to+-- the growth policies of the contained widgets (if any are greedy, so+-- is the box).+hBox :: [Widget] -> Widget+hBox [] = emptyWidget+hBox pairs = renderBox hBoxRenderer pairs++-- | The process of rendering widgets in a box layout is exactly the+-- same except for the dimension under consideration (width vs. height),+-- in which case all of the same operations that consider one dimension+-- in the layout algorithm need to be switched to consider the other.+-- Because of this we fill a BoxRenderer with all of the functions+-- needed to consider the "primary" dimension (e.g. vertical if the+-- box layout is vertical) as well as the "secondary" dimension (e.g.+-- horizontal if the box layout is vertical). Doing this permits us to+-- have one implementation for box layout and parameterizing on the+-- orientation of all of the operations.+data BoxRenderer =+    BoxRenderer { contextPrimary :: Lens' Context Int+                , contextSecondary :: Lens' Context Int+                , imagePrimary :: V.Image -> Int+                , imageSecondary :: V.Image -> Int+                , limitPrimary :: Int -> Widget -> Widget+                , limitSecondary :: Int -> Widget -> Widget+                , primaryWidgetSize :: Widget -> Size+                , concatenatePrimary :: [V.Image] -> V.Image+                , locationFromOffset :: Int -> Location+                , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image+                }++vBoxRenderer :: BoxRenderer+vBoxRenderer =+    BoxRenderer { contextPrimary = availHeightL+                , contextSecondary = availWidthL+                , imagePrimary = V.imageHeight+                , imageSecondary = V.imageWidth+                , limitPrimary = vLimit+                , limitSecondary = hLimit+                , primaryWidgetSize = vSize+                , concatenatePrimary = V.vertCat+                , locationFromOffset = Location . (0 ,)+                , padImageSecondary = \amt img a ->+                    let p = V.charFill a ' ' amt (V.imageHeight img)+                    in V.horizCat [img, p]+                }++hBoxRenderer :: BoxRenderer+hBoxRenderer =+    BoxRenderer { contextPrimary = availWidthL+                , contextSecondary = availHeightL+                , imagePrimary = V.imageWidth+                , imageSecondary = V.imageHeight+                , limitPrimary = hLimit+                , limitSecondary = vLimit+                , primaryWidgetSize = hSize+                , concatenatePrimary = V.horizCat+                , locationFromOffset = Location . (, 0)+                , padImageSecondary = \amt img a ->+                    let p = V.charFill a ' ' (V.imageWidth img) amt+                    in V.vertCat [img, p]+                }++-- | Render a series of widgets in a box layout in the order given.+--+-- The growth policy of a box layout is the most unrestricted of the+-- growth policies of the widgets it contains, so to determine the hSize+-- and vSize of the box we just take the maximum (using the Ord instance+-- for Size) of all of the widgets to be rendered in the box.+--+-- Then the box layout algorithm proceeds as follows. We'll use+-- the vertical case to concretely describe the algorithm, but the+-- horizontal case can be envisioned just by exchanging all+-- "vertical"/"horizontal" and "rows"/"columns", etc., in the+-- description.+--+-- The growth policies of the child widgets determine the order in which+-- they are rendered, i.e., the order in which space in the box is+-- allocated to widgets as the algorithm proceeds. This is because order+-- matters: if we render greedy widgets first, there will be no space+-- left for non-greedy ones.+--+-- So we render all widgets with size 'Fixed' in the vertical dimension+-- first. Each is rendered with as much room as the overall box has, but+-- we assume that they will not be greedy and use it all. If they do,+-- maybe it's because the terminal is small and there just isn't enough+-- room to render everything.+--+-- Then the remaining height is distributed evenly amongst all remaining+-- (greedy) widgets and they are rendered in sub-boxes that are as high+-- as this even slice of rows and as wide as the box is permitted to be.+-- We only do this step at all if rendering the non-greedy widgets left+-- us any space, i.e., if there were any rows left.+--+-- After rendering the non-greedy and then greedy widgets, their images+-- are sorted so that they are stored in the order the original widgets+-- were given. All cursor locations and visibility requests in each+-- sub-widget are translated according to the position of the sub-widget+-- in the box.+--+-- All images are padded to be as wide as the widest sub-widget to+-- prevent attribute over-runs. Without this step the attribute used by+-- a sub-widget may continue on in an undesirable fashion until it hits+-- something with a different attribute. To prevent this and to behave+-- in the least surprising way, we pad the image on the right with+-- whitespace using the context's current attribute.+--+-- Finally, the padded images are concatenated together vertically and+-- returned along with the translated cursor positions and visibility+-- requests.+renderBox :: BoxRenderer -> [Widget] -> Widget+renderBox br ws = do+    Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do+      c <- getContext++      let pairsIndexed = zip [(0::Int)..] ws+          (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed) pairsIndexed++      renderedHis <- mapM (\(i, prim) -> (i,) <$> render prim) his++      renderedLows <- case lows of+          [] -> return []+          ls -> do+              let remainingPrimary = c^.(contextPrimary br) - (sum $ (^._2.imageL.(to $ imagePrimary br)) <$> renderedHis)+                  primaryPerLow = remainingPrimary `div` length ls+                  padFirst = remainingPrimary - (primaryPerLow * length ls)+                  secondaryPerLow = c^.(contextSecondary br)+                  primaries = replicate (length ls) primaryPerLow & ix 0 %~ (+ padFirst)++              let renderLow ((i, prim), pri) =+                      (i,) <$> (render $ limitPrimary br pri+                                       $ limitSecondary br secondaryPerLow+                                       $ cropToContext prim)++              if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return []++      let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows+          allResults = snd <$> rendered+          allImages = (^.imageL) <$> allResults+          allPrimaries = imagePrimary br <$> allImages+          allTranslatedResults = (flip map) (zip [0..] allResults) $ \(i, result) ->+              let off = locationFromOffset br offPrimary+                  offPrimary = sum $ take i allPrimaries+              in addResultOffset off result+          -- Determine the secondary dimension value to pad to. In a+          -- vertical box we want all images to be the same width to+          -- avoid attribute over-runs or blank spaces with the wrong+          -- attribute. In a horizontal box we want all images to have+          -- the same height for the same reason.+          maxSecondary = maximum $ imageSecondary br <$> allImages+          padImage img = padImageSecondary br (maxSecondary - imageSecondary br img) img (c^.attrL)+          paddedImages = padImage <$> allImages++      cropResultToContext $ Result (concatenatePrimary br paddedImages)+                            (concat $ cursors <$> allTranslatedResults)+                            (concat $ visibilityRequests <$> allTranslatedResults)++-- | Limit the space available to the specified widget to the specified+-- number of columns. This is important for constraining the horizontal+-- growth of otherwise-greedy widgets. This is non-greedy horizontally+-- and defers to the limited widget vertically.+hLimit :: Int -> Widget -> Widget+hLimit w p =+    Widget Fixed (vSize p) $ do+      withReaderT (& availWidthL .~ w) $ render $ cropToContext p++-- | Limit the space available to the specified widget to the specified+-- number of rows. This is important for constraining the vertical+-- growth of otherwise-greedy widgets. This is non-greedy vertically and+-- defers to the limited widget horizontally.+vLimit :: Int -> Widget -> Widget+vLimit h p =+    Widget (hSize p) Fixed $ do+      withReaderT (& availHeightL .~ h) $ render $ cropToContext p++-- | When drawing the specified widget, set the current attribute used+-- for drawing to the one with the specified name. Note that the widget+-- may use further calls to 'withAttr' to override this; if you really+-- want to prevent that, use 'forceAttr'. Attributes used this way still+-- get merged hierarchically and still fall back to the attribute map's+-- default attribute. If you want to change the default attribute, use+-- 'withDefAttr'.+withAttr :: AttrName -> Widget -> Widget+withAttr an p =+    Widget (hSize p) (vSize p) $ do+      withReaderT (& ctxAttrNameL .~ an) (render p)++-- | Update the attribute map while rendering the specified widget: set+-- its new default attribute to the one that we get by looking up the+-- specified attribute name in the map.+withDefAttr :: AttrName -> Widget -> Widget+withDefAttr an p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        withReaderT (& ctxAttrMapL %~ (setDefault (attrMapLookup an (c^.ctxAttrMapL)))) (render p)++-- | When rendering the specified widget, update the attribute map with+-- the specified transformation.+updateAttrMap :: (AttrMap -> AttrMap) -> Widget -> Widget+updateAttrMap f p =+    Widget (hSize p) (vSize p) $ do+        withReaderT (& ctxAttrMapL %~ f) (render p)++-- | When rendering the specified widget, force all attribute lookups+-- in the attribute map to use the value currently assigned to the+-- specified attribute name.+forceAttr :: AttrName -> Widget -> Widget+forceAttr an p =+    Widget (hSize p) (vSize p) $ do+        c <- getContext+        withReaderT (& ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)++-- | Build a widget directly from a raw Vty image.+raw :: V.Image -> Widget+raw img = Widget Fixed Fixed $ return $ def & imageL .~ img++-- | Translate the specified widget by the specified offset amount.+-- Defers to the translated width for growth policy.+translateBy :: Location -> Widget -> Widget+translateBy off p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      return $ addResultOffset off+             $ result & imageL %~ (V.translate (off^.columnL) (off^.rowL))++-- | Crop the specified widget on the left by the specified number of+-- columns. Defers to the translated width for growth policy.+cropLeftBy :: Int -> Widget -> Widget+cropLeftBy cols p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageWidth (result^.imageL) - cols+          cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img+      return $ addResultOffset (Location (-1 * cols, 0))+             $ result & imageL %~ cropped++-- | Crop the specified widget on the right by the specified number of+-- columns. Defers to the translated width for growth policy.+cropRightBy :: Int -> Widget -> Widget+cropRightBy cols p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageWidth (result^.imageL) - cols+          cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img+      return $ result & imageL %~ cropped++-- | Crop the specified widget on the top by the specified number of+-- rows. Defers to the translated width for growth policy.+cropTopBy :: Int -> Widget -> Widget+cropTopBy rows p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageHeight (result^.imageL) - rows+          cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img+      return $ addResultOffset (Location (0, -1 * rows))+             $ result & imageL %~ cropped++-- | Crop the specified widget on the bottom by the specified number of+-- rows. Defers to the translated width for growth policy.+cropBottomBy :: Int -> Widget -> Widget+cropBottomBy rows p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let amt = V.imageHeight (result^.imageL) - rows+          cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img+      return $ result & imageL %~ cropped++-- | When rendering the specified widget, also register a cursor+-- positioning request using the specified name and location.+showCursor :: Name -> Location -> Widget -> Widget+showCursor n cloc p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      return $ result & cursorsL %~ (CursorLocation cloc (Just n):)++hRelease :: Widget -> Maybe Widget+hRelease p =+    case hSize p of+        Fixed -> Just $ Widget Greedy (vSize p) $ withReaderT (& availWidthL .~ unrestricted) (render p)+        Greedy -> Nothing++vRelease :: Widget -> Maybe Widget+vRelease p =+    case vSize p of+        Fixed -> Just $ Widget (hSize p) Greedy $ withReaderT (& availHeightL .~ unrestricted) (render p)+        Greedy -> Nothing++-- | Render the specified widget in a named viewport with the+-- specified type. This permits widgets to be scrolled without being+-- scrolling-aware. To make the most use of viewports, the specified+-- widget should use the 'visible' combinator to make a "visibility+-- request". This viewport combinator will then translate the resulting+-- rendering to make the requested region visible. In addition, the+-- 'Brick.Main.EventM' monad provides primitives to scroll viewports+-- created by this function if 'visible' is not what you want.+--+-- If a viewport receives more than one visibility request, only the+-- first is honored. If a viewport receives more than one scrolling+-- request from 'Brick.Main.EventM', all are honored in the order in+-- which they are received.+viewport :: Name+         -- ^ The name of the viewport (must be unique and stable for+         -- reliable behavior)+         -> ViewportType+         -- ^ The type of viewport (indicates the permitted scrolling+         -- direction)+         -> Widget+         -- ^ The widget to be rendered in the scrollable viewport+         -> Widget+viewport vpname typ p =+    Widget Greedy Greedy $ do+      -- First, update the viewport size.+      c <- getContext+      let newVp = VP 0 0 newSize+          newSize = (c^.availWidthL, c^.availHeightL)+          doInsert (Just vp) = Just $ vp & vpSize .~ newSize+          doInsert Nothing = Just newVp++      lift $ modify (& viewportMapL %~ (M.alter doInsert vpname))++      -- Then render the sub-rendering with the rendering layout+      -- constraint released (but raise an exception if we are asked to+      -- render an infinitely-sized widget in the viewport's scrolling+      -- dimension)+      let Name vpn = vpname+          release = case typ of+            Vertical -> vRelease+            Horizontal -> hRelease+            Both -> \w -> vRelease w >>= hRelease+          released = case release p of+            Just w -> w+            Nothing -> case typ of+                Vertical -> error $ "tried to embed an infinite-height widget in vertical viewport " <> (show vpn)+                Horizontal -> error $ "tried to embed an infinite-width widget in horizontal viewport " <> (show vpn)+                Both -> error $ "tried to embed an infinite-width or infinite-height widget in 'Both' type viewport " <> (show vpn)++      initialResult <- render released++      -- If the rendering state includes any scrolling requests for this+      -- viewport, apply those+      reqs <- lift $ gets $ (^.scrollRequestsL)+      let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs+      when (not $ null relevantRequests) $ do+          Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))+          let updatedVp = applyRequests relevantRequests vp+              applyRequests [] v = v+              applyRequests (rq:rqs) v =+                  case typ of+                      Horizontal -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v+                      Vertical -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v+                      Both -> scrollTo Horizontal rq (initialResult^.imageL) $+                              scrollTo Vertical rq (initialResult^.imageL) $+                              applyRequests rqs v+          lift $ modify (& viewportMapL %~ (M.insert vpname updatedVp))+          return ()++      -- If the sub-rendering requested visibility, update the scroll+      -- state accordingly+      when (not $ null $ initialResult^.visibilityRequestsL) $ do+          Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))+          let rq = head $ initialResult^.visibilityRequestsL+              updatedVp = case typ of+                  Both -> scrollToView Horizontal rq $ scrollToView Vertical rq vp+                  Horizontal -> scrollToView typ rq vp+                  Vertical -> scrollToView typ rq vp+          lift $ modify (& viewportMapL %~ (M.insert vpname updatedVp))++      -- Get the viewport state now that it has been updated.+      Just vp <- lift $ gets (M.lookup vpname . (^.viewportMapL))++      -- Then perform a translation of the sub-rendering to fit into the+      -- viewport+      translated <- render $ translateBy (Location (-1 * vp^.vpLeft, -1 * vp^.vpTop))+                           $ Widget Fixed Fixed $ return initialResult++      -- Return the translated result with the visibility requests+      -- discarded+      let translatedSize = ( translated^.imageL.to V.imageWidth+                           , translated^.imageL.to V.imageHeight+                           )+      case translatedSize of+          (0, 0) -> return $ translated & imageL .~ (V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL))+                                        & visibilityRequestsL .~ mempty+          _ -> render $ cropToContext+                      $ padBottom Max+                      $ padRight Max+                      $ Widget Fixed Fixed $ return $ translated & visibilityRequestsL .~ mempty++scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport+scrollTo Both _ _ _ = error "BUG: called scrollTo on viewport type 'Both'"+scrollTo Vertical req img vp = vp & vpTop .~ newVStart+    where+        newVStart = clamp 0 (V.imageHeight img - vp^.vpSize._2) adjustedAmt+        adjustedAmt = case req of+            VScrollBy amt -> vp^.vpTop + amt+            VScrollPage Up -> vp^.vpTop - vp^.vpSize._2+            VScrollPage Down -> vp^.vpTop + vp^.vpSize._2+            VScrollToBeginning -> 0+            VScrollToEnd -> V.imageHeight img - vp^.vpSize._2+            _ -> vp^.vpTop+scrollTo Horizontal req img vp = vp & vpLeft .~ newHStart+    where+        newHStart = clamp 0 (V.imageWidth img - vp^.vpSize._1) adjustedAmt+        adjustedAmt = case req of+            HScrollBy amt -> vp^.vpLeft + amt+            HScrollPage Up -> vp^.vpLeft - vp^.vpSize._1+            HScrollPage Down -> vp^.vpLeft + vp^.vpSize._1+            HScrollToBeginning -> 0+            HScrollToEnd -> V.imageWidth img - vp^.vpSize._1+            _ -> vp^.vpLeft++scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport+scrollToView Both _ _ = error "BUG: called scrollToView on 'Both' type viewport"+scrollToView Vertical rq vp = vp & vpTop .~ newVStart+    where+        curStart = vp^.vpTop+        curEnd = curStart + vp^.vpSize._2+        reqStart = rq^.vrPositionL.rowL++        reqEnd = rq^.vrPositionL.rowL + rq^.vrSizeL._2+        newVStart :: Int+        newVStart = if reqStart < curStart+                   then reqStart+                   else if reqStart > curEnd || reqEnd > curEnd+                        then reqEnd - vp^.vpSize._2+                        else curStart+scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart+    where+        curStart = vp^.vpLeft+        curEnd = curStart + vp^.vpSize._1+        reqStart = rq^.vrPositionL.columnL++        reqEnd = rq^.vrPositionL.columnL + rq^.vrSizeL._1+        newHStart :: Int+        newHStart = if reqStart < curStart+                   then reqStart+                   else if reqStart > curEnd || reqEnd > curEnd+                        then reqEnd - vp^.vpSize._1+                        else curStart++-- | Request that the specified widget be made visible when it is+-- rendered inside a viewport. This permits widgets (whose sizes and+-- positions cannot be known due to being embedded in arbitrary layouts)+-- to make a request for a parent viewport to locate them and scroll+-- enough to put them in view. This, together with 'viewport', is what+-- makes the text editor and list widgets possible without making them+-- deal with the details of scrolling state management.+--+-- This does nothing if not rendered in a viewport.+visible :: Widget -> Widget+visible p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      let imageSize = ( result^.imageL.to V.imageWidth+                      , result^.imageL.to V.imageHeight+                      )+      -- The size of the image to be made visible in a viewport must have+      -- non-zero size in both dimensions.+      return $ if imageSize^._1 > 0 && imageSize^._2 > 0+               then result & visibilityRequestsL %~ (VR (Location (0, 0)) imageSize :)+               else result++-- | Similar to 'visible', request that a region (with the specified+-- 'Location' as its origin and 'V.DisplayRegion' as its size) be made+-- visible when it is rendered inside a viewport. The 'Location' is+-- relative to the specified widget's upper-left corner of (0, 0).+--+-- This does nothing if not rendered in a viewport.+visibleRegion :: Location -> V.DisplayRegion -> Widget -> Widget+visibleRegion vrloc sz p =+    Widget (hSize p) (vSize p) $ do+      result <- render p+      -- The size of the image to be made visible in a viewport must have+      -- non-zero size in both dimensions.+      return $ if sz^._1 > 0 && sz^._2 > 0+               then result & visibilityRequestsL %~ (VR vrloc sz :)+               else result++-- | Horizontal box layout: put the specified widgets next to each other+-- in the specified order. Defers growth policies to the growth policies+-- of both widgets.  This operator is a binary version of 'hBox'.+(<+>) :: Widget+      -- ^ Left+      -> Widget+      -- ^ Right+      -> Widget+(<+>) a b = hBox [a, b]++-- | Vertical box layout: put the specified widgets one above the other+-- in the specified order. Defers growth policies to the growth policies+-- of both widgets.  This operator is a binary version of 'vBox'.+(<=>) :: Widget+      -- ^ Top+      -> Widget+      -- ^ Bottom+      -> Widget+(<=>) a b = vBox [a, b]

@@ -68,9 +68,9 @@ instance HandleEvent (Dialog a) where     handleEvent ev d =         case ev of-            EvKey (KChar '\t') [] -> nextButtonBy 1 d-            EvKey KBackTab [] -> nextButtonBy (-1) d-            _ -> d+            EvKey (KChar '\t') [] -> return $ nextButtonBy 1 d+            EvKey KBackTab [] -> return $ nextButtonBy (-1) d+            _ -> return d  -- | Create a dialog. dialog :: Name@@ -106,7 +106,7 @@ -- | Render a dialog with the specified body widget. renderDialog :: Dialog a -> Widget -> Widget renderDialog d body =-    let buttonPadding = "  "+    let buttonPadding = str "   "         mkButton (i, (s, _)) = let att = if Just i == d^.dialogSelectedIndexL                                          then buttonSelectedAttr                                          else buttonAttr

@@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}--- | This module provides a basic single-line 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+-- | 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 -- of the editor, just use 'getEditContents'. To modify it, use the -- 'Z.TextZipper' interface with 'applyEdit'. --@@ -72,7 +72,7 @@                   EvKey KRight [] -> Z.moveRight                   EvKey KBS [] -> Z.deletePrevChar                   _ -> id-        in applyEdit f ed+        in return $ applyEdit f ed  -- | Construct an editor. editor :: Name

@@ -1,226 +1,22 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BangPatterns #-} module Brick.Widgets.Internal-  ( Result(..)-  , visibilityRequestsL-  , imageL-  , cursorsL-  , addResultOffset--  , VisibilityRequest(..)-  , vrPositionL-  , vrSizeL--  , RenderState(..)-  , ScrollRequest(..)-  , Direction(..)--  , renderFinal-  , Widget(..)-  , Size(..)-  , RenderM--  , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap)-  , lookupAttrName-  , getContext-  , attrL-  , availWidthL-  , availHeightL-  , ctxAttrMapL-  , ctxAttrNameL-  , ctxBorderStyleL+  ( renderFinal   , cropToContext--  , withBorderStyle--  , ViewportType(..)--  , txt-  , str-  , fill--  , Padding(..)-  , padLeft-  , padRight-  , padTop-  , padBottom-  , padLeftRight-  , padTopBottom-  , padAll--  , emptyWidget-  , hBox-  , vBox-  , (<=>)-  , (<+>)--  , hLimit-  , vLimit-  , withDefAttr-  , withAttr-  , forceAttr-  , updateAttrMap-  , raw-  , translateBy-  , cropLeftBy-  , cropRightBy-  , cropTopBy-  , cropBottomBy-  , showCursor-  , viewport-  , visible-  , visibleRegion+  , cropResultToContext   ) where  import Control.Applicative-import Control.Lens (makeLenses, (^.), (.~), (&), (%~), to, _1, _2, each, to, ix)-import Control.Monad (when)+import Control.Lens ((^.), (&), (%~)) 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.Functor.Contravariant-import Data.Monoid ((<>), mempty)-import qualified Data.Map as M-import qualified Data.Function as DF-import Data.List (sortBy, partition)-import Control.Lens (Lens')-import Data.String (IsString(..)) import qualified Graphics.Vty as V  import Brick.Types-import Brick.Widgets.Border.Style-import Brick.Util (clOffset)+import Brick.Types.Internal import Brick.AttrMap-import Brick.Util (clamp) -data VisibilityRequest =-    VR { vrPosition :: Location-       , vrSize :: V.DisplayRegion-       }-       deriving Show---- | The type of viewports that indicates the direction(s) in which a--- viewport is scrollable.-data ViewportType = Vertical-                  -- ^ Viewports of this type are scrollable only vertically.-                  | Horizontal-                  -- ^ Viewports of this type are scrollable only horizontally.-                  | Both-                  -- ^ Viewports of this type are scrollable vertically and horizontally.-                  deriving Show--data Viewport =-    VP { _vpLeft :: Int-       , _vpTop :: Int-       , _vpSize :: V.DisplayRegion-       }-       deriving Show---- | The type of result returned by a widget's rendering function. The--- result provides the image, cursor positions, and visibility requests--- that resulted from the rendering process.-data Result =-    Result { image :: V.Image-           -- ^ The final rendered image for a widget-           , cursors :: [CursorLocation]-           -- ^ The list of reported cursor positions for the-           -- application to choose from-           , visibilityRequests :: [VisibilityRequest]-           -- ^ The list of visibility requests made by widgets rendered-           -- while rendering this one (used by viewports)-           }-           deriving Show---- | The rendering context. This tells widgets how to render: how much--- space they have in which to render, which attribute they should use--- to render, which bordring style should be used, and the attribute map--- available for rendering.-data Context =-    Context { ctxAttrName :: AttrName-            , availWidth :: Int-            , availHeight :: Int-            , ctxBorderStyle :: BorderStyle-            , ctxAttrMap :: AttrMap-            }---- | 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---- | Widget growth policies. These policies communicate to layout--- algorithms how a widget uses space when being rendered. These--- policies influence rendering order and space allocation in the box--- layout algorithm.-data Size = Fixed-          -- ^ Fixed widgets take up the same amount of space no matter-          -- how much they are given (non-greedy).-          | Greedy-          -- ^ Greedy widgets take up all the space they are given.-          deriving (Show, Eq, Ord)---- | The type of widgets.-data Widget =-    Widget { hSize :: Size-           -- ^ This widget's horizontal growth policy-           , vSize :: Size-           -- ^ This widget's vertical growth policy-           , render :: RenderM Result-           -- ^ This widget's rendering function-           }---- | Scrolling direction.-data Direction = Up-               -- ^ Up/left-               | Down-               -- ^ Down/right--data ScrollRequest = HScrollBy Int-                   | HScrollPage Direction-                   | HScrollToBeginning-                   | HScrollToEnd-                   | VScrollBy Int-                   | VScrollPage Direction-                   | VScrollToBeginning-                   | VScrollToEnd--data RenderState =-    RS { viewportMap :: M.Map Name Viewport-       , scrollRequests :: [(Name, ScrollRequest)]-       }--suffixLenses ''Result-suffixLenses ''Context-suffixLenses ''VisibilityRequest-suffixLenses ''RenderState--makeLenses ''Viewport--instance IsString Widget where-    fromString = str--instance Default Result where-    def = Result V.emptyImage [] []---- | Get the current rendering context.-getContext :: RenderM Context-getContext = ask---- | When rendering the specified widget, use the specified border style--- for any border rendering.-withBorderStyle :: BorderStyle -> Widget -> Widget-withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p)---- | The empty widget.-emptyWidget :: Widget-emptyWidget = raw V.emptyImage- renderFinal :: AttrMap             -> [Widget]             -> V.DisplayRegion@@ -229,7 +25,7 @@             -> (RenderState, V.Picture, Maybe CursorLocation) renderFinal aMap layerRenders sz chooseCursor rs = (newRS, pic, theCursor)     where-        (layerResults, newRS) = flip runState rs $ sequence $+        (layerResults, !newRS) = flip runState rs $ sequence $             (\p -> runReaderT p ctx) <$>             (render <$> cropToContext <$> layerRenders)         ctx = Context def (fst sz) (snd sz) def aMap@@ -237,641 +33,13 @@         layerCursors = (^.cursorsL) <$> layerResults         theCursor = chooseCursor $ concat layerCursors --- | Add an offset to all cursor locations and visbility requests--- in the specified rendering result. This function is critical for--- maintaining correctness in the rendering results as they are--- processed successively by box layouts and other wrapping combinators,--- since calls to this function result in converting from widget-local--- coordinates to (ultimately) terminal-global ones so they can be used--- by other combinators. You should call this any time you render--- something and then translate it or otherwise offset it from its--- original origin.-addResultOffset :: Location -> Result -> Result-addResultOffset off = addCursorOffset off . addVisibilityOffset off--addVisibilityOffset :: Location -> Result -> Result-addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)--addCursorOffset :: Location -> Result -> Result-addCursorOffset off r =-    let onlyVisible = filter isVisible-        isVisible l = l^.columnL >= 0 && l^.rowL >= 0-    in r & cursorsL %~ (\cs -> onlyVisible $ (`clOffset` off) <$> cs)--unrestricted :: Int-unrestricted = 100000---- | The rendering context's current drawing attribute.-attrL :: (Contravariant f, Functor f) => (V.Attr -> f V.Attr) -> Context -> f Context-attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL))---- | Given an attribute name, obtain the attribute for the attribute--- name by consulting the context's attribute map.-lookupAttrName :: AttrName -> RenderM V.Attr-lookupAttrName n = do-    c <- getContext-    return $ attrMapLookup n (c^.ctxAttrMapL)---- | Build a widget from a 'String'. Breaks newlines up and space-pads--- short lines out to the length of the longest line.-str :: String -> Widget-str s =-    Widget Fixed Fixed $ do-      c <- getContext-      let theLines = lines s-          fixEmpty [] = " "-          fixEmpty l = l-      case fixEmpty <$> theLines of-          [] -> return def-          [one] -> return $ def & imageL .~ (V.string (c^.attrL) one)-          multiple ->-              let maxLength = maximum $ length <$> multiple-                  lineImgs = lineImg <$> multiple-                  lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - length lStr) ' ')-              in return $ def & imageL .~ (V.vertCat lineImgs)---- | Build a widget from a 'T.Text' value.  Behaves the same as 'str'.-txt :: T.Text -> Widget-txt = str . T.unpack---- | The type of padding.-data Padding = Pad Int-             -- ^ Pad by the specified number of rows or columns.-             | Max-             -- ^ Pad up to the number of available rows or columns.---- | Pad the specified widget on the left.-padLeft :: Padding -> Widget -> Widget-padLeft padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (hLimit i, hSize p)-    in Widget sz (vSize p) $ do-        result <- render p-        render $ (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ') <+>-                 (Widget Fixed Fixed $ return result)---- | Pad the specified widget on the right.-padRight :: Padding -> Widget -> Widget-padRight padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (hLimit i, hSize p)-    in Widget sz (vSize p) $ do-        result <- render p-        render $ (Widget Fixed Fixed $ return result) <+>-                 (f $ vLimit (result^.imageL.to V.imageHeight) $ fill ' ')---- | Pad the specified widget on the top.-padTop :: Padding -> Widget -> Widget-padTop padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (vLimit i, vSize p)-    in Widget (hSize p) sz $ do-        result <- render p-        render $ (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ') <=>-                 (Widget Fixed Fixed $ return result)---- | Pad the specified widget on the bottom.-padBottom :: Padding -> Widget -> Widget-padBottom padding p =-    let (f, sz) = case padding of-          Max -> (id, Greedy)-          Pad i -> (vLimit i, vSize p)-    in Widget (hSize p) sz $ do-        result <- render p-        render $ (Widget Fixed Fixed $ return result) <=>-                 (f $ hLimit (result^.imageL.to V.imageWidth) $ fill ' ')---- | Pad a widget on the left and right.-padLeftRight :: Int -> Widget -> Widget-padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w---- | Pad a widget on the top and bottom.-padTopBottom :: Int -> Widget -> Widget-padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w---- | Pad a widget on all sides.-padAll :: Int -> Widget -> Widget-padAll v w = padLeftRight v $ padTopBottom v w---- | Fill all available space with the specified character. Grows both--- horizontally and vertically.-fill :: Char -> Widget-fill ch =-    Widget Greedy Greedy $ do-      c <- getContext-      return $ def & imageL .~ (V.charFill (c^.attrL) ch (c^.availWidthL) (c^.availHeightL))---- | Vertical box layout: put the specified widgets one above the other--- in the specified order (uppermost first). Defers growth policies to--- the growth policies of both widgets.-vBox :: [Widget] -> Widget-vBox [] = emptyWidget-vBox pairs = renderBox vBoxRenderer pairs---- | Horizontal box layout: put the specified widgets next to each other--- in the specified order (leftmost first). Defers growth policies to--- the growth policies of both widgets.-hBox :: [Widget] -> Widget-hBox [] = emptyWidget-hBox pairs = renderBox hBoxRenderer pairs---- | The process of rendering widgets in a box layout is exactly the--- same except for the dimension under consideration (width vs. height),--- in which case all of the same operations that consider one dimension--- in the layout algorithm need to be switched to consider the other.--- Because of this we fill a BoxRenderer with all of the functions--- needed to consider the "primary" dimension (e.g. vertical if the--- box layout is vertical) as well as the "secondary" dimension (e.g.--- horizontal if the box layout is vertical). Doing this permits us to--- have one implementation for box layout and parameterizing on the--- orientation of all of the operations.-data BoxRenderer =-    BoxRenderer { contextPrimary :: Lens' Context Int-                , contextSecondary :: Lens' Context Int-                , imagePrimary :: V.Image -> Int-                , imageSecondary :: V.Image -> Int-                , limitPrimary :: Int -> Widget -> Widget-                , limitSecondary :: Int -> Widget -> Widget-                , primaryWidgetSize :: Widget -> Size-                , concatenatePrimary :: [V.Image] -> V.Image-                , locationFromOffset :: Int -> Location-                , padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image-                }--vBoxRenderer :: BoxRenderer-vBoxRenderer =-    BoxRenderer { contextPrimary = availHeightL-                , contextSecondary = availWidthL-                , imagePrimary = V.imageHeight-                , imageSecondary = V.imageWidth-                , limitPrimary = vLimit-                , limitSecondary = hLimit-                , primaryWidgetSize = vSize-                , concatenatePrimary = V.vertCat-                , locationFromOffset = Location . (0 ,)-                , padImageSecondary = \amt img a ->-                    let p = V.charFill a ' ' amt (V.imageHeight img)-                    in V.horizCat [img, p]-                }--hBoxRenderer :: BoxRenderer-hBoxRenderer =-    BoxRenderer { contextPrimary = availWidthL-                , contextSecondary = availHeightL-                , imagePrimary = V.imageWidth-                , imageSecondary = V.imageHeight-                , limitPrimary = hLimit-                , limitSecondary = vLimit-                , primaryWidgetSize = hSize-                , concatenatePrimary = V.horizCat-                , locationFromOffset = Location . (, 0)-                , padImageSecondary = \amt img a ->-                    let p = V.charFill a ' ' (V.imageWidth img) amt-                    in V.vertCat [img, p]-                }---- | Render a series of widgets in a box layout in the order given.------ The growth policy of a box layout is the most unrestricted of the--- growth policies of the widgets it contains, so to determine the hSize--- and vSize of the box we just take the maximum (using the Ord instance--- for Size) of all of the widgets to be rendered in the box.------ Then the box layout algorithm proceeds as follows. We'll use--- the vertical case to concretely describe the algorithm, but the--- horizontal case can be envisioned just by exchanging all--- "vertical"/"horizontal" and "rows"/"columns", etc., in the--- description.------ The growth policies of the child widgets determine the order in which--- they are rendered, i.e., the order in which space in the box is--- allocated to widgets as the algorithm proceeds. This is because order--- matters: if we render greedy widgets first, there will be no space--- left for non-greedy ones.------ So we render all widgets with size 'Fixed' in the vertical dimension--- first. Each is rendered with as much room as the overall box has, but--- we assume that they will not be greedy and use it all. If they do,--- maybe it's because the terminal is small and there just isn't enough--- room to render everything.------ Then the remaining height is distributed evenly amongst all remaining--- (greedy) widgets and they are rendered in sub-boxes that are as high--- as this even slice of rows and as wide as the box is permitted to be.--- We only do this step at all if rendering the non-greedy widgets left--- us any space, i.e., if there were any rows left.------ After rendering the non-greedy and then greedy widgets, their images--- are sorted so that they are stored in the order the original widgets--- were given. All cursor locations and visibility requests in each--- sub-widget are translated according to the position of the sub-widget--- in the box.------ All images are padded to be as wide as the widest sub-widget to--- prevent attribute over-runs. Without this step the attribute used by--- a sub-widget may continue on in an undesirable fashion until it hits--- something with a different attribute. To prevent this and to behave--- in the least surprising way, we pad the image on the right with--- whitespace using the context's current attribute.------ Finally, the padded images are concatenated together vertically and--- returned along with the translated cursor positions and visibility--- requests.-renderBox :: BoxRenderer -> [Widget] -> Widget-renderBox br ws = do-    Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do-      c <- getContext--      let pairsIndexed = zip [(0::Int)..] ws-          (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed) pairsIndexed--      renderedHis <- mapM (\(i, prim) -> (i,) <$> render prim) his--      renderedLows <- case lows of-          [] -> return []-          ls -> do-              let remainingPrimary = c^.(contextPrimary br) - (sum $ (^._2.imageL.(to $ imagePrimary br)) <$> renderedHis)-                  primaryPerLow = remainingPrimary `div` length ls-                  padFirst = remainingPrimary - (primaryPerLow * length ls)-                  secondaryPerLow = c^.(contextSecondary br)-                  primaries = replicate (length ls) primaryPerLow & ix 0 %~ (+ padFirst)--              let renderLow ((i, prim), pri) =-                      (i,) <$> (render $ limitPrimary br pri-                                       $ limitSecondary br secondaryPerLow-                                       $ cropToContext prim)--              if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return []--      let rendered = sortBy (compare `DF.on` fst) $ renderedHis ++ renderedLows-          allResults = snd <$> rendered-          allImages = (^.imageL) <$> allResults-          allPrimaries = imagePrimary br <$> allImages-          allTranslatedResults = (flip map) (zip [0..] allResults) $ \(i, result) ->-              let off = locationFromOffset br offPrimary-                  offPrimary = sum $ take i allPrimaries-              in addResultOffset off result-          -- Determine the secondary dimension value to pad to. In a-          -- vertical box we want all images to be the same width to-          -- avoid attribute over-runs or blank spaces with the wrong-          -- attribute. In a horizontal box we want all images to have-          -- the same height for the same reason.-          maxSecondary = maximum $ imageSecondary br <$> allImages-          padImage img = padImageSecondary br (maxSecondary - imageSecondary br img) img (c^.attrL)-          paddedImages = padImage <$> allImages--      cropResultToContext $ Result (concatenatePrimary br paddedImages)-                            (concat $ cursors <$> allTranslatedResults)-                            (concat $ visibilityRequests <$> allTranslatedResults)---- | Limit the space available to the specified widget to the specified--- number of columns. This is important for constraining the horizontal--- growth of otherwise-greedy widgets.-hLimit :: Int -> Widget -> Widget-hLimit w p =-    Widget Fixed (vSize p) $ do-      withReaderT (& availWidthL .~ w) $ render $ cropToContext p---- | Limit the space available to the specified widget to the specified--- number of rows. This is important for constraining the vertical--- growth of otherwise-greedy widgets.-vLimit :: Int -> Widget -> Widget-vLimit h p =-    Widget (hSize p) Fixed $ do-      withReaderT (& availHeightL .~ h) $ render $ cropToContext p---- | When drawing the specified widget, set the current attribute used--- for drawing to the one with the specified name. Note that the widget--- may use further calls to 'withAttr' to override this; if you really--- want to prevent that, use 'forceAttr'. Attributes used this way still--- get merged hierarchically and still fall back to the attribute map's--- default attribute. If you want to change the default attribute, use--- 'withDefAttr'.-withAttr :: AttrName -> Widget -> Widget-withAttr an p =-    Widget (hSize p) (vSize p) $ do-      withReaderT (& ctxAttrNameL .~ an) (render p)---- | Update the attribute map while rendering the specified widget: set--- its new default attribute to the one that we get by looking up the--- specified attribute name in the map.-withDefAttr :: AttrName -> Widget -> Widget-withDefAttr an p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL %~ (setDefault (attrMapLookup an (c^.ctxAttrMapL)))) (render p)---- | When rendering the specified widget, update the attribute map with--- the specified transformation.-updateAttrMap :: (AttrMap -> AttrMap) -> Widget -> Widget-updateAttrMap f p =-    Widget (hSize p) (vSize p) $ do-        withReaderT (& ctxAttrMapL %~ f) (render p)---- | When rendering the specified widget, force all attribute lookups--- in the attribute map to use the value currently assigned to the--- specified attribute name.-forceAttr :: AttrName -> Widget -> Widget-forceAttr an p =-    Widget (hSize p) (vSize p) $ do-        c <- getContext-        withReaderT (& ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)---- | Build a widget directly from a raw Vty image.-raw :: V.Image -> Widget-raw img = Widget Fixed Fixed $ return $ def & imageL .~ img---- | Translate the specified widget by the specified offset amount.-translateBy :: Location -> Widget -> Widget-translateBy off p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ addResultOffset off-             $ result & imageL %~ (V.translate (off^.columnL) (off^.rowL))--cropResultToContext :: Result -> RenderM Result-cropResultToContext result = do-    c <- getContext-    return $ result & imageL %~ (V.crop (c^.availWidthL) (c^.availHeightL))- -- | After rendering the specified widget, crop its result image to the -- dimensions in the rendering context. cropToContext :: Widget -> Widget cropToContext p =     Widget (hSize p) (vSize p) $ (render p >>= cropResultToContext) --- | Crop the specified widget on the left by the specified number of--- columns.-cropLeftBy :: Int -> Widget -> Widget-cropLeftBy cols p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageWidth (result^.imageL) - cols-          cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img-      return $ addResultOffset (Location (-1 * cols, 0))-             $ result & imageL %~ cropped---- | Crop the specified widget on the right by the specified number of--- columns.-cropRightBy :: Int -> Widget -> Widget-cropRightBy cols p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageWidth (result^.imageL) - cols-          cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img-      return $ result & imageL %~ cropped---- | Crop the specified widget on the top by the specified number of--- rows.-cropTopBy :: Int -> Widget -> Widget-cropTopBy rows p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageHeight (result^.imageL) - rows-          cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img-      return $ addResultOffset (Location (0, -1 * rows))-             $ result & imageL %~ cropped---- | Crop the specified widget on the bottom by the specified number of--- rows.-cropBottomBy :: Int -> Widget -> Widget-cropBottomBy rows p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let amt = V.imageHeight (result^.imageL) - rows-          cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img-      return $ result & imageL %~ cropped---- | When rendering the specified widget, also register a cursor--- positioning request using the specified name and location.-showCursor :: Name -> Location -> Widget -> Widget-showCursor n cloc p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      return $ result & cursorsL %~ (CursorLocation cloc (Just n):)--hRelease :: Widget -> Maybe Widget-hRelease p =-    case hSize p of-        Fixed -> Just $ Widget Greedy (vSize p) $ withReaderT (& availWidthL .~ unrestricted) (render p)-        Greedy -> Nothing--vRelease :: Widget -> Maybe Widget-vRelease p =-    case vSize p of-        Fixed -> Just $ Widget (hSize p) Greedy $ withReaderT (& availHeightL .~ unrestricted) (render p)-        Greedy -> Nothing---- | Render the specified widget in a named viewport with the--- specified type. This permits widgets to be scrolled without being--- scrolling-aware. To make the most use of viewports, the specified--- widget should use the 'visible' combinator to make a "visibility--- request". This viewport combinator will then translate the resulting--- rendering to make the requested region visible. In addition, the--- 'Brick.Main.EventM' monad provides primitives to scroll viewports--- created by this function if 'visible' is not what you want.------ If a viewport receives more than one visibility request, only the--- first is honored. If a viewport receives more than one scrolling--- request from 'Brick.Main.EventM', all are honored in the order in--- which they are received.-viewport :: Name-         -- ^ The name of the viewport (must be unique and stable for-         -- reliable behavior)-         -> ViewportType-         -- ^ The type of viewport (indicates the permitted scrolling-         -- direction)-         -> Widget-         -- ^ The widget to be rendered in the scrollable viewport-         -> Widget-viewport vpname typ p =-    Widget Greedy Greedy $ do-      -- First, update the viewport size.-      c <- getContext-      let newVp = VP 0 0 newSize-          newSize = (c^.availWidthL, c^.availHeightL)-          doInsert (Just vp) = Just $ vp & vpSize .~ newSize-          doInsert Nothing = Just newVp--      lift $ modify (& viewportMapL %~ (M.alter doInsert vpname))--      -- Then render the sub-rendering with the rendering layout-      -- constraint released (but raise an exception if we are asked to-      -- render an infinitely-sized widget in the viewport's scrolling-      -- dimension)-      let Name vpn = vpname-          release = case typ of-            Vertical -> vRelease-            Horizontal -> hRelease-            Both -> \w -> vRelease w >>= hRelease-          released = case release p of-            Just w -> w-            Nothing -> case typ of-                Vertical -> error $ "tried to embed an infinite-height widget in vertical viewport " <> (show vpn)-                Horizontal -> error $ "tried to embed an infinite-width widget in horizontal viewport " <> (show vpn)-                Both -> error $ "tried to embed an infinite-width or infinite-height widget in 'Both' type viewport " <> (show vpn)--      initialResult <- render released--      -- If the sub-rendering requested visibility, update the scroll-      -- state accordingly-      when (not $ null $ initialResult^.visibilityRequestsL) $ do-          Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))-          let rq = head $ initialResult^.visibilityRequestsL-              updatedVp = case typ of-                  Both -> scrollToView Horizontal rq $ scrollToView Vertical rq vp-                  Horizontal -> scrollToView typ rq vp-                  Vertical -> scrollToView typ rq vp-          lift $ modify (& viewportMapL %~ (M.insert vpname updatedVp))--      -- If the rendering state includes any scrolling requests for this-      -- viewport, apply those-      reqs <- lift $ gets $ (^.scrollRequestsL)-      let relevantRequests = snd <$> filter (\(n, _) -> n == vpname) reqs-      when (not $ null relevantRequests) $ do-          Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))-          let updatedVp = applyRequests relevantRequests vp-              applyRequests [] v = v-              applyRequests (rq:rqs) v =-                  case typ of-                      Horizontal -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v-                      Vertical -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v-                      Both -> scrollTo Horizontal rq (initialResult^.imageL) $-                              scrollTo Vertical rq (initialResult^.imageL) $-                              applyRequests rqs v-          lift $ modify (& viewportMapL %~ (M.insert vpname updatedVp))-          return ()--      -- Get the viewport state now that it has been updated.-      Just vp <- lift $ gets (M.lookup vpname . (^.viewportMapL))--      -- Then perform a translation of the sub-rendering to fit into the-      -- viewport-      translated <- render $ translateBy (Location (-1 * vp^.vpLeft, -1 * vp^.vpTop))-                           $ Widget Fixed Fixed $ return initialResult--      -- Return the translated result with the visibility requests-      -- discarded-      let translatedSize = ( translated^.imageL.to V.imageWidth-                           , translated^.imageL.to V.imageHeight-                           )-      case translatedSize of-          (0, 0) -> return $ translated & imageL .~ (V.charFill (c^.attrL) ' ' (c^.availWidthL) (c^.availHeightL))-                                        & visibilityRequestsL .~ mempty-          _ -> render $ cropToContext-                      $ padBottom Max-                      $ padRight Max-                      $ Widget Fixed Fixed $ return $ translated & visibilityRequestsL .~ mempty--scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport-scrollTo Both _ _ _ = error "BUG: called scrollTo on viewport type 'Both'"-scrollTo Vertical req img vp = vp & vpTop .~ newVStart-    where-        newVStart = clamp 0 (V.imageHeight img - vp^.vpSize._2) adjustedAmt-        adjustedAmt = case req of-            VScrollBy amt -> vp^.vpTop + amt-            VScrollPage Up -> vp^.vpTop - vp^.vpSize._2-            VScrollPage Down -> vp^.vpTop + vp^.vpSize._2-            VScrollToBeginning -> 0-            VScrollToEnd -> V.imageHeight img - vp^.vpSize._2-            _ -> vp^.vpTop-scrollTo Horizontal req img vp = vp & vpLeft .~ newHStart-    where-        newHStart = clamp 0 (V.imageWidth img - vp^.vpSize._1) adjustedAmt-        adjustedAmt = case req of-            HScrollBy amt -> vp^.vpLeft + amt-            HScrollPage Up -> vp^.vpLeft - vp^.vpSize._1-            HScrollPage Down -> vp^.vpLeft + vp^.vpSize._1-            HScrollToBeginning -> 0-            HScrollToEnd -> V.imageWidth img - vp^.vpSize._1-            _ -> vp^.vpLeft--scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport-scrollToView Both _ _ = error "BUG: called scrollToView on 'Both' type viewport"-scrollToView Vertical rq vp = vp & vpTop .~ newVStart-    where-        curStart = vp^.vpTop-        curEnd = curStart + vp^.vpSize._2-        reqStart = rq^.vrPositionL.rowL--        reqEnd = rq^.vrPositionL.rowL + rq^.vrSizeL._2-        newVStart :: Int-        newVStart = if reqStart < curStart-                   then reqStart-                   else if reqStart > curEnd || reqEnd > curEnd-                        then reqEnd - vp^.vpSize._2-                        else curStart-scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart-    where-        curStart = vp^.vpLeft-        curEnd = curStart + vp^.vpSize._1-        reqStart = rq^.vrPositionL.columnL--        reqEnd = rq^.vrPositionL.columnL + rq^.vrSizeL._1-        newHStart :: Int-        newHStart = if reqStart < curStart-                   then reqStart-                   else if reqStart > curEnd || reqEnd > curEnd-                        then reqEnd - vp^.vpSize._1-                        else curStart---- | Request that the specified widget be made visible when it is--- rendered inside a viewport. This permits widgets (whose sizes and--- positions cannot be known due to being embedded in arbitrary layouts)--- to make a request for a parent viewport to locate them and scroll--- enough to put them in view. This, together with 'viewport', is what--- makes the text editor and list widgets possible without making them--- deal with the details of scrolling state management.------ This does nothing if not rendered in a viewport.-visible :: Widget -> Widget-visible p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      let imageSize = ( result^.imageL.to V.imageWidth-                      , result^.imageL.to V.imageHeight-                      )-      -- The size of the image to be made visible in a viewport must have-      -- non-zero size in both dimensions.-      return $ if imageSize^._1 > 0 && imageSize^._2 > 0-               then result & visibilityRequestsL %~ (VR (Location (0, 0)) imageSize :)-               else result---- | Similar to 'visible', request that a region (with the specified--- 'Location' as its origin and 'V.DisplayRegion' as its size) be made--- visible when it is rendered inside a viewport. The 'Location' is--- relative to the specified widget's upper-left corner of (0, 0).------ This does nothing if not rendered in a viewport.-visibleRegion :: Location -> V.DisplayRegion -> Widget -> Widget-visibleRegion vrloc sz p =-    Widget (hSize p) (vSize p) $ do-      result <- render p-      -- The size of the image to be made visible in a viewport must have-      -- non-zero size in both dimensions.-      return $ if sz^._1 > 0 && sz^._2 > 0-               then result & visibilityRequestsL %~ (VR vrloc sz :)-               else result---- | Horizontal box layout: put the specified widgets next to each other--- in the specified order. Defers growth policies to the growth policies--- of both widgets.  This operator is a binary version of 'hBox'.-(<+>) :: Widget-      -- ^ Left-      -> Widget-      -- ^ Right-      -> Widget-(<+>) a b = hBox [a, b]---- | Vertical box layout: put the specified widgets one above the other--- in the specified order. Defers growth policies to the growth policies--- of both widgets.  This operator is a binary version of 'vBox'.-(<=>) :: Widget-      -- ^ Top-      -> Widget-      -- ^ Bottom-      -> Widget-(<=>) a b = vBox [a, b]+cropResultToContext :: Result -> RenderM Result+cropResultToContext result = do+    c <- getContext+    return $ result & imageL %~ (V.crop (c^.availWidthL) (c^.availHeightL))

@@ -4,7 +4,7 @@ -- | This module provides a scrollable list type and functions for -- manipulating and rendering it. module Brick.Widgets.List-  ( List(listElements, listSelected, listName, listElementDraw)+  ( List(listElements, listSelected, listName, listItemHeight)    -- * Consructing a list   , list@@ -16,6 +16,7 @@   , listElementsL   , listSelectedL   , listNameL+  , listItemHeightL    -- * Manipulating a list   , listMoveBy@@ -34,13 +35,15 @@ where  import Control.Applicative ((<$>))-import Control.Lens ((^.), (&), (.~))+import Control.Lens ((^.), (&), (.~), _2) import Data.Monoid ((<>)) import Data.Maybe (fromMaybe) import qualified Data.Algorithm.Diff as D import Graphics.Vty (Event(..), Key(..))+import qualified Data.Vector as V  import Brick.Types+import Brick.Main (lookupViewport) import Brick.Widgets.Core import Brick.Util (clamp) import Brick.AttrMap@@ -49,22 +52,38 @@ -- by the list.  Lists handle the following events by default: -- -- * Up/down arrow keys: move cursor of selected item+-- * Page up / page down keys: move cursor of selected item by one page+--   at a time (based on the number of items shown)+-- * Home/end keys: move cursor of selected item to beginning or end of+--   list data List e =-    List { listElements :: ![e]-         , listElementDraw :: Bool -> e -> Widget+    List { listElements :: !(V.Vector e)          , listSelected :: !(Maybe Int)          , listName :: Name+         , listItemHeight :: Int          }  suffixLenses ''List  instance HandleEvent (List e) where-    handleEvent e theList = f theList+    handleEvent e theList = f         where             f = case e of-                  EvKey KUp [] -> listMoveUp-                  EvKey KDown [] -> listMoveDown-                  _ -> id+                  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@@ -78,35 +97,51 @@ -- | Construct a list in terms of an element type 'e'. list :: Name      -- ^ The list name (must be unique)-     -> (Bool -> e -> Widget)-     -- ^ The item rendering function (takes the item and whether it is-     -- currently selected)-     -> [e]+     -> 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 name draw es =-    let selIndex = if null es then Nothing else Just 0-    in List es draw selIndex name+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.-renderList :: List e -> Widget-renderList l = withDefAttr listAttr $-               viewport (l^.listNameL) Vertical $-               vBox $-               drawListElements l+-- | Turn a list state value into a widget given an item drawing+-- function.+renderList :: List e -> (Bool -> e -> Widget) -> Widget+renderList l drawElem =+    withDefAttr listAttr $+    drawListElements l drawElem -drawListElements :: List e -> [Widget]-drawListElements l = drawnElements-    where-        es = l^.listElementsL-        drawnElements = (flip map) (zip [0..] es) $ \(i, e) ->-            let isSelected = Just i == l^.listSelectedL-                elemWidget = (l^.listElementDrawL) isSelected e-                makeVisible = if isSelected-                              then (visible . withDefAttr listSelectedAttr)-                              else id-            in makeVisible elemWidget+drawListElements :: List e -> (Bool -> e -> Widget) -> Widget+drawListElements l drawElem =+    Widget Fixed Fixed $ do+        c <- getContext +        let es = V.slice start num (l^.listElementsL)+            idx = case l^.listSelectedL of+                Nothing -> 0+                Just i -> i++            start = max 0 $ idx - numPerHeight + 1+            num = min (numPerHeight * 2) (V.length (l^.listElementsL) - start)+            numPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL)++            off = start * (l^.listItemHeightL)++            drawnElements = (flip V.imap) es $ \i e ->+                let isSelected = Just (i + start) == l^.listSelectedL+                    elemWidget = drawElem isSelected e+                    makeVisible = if isSelected+                                  then (visible . withDefAttr listSelectedAttr)+                                  else id+                in makeVisible elemWidget++        render $ viewport (l^.listNameL) Vertical $+                 translateBy (Location (0, off)) $+                 vBox $ V.toList drawnElements+ -- | Insert an item into a list at the specified position. listInsert :: Int            -- ^ The position at which to insert (0 <= i <= size)@@ -115,24 +150,24 @@            -> List e            -> List e listInsert pos e l =-    let safePos = clamp 0 (length es) pos+    let safePos = clamp 0 (V.length es) pos         es = l^.listElementsL         newSel = case l^.listSelectedL of           Nothing -> 0           Just s -> if safePos < s                     then s + 1                     else s-        (front, back) = splitAt safePos es+        (front, back) = V.splitAt safePos es     in l & listSelectedL .~ Just newSel-         & listElementsL .~ (front ++ (e : back))+         & listElementsL .~ (front V.++ (e `V.cons` back))  -- | Remove an element from a list at the specified position. listRemove :: Int            -- ^ The position at which to remove an element (0 <= i < size)            -> List e            -> List e-listRemove pos l | null (l^.listElementsL) = l-                 | pos /= clamp 0 (length (l^.listElementsL) - 1) pos = l+listRemove pos l | V.null (l^.listElementsL) = l+                 | pos /= clamp 0 (V.length (l^.listElementsL) - 1) pos = l                  | otherwise =     let newSel = case l^.listSelectedL of           Nothing -> 0@@ -143,22 +178,22 @@                           else if pos < s                                then s - 1                                else s-        (front, back) = splitAt pos es-        es' = front ++ tail back+        (front, back) = V.splitAt pos es+        es' = front V.++ V.tail back         es = l^.listElementsL-    in l & listSelectedL .~ (if null es' then Nothing else Just newSel)+    in l & listSelectedL .~ (if V.null es' then Nothing else Just newSel)          & listElementsL .~ es'  -- | Replace the contents of a list with a new set of elements but -- preserve the currently selected index.-listReplace :: Eq e => [e] -> List e -> List e+listReplace :: Eq e => V.Vector e -> List e -> List e listReplace es' l | es' == l^.listElementsL = l                   | otherwise =     let sel = fromMaybe 0 (l^.listSelectedL)-        getNewSel es = case (null es, null es') of+        getNewSel es = case (V.null es, V.null es') of           (_, True)      -> Nothing           (True, False)  -> Just 0-          (False, False) -> Just (maintainSel es es' sel)+          (False, False) -> Just (maintainSel (V.toList es) (V.toList es') sel)         newSel = getNewSel (l^.listElementsL)      in l & listSelectedL .~ newSel@@ -178,14 +213,14 @@ -- validation. listMoveBy :: Int -> List e -> List e listMoveBy amt l =-    let newSel = clamp 0 (length (l^.listElementsL) - 1) <$> (amt +) <$> (l^.listSelectedL)+    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 pos l =-    let len = length (l^.listElementsL)+    let len = V.length (l^.listElementsL)         newSel = clamp 0 (len - 1) $ if pos < 0 then (len - pos) else pos     in l & listSelectedL .~ if len > 0                             then Just newSel@@ -195,7 +230,7 @@ listSelectedElement :: List e -> Maybe (Int, e) listSelectedElement l = do   sel <- l^.listSelectedL-  return (sel, (l^.listElementsL) !! sel)+  return (sel, (l^.listElementsL) V.! sel)  -- Assuming `xs` is an existing list that we want to update to match the -- state of `ys`. Given a selected index in `xs`, the goal is to compute

@@ -11,6 +11,7 @@ import Control.Lens ((^.)) import Data.Monoid +import Brick.Types import Brick.AttrMap import Brick.Widgets.Core