diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,76 @@ Brick changelog --------------- +2.12 +---- + +Package changes: + +* Raised upper bound on microlens to allow building with 0.5. + +2.11 +---- + +Bug fixes: + +* Fixed a bug in FileBrowser: if a user pressed Enter when the cursor + was on a selected entry, it was omitted from the list of + selected browser entries. As part of this change, the function + `actionFileBrowserSelectCurrent` previously toggled the selection + of the entry at the cursor, but should have selected it instead. + It now does so, and a new function for toggling was introduced: + `actionFileBrowserToggleCurrent`. + +Other changes: + +* Upper bounds on `base` and `microlens` were adjusted. + +2.10 +---- + +* Updated `brick` to build with `microlens == 0.5.0.0` which moved its + Field* classes to `Lens.Micro.FieldN`. + +2.9 +--- + +API changes: +* Added `Brick.Widgets.List.listFindFirst` function. + +2.8.3 +----- + +Bug fixes: + +* Fixed a bug that completely broke `makeVisible` that was introduced + in brick 2.6. +* Fixed context cropping in `cropRightBy` and `cropBottomBy`. + +2.8.2 +----- + +* Updated `Brick.Widgets.Core` functions `cropBottomBy`, `cropToBy`, + `cropLeftBy`, and `cropRightBy` to properly perform result cropping to + actually address the internal bug fixed in 2.8.1. + +2.8.1 +----- + +* Fixed a long-standing bug in `cropToContext` that resulted in some + extents getting left around when they should be dropped, possibly + leading to application bugs when handling mouse clicks in extent + regions that should have been removed from the rendering result. + +2.8 +--- + +Behavior changes: +* `FileBrowser` file marking with `Space` now honors the file browser's + configured file selector predicate. +* `FileBrowser` file marking with `Space` and `Enter` now toggles file + selection rather than just selecting files, allowing for selected + files to be unselected. + 2.7 --- @@ -1802,7 +1872,7 @@ Bug fixes: * Fixed viewport behavior when the image in a viewport reduces its size enough to render the viewport offsets invalid. Before, this behavior - caused a crash during image croppin in vty; now the behavior is + caused a crash during image cropping in vty; now the behavior is handled sanely (fixes #22; reported by Hans-Peter Deifel) 0.2.2 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015-2018, Jonathan Daugherty. +Copyright (c) 2015-2025, Jonathan Daugherty. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -53,6 +53,7 @@ | [`2048Haskell`](https://github.com/8Gitbrix/2048Haskell) | An implementation of the 2048 game | | [`babel-cards`](https://github.com/srhoulam/babel-cards) | A TUI spaced-repetition memorization tool. Similar to Anki. | | [`bhoogle`](https://github.com/andrevdm/bhoogle) | A [Hoogle](https://www.haskell.org/hoogle/) client | +| [`bollama`](https://github.com/andrevdm/bollama) | A simple [Ollama](https://ollama.com/) TUI | | [`brewsage`](https://github.com/gerdreiss/brewsage#readme) | A TUI for Homebrew | | [`brick-trading-journal`](https://codeberg.org/amano.kenji/brick-trading-journal) | A TUI program that calculates basic statistics from trades | | [`Brickudoku`](https://github.com/Thecentury/brickudoku) | A hybrid of Tetris and Sudoku | @@ -72,11 +73,13 @@ | [`hledger-iadd`](http://github.com/rootzlevel/hledger-iadd) | An interactive terminal UI for adding hledger journal entries | | [`hledger-ui`](https://github.com/simonmichael/hledger) | A terminal UI for the hledger accounting system. | | [`homodoro`](https://github.com/c0nradLC/homodoro) | A terminal application to use the pomodoro technique and keep track of daily tasks | +| [`hskanban`](https://github.com/vincentaxhe/hskanban) | A Kanban organizer | | [`htyper`](https://github.com/Simon-Hostettler/htyper) | A typing speed test program | | [`hyahtzee2`](https://github.com/DamienCassou/hyahtzee2#readme) | Famous Yahtzee dice game | | [`kpxhs`](https://github.com/akazukin5151/kpxhs) | An interactive [Keepass](https://github.com/keepassxreboot/keepassxc/) database viewer | | [`matterhorn`](https://github.com/matterhorn-chat/matterhorn) | A client for [Mattermost](https://about.mattermost.com/) | | [`maze`](https://github.com/benjaminselfridge/maze) | A Brick-based maze game | +| [`monad-torrent`](https://github.com/davorluc/monad-torrent) | A simple and minimal torrent client | | [`monalog`](https://github.com/goosedb/Monalog) | Terminal logs observer | | [`mushu`](https://github.com/elaye/mushu) | An `MPD` client | | [`mywork`](https://github.com/kquick/mywork) [[Hackage]](https://hackage.haskell.org/package/mywork) | A tool to keep track of the projects you are working on | @@ -102,12 +105,14 @@ | [`wrapping-editor`](https://github.com/ta0kira/wrapping-editor) | An embeddable editor with support for Brick | | [`youbrick`](https://github.com/florentc/youbrick) | A feed aggregator and launcher for Youtube channels | -These third-party packages also extend `brick`: +These additional packages also extend `brick`: -| 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 | -| [`brick-panes`](https://github.com/kquick/brick-panes) [[Hackage]](https://hackage.haskell.org/package/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. | +| Project | Description | Hackage | +| ------- | ----------- | ------- | +| [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories | [Hackage](https://hackage.haskell.org/package/brick-filetree) | +| [`brick-panes`](https://github.com/kquick/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. | [Hackage](https://hackage.haskell.org/package/brick-panes) | +| [`brick-calendar`](https://github.com/ldgrp/brick-calendar) | A library providing a calendar widget for Brick-based applications. | [Hackage](https://hackage.haskell.org/package/brick-calendar) | +| [`brick-skylighting`](https://github.com/jtdaugherty/brick-skylighting) | A library providing integration support for [Skylighting](https://hackage.haskell.org/package/skylighting)-based syntax highlighting. | [Hackage](https://hackage.haskell.org/package/brick-skylighting) | Getting Started --------------- @@ -209,6 +214,8 @@ If you decide to contribute, that's great! Here are some guidelines you should consider to make submitting patches easier for all concerned: + - Patches written completely or partially by AI are unlikely to be + accepted. - If you want to take on big things, talk to me first; let's have a design/vision discussion before you start coding. Create a GitHub issue and we can use that as the place to hash things out. diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 2.7 +version: 2.12 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You @@ -32,7 +32,7 @@ license-file: LICENSE author: Jonathan Daugherty maintainer: Jonathan Daugherty -copyright: (c) Jonathan Daugherty 2015-2024 +copyright: (c) Jonathan Daugherty 2015-2025 category: Graphics build-type: Simple cabal-version: 1.18 @@ -46,10 +46,10 @@ || == 9.0.2 || == 9.2.8 || == 9.4.8 - || == 9.6.6 + || == 9.6.7 || == 9.8.4 - || == 9.10.1 - || == 9.12.1 + || == 9.10.3 + || == 9.12.2 extra-doc-files: README.md, docs/guide.rst, @@ -59,7 +59,7 @@ Source-Repository head type: git - location: git://github.com/jtdaugherty/brick.git + location: http://github.com/jtdaugherty/brick Flag demos Description: Build demonstration programs @@ -108,7 +108,7 @@ Brick.Types.Internal Brick.Widgets.Internal - build-depends: base >= 4.9.0.0 && < 4.22.0.0, + build-depends: base >= 4.9.0.0 && < 4.23.0.0, vty >= 6.0, vty-crossplatform, bimap >= 0.5 && < 0.6, @@ -117,7 +117,7 @@ exceptions >= 0.10.0, filepath, containers >= 0.5.7, - microlens >= 0.3.0.0, + microlens >= 0.3.0.0 && < 0.6, microlens-th, microlens-mtl, mtl, @@ -161,9 +161,7 @@ default-extensions: CPP main-is: TableDemo.hs build-depends: base, - brick, - text, - vty + brick executable brick-tail-demo if !flag(demos) @@ -177,7 +175,6 @@ brick, text, vty, - vty-crossplatform, random, microlens-th, microlens-mtl @@ -191,8 +188,7 @@ default-extensions: CPP main-is: ReadmeDemo.hs build-depends: base, - brick, - text + brick executable brick-file-browser-demo if !flag(demos) @@ -234,7 +230,6 @@ main-is: TextWrapDemo.hs build-depends: base, brick, - text, word-wrap executable brick-cache-demo @@ -248,9 +243,6 @@ build-depends: base, brick, vty, - text, - microlens >= 0.3.0.0, - microlens-th, mtl executable brick-visibility-demo @@ -263,7 +255,6 @@ build-depends: base, brick, vty, - text, microlens >= 0.3.0.0, microlens-th, microlens-mtl @@ -280,8 +271,6 @@ brick, vty, vty-crossplatform, - text, - microlens, microlens-mtl, microlens-th @@ -295,9 +284,7 @@ main-is: ViewportScrollDemo.hs build-depends: base, brick, - vty, - text, - microlens + vty executable brick-dialog-demo if !flag(demos) @@ -308,9 +295,7 @@ main-is: DialogDemo.hs build-depends: base, brick, - vty, - text, - microlens + vty executable brick-mouse-demo if !flag(demos) @@ -322,11 +307,9 @@ build-depends: base, brick, vty, - text, microlens >= 0.3.0.0, microlens-th, microlens-mtl, - text-zipper, mtl executable brick-layer-demo @@ -339,7 +322,6 @@ build-depends: base, brick, vty, - text, microlens >= 0.3.0.0, microlens-th, microlens-mtl @@ -354,7 +336,6 @@ build-depends: base, brick, vty, - text, microlens >= 0.3.0.0, microlens-th @@ -367,9 +348,7 @@ main-is: CroppingDemo.hs build-depends: base, brick, - vty, - text, - microlens + vty executable brick-padding-demo if !flag(demos) @@ -380,9 +359,7 @@ main-is: PaddingDemo.hs build-depends: base, brick, - vty, - text, - microlens + vty executable brick-theme-demo if !flag(demos) @@ -394,9 +371,7 @@ build-depends: base, brick, vty, - text, - mtl, - microlens + mtl executable brick-attr-demo if !flag(demos) @@ -407,9 +382,7 @@ main-is: AttrDemo.hs build-depends: base, brick, - vty, - text, - microlens + vty executable brick-tabular-list-demo if !flag(demos) @@ -421,11 +394,9 @@ build-depends: base, brick, vty, - text, microlens >= 0.3.0.0, microlens-mtl, microlens-th, - mtl, vector executable brick-list-demo @@ -438,7 +409,6 @@ build-depends: base, brick, vty, - text, microlens >= 0.3.0.0, microlens-mtl, mtl, @@ -454,7 +424,6 @@ build-depends: base, brick, vty, - text, microlens >= 0.3.0.0, microlens-mtl, mtl, @@ -472,10 +441,7 @@ vty, vty-crossplatform, containers, - text, - microlens-platform, - stm, - mtl + microlens-platform executable brick-custom-event-demo if !flag(demos) @@ -487,7 +453,6 @@ build-depends: base, brick, vty, - text, microlens >= 0.3.0.0, microlens-th, microlens-mtl @@ -500,10 +465,7 @@ default-language: Haskell2010 main-is: FillDemo.hs build-depends: base, - brick, - vty, - text, - microlens + brick executable brick-hello-world-demo if !flag(demos) @@ -513,10 +475,7 @@ default-language: Haskell2010 main-is: HelloWorldDemo.hs build-depends: base, - brick, - vty, - text, - microlens + brick executable brick-edit-demo if !flag(demos) @@ -528,9 +487,6 @@ build-depends: base, brick, vty, - text, - vector, - mtl, microlens >= 0.3.0.0, microlens-th, microlens-mtl @@ -545,9 +501,6 @@ build-depends: base, brick, vty, - text, - vector, - mtl, microlens >= 0.3.0.0, microlens-th, microlens-mtl @@ -563,8 +516,7 @@ build-depends: base, brick, vty, - text, - microlens + text executable brick-dynamic-border-demo if !flag(demos) @@ -575,10 +527,7 @@ default-language: Haskell2010 main-is: DynamicBorderDemo.hs build-depends: base <= 5, - brick, - vty, - text, - microlens + brick executable brick-progressbar-demo if !flag(demos) @@ -591,8 +540,6 @@ build-depends: base, brick, vty, - text, - microlens, microlens-mtl, microlens-th diff --git a/docs/guide.rst b/docs/guide.rst --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1993,8 +1993,8 @@ border $ str "This will be cached" -In the example above, the first time the ``border $ str "This will be -cached"`` widget is rendered, the resulting Vty image will be stored +In the example above, the first time the ``border $ str "This will be cached"`` +widget is rendered, the resulting Vty image will be stored in the rendering cache under the key ``ExpensiveThing``. On subsequent renderings the cached Vty image will be used instead of re-rendering the widget. This example doesn't need caching to improve performance, but diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -94,9 +94,9 @@ [ withDefAttr attr6 $ str "0" , withDefAttr attr5 $ str "O" , withDefAttr attr4 $ str "o" - , withDefAttr attr3 $ str "*" - , withDefAttr attr2 $ str "~" - , withDefAttr attr1 $ str "." + , withDefAttr attr3 $ str "•" + , withDefAttr attr2 $ str "*" + , withDefAttr attr2 $ str "." ] attr6 :: AttrName diff --git a/src/Brick/Main.hs b/src/Brick/Main.hs --- a/src/Brick/Main.hs +++ b/src/Brick/Main.hs @@ -238,6 +238,10 @@ -- | Like 'customMainWithVty', except that Vty is initialized with the -- default configuration. +-- +-- The returned 'Vty' handle still has control of the terminal. The +-- caller is responsible for calling 'shutdown' to restore the terminal +-- state. customMainWithDefaultVty :: (Ord n) => Maybe (BChan e) -- ^ An event channel for sending custom diff --git a/src/Brick/Types/Common.hs b/src/Brick/Types/Common.hs --- a/src/Brick/Types/Common.hs +++ b/src/Brick/Types/Common.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE CPP #-} module Brick.Types.Common ( Location(..) , locL @@ -16,10 +17,14 @@ import GHC.Generics import Control.DeepSeq import Lens.Micro (_1, _2) +#if MIN_VERSION_microlens(0,5,0) +import Lens.Micro.FieldN (Field1, Field2) +#else import Lens.Micro.Internal (Field1, Field2) +#endif -- | A terminal screen location. -data Location = Location { loc :: (Int, Int) +data Location = Location { loc :: !(Int, Int) -- ^ (Column, Row) } deriving (Show, Eq, Ord, Read, Generic, NFData) @@ -43,7 +48,7 @@ mempty = origin mappend = (Sem.<>) -data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a } +data Edges a = Edges { eTop, eBottom, eLeft, eRight :: !a } deriving (Eq, Ord, Read, Show, Functor, Generic, NFData) suffixLenses ''Edges diff --git a/src/Brick/Types/Internal.hs b/src/Brick/Types/Internal.hs --- a/src/Brick/Types/Internal.hs +++ b/src/Brick/Types/Internal.hs @@ -103,16 +103,16 @@ import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) -data ScrollRequest = HScrollBy Int - | HScrollPage Direction +data ScrollRequest = HScrollBy !Int + | HScrollPage !Direction | HScrollToBeginning | HScrollToEnd - | VScrollBy Int - | VScrollPage Direction + | VScrollBy !Int + | VScrollPage !Direction | VScrollToBeginning | VScrollToEnd - | SetTop Int - | SetLeft Int + | SetTop !Int + | SetLeft !Int deriving (Read, Show, Generic, NFData) -- | Widget size policies. These policies communicate how a widget uses @@ -131,9 +131,9 @@ -- | The type of widgets. data Widget n = - Widget { hSize :: Size + Widget { hSize :: !Size -- ^ This widget's horizontal growth policy - , vSize :: Size + , vSize :: !Size -- ^ This widget's vertical growth policy , render :: RenderM n (Result n) -- ^ This widget's rendering function @@ -230,21 +230,21 @@ } data VisibilityRequest = - VR { vrPosition :: Location - , vrSize :: DisplayRegion + VR { vrPosition :: !Location + , vrSize :: !DisplayRegion } deriving (Show, Eq, Read, Generic, NFData) -- | Describes the state of a viewport as it appears as its most recent -- rendering. data Viewport = - VP { _vpLeft :: Int + VP { _vpLeft :: !Int -- ^ The column offset of left side of the viewport. - , _vpTop :: Int + , _vpTop :: !Int -- ^ The row offset of the top of the viewport. - , _vpSize :: DisplayRegion + , _vpSize :: !DisplayRegion -- ^ The size of the viewport. - , _vpContentSize :: DisplayRegion + , _vpContentSize :: !DisplayRegion -- ^ The size of the contents of the viewport. } deriving (Show, Read, Generic, NFData) @@ -274,9 +274,9 @@ } data VtyContext = - VtyContext { vtyContextBuilder :: IO Vty - , vtyContextHandle :: Vty - , vtyContextThread :: ThreadId + VtyContext { vtyContextBuilder :: !(IO Vty) + , vtyContextHandle :: !Vty + , vtyContextThread :: !ThreadId , vtyContextPutEvent :: Event -> IO () } @@ -330,27 +330,27 @@ -- | A border character has four segments, one extending in each direction -- (horizontally and vertically) from the center of the character. data BorderSegment = BorderSegment - { bsAccept :: Bool + { bsAccept :: !Bool -- ^ Would this segment be willing to be drawn if a neighbor wanted to -- connect to it? - , bsOffer :: Bool + , bsOffer :: !Bool -- ^ Does this segment want to connect to its neighbor? - , bsDraw :: Bool + , bsDraw :: !Bool -- ^ Should this segment be represented visually? } deriving (Eq, Ord, Read, Show, Generic, NFData) -- | Information about how to redraw a dynamic border character when it abuts -- another dynamic border character. data DynBorder = DynBorder - { dbStyle :: BorderStyle + { dbStyle :: !BorderStyle -- ^ The 'Char's to use when redrawing the border. Also used to filter -- connections: only dynamic borders with equal 'BorderStyle's will connect -- to each other. - , dbAttr :: Attr + , dbAttr :: !Attr -- ^ What 'Attr' to use to redraw the border character. Also used to filter -- connections: only dynamic borders with equal 'Attr's will connect to -- each other. - , dbSegments :: Edges BorderSegment + , dbSegments :: !(Edges BorderSegment) } deriving (Eq, Read, Show, Generic, NFData) -- | The type of result returned by a widget's rendering function. The @@ -394,23 +394,23 @@ } -- | The type of events. -data BrickEvent n e = VtyEvent Event +data BrickEvent n e = VtyEvent !Event -- ^ The event was a Vty event. - | AppEvent e + | AppEvent !e -- ^ The event was an application event. - | MouseDown n Button [Modifier] Location + | MouseDown !n !Button ![Modifier] !Location -- ^ A mouse-down event on the specified region was -- received. The 'n' value is the resource name of -- the clicked widget (see 'clickable'). - | MouseUp n (Maybe Button) Location + | MouseUp !n !(Maybe Button) !Location -- ^ A mouse-up event on the specified region was -- received. The 'n' value is the resource name of -- the clicked widget (see 'clickable'). deriving (Show, Eq, Ord) -data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport - , latestExtents :: [Extent n] - , oldState :: RenderState n +data EventRO n = EventRO { eventViewportMap :: !(M.Map n Viewport) + , latestExtents :: ![Extent n] + , oldState :: !(RenderState n) } -- | Clickable elements of a scroll bar. @@ -432,22 +432,22 @@ -- to render, which bordering style should be used, and the attribute map -- available for rendering. data Context n = - Context { ctxAttrName :: AttrName - , availWidth :: Int - , availHeight :: Int - , windowWidth :: Int - , windowHeight :: Int - , ctxBorderStyle :: BorderStyle - , ctxAttrMap :: AttrMap - , ctxDynBorders :: Bool - , ctxVScrollBarOrientation :: Maybe VScrollBarOrientation - , ctxVScrollBarRenderer :: Maybe (VScrollbarRenderer n) - , ctxHScrollBarOrientation :: Maybe HScrollBarOrientation - , ctxHScrollBarRenderer :: Maybe (HScrollbarRenderer n) - , ctxVScrollBarShowHandles :: Bool - , ctxHScrollBarShowHandles :: Bool - , ctxVScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n) - , ctxHScrollBarClickableConstr :: Maybe (ClickableScrollbarElement -> n -> n) + Context { ctxAttrName :: !AttrName + , availWidth :: !Int + , availHeight :: !Int + , windowWidth :: !Int + , windowHeight :: !Int + , ctxBorderStyle :: !BorderStyle + , ctxAttrMap :: !AttrMap + , ctxDynBorders :: !Bool + , ctxVScrollBarOrientation :: !(Maybe VScrollBarOrientation) + , ctxVScrollBarRenderer :: !(Maybe (VScrollbarRenderer n)) + , ctxHScrollBarOrientation :: !(Maybe HScrollBarOrientation) + , ctxHScrollBarRenderer :: !(Maybe (HScrollbarRenderer n)) + , ctxVScrollBarShowHandles :: !Bool + , ctxHScrollBarShowHandles :: !Bool + , ctxVScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n)) + , ctxHScrollBarClickableConstr :: !(Maybe (ClickableScrollbarElement -> n -> n)) } suffixLenses ''RenderState diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -340,7 +340,7 @@ -- input text should not contain escape sequences or carriage returns. txt :: T.Text -> Widget n txt s = - -- Althoguh vty Image uses lazy Text internally, using lazy text at this + -- Although vty Image uses lazy Text internally, using lazy text at this -- level may not be an improvement. Indeed it can be much worse, due -- the overhead of lazy Text being significant compared to the typically -- short string content used to compose UIs. @@ -719,12 +719,11 @@ (concatMap extents allTranslatedResults) newBorders -catDynBorder - :: Lens' (Edges BorderSegment) BorderSegment - -> Lens' (Edges BorderSegment) BorderSegment - -> DynBorder - -> DynBorder - -> Maybe DynBorder +catDynBorder :: Lens' (Edges BorderSegment) BorderSegment + -> Lens' (Edges BorderSegment) BorderSegment + -> DynBorder + -> DynBorder + -> Maybe DynBorder catDynBorder towardsA towardsB a b -- Currently, we check if the 'BorderStyle's are exactly the same. In the -- future, it might be nice to relax this restriction. For example, if a @@ -742,12 +741,11 @@ = Just (a & dbSegmentsL.towardsB.bsDrawL .~ True) | otherwise = Nothing -catDynBorders - :: Lens' (Edges BorderSegment) BorderSegment - -> Lens' (Edges BorderSegment) BorderSegment - -> I.IMap DynBorder - -> I.IMap DynBorder - -> I.IMap DynBorder +catDynBorders :: Lens' (Edges BorderSegment) BorderSegment + -> Lens' (Edges BorderSegment) BorderSegment + -> I.IMap DynBorder + -> I.IMap DynBorder + -> I.IMap DynBorder catDynBorders towardsA towardsB am bm = I.mapMaybe id $ I.intersectionWith (catDynBorder towardsA towardsB) am bm @@ -757,9 +755,8 @@ -- images to keep the image in sync with the border information. -- -- The input borders are assumed to be disjoint. This property is not checked. -catBorders - :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image) - => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border) +catBorders :: (border ~ BM.BorderMap DynBorder, rewrite ~ I.IMap V.Image) + => BoxRenderer n -> border -> border -> ((rewrite, rewrite), border) catBorders br r l = if lCoord + 1 == rCoord then ((lRe, rRe), lr') else ((I.empty, I.empty), lr) @@ -788,20 +785,20 @@ -- overlap and are strictly increasing in the primary direction), produce: a -- list of rewrites for the lo and hi directions of each border, respectively, -- and the borders describing the fully concatenated object. -catAllBorders :: - BoxRenderer n -> - [BM.BorderMap DynBorder] -> - ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder) +catAllBorders :: BoxRenderer n + -> [BM.BorderMap DynBorder] + -> ([(I.IMap V.Image, I.IMap V.Image)], BM.BorderMap DynBorder) catAllBorders _ [] = ([], BM.empty) catAllBorders br (bm:bms) = (zip ([I.empty]++los) (his++[I.empty]), bm') where (rewrites, bm') = runState (traverse (state . catBorders br) bms) bm (his, los) = unzip rewrites -rewriteEdge :: - (Int -> V.Image -> V.Image) -> - (Int -> V.Image -> V.Image) -> - ([V.Image] -> V.Image) -> - I.IMap V.Image -> V.Image -> V.Image +rewriteEdge :: (Int -> V.Image -> V.Image) + -> (Int -> V.Image -> V.Image) + -> ([V.Image] -> V.Image) + -> I.IMap V.Image + -> V.Image + -> V.Image rewriteEdge splitLo splitHi combine = (combine .) . go . offsets 0 . I.unsafeToAscList where -- convert absolute positions into relative ones @@ -1115,8 +1112,11 @@ 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 + render $ Widget (hSize p) (vSize p) $ + withReaderT (availWidthL .~ amt) $ + cropResultToContext $ + addResultOffset (Location (-1 * cols, 0)) $ + result & imageL %~ cropped -- | Crop the specified widget to the specified size from the left. -- Defers to the cropped widget for growth policy. @@ -1138,7 +1138,8 @@ 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 + withReaderT (availWidthL .~ amt) $ + cropResultToContext $ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the right. -- Defers to the cropped widget for growth policy. @@ -1160,8 +1161,11 @@ 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 + render $ Widget (hSize p) (vSize p) $ + withReaderT (availHeightL .~ amt) $ + cropResultToContext $ + addResultOffset (Location (0, -1 * rows)) $ + result & imageL %~ cropped -- | Crop the specified widget to the specified size from the top. -- Defers to the cropped widget for growth policy. @@ -1183,7 +1187,8 @@ 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 + withReaderT (availHeightL .~ amt) $ + cropResultToContext $ result & imageL %~ cropped -- | Crop the specified widget to the specified size from the bottom. -- Defers to the cropped widget for growth policy. diff --git a/src/Brick/Widgets/FileBrowser.hs b/src/Brick/Widgets/FileBrowser.hs --- a/src/Brick/Widgets/FileBrowser.hs +++ b/src/Brick/Widgets/FileBrowser.hs @@ -71,6 +71,7 @@ , actionFileBrowserBeginSearch , actionFileBrowserSelectEnter , actionFileBrowserSelectCurrent + , actionFileBrowserToggleCurrent , actionFileBrowserListPageUp , actionFileBrowserListPageDown , actionFileBrowserListHalfPageUp @@ -158,7 +159,7 @@ import qualified Data.Set as Set import qualified Data.Vector as V import Lens.Micro -import Lens.Micro.Mtl ((%=)) +import Lens.Micro.Mtl ((%=), use) import Lens.Micro.TH (lensRules, generateUpdateableOptics) import qualified Graphics.Vty as Vty import qualified System.Directory as D @@ -602,7 +603,7 @@ -- -- * @/@: 'actionFileBrowserBeginSearch' -- * @Enter@: 'actionFileBrowserSelectEnter' --- * @Space@: 'actionFileBrowserSelectCurrent' +-- * @Space@: 'actionFileBrowserToggleCurrent' -- * @g@: 'actionFileBrowserListTop' -- * @G@: 'actionFileBrowserListBottom' -- * @j@: 'actionFileBrowserListNext' @@ -625,6 +626,10 @@ actionFileBrowserSelectCurrent = selectCurrentEntry +actionFileBrowserToggleCurrent :: EventM n (FileBrowser n) () +actionFileBrowserToggleCurrent = + toggleCurrentEntrySelected + actionFileBrowserListPageUp :: Ord n => EventM n (FileBrowser n) () actionFileBrowserListPageUp = zoom fileBrowserEntriesL listMovePageUp @@ -697,8 +702,8 @@ -- Select file or enter directory actionFileBrowserSelectEnter Vty.EvKey (Vty.KChar ' ') [] -> - -- Select entry - actionFileBrowserSelectCurrent + -- Toggle selected status of current entry + actionFileBrowserToggleCurrent _ -> handleFileBrowserEventCommon e @@ -728,9 +733,29 @@ _ -> zoom fileBrowserEntriesL $ handleListEvent e -markSelected :: FileInfo -> EventM n (FileBrowser n) () -markSelected e = fileBrowserSelectedFilesL %= Set.insert (fileInfoFilename e) +toggleSelected :: FileInfo -> EventM n (FileBrowser n) () +toggleSelected e = do + sel <- fileBrowserIsSelected e + if sel + then fileBrowserRemoveSelected e + else fileBrowserAddSelected e +fileBrowserIsSelected :: FileInfo -> EventM n (FileBrowser n) Bool +fileBrowserIsSelected e = do + fs <- use fileBrowserSelectedFilesL + let fName = fileInfoFilename e + return $ Set.member fName fs + +fileBrowserAddSelected :: FileInfo -> EventM n (FileBrowser n) () +fileBrowserAddSelected e = do + let fName = fileInfoFilename e + fileBrowserSelectedFilesL %= Set.insert fName + +fileBrowserRemoveSelected :: FileInfo -> EventM n (FileBrowser n) () +fileBrowserRemoveSelected e = do + let fName = fileInfoFilename e + fileBrowserSelectedFilesL %= Set.delete fName + -- | If the browser's current entry is selectable according to -- @fileBrowserSelectable@, add it to the selection set and return. -- If not, and if the entry is a directory or a symlink targeting a @@ -742,14 +767,23 @@ b <- get for_ (fileBrowserCursor b) $ \entry -> if fileBrowserSelectable b entry - then markSelected entry + then fileBrowserAddSelected entry else when (selectDirectories entry) $ put =<< liftIO (setWorkingDirectory (fileInfoFilePath entry) b) selectCurrentEntry :: EventM n (FileBrowser n) () selectCurrentEntry = do b <- get - for_ (fileBrowserCursor b) markSelected + for_ (fileBrowserCursor b) $ \entry -> + when (fileBrowserSelectable b entry) $ + fileBrowserAddSelected entry + +toggleCurrentEntrySelected :: EventM n (FileBrowser n) () +toggleCurrentEntrySelected = do + b <- get + for_ (fileBrowserCursor b) $ \entry -> + when (fileBrowserSelectable b entry) $ + toggleSelected entry -- | Render a file browser. This renders a list of entries in the -- working directory, a cursor to select from among the entries, a diff --git a/src/Brick/Widgets/Internal.hs b/src/Brick/Widgets/Internal.hs --- a/src/Brick/Widgets/Internal.hs +++ b/src/Brick/Widgets/Internal.hs @@ -40,7 +40,6 @@ resetRs = rs & reportedExtentsL .~ mempty & observedNamesL .~ mempty & clickableNamesL .~ mempty - & requestedVisibleNames_L .~ mempty (layerResults, !newRS) = flip runState resetRs $ sequence $ (\p -> runReaderT p ctx) <$> @@ -114,29 +113,31 @@ cropExtents :: Context n -> [Extent n] -> [Extent n] cropExtents ctx es = mapMaybe cropExtent es where - -- An extent is cropped in places where it is not within the - -- region described by the context. - -- - -- If its entirety is outside the context region, it is dropped. - -- - -- Otherwise its size is adjusted so that it is contained within - -- the context region. cropExtent (Extent n (Location (c, r)) (w, h)) = - -- Determine the new lower-right corner - let endCol = c + w - endRow = r + h - -- Then clamp the lower-right corner based on the - -- context - endCol' = min (ctx^.availWidthL) endCol - endRow' = min (ctx^.availHeightL) endRow - -- Then compute the new width and height from the - -- clamped lower-right corner. - w' = endCol' - c - h' = endRow' - r - e = Extent n (Location (c, r)) (w', h') - in if w' < 0 || h' < 0 - then Nothing - else Just e + -- Clamp the original extent's UL corner to the context. + -- + -- Clamp the original extent's LR corner to the context. + -- + -- Keep the modified extent (i.e. with clamped corners) + -- only if the resulting extent has non-zero size in both + -- dimensions. + let nonEmpty = nonEmptyH && nonEmptyV + nonEmptyH = newWidth > 0 + nonEmptyV = newHeight > 0 + newWidth = newEndCol - newStartCol + newHeight = newEndRow - newStartRow + (newStartCol, newStartRow) = clampCorner (c, r) + (newEndCol, newEndRow) = clampCorner (c + w, r + h) + clampCorner (cols, rows) = + ( clampRange (ctx^.availWidthL) cols + , clampRange (ctx^.availHeightL) rows + ) + clampRange bound val = + min bound $ max 0 val + newExtent = Extent n (Location (newStartCol, newStartRow)) (newWidth, newHeight) + in if nonEmpty + then Just newExtent + else Nothing cropBorders :: Context n -> BorderMap DynBorder -> BorderMap DynBorder cropBorders ctx = BM.crop Edges diff --git a/src/Brick/Widgets/List.hs b/src/Brick/Widgets/List.hs --- a/src/Brick/Widgets/List.hs +++ b/src/Brick/Widgets/List.hs @@ -63,6 +63,9 @@ , listReverse , listModify + -- * Querying a list + , listFindFirst + -- * Attributes , listAttr , listSelectedAttr @@ -577,6 +580,20 @@ -> GenericList n t e -> GenericList n t e listMoveToElement e = listFindBy (== e) . set listSelectedL Nothing + +-- | Find the first element in the list that satisfies the specified +-- predicate. If such an element is found, return the resulting index +-- and element. +-- +-- /O(n)/. +listFindFirst :: (Semigroup (t e), Splittable t, Traversable t) + => (e -> Bool) + -> GenericList n t e + -> Maybe (Int, e) +listFindFirst f l = + listSelectedElement $ + listFindBy f $ + set listSelectedL Nothing l -- | Starting from the currently-selected position, attempt to find -- and select the next element matching the predicate. If there are no diff --git a/tests/List.hs b/tests/List.hs --- a/tests/List.hs +++ b/tests/List.hs @@ -348,6 +348,15 @@ in l' ^. listSelectedL == Just 1 && l'' ^. listSelectedL == Just 3 +prop_listFindFirst :: Bool +prop_listFindFirst = + let v = L [1..5] :: L Int + l = list () v 1 + result1 = listFindFirst even l + result2 = listFindFirst (> 10) l + in result1 == Just (1, 2) && + result2 == Nothing + prop_listSelectedElement_lazy :: Bool prop_listSelectedElement_lazy = let v = L (1:2:3:4:undefined) :: L Int