brick 0.40 → 0.41

raw patch · 13 files changed

+178/−51 lines, 13 filesdep ~basedep ~vtyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• brick.cabal +2/−2
• src/Brick/AttrMap.hs +4/−2
• src/Brick/BorderMap.hs +5/−1
• src/Brick/Forms.hs +48/−0
• src/Brick/Main.hs +17/−4
• src/Brick/Types.hs +2/−0
• src/Brick/Types/Common.hs +6/−3
• src/Brick/Types/Internal.hs +20/−14
• src/Brick/Widgets/Border/Style.hs +6/−1
• src/Brick/Widgets/Core.hs +33/−21
• src/Brick/Widgets/List.hs +12/−1
• src/Data/IMap.hs +6/−2

@@ -2,6 +2,23 @@ Brick changelog --------------- +0.41+----++New features:+ * `Brick.Forms` got a new field constructor, `listField`, that provides+   a form field using a `List`.+ * `List`: added the `listMoveToElement` function for changing the list+   selection to the specified element, if it exists.++Package changes:+ * Now depends on vty >= 5.24.++Other changes:+ * `viewport`: fixed failable patterns for forward compatibility with+   GHC 8.6 (#183)+ * Add `Generic`, `NFData`, and `Read` instances for some types+ 0.40 ---- 

@@ -1,5 +1,5 @@ name:                brick-version:             0.40+version:             0.41 synopsis:            A declarative terminal user interface library description:   Write terminal applications painlessly with 'brick'! You write an@@ -87,7 +87,7 @@     Brick.Widgets.Internal    build-depends:       base <= 4.11.1.0,-                       vty >= 5.23.1,+                       vty >= 5.24,                        transformers,                        data-clist >= 0.1,                        dlist,

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} -- | This module provides types and functions for managing an attribute -- map which maps attribute names ('AttrName') to attributes ('Attr'). -- This module is designed to be used with the 'OverloadedStrings'@@ -54,6 +55,7 @@ import Data.Maybe (catMaybes) import Data.List (inits) import Data.String (IsString(..))+import GHC.Generics (Generic)  import Graphics.Vty (Attr(..), MaybeDefault(..)) @@ -70,7 +72,7 @@ -- "header" <> "clock" <> "seconds" -- @ data AttrName = AttrName [String]-              deriving (Show, Read, Eq, Ord)+              deriving (Show, Read, Eq, Ord, Generic)  instance Sem.Semigroup AttrName where     (AttrName as) <> (AttrName bs) = AttrName $ as `mappend` bs@@ -85,7 +87,7 @@ -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr)              | ForceAttr Attr-             deriving Show+             deriving (Show, Generic)  -- | Create an attribute name from a string. attrName :: String -> AttrName

@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Brick.BorderMap     ( BorderMap     , Edges(..)@@ -18,6 +20,8 @@ import Brick.Types.Common (Edges(..), Location(..), eTopL, eBottomL, eRightL, eLeftL, origin) import Control.Applicative (liftA2) import Data.IMap (IMap, Run(Run))+import GHC.Generics+import Control.DeepSeq import Prelude hiding (lookup) import qualified Data.IMap as IM @@ -43,7 +47,7 @@ data BorderMap a = BorderMap     { _coordinates :: Edges Int     , _values :: Edges (IMap a)-    } deriving (Eq, Ord, Show, Functor)+    } deriving (Eq, Ord, Show, Functor, Read, Generic, NFData)  -- | Given a rectangle (specified as the coordinates of the top, left, bottom, -- and right sides), initialize an empty 'BorderMap'.

@@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | NOTE: This API is experimental and will probably change. Please try -- it out! Feedback is very much appreciated, and your patience in the -- face of breaking API changes is also appreciated!@@ -65,6 +66,7 @@   , editPasswordField   , radioField   , checkboxField+  , listField    -- * Advanced form field constructors   , editField@@ -82,10 +84,12 @@ #endif import Data.Maybe (isJust, isNothing) import Data.List (elemIndex)+import Data.Vector (Vector)  import Brick import Brick.Focus import Brick.Widgets.Edit+import Brick.Widgets.List import qualified Data.Text.Zipper as Z  import qualified Data.Text as T@@ -287,6 +291,50 @@        addAttr $        (str $ "[" <> (if val then "X" else " ") <> "] ") <+> txt label +-- | A form field for selecting a single choice from a set of possible+-- choices in a scrollable list. This uses a 'List' internally.+--+-- This field responds to the same input events that a 'List' does.+listField :: forall s e n a . (Ord n, Show n, Eq a)+          => (s -> Vector a)+          -- ^ Possible choices.+          -> Lens' s (Maybe a)+          -- ^ The state lens for the initially/finally selected+          -- element.+          -> (Bool -> a -> Widget n)+          -- ^ List item rendering function.+          -> Int+          -- ^ List item height in rows.+          -> n+          -- ^ The resource name for the input field.+          -> s+          -- ^ The initial form state.+          -> FormFieldState s e n+listField options stLens renderItem itemHeight name initialState =+    let optionsVector = options initialState+        initVal = initialState ^. customStLens++        customStLens :: Lens' s (List n a)+        customStLens = lens getList setList+            where+               getList s = let l = list name optionsVector itemHeight+                           in case s ^. stLens of+                               Nothing -> l+                               Just e -> listMoveToElement e l+               setList s l = s & stLens .~ (snd <$> listSelectedElement l)++        handleEvent (VtyEvent e) s = handleListEvent e s+        handleEvent _ s = return s++    in FormFieldState { formFieldState        = initVal+                      , formFields            = [ FormField name Just True+                                                            (renderList renderItem)+                                                            handleEvent+                                                ]+                      , formFieldLens         = customStLens+                      , formFieldRenderHelper = id+                      , formFieldConcat       = vBox+                      } -- | A form field for selecting a single choice from a set of possible -- choices. Each choice has an associated value and text label. --

@@ -38,6 +38,11 @@   -- * Rendering cache management   , invalidateCacheEntry   , invalidateCache++  -- * Renderer internals (for benchmarking)+  , renderFinal+  , getRenderState+  , resetRenderState   ) where @@ -180,8 +185,7 @@               Nothing -> readBChan brickChan               Just uc -> readBrickEvent brickChan uc             runInner rs st = do-              (result, newRS) <- runVty vty readEvent app st (rs & observedNamesL .~ S.empty-                                                                 & clickableNamesL .~ mempty)+              (result, newRS) <- runVty vty readEvent app st (resetRenderState rs)               case result of                   SuspendAndResume act -> do                       killThread pid@@ -221,7 +225,8 @@                     run newVty newRS newAppState brickChan          emptyES = ES [] mempty-        eventRO = EventRO M.empty initialVty mempty+        emptyRS = RS M.empty mempty S.empty mempty mempty+        eventRO = EventRO M.empty initialVty mempty emptyRS     (st, eState) <- runStateT (runReaderT (runEventM (appStartEvent app initialAppState)) eventRO) emptyES     let initialRS = RS M.empty (esScrollRequests eState) S.empty mempty []     brickChan <- newBChan 20@@ -303,7 +308,7 @@         _ -> return (e, firstRS, exts)      let emptyES = ES [] mempty-        eventRO = EventRO (viewportMap nextRS) vty nextExts+        eventRO = EventRO (viewportMap nextRS) vty nextExts nextRS      (next, eState) <- runStateT (runReaderT (runEventM (appHandleEvent app appState e'))                                 eventRO) emptyES@@ -372,6 +377,14 @@ withVty :: Vty -> (Vty -> IO a) -> IO a withVty vty useVty = do     useVty vty `finally` shutdown vty++getRenderState :: EventM n (RenderState n)+getRenderState = EventM $ asks oldState++resetRenderState :: RenderState n -> RenderState n+resetRenderState s =+    s & observedNamesL .~ S.empty+      & clickableNamesL .~ mempty  renderApp :: Vty -> App s e n -> s -> RenderState n -> IO (RenderState n, [Extent n]) renderApp vty app appState rs = do

@@ -76,6 +76,8 @@   , Padding(..)   , Direction(..) +  -- * Renderer internals (for benchmarking)+  , RenderState   ) where 

@@ -1,7 +1,8 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}-+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Brick.Types.Common   ( Location(..)   , locL@@ -12,6 +13,8 @@  import Brick.Types.TH (suffixLenses) import qualified Data.Semigroup as Sem+import GHC.Generics+import Control.DeepSeq import Lens.Micro (_1, _2) import Lens.Micro.Internal (Field1, Field2) @@ -19,7 +22,7 @@ data Location = Location { loc :: (Int, Int)                          -- ^ (Column, Row)                          }-                deriving (Show, Eq, Ord)+                deriving (Show, Eq, Ord, Read, Generic, NFData)  suffixLenses ''Location @@ -41,7 +44,7 @@     mappend = (Sem.<>)  data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a }-    deriving (Eq, Ord, Read, Show, Functor)+    deriving (Eq, Ord, Read, Show, Functor, Generic, NFData)  suffixLenses ''Edges 

@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Brick.Types.Internal   ( ScrollRequest(..)   , VisibilityRequest(..)@@ -58,6 +60,8 @@ import qualified Data.Set as S import qualified Data.Map as M import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, Attr, emptyImage)+import GHC.Generics+import Control.DeepSeq (NFData)  import Brick.BorderMap (BorderMap) import qualified Brick.BorderMap as BM@@ -76,12 +80,13 @@                    | VScrollToEnd                    | SetTop Int                    | SetLeft Int+                   deriving (Read, Show, Generic, NFData)  data VisibilityRequest =     VR { vrPosition :: Location        , vrSize :: DisplayRegion        }-       deriving (Show, Eq)+       deriving (Show, Eq, Read, Generic, NFData)  -- | Describes the state of a viewport as it appears as its most recent -- rendering.@@ -93,7 +98,7 @@        , _vpSize :: DisplayRegion        -- ^ The size of the viewport.        }-       deriving Show+       deriving (Show, Read, Generic, NFData)  -- | The type of viewports that indicates the direction(s) in which a -- viewport is scrollable.@@ -120,12 +125,7 @@                        , extentSize      :: (Int, Int)                        , extentOffset    :: Location                        }-              deriving (Show)--data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport-                         , eventVtyHandle :: Vty-                         , latestExtents :: [Extent n]-                         }+                       deriving (Show, Read, Generic, NFData)  -- | The type of actions to take upon completion of an event handler. data Next a = Continue a@@ -138,7 +138,7 @@                -- ^ Up/left                | Down                -- ^ Down/right-               deriving (Show, Eq)+               deriving (Show, Eq, Read, Generic, NFData)  -- | The class of types that behave like terminal locations. class TerminalLocation a where@@ -163,7 +163,7 @@                    , cursorLocationName :: !(Maybe n)                    -- ^ The name of the widget associated with the location                    }-                   deriving Show+                   deriving (Read, Show, Generic, NFData)  -- | A border character has four segments, one extending in each direction -- (horizontally and vertically) from the center of the character.@@ -175,7 +175,7 @@     -- ^ Does this segment want to connect to its neighbor?     , bsDraw :: Bool     -- ^ Should this segment be represented visually?-    } deriving (Eq, Ord, Read, Show)+    } deriving (Eq, Ord, Read, Show, Generic, NFData)  suffixLenses ''BorderSegment @@ -191,7 +191,7 @@     -- connections: only dynamic borders with equal 'Attr's will connect to     -- each other.     , dbSegments :: Edges BorderSegment-    } deriving (Eq, Read, Show)+    } deriving (Eq, Read, Show, Generic, NFData)  suffixLenses ''DynBorder @@ -224,7 +224,7 @@            -- ^ Places where we may rewrite the edge of the image when            -- placing this widget next to another one.            }-           deriving Show+           deriving (Show, Read, Generic, NFData)  suffixLenses ''Result @@ -252,7 +252,13 @@        , observedNames :: !(S.Set n)        , renderCache :: M.Map n (Result n)        , clickableNames :: [n]-       }+       } deriving (Read, Show, Generic, NFData)++data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport+                         , eventVtyHandle :: Vty+                         , latestExtents :: [Extent n]+                         , oldState :: RenderState n+                         }  -- | The rendering context. This tells widgets how to render: how much -- space they have in which to render, which attribute they should use

@@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} -- | This module provides styles for borders as used in terminal -- applications. Your mileage may vary on some of the fancier styles -- due to varying support for some border characters in the fonts your@@ -21,6 +23,9 @@   ) where +import GHC.Generics+import Control.DeepSeq+ -- | A border style for use in any widget that needs to render borders -- in a consistent style. data BorderStyle =@@ -47,7 +52,7 @@                 , bsVertical :: Char                 -- ^ Vertical border character                 }-                deriving (Show, Read, Eq)+                deriving (Show, Read, Eq, Generic, NFData)  defaultBorderStyle :: BorderStyle defaultBorderStyle = unicode

@@ -1041,33 +1041,42 @@       reqs <- lift $ gets $ (^.rsScrollRequestsL)       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 ()+          mVp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))+          case mVp of+              Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+              Just vp -> do+                  let updatedVp = applyRequests relevantRequests vp+                      applyRequests [] v = v+                      applyRequests (rq:rqs) v =+                          case typ of+                              Horizontal -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v+                              Vertical -> scrollTo typ rq (initialResult^.imageL) $ applyRequests rqs v+                              Both -> scrollTo Horizontal rq (initialResult^.imageL) $+                                      scrollTo Vertical rq (initialResult^.imageL) $+                                      applyRequests rqs v+                  lift $ modify (& viewportMapL %~ (M.insert vpname updatedVp))        -- If the sub-rendering requested visibility, update the scroll       -- state accordingly       when (not $ null $ initialResult^.visibilityRequestsL) $ do-          Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))-          let rqs = initialResult^.visibilityRequestsL-              updateVp vp' rq = case typ of-                  Both -> scrollToView Horizontal rq $ scrollToView Vertical rq vp'-                  Horizontal -> scrollToView typ rq vp'-                  Vertical -> scrollToView typ rq vp'-          lift $ modify (& viewportMapL %~ (M.insert vpname $ foldl updateVp vp rqs))+          mVp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))+          case mVp of+              Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+              Just vp -> do+                  let rqs = initialResult^.visibilityRequestsL+                      updateVp vp' rq = case typ of+                          Both -> scrollToView Horizontal rq $ scrollToView Vertical rq vp'+                          Horizontal -> scrollToView typ rq vp'+                          Vertical -> scrollToView typ rq vp'+                  lift $ modify (& viewportMapL %~ (M.insert vpname $ foldl updateVp vp rqs))        -- If the size of the rendering changes enough to make the       -- viewport offsets invalid, reset them-      Just vp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))+      mVp <- lift $ gets $ (^.viewportMapL.to (M.lookup vpname))+      vp <- case mVp of+          Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+          Just v -> return v+       let img = initialResult^.imageL           fixTop v = if V.imageHeight img < v^.vpSize._2                    then v & vpTop .~ 0@@ -1082,7 +1091,10 @@       lift $ modify (& viewportMapL %~ (M.insert vpname (updateVp vp)))        -- Get the viewport state now that it has been updated.-      Just vpFinal <- lift $ gets (M.lookup vpname . (^.viewportMapL))+      mVpFinal <- lift $ gets (M.lookup vpname . (^.viewportMapL))+      vpFinal <- case mVpFinal of+          Nothing -> error $ "BUG: viewport: viewport name " <> show vpname <> " absent from viewport map"+          Just v -> return v        -- Then perform a translation of the sub-rendering to fit into the       -- viewport

@@ -6,6 +6,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-} -- | This module provides a scrollable list type and functions for -- manipulating and rendering it. module Brick.Widgets.List@@ -38,6 +39,7 @@   -- * Manipulating a list   , listMoveBy   , listMoveTo+  , listMoveToElement   , listMoveUp   , listMoveDown   , listMoveByPages@@ -62,12 +64,14 @@ import Data.Foldable (Foldable) import Data.Traversable (Traversable) #endif+import Control.Applicative ((<|>))  import Lens.Micro ((^.), (&), (.~), (%~), _2) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Graphics.Vty (Event(..), Key(..), Modifier(..)) import qualified Data.Vector as V+import GHC.Generics (Generic)  import Brick.Types import Brick.Main (lookupViewport)@@ -92,7 +96,7 @@          -- ^ The list's name.          , listItemHeight :: Int          -- ^ The height of the list items.-         } deriving (Functor, Foldable, Traversable, Show)+         } deriving (Functor, Foldable, Traversable, Show, Generic)  suffixLenses ''List @@ -348,6 +352,13 @@     in l & listSelectedL .~ if len > 0                             then Just newSel                             else Nothing++-- | Set the selected index for a list to the index of the specified+-- element if it is in the list, or leave the list unmodified otherwise.+listMoveToElement :: (Eq e) => e -> List n e -> List n e+listMoveToElement e l =+    let i = V.elemIndex e (l^.listElementsL)+    in l & listSelectedL %~ (i <|>)  -- | Return a list's selected element, if any. listSelectedElement :: List n e -> Maybe (Int, e)

@@ -1,4 +1,6 @@ {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Data.IMap     ( IMap     , Run(..)@@ -22,13 +24,15 @@ import Data.List (foldl') import Data.Monoid import Data.IntMap.Strict (IntMap)+import GHC.Generics+import Control.DeepSeq import Prelude hiding (lookup) import qualified Data.IntMap.Strict as IM  -- | Semantically, 'IMap' and 'IntMap' are identical; but 'IMap' is more -- efficient when large sequences of contiguous keys are mapped to the same -- value.-newtype IMap a = IMap { _runs :: IntMap (Run a) } deriving (Show, Functor)+newtype IMap a = IMap { _runs :: IntMap (Run a) } deriving (Show, Functor, Read, Generic, NFData)  {-# INLINE unsafeRuns #-} -- | This function is unsafe because 'IMap's that compare equal may split their@@ -72,7 +76,7 @@ data Run a = Run     { len :: !Int     , val :: !a-    } deriving (Eq, Ord, Read, Show, Functor)+    } deriving (Eq, Ord, Read, Show, Functor, Generic, NFData)  instance Foldable    Run where foldMap f r = f (val r) instance Traversable Run where sequenceA (Run n v) = Run n <$> v