brick 0.55 → 0.56

raw patch · 11 files changed

+297/−47 lines, 11 filesdep +randomdep ~basedep ~vtynew-component:exe:brick-tail-demoPVP ok

version bump matches the API change (PVP)

Dependencies added: random

Dependency ranges changed: base, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−0
• README.md +26/−21
• brick.cabal +17/−3
• programs/TailDemo.hs +144/−0
• src/Brick/Forms.hs +43/−8
• src/Brick/Main.hs +11/−9
• src/Brick/Types.hs +3/−1
• src/Brick/Types/Internal.hs +2/−0
• src/Brick/Widgets/Core.hs +7/−0
• src/Brick/Widgets/Internal.hs +15/−3
• src/Brick/Widgets/ProgressBar.hs +7/−2

@@ -2,6 +2,28 @@ Brick changelog --------------- +0.56+----++Package changes:+ * Increased upper bound for `base` to support GHC 8.10.2 (thanks Ryan+   Scott)++API changes:+ * Added `Brick.Forms.updateFormState` to update the state contained+   within (and managed by) a Form. This function takes care of the+   details of updating the form fields themselves to be consistent with+   the change in underlying state.+ * Added the overall window width (`windowWidth`) and height+   (`windowHeight`) to `Context`, the rendering context type (thanks Tom+   McLaughlin)++Other changes:+ * Added `brick-tail-demo`, a demonstration program for writing a+   `tail`-style output-following interface.+ * Updated `Brick.Widgets.ProgressBar` so that it handles near-endpoint+   cases more naturally (fixes #281)+ 0.55 ---- 

@@ -43,30 +43,35 @@ To get an idea of what some people have done with `brick`, take a look at these projects: - * [`tetris`](https://github.com/SamTay/tetris), an implementation of the Tetris game- * [`gotta-go-fast`](https://github.com/callum-oakley/gotta-go-fast), a typing tutor- * [`haskell-player`](https://github.com/potomak/haskell-player), an `afplay` frontend- * [`mushu`](https://github.com/elaye/mushu), an `MPD` client- * [`matterhorn`](https://github.com/matterhorn-chat/matterhorn), a client for [Mattermost](https://about.mattermost.com/)- * [`viewprof`](https://github.com/maoe/viewprof), a GHC profile viewer- * [`tart`](https://github.com/jtdaugherty/tart), a mouse-driven ASCII art drawing program- * [`silly-joy`](https://github.com/rootmos/silly-joy), an interpreter for Joy- * [`herms`](https://github.com/jackkiefer/herms), a command-line tool for managing kitchen recipes- * [`purebred`](https://github.com/purebred-mua/purebred), a mail user agent- * [`2048Haskell`](https://github.com/8Gitbrix/2048Haskell), an implementation of the 2048 game- * [`bhoogle`](https://github.com/andrevdm/bhoogle), a [Hoogle](https://www.haskell.org/hoogle/) client- * [`clifm`](https://github.com/pasqu4le/clifm), a file manager- * [`towerHanoi`](https://github.com/shajenM/projects/tree/master/towerHanoi), animated solutions to The Tower of Hanoi- * [`VOIDSPACE`](https://github.com/ChrisPenner/void-space), a space-themed typing-tutor game- * [`solitaire`](https://github.com/ambuc/solitaire), the card game- * [`sudoku-tui`](https://github.com/evanrelf/sudoku-tui), a Sudoku implementation- * [`summoner-tui`](https://github.com/kowainik/summoner/tree/master/summoner-tui), an interactive frontend to the Summoner tool- * [`wrapping-editor`](https://github.com/ta0kira/wrapping-editor), an embeddable editor with support for Brick- * [`git-brunch`](https://github.com/andys8/git-brunch), a git branch checkout utility+| Project | Description |+| ------- | ----------- |+| [`tetris`](https://github.com/SamTay/tetris) | An implementation of the Tetris game |+| [`gotta-go-fast`](https://github.com/callum-oakley/gotta-go-fast) | A typing tutor |+| [`haskell-player`](https://github.com/potomak/haskell-player) | An `afplay` frontend |+| [`mushu`](https://github.com/elaye/mushu) | An `MPD` client |+| [`matterhorn`](https://github.com/matterhorn-chat/matterhorn) | A client for [Mattermost](https://about.mattermost.com/) |+| [`viewprof`](https://github.com/maoe/viewprof) | A GHC profile viewer |+| [`tart`](https://github.com/jtdaugherty/tart) | A mouse-driven ASCII art drawing program |+| [`silly-joy`](https://github.com/rootmos/silly-joy) | An interpreter for Joy |+| [`herms`](https://github.com/jackkiefer/herms) | A command-line tool for managing kitchen recipes |+| [`purebred`](https://github.com/purebred-mua/purebred) | A mail user agent |+| [`2048Haskell`](https://github.com/8Gitbrix/2048Haskell) | An implementation of the 2048 game |+| [`bhoogle`](https://github.com/andrevdm/bhoogle) | A [Hoogle](https://www.haskell.org/hoogle/) client |+| [`clifm`](https://github.com/pasqu4le/clifm) | A file manager |+| [`towerHanoi`](https://github.com/shajenM/projects/tree/master/towerHanoi) | Animated solutions to The Tower of Hanoi |+| [`VOIDSPACE`](https://github.com/ChrisPenner/void-space) | A space-themed typing-tutor game |+| [`solitaire`](https://github.com/ambuc/solitaire) | The card game |+| [`sudoku-tui`](https://github.com/evanrelf/sudoku-tui) | A Sudoku implementation |+| [`summoner-tui`](https://github.com/kowainik/summoner/tree/master/summoner-tui) | An interactive frontend to the Summoner tool |+| [`wrapping-editor`](https://github.com/ta0kira/wrapping-editor) | An embeddable editor with support for Brick |+| [`git-brunch`](https://github.com/andys8/git-brunch) | A git branch checkout utility |+| [`hascard`](https://github.com/Yvee1/hascard) | A program for reviewing "flash card" notes |  These third-party packages also extend `brick`: - * [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) [[Hackage]](http://hackage.haskell.org/package/brick-filetree) - A widget for exploring a directory tree and selecting or flagging files and directories+| Project | Description |+| ------- | ----------- |+| [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) [[Hackage]](http://hackage.haskell.org/package/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories |  Release Announcements / News ----------------------------

@@ -1,5 +1,5 @@ name:                brick-version:             0.55+version:             0.56 synopsis:            A declarative terminal user interface library description:   Write terminal user interfaces (TUIs) painlessly with 'brick'! You@@ -38,7 +38,7 @@ cabal-version:       1.18 Homepage:            https://github.com/jtdaugherty/brick/ Bug-reports:         https://github.com/jtdaugherty/brick/issues-tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1, GHC == 8.6.5, GHC == 8.8.1+tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2  extra-doc-files:     README.md,                      docs/guide.rst,@@ -113,7 +113,7 @@     Brick.Types.Internal     Brick.Widgets.Internal -  build-depends:       base <= 4.14.0.0,+  build-depends:       base <= 4.14.1.0,                        vty >= 5.29,                        transformers,                        data-clist >= 0.1,@@ -138,6 +138,20 @@                        word-wrap >= 0.2   if impl(ghc < 8.0)     build-depends:     semigroups++executable brick-tail-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  default-extensions:  CPP+  main-is:             TailDemo.hs+  build-depends:       base,+                       brick,+                       text,+                       vty,+                       random  executable brick-readme-demo   if !flag(demos)

@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Data.Text as T+import Control.Monad (void)+import Control.Concurrent+import System.Random++import Brick+import Brick.BChan+import Brick.Widgets.Border+import qualified Graphics.Vty as V++draw :: AppState -> Widget n+draw st =+    header st <=> box st++header :: AppState -> Widget n+header st =+    padBottom (Pad 1) $+    hBox [ padRight (Pad 7) $+           (str $ "Max width: " <> show (textAreaWidth st)) <=>+           (str "Left(-)/Right(+)")+         , (str $ "Max height: " <> show (textAreaHeight st)) <=>+           (str "Down(-)/Up(+)")+         ]++box :: AppState -> Widget n+box st =+    border $+    hLimit (textAreaWidth st) $+    vLimit (textAreaHeight st) $+    (renderBottomUp (txtWrap <$> textAreaContents st))++-- | Given a list of widgets, draw them bottom-up in a vertical+-- arrangement, i.e., the first widget in this list will appear at the+-- bottom of the rendering area. Rendering stops when the rendering area+-- is full, i.e., items that cannot be rendered are never evaluated or+-- drawn.+renderBottomUp :: [Widget n] -> Widget n+renderBottomUp ws =+    Widget Greedy Greedy $ do+        let go _ [] = return V.emptyImage+            go remainingHeight (c:cs) = do+                cResult <- render c+                let img = image cResult+                    newRemainingHeight = remainingHeight - V.imageHeight img+                if newRemainingHeight == 0+                   then return img+                   else if newRemainingHeight < 0+                        then return $ V.cropTop remainingHeight img+                        else do+                            rest <- go newRemainingHeight cs+                            return $ V.vertCat [rest, img]++        ctx <- getContext+        img <- go (availHeight ctx) ws+        render $ fill ' ' <=> raw img++textLines :: [T.Text]+textLines =+    [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut"+    , "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco"+    , "laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit"+    , "in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat"+    , "cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."+    ]++handleEvent :: AppState -> BrickEvent n CustomEvent -> EventM n (Next AppState)+handleEvent s (AppEvent (NewLine l)) =+    continue $ s { textAreaContents = l : textAreaContents s }+handleEvent s (VtyEvent (V.EvKey V.KUp [])) =+    continue $ s { textAreaHeight = textAreaHeight s + 1 }+handleEvent s (VtyEvent (V.EvKey V.KDown [])) =+    continue $ s { textAreaHeight = max 0 $ textAreaHeight s - 1 }+handleEvent s (VtyEvent (V.EvKey V.KRight [])) =+    continue $ s { textAreaWidth = textAreaWidth s + 1 }+handleEvent s (VtyEvent (V.EvKey V.KLeft [])) =+    continue $ s { textAreaWidth = max 0 $ textAreaWidth s - 1 }+handleEvent s (VtyEvent (V.EvKey V.KEsc [])) =+    halt s+handleEvent s _ =+    continue s++data CustomEvent =+    NewLine T.Text++data AppState =+    AppState { textAreaHeight :: Int+             , textAreaWidth :: Int+             , textAreaContents :: [T.Text]+             }++app :: App AppState CustomEvent ()+app =+    App { appDraw = (:[]) . draw+        , appChooseCursor = neverShowCursor+        , appHandleEvent = handleEvent+        , appAttrMap = const $ attrMap V.defAttr []+        , appStartEvent = return+        }++initialState :: AppState+initialState =+    AppState { textAreaHeight = 20+             , textAreaWidth = 40+             , textAreaContents = []+             }++-- | Run forever, generating new lines of text for the application+-- window, prefixed with a line number. This function simulates the kind+-- of behavior that you'd get from running 'tail -f' on a file.+generateLines :: BChan CustomEvent -> IO ()+generateLines chan = go (1::Integer)+    where+        go lineNum = do+            -- Wait a random amount of time (in milliseconds)+            let delayOptions = [500, 1000, 2000]+            delay <- randomVal delayOptions+            threadDelay $ delay * 1000++            -- Choose a random line of text from our collection+            l <- randomVal textLines++            -- Send it to the application to be added to the UI+            writeBChan chan $ NewLine $ (T.pack $ "Line " <> show lineNum <> " - ") <> l++            go $ lineNum + 1++randomVal :: [a] -> IO a+randomVal as = do+    idx <- randomRIO (0, length as - 1)+    return $ as !! idx++main :: IO ()+main = do+    cfg <- V.standardIOConfig+    vty <- V.mkVty cfg+    chan <- newBChan 10++    -- Run thread to simulate incoming data+    void $ forkIO $ generateLines chan++    void $ customMain vty (V.mkVty cfg) (Just chan) app initialState

@@ -60,6 +60,7 @@   , setFormConcat   , setFieldConcat   , setFormFocus+  , updateFormState    -- * Simple form field constructors   , editTextField@@ -169,6 +170,9 @@                       -- ^ A lens to extract and store a                       -- successfully-validated form input back into                       -- your form state.+                      , formFieldUpdate :: a -> b -> b+                      -- ^ Given a new form state value, update the form+                      -- field state in place.                       , formFields :: [FormField a b e n]                       -- ^ The form fields, in order, that the user will                       -- interact with to manipulate this state value.@@ -226,6 +230,25 @@     let v = mkFs s     in v { formFieldRenderHelper = h . (formFieldRenderHelper v) } +-- | Update the state contained in a form.+--+-- This updates all form fields to be consistent with the new form+-- state. Where possible, this attempts to maintain other input state,+-- such as text editor cursor position.+--+-- Note that since this updates the form fields, this means that any+-- field values will be completely overwritten! This may or may not+-- be what you want, since a user actively using the form could get+-- confused if their edits go away. Use carefully.+updateFormState :: s -> Form s e n -> Form s e n+updateFormState newState f =+    let updateField fs = case fs of+            FormFieldState st l upd s rh concatAll ->+                FormFieldState (upd (newState^.l) st) l upd s rh concatAll+    in f { formState = newState+         , formFieldStates = updateField <$> formFieldStates f+         }+ -- | Set the focused field of a form. setFormFocus :: (Eq n) => n -> Form s e n -> Form s e n setFormFocus n f = f { formFocus = focusSetCurrent n $ formFocus f }@@ -257,7 +280,7 @@             }  formFieldNames :: FormFieldState s e n -> [n]-formFieldNames (FormFieldState _ _ fields _ _) = formFieldName <$> fields+formFieldNames (FormFieldState _ _ _ fields _ _) = formFieldName <$> fields  -- | A form field for manipulating a boolean value. This represents -- 'True' as @[X] label@ and 'False' as @[ ] label@.@@ -311,6 +334,8 @@                                                  handleEvent                                      ]                       , formFieldLens = stLens+                      , formFieldUpdate =+                          \val _ -> val                       , formFieldRenderHelper = id                       , formFieldConcat = vBox                       }@@ -365,6 +390,10 @@                                                  handleEvent                                      ]                       , formFieldLens = customStLens+                      , formFieldUpdate = \listState l ->+                           case listSelectedElement listState of+                               Nothing -> l+                               Just (_, e) -> listMoveToElement e l                       , formFieldRenderHelper = id                       , formFieldConcat = vBox                       }@@ -432,6 +461,7 @@     in FormFieldState { formFieldState = initVal                       , formFields = optionFields                       , formFieldLens = stLens+                      , formFieldUpdate = \val _ -> val                       , formFieldRenderHelper = id                       , formFieldConcat = vBox                       }@@ -468,7 +498,7 @@           -- the editor's initial contents. The resulting text may           -- contain newlines.           -> ([T.Text] -> Maybe a)-          -- ^ The validation function that converts the editors+          -- ^ The validation function that converts the editor's           -- contents into a valid value of type @a@.           -> ([T.Text] -> Widget n)           -- ^ The rendering function for the editor's contents (see@@ -499,6 +529,11 @@                                                  handleEvent                                      ]                       , formFieldLens = stLens+                      , formFieldUpdate = \newVal e ->+                          let newTxt = ini newVal+                          in if newTxt == (T.unlines $ getEditContents e)+                             then e+                             else applyEdit (Z.insertMany newTxt . Z.clearZipper) e                       , formFieldRenderHelper = id                       , formFieldConcat = vBox                       }@@ -613,18 +648,18 @@     let go1 [] = []         go1 (s:ss) =             let s' = case s of-                       FormFieldState st l fs rh concatAll ->+                       FormFieldState st l upd fs rh concatAll ->                            let go2 [] = []                                go2 (f@(FormField fn val _ r h):ff)                                    | n == fn = FormField fn val v r h : ff                                    | otherwise = f : go2 ff-                           in FormFieldState st l (go2 fs) rh concatAll+                           in FormFieldState st l upd (go2 fs) rh concatAll             in s' : go1 ss      in form { formFieldStates = go1 (formFieldStates form) }  getInvalidFields :: FormFieldState s e n -> [n]-getInvalidFields (FormFieldState st _ fs _ _) =+getInvalidFields (FormFieldState st _ _ fs _ _) =     let gather (FormField n validate extValid _ _) =             if (not extValid || (isNothing $ validate st)) then [n] else []     in concat $ gather <$> fs@@ -654,7 +689,7 @@                      => FocusRing n                      -> FormFieldState s e n                      -> Widget n-renderFormFieldState fr (FormFieldState st _ fields helper concatFields) =+renderFormFieldState fr (FormFieldState st _ _ fields helper concatFields) =     let renderFields [] = []         renderFields ((FormField n validate extValid renderField _):fs) =             let maybeInvalid = if (isJust $ validate st) && extValid@@ -763,7 +798,7 @@         findFieldState _ [] = return f         findFieldState prev (e:es) =             case e of-                FormFieldState st stLens fields helper concatAll -> do+                FormFieldState st stLens upd fields helper concatAll -> do                     let findField [] = return Nothing                         findField (field:rest) =                             case field of@@ -780,7 +815,7 @@                     case result of                         Nothing -> findFieldState (prev <> [e]) es                         Just (newSt, maybeSt) ->-                            let newFieldState = FormFieldState newSt stLens fields helper concatAll+                            let newFieldState = FormFieldState newSt stLens upd fields helper concatAll                             in return $ f { formFieldStates = prev <> [newFieldState] <> es                                           , formState = case maybeSt of                                               Nothing -> formState f

@@ -87,15 +87,17 @@ import Brick.AttrMap  -- | The library application abstraction. Your application's operations--- are represented here and passed to one of the various main functions--- in this module. An application is in terms of an application state--- type 's', an application event type 'e', and a resource name type--- 'n'. In the simplest case 'e' is unused (left polymorphic or set to--- '()'), but you may define your own event type and use 'customMain'--- to provide custom events. The state type is the type of application--- state to be provided by you and iteratively modified by event--- handlers. The resource name type is the type of names you can assign--- to rendering resources such as viewports and cursor locations.+-- are provided in an @App@ and then the @App@ is provided to one of the+-- various main functions in this module. An application @App s e n@+-- is in terms of an application state type @s@, an application event+-- type @e@, and a resource name type @n@. In the simplest case 'e' is+-- unused (left polymorphic or set to @()@), but you may define your own+-- event type and use 'customMain' to provide custom events. The state+-- type @s@ is the type of application state to be provided by you and+-- iteratively modified by event handlers. The resource name type @n@+-- is the type of names you can assign to rendering resources such as+-- viewports and cursor locations. Your application must define this+-- type. data App s e n =     App { appDraw :: s -> [Widget n]         -- ^ This function turns your application state into a list of

@@ -33,10 +33,12 @@   , getContext    -- ** The rendering context-  , Context(ctxAttrName, availWidth, availHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)+  , Context(ctxAttrName, availWidth, availHeight, windowWidth, windowHeight, ctxBorderStyle, ctxAttrMap, ctxDynBorders)   , attrL   , availWidthL   , availHeightL+  , windowWidthL+  , windowHeightL   , ctxAttrMapL   , ctxAttrNameL   , ctxBorderStyleL

@@ -268,6 +268,8 @@     Context { ctxAttrName :: AttrName             , availWidth :: Int             , availHeight :: Int+            , windowWidth :: Int+            , windowHeight :: Int             , ctxBorderStyle :: BorderStyle             , ctxAttrMap :: AttrMap             , ctxDynBorders :: Bool

@@ -992,6 +992,13 @@ -- taking preference. If a viewport receives more than one scrolling -- request from 'Brick.Main.EventM', all are honored in the order in -- which they are received.+--+-- Some caution should be advised when using this function. The viewport+-- renders its contents anew each time the viewport is drawn; in many+-- cases this is prohibitively expensive, and viewports should not be+-- used to display large contents for scrolling. This function is best+-- used when the contents are not too large OR when the contents are+-- large and render-cacheable. viewport :: (Ord n, Show n)          => n          -- ^ The name of the viewport (must be unique and stable for

@@ -30,16 +30,28 @@             -> ([CursorLocation n] -> Maybe (CursorLocation n))             -> RenderState n             -> (RenderState n, V.Picture, Maybe (CursorLocation n), [Extent n])-renderFinal aMap layerRenders sz chooseCursor rs = (newRS, picWithBg, theCursor, concat layerExtents)+renderFinal aMap layerRenders (w, h) chooseCursor rs =+    (newRS, picWithBg, theCursor, concat layerExtents)     where         (layerResults, !newRS) = flip runState rs $ sequence $             (\p -> runReaderT p ctx) <$>             (render <$> cropToContext <$> layerRenders)-        ctx = Context mempty (fst sz) (snd sz) defaultBorderStyle aMap False-        pic = V.picForLayers $ uncurry V.resize sz <$> (^.imageL) <$> layerResults++        ctx = Context { ctxAttrName = mempty+                      , availWidth = w+                      , availHeight = h+                      , windowWidth = w+                      , windowHeight = h+                      , ctxBorderStyle = defaultBorderStyle+                      , ctxAttrMap = aMap+                      , ctxDynBorders = False+                      }+        pic = V.picForLayers $ uncurry V.resize (w, h) <$> (^.imageL) <$> layerResults+         -- picWithBg is a workaround for runaway attributes.         -- See https://github.com/coreyoconnor/vty/issues/95         picWithBg = pic { V.picBackground = V.Background ' ' V.defAttr }+         layerCursors = (^.cursorsL) <$> layerResults         layerExtents = reverse $ (^.extentsL) <$> layerResults         theCursor = chooseCursor $ concat layerCursors

@@ -10,6 +10,7 @@ where  import Lens.Micro ((^.))+import Data.List (splitAt) import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid@@ -48,7 +49,11 @@             rightPart = replicate (barWidth - (labelWidth + length leftPart)) ' '             fullBar = leftPart <> label <> rightPart             completeWidth = round $ progress * toEnum (length fullBar)-            completePart = take completeWidth fullBar-            incompletePart = drop completeWidth fullBar+            adjustedCompleteWidth = if completeWidth == length fullBar && progress < 1.0+                                    then completeWidth - 1+                                    else if completeWidth == 0 && progress > 0.0+                                         then 1+                                         else completeWidth+            (completePart, incompletePart) = splitAt adjustedCompleteWidth fullBar         render $ (withAttr progressCompleteAttr $ str completePart) <+>                  (withAttr progressIncompleteAttr $ str incompletePart)