Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-brick for openSUSE:Factory checked in at 2023-01-28 18:44:26 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-brick (Old) and /work/SRC/openSUSE:Factory/.ghc-brick.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-brick" Sat Jan 28 18:44:26 2023 rev:23 rq:1061626 version:1.6 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-brick/ghc-brick.changes 2023-01-18 13:09:50.296476379 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-brick.new.32243/ghc-brick.changes 2023-01-28 18:51:44.820806442 +0100 @@ -1,0 +2,27 @@ +Sun Jan 22 00:28:19 UTC 2023 - Peter Simons <[email protected]> + +- Update brick to version 1.6. + 1.6 + --- + + Package changes: + * Support `mtl` 2.3 (thanks Daniel Firth) + + API changes: + * `Brick.Widgets.Table` got a new `alignColumns` function that can be + used to do column layout of a list of widgets using `ColumnAlignment` + values from the table API. + * `Brick.Widgets.Table` got a new low-level table-rendering API for use + in applications that want to use the table layout machinery without + using `Table` itself. This includes: + * `tableCellLayout` - does table cell layout using table configuration + settings, + * `addBorders` - adds row, column, and surrounding borders using table + border-drawing settings, and + * `RenderedTableCells` and `BorderConfiguration` - the low-level types + used for the new functions. + + Other changes: + * Added a new `EditorLineNumbersDemo` demo program. + +------------------------------------------------------------------- Old: ---- brick-1.5.tar.gz New: ---- brick-1.6.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-brick.spec ++++++ --- /var/tmp/diff_new_pack.kePUCa/_old 2023-01-28 18:51:45.316809271 +0100 +++ /var/tmp/diff_new_pack.kePUCa/_new 2023-01-28 18:51:45.324809317 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-brick # -# Copyright (c) 2022 SUSE LLC +# Copyright (c) 2023 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name brick %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.5 +Version: 1.6 Release: 0 Summary: A declarative terminal user interface library License: BSD-3-Clause ++++++ brick-1.5.tar.gz -> brick-1.6.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/CHANGELOG.md new/brick-1.6/CHANGELOG.md --- old/brick-1.5/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-1.6/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -2,6 +2,29 @@ Brick changelog --------------- +1.6 +--- + +Package changes: +* Support `mtl` 2.3 (thanks Daniel Firth) + +API changes: +* `Brick.Widgets.Table` got a new `alignColumns` function that can be + used to do column layout of a list of widgets using `ColumnAlignment` + values from the table API. +* `Brick.Widgets.Table` got a new low-level table-rendering API for use + in applications that want to use the table layout machinery without + using `Table` itself. This includes: + * `tableCellLayout` - does table cell layout using table configuration + settings, + * `addBorders` - adds row, column, and surrounding borders using table + border-drawing settings, and + * `RenderedTableCells` and `BorderConfiguration` - the low-level types + used for the new functions. + +Other changes: +* Added a new `EditorLineNumbersDemo` demo program. + 1.5 --- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/README.md new/brick-1.6/README.md --- old/brick-1.5/README.md 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-1.6/README.md 2001-09-09 03:46:40.000000000 +0200 @@ -6,9 +6,10 @@ you provide a state transformation function to handle events. `brick` exposes a declarative API. Unlike most GUI toolkits which -require you to write a long and tedious sequence of "create a widget, -now bind an event handler", `brick` just requires you to describe your -interface using a set of declarative layout combinators. +require you to write a long and tedious sequence of widget creations +and layout setup, `brick` just requires you to describe your interface +using a set of declarative layout combinators. Event-handling is done by +pattern-matching on incoming events and updating your application state. Under the hood, this library builds upon [vty](http://hackage.haskell.org/package/vty), so some knowledge of Vty @@ -87,6 +88,10 @@ | [`htyper`](https://github.com/Simon-Hostettler/htyper) | A typing speed test program | | [`ullekha`](https://github.com/ajithnn/ullekha) | An interactive terminal notes/todo app with file/redis persistence | | [`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 | +| [`hic-hac-hoe`](https://github.com/blastwind/hic-hac-hoe) | Play tic tac toe in terminal! | +| [`babel-cards`](https://github.com/srhoulam/babel-cards) | A TUI spaced-repetition memorization tool. Similar to Anki. | +| [`codenames-haskell`](https://github.com/VigneshN1997/codenames-haskell) | An implementation of the Codenames game | +| [`haradict`](https://github.com/srhoulam/haradict) | A TUI Arabic dictionary powered by [ElixirFM](https://github.com/otakar-smrz/elixir-fm) | These third-party packages also extend `brick`: @@ -144,13 +149,14 @@ * A filesystem browser for file and directory selection * Borders can be configured to automatically connect! -Brick-Users Discussion ----------------------- +Brick Discussion +---------------- -The `brick-users` Google Group / e-mail list is a place to discuss -library changes, give feedback, and ask questions. You can subscribe at: +There are two forums for discussing brick-related things: -[https://groups.google.com/group/brick-users](https://groups.google.com/group/brick-users) +1. The [Discussions page](https://github.com/jtdaugherty/brick/discussions) on the github repo, and +1. The `brick-users` Google Group / e-mail list. You can subscribe + [here](https://groups.google.com/group/brick-users). Status ------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/brick.cabal new/brick-1.6/brick.cabal --- old/brick-1.5/brick.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-1.6/brick.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: brick -version: 1.5 +version: 1.6 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You @@ -415,6 +415,23 @@ text, microlens +executable brick-tabular-list-demo + if !flag(demos) + Buildable: False + hs-source-dirs: programs + ghc-options: -threaded -Wall -Wcompat -O2 + default-language: Haskell2010 + main-is: TabularListDemo.hs + build-depends: base, + brick, + vty, + text, + microlens >= 0.3.0.0, + microlens-mtl, + microlens-th, + mtl, + vector + executable brick-list-demo if !flag(demos) Buildable: False @@ -498,6 +515,23 @@ build-depends: base, brick, vty, + text, + vector, + mtl, + microlens >= 0.3.0.0, + microlens-th, + microlens-mtl + +executable brick-editor-line-numbers-demo + if !flag(demos) + Buildable: False + hs-source-dirs: programs + ghc-options: -threaded -Wall -Wcompat -O2 + default-language: Haskell2010 + main-is: EditorLineNumbersDemo.hs + build-depends: base, + brick, + vty, text, vector, mtl, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/docs/guide.rst new/brick-1.6/docs/guide.rst --- old/brick-1.5/docs/guide.rst 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-1.6/docs/guide.rst 2001-09-09 03:46:40.000000000 +0200 @@ -214,8 +214,8 @@ appHandleEvent :: BrickEvent n e -> EventM n s () ``appHandleEvent`` is responsible for deciding how to change the state -based on the event. The single parameter to the event handler is the -event to be handled. Its type variables ``n`` and ``e`` correspond +based on incoming events. The single parameter to the event handler is +the event to be handled. Its type variables ``n`` and ``e`` correspond to the *resource name type* and *event type* of your application, respectively, and must match the corresponding types in ``App`` and ``EventM``. @@ -254,11 +254,11 @@ in this monad by using ``liftIO``. Keep in mind, however, that event handlers should execute as quickly as possible to avoid introducing screen redraw latency. Consider using background threads to work -asynchronously when it would otherwise cause redraw latency. +asynchronously when handling an event would otherwise cause redraw +latency. -Beyond I/O, ``EventM`` is used to make scrolling requests to the -renderer (see `Viewports`_), obtain named extents (see `Extents`_), and -other duties. +``EventM`` is also used to make scrolling requests to the renderer (see +`Viewports`_), obtain named extents (see `Extents`_), and other duties. Event Handlers for Component State ********************************** diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/programs/EditorLineNumbersDemo.hs new/brick-1.6/programs/EditorLineNumbersDemo.hs --- old/brick-1.5/programs/EditorLineNumbersDemo.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/brick-1.6/programs/EditorLineNumbersDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,135 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} +module Main where + +import Control.Monad (void) +import Lens.Micro +import Lens.Micro.TH +import Lens.Micro.Mtl +import qualified Graphics.Vty as V +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup ((<>)) +#endif + +import qualified Brick.Main as M +import qualified Brick.Types as T +import Brick.Widgets.Core + ( (<+>) + , vBox + , hLimit + , vLimit + , str + , visible + , viewport + , withDefAttr + ) +import qualified Brick.Widgets.Center as C +import qualified Brick.Widgets.Edit as E +import qualified Brick.AttrMap as A +import Brick.Util (on, fg) + +data Name = Edit + | EditLines + deriving (Ord, Show, Eq) + +data St = + St { _edit :: E.Editor String Name + } + +makeLenses ''St + +drawUI :: St -> [T.Widget Name] +drawUI st = [ui] + where + e = renderWithLineNumbers (st^.edit) + ui = C.center $ hLimit 50 $ vLimit 10 e + +-- | Given an editor, render the editor with line numbers to the left of +-- the editor. +-- +-- This essentially exploits knowledge of how the editor is implemented: +-- we make a viewport containing line numbers that is just as high as +-- the editor, then request that the line number associated with the +-- editor's current line position be made visible, thus scrolling it +-- into view. This is slightly brittle, however, because it relies on +-- essentially keeping the line number viewport and the editor viewport +-- in the same vertical scrolling state; with direct scrolling requests +-- from EventM it is easily possible to put the two viewports into a +-- state where they do not have the same vertical scrolling offset. That +-- means that visibility requests made with 'visible' won't necessarily +-- have the same effect in each viewport in that case. So this is +-- only really usable in the case where you're sure that the editor's +-- viewport and the line number viewports will not be managed by direct +-- viewport operations in EventM. That's what I'd recommend anyway, but +-- still, this is an important caveat. +-- +-- There's another important caveat here: this particular implementation +-- has @O(n)@ performance for editor height @n@ because we generate +-- the entire list of line numbers on each rendering depending on the +-- height of the editor. That means that for sufficiently large files, +-- it will get more expensive to render the line numbers. There is a way +-- around this problem, which is to take the approach that the @List@ +-- implementation takes: only render a region of visible line numbers +-- around the currently-edited line that is just large enough to be +-- guaranteed to fill the viewport, then translate that so that it +-- appears at the right viewport offset, thus faking a viewport filled +-- with line numbers when in fact we'd only ever render at most @2 * K + +-- 1@ line numbers for a viewport height of @K@. That's more involved, +-- so I didn't do it here, but that would be the way to go for a Real +-- Application. +renderWithLineNumbers :: E.Editor String Name -> T.Widget Name +renderWithLineNumbers e = + lineNumbersVp <+> editorVp + where + lineNumbersVp = hLimit (maxNumWidth + 1) $ viewport EditLines T.Vertical body + editorVp = E.renderEditor (str . unlines) True e + body = withDefAttr lineNumberAttr $ vBox numWidgets + numWidgets = mkNumWidget <$> numbers + mkNumWidget i = maybeVisible i $ str $ show i + maybeVisible i + | i == curLine + 1 = + visible . withDefAttr currentLineNumberAttr + | otherwise = + id + numbers = [1..h] + contents = E.getEditContents e + h = length contents + curLine = fst $ E.getCursorPosition e + maxNumWidth = length $ show h + +appEvent :: T.BrickEvent Name e -> T.EventM Name St () +appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = + M.halt +appEvent ev = do + zoom edit $ E.handleEditorEvent ev + +initialState :: St +initialState = + St (E.editor Edit Nothing "") + +lineNumberAttr :: A.AttrName +lineNumberAttr = A.attrName "lineNumber" + +currentLineNumberAttr :: A.AttrName +currentLineNumberAttr = lineNumberAttr <> A.attrName "current" + +theMap :: A.AttrMap +theMap = A.attrMap V.defAttr + [ (E.editAttr, V.white `on` V.blue) + , (E.editFocusedAttr, V.black `on` V.yellow) + , (lineNumberAttr, fg V.cyan) + , (currentLineNumberAttr, V.defAttr `V.withStyle` V.bold) + ] + +theApp :: M.App St e Name +theApp = + M.App { M.appDraw = drawUI + , M.appChooseCursor = const $ M.showCursorNamed Edit + , M.appHandleEvent = appEvent + , M.appStartEvent = return () + , M.appAttrMap = const theMap + } + +main :: IO () +main = do + void $ M.defaultMain theApp initialState diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/programs/TabularListDemo.hs new/brick-1.6/programs/TabularListDemo.hs --- old/brick-1.5/programs/TabularListDemo.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/brick-1.6/programs/TabularListDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,146 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} +module Main where + +import Lens.Micro ((^.)) +import Lens.Micro.Mtl +import Lens.Micro.TH +import Control.Monad (void) +#if !(MIN_VERSION_base(4,11,0)) +import Data.Monoid +#endif +import qualified Graphics.Vty as V + +import qualified Brick.Main as M +import qualified Brick.Types as T +import qualified Brick.Widgets.Border as B +import qualified Brick.Widgets.List as L +import qualified Brick.Widgets.Center as C +import qualified Brick.Widgets.Table as Table +import qualified Brick.AttrMap as A +import qualified Data.Vector as Vec +import Brick.Types + ( Widget + ) +import Brick.Widgets.Core + ( (<=>) + , str + , vLimit + , hLimit + , vBox + , hBox + , withDefAttr + ) +import Brick.Util (on) + +data Row = Row String String String + +data AppState = + AppState { _tabularList :: L.List () Row + , _colIndex :: Int + } + +makeLenses ''AppState + +drawUI :: AppState -> [Widget ()] +drawUI s = [ui] + where + l = s^.tabularList + label = str $ "Row " <> cur <> " / col " <> show (s^.colIndex + 1) + cur = case l^.(L.listSelectedL) of + Nothing -> "-" + Just i -> show (i + 1) + box = B.borderWithLabel label $ + hLimit totalWidth $ + vLimit 15 $ + listDrawElement 0 False headerRow <=> + L.renderList (listDrawElement (s^.colIndex)) True l + ui = C.vCenter $ vBox [ C.hCenter box + , str " " + , C.hCenter $ str "Press +/- to add/remove list elements." + , C.hCenter $ str "Use arrow keys to change selection." + , C.hCenter $ str "Press Esc to exit." + ] + +appEvent :: T.BrickEvent () e -> T.EventM () AppState () +appEvent (T.VtyEvent e) = + case e of + V.EvKey (V.KChar '+') [] -> do + els <- use (tabularList.L.listElementsL) + let el = Row (show pos) (show $ pos * 3) (show $ pos * 9) + pos = Vec.length els + tabularList %= L.listInsert pos el + + V.EvKey (V.KChar '-') [] -> do + sel <- use (tabularList.L.listSelectedL) + case sel of + Nothing -> return () + Just i -> tabularList %= L.listRemove i + + V.EvKey V.KLeft [] -> + colIndex %= (\i -> max 0 (i - 1)) + V.EvKey V.KRight [] -> + colIndex %= (\i -> min (length columnAlignments - 1) (i + 1)) + + V.EvKey V.KEsc [] -> M.halt + + ev -> T.zoom tabularList $ L.handleListEvent ev +appEvent _ = return () + +listDrawElement :: Int -> Bool -> Row -> Widget () +listDrawElement colIdx sel (Row a b c) = + let ws = [str a, str b, str c] + maybeSelect es = selectCell <$> zip [0..] es + selectCell (i, w) = if sel && i == colIdx + then withDefAttr selectedCellAttr w + else w + in hLimit totalWidth $ + hBox $ + maybeSelect $ + Table.alignColumns columnAlignments columnWidths ws + +initialState :: AppState +initialState = + AppState { _tabularList = L.list () (Vec.fromList initialRows) 1 + , _colIndex = 0 + } + +selectedCellAttr :: A.AttrName +selectedCellAttr = A.attrName "selectedCell" + +theMap :: A.AttrMap +theMap = A.attrMap V.defAttr + [ (L.listAttr, V.white `on` V.blue) + , (selectedCellAttr, V.blue `on` V.white) + ] + +columnWidths :: [Int] +columnWidths = [10, 15, 20] + +totalWidth :: Int +totalWidth = sum columnWidths + +headerRow :: Row +headerRow = Row "Col 1" "Col 2" "Col 3" + +columnAlignments :: [Table.ColumnAlignment] +columnAlignments = [Table.AlignLeft, Table.AlignCenter, Table.AlignRight] + +initialRows :: [Row] +initialRows = + [ Row "one" "two" "three" + , Row "foo" "bar" "baz" + , Row "stuff" "things" "blah" + ] + +theApp :: M.App AppState e () +theApp = + M.App { M.appDraw = drawUI + , M.appChooseCursor = M.showFirstCursor + , M.appHandleEvent = appEvent + , M.appStartEvent = return () + , M.appAttrMap = const theMap + } + +main :: IO () +main = void $ M.defaultMain theApp initialState diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/src/Brick/Main.hs new/brick-1.6/src/Brick/Main.hs --- old/brick-1.5/src/Brick/Main.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-1.6/src/Brick/Main.hs 2001-09-09 03:46:40.000000000 +0200 @@ -54,6 +54,7 @@ import qualified Control.Exception as E import Lens.Micro ((^.), (&), (.~), (%~), _1, _2) +import Control.Monad import Control.Monad.State.Strict import Control.Monad.Reader import Control.Concurrent (forkIO, killThread) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/src/Brick/Widgets/Core.hs new/brick-1.6/src/Brick/Widgets/Core.hs --- old/brick-1.5/src/Brick/Widgets/Core.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-1.6/src/Brick/Widgets/Core.hs 2001-09-09 03:46:40.000000000 +0200 @@ -122,6 +122,7 @@ import Lens.Micro ((^.), (.~), (&), (%~), to, _1, _2, each, to, Lens') import Lens.Micro.Mtl (use, (%=)) +import Control.Monad import Control.Monad.State.Strict import Control.Monad.Reader import qualified Data.Foldable as F diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/src/Brick/Widgets/Internal.hs new/brick-1.6/src/Brick/Widgets/Internal.hs --- old/brick-1.5/src/Brick/Widgets/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-1.6/src/Brick/Widgets/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,6 +10,7 @@ import Lens.Micro ((^.), (&), (%~)) import Lens.Micro.Mtl ((%=)) +import Control.Monad import Control.Monad.State.Strict import Control.Monad.Reader import Data.Maybe (fromMaybe, mapMaybe) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-1.5/src/Brick/Widgets/Table.hs new/brick-1.6/src/Brick/Widgets/Table.hs --- old/brick-1.5/src/Brick/Widgets/Table.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-1.6/src/Brick/Widgets/Table.hs 2001-09-09 03:46:40.000000000 +0200 @@ -31,6 +31,13 @@ -- * Rendering , renderTable + + -- * Low-level API + , RenderedTableCells(..) + , BorderConfiguration(..) + , tableCellLayout + , addBorders + , alignColumns ) where @@ -90,11 +97,16 @@ , tableRows :: [[Widget n]] , defaultColumnAlignment :: ColumnAlignment , defaultRowAlignment :: RowAlignment - , drawSurroundingBorder :: Bool - , drawRowBorders :: Bool - , drawColumnBorders :: Bool + , tableBorderConfiguration :: BorderConfiguration } +-- | A border configuration for a table. +data BorderConfiguration = + BorderConfiguration { drawSurroundingBorder :: Bool + , drawRowBorders :: Bool + , drawColumnBorders :: Bool + } + -- | Construct a new table. -- -- The argument is the list of rows with the topmost row first, with @@ -148,27 +160,29 @@ t = Table { columnAlignments = mempty , rowAlignments = mempty , tableRows = rows - , drawSurroundingBorder = True - , drawRowBorders = True - , drawColumnBorders = True , defaultColumnAlignment = AlignLeft , defaultRowAlignment = AlignTop + , tableBorderConfiguration = + BorderConfiguration { drawSurroundingBorder = True + , drawRowBorders = True + , drawColumnBorders = True + } } -- | Configure whether the table draws a border on its exterior. surroundingBorder :: Bool -> Table n -> Table n surroundingBorder b t = - t { drawSurroundingBorder = b } + t { tableBorderConfiguration = (tableBorderConfiguration t) { drawSurroundingBorder = b } } -- | Configure whether the table draws borders between its rows. rowBorders :: Bool -> Table n -> Table n rowBorders b t = - t { drawRowBorders = b } + t { tableBorderConfiguration = (tableBorderConfiguration t) { drawRowBorders = b } } -- | Configure whether the table draws borders between its columns. columnBorders :: Bool -> Table n -> Table n columnBorders b t = - t { drawColumnBorders = b } + t { tableBorderConfiguration = (tableBorderConfiguration t) { drawColumnBorders = b } } -- | Align the specified column to the right. The argument is the column -- index, starting with zero. Silently does nothing if the index is out @@ -235,59 +249,103 @@ renderTable t = joinBorders $ Widget Fixed Fixed $ do - ctx <- getContext - cellResults <- forM (tableRows t) $ mapM render + tableCellLayout t >>= addBorders >>= render - let maybeIntersperse f v = if f t then intersperse v else id - rowHeights = rowHeight <$> cellResults - colWidths = colWidth <$> byColumn - allRowAligns = (\i -> M.findWithDefault (defaultRowAlignment t) i (rowAlignments t)) <$> - [0..length rowHeights - 1] - allColAligns = (\i -> M.findWithDefault (defaultColumnAlignment t) i (columnAlignments t)) <$> - [0..length byColumn - 1] - rowHeight = maximum . fmap (imageHeight . image) - colWidth = maximum . fmap (imageWidth . image) - byColumn = transpose cellResults - toW = Widget Fixed Fixed . return - fillEmptyCell w h result = - if imageWidth (image result) == 0 && imageHeight (image result) == 0 - then result { image = charFill (ctx^.attrL) ' ' w h } - else result - mkColumn (hAlign, width, colCells) = - let paddedCells = flip map (zip3 allRowAligns rowHeights colCells) $ \(vAlign, rHeight, cell) -> - applyColAlignment width hAlign $ - applyRowAlignment rHeight vAlign $ - toW $ - fillEmptyCell width rHeight cell - maybeRowBorders = maybeIntersperse drawRowBorders (hLimit width hBorder) - in vBox $ maybeRowBorders paddedCells - - vBorders = mkVBorder <$> rowHeights - hBorders = mkHBorder <$> colWidths - mkHBorder w = hLimit w hBorder - mkVBorder h = vLimit h vBorder - topBorder = - hBox $ maybeIntersperse drawColumnBorders topT hBorders - bottomBorder = - hBox $ maybeIntersperse drawColumnBorders bottomT hBorders - leftBorder = - vBox $ topLeftCorner : maybeIntersperse drawRowBorders leftT vBorders <> [bottomLeftCorner] - rightBorder = - vBox $ topRightCorner : maybeIntersperse drawRowBorders rightT vBorders <> [bottomRightCorner] - - maybeWrap check f = - if check t then f else id - addSurroundingBorder body = - leftBorder <+> (topBorder <=> body <=> bottomBorder) <+> rightBorder - addColumnBorders = - let maybeAddCrosses = maybeIntersperse drawRowBorders cross - columnBorder = vBox $ maybeAddCrosses vBorders - in intersperse columnBorder - - let columns = mkColumn <$> zip3 allColAligns colWidths byColumn - body = hBox $ - maybeWrap drawColumnBorders addColumnBorders columns - render $ maybeWrap drawSurroundingBorder addSurroundingBorder body +-- | The result of performing table cell intermediate rendering and +-- layout. +data RenderedTableCells n = + RenderedTableCells { renderedTableRows :: [[Widget n]] + -- ^ The table's cells in row-major order. + , renderedTableColumnWidths :: [Int] + -- ^ The widths of the table's columns. + , renderedTableRowHeights :: [Int] + -- ^ The heights of the table's rows. + , borderConfiguration :: BorderConfiguration + -- ^ The border configuration to use. + } + +-- | Augment rendered table cells with borders according to the +-- border configuration accompanying the cells. +addBorders :: RenderedTableCells n -> RenderM n (Widget n) +addBorders r = do + let cfg = borderConfiguration r + rows = renderedTableRows r + rowHeights = renderedTableRowHeights r + colWidths = renderedTableColumnWidths r + + contentWidth = sum colWidths + contentHeight = sum rowHeights + + hBorderLength = contentWidth + if drawColumnBorders cfg + then max (length colWidths - 1) 0 + else 0 + vBorderHeight = contentHeight + if drawRowBorders cfg + then max (length rowHeights - 1) 0 + else 0 + horizBorder = hLimit hBorderLength hBorder + vertBorder = vLimit vBorderHeight vBorder + + leftBorder = + vBox [topLeftCorner, vertBorder, bottomLeftCorner] + rightBorder = + vBox [topRightCorner, vertBorder, bottomRightCorner] + + maybeWrap check f = + if check cfg then f else id + addSurroundingBorder b = + leftBorder <+> (horizBorder <=> b <=> horizBorder) <+> rightBorder + addRowBorders = + intersperse horizBorder + + rowsWithColumnBorders = (\(h, row) -> hBox $ maybeColumnBorders h row) <$> zip rowHeights rows + maybeColumnBorders height = maybeIntersperse cfg drawColumnBorders (vLimit height vBorder) + body = vBox $ + maybeWrap drawRowBorders addRowBorders rowsWithColumnBorders + + return $ maybeWrap drawSurroundingBorder addSurroundingBorder body + +tableCellLayout :: Table n -> RenderM n (RenderedTableCells n) +tableCellLayout t = do + ctx <- getContext + cellResults <- forM (tableRows t) $ mapM render + + let rowHeights = rowHeight <$> cellResults + colWidths = colWidth <$> transpose cellResults + numRows = length rowHeights + numCols = if length cellResults >= 1 + then length (cellResults !! 0) + else 0 + allRowAligns = (\i -> M.findWithDefault (defaultRowAlignment t) i (rowAlignments t)) <$> + [0..numRows - 1] + allColAligns = (\i -> M.findWithDefault (defaultColumnAlignment t) i (columnAlignments t)) <$> + [0..numCols - 1] + rowHeight = maximum . fmap (imageHeight . image) + colWidth = maximum . fmap (imageWidth . image) + + toW = Widget Fixed Fixed . return + fillEmptyCell w h result = + if imageWidth (image result) == 0 && imageHeight (image result) == 0 + then result { image = charFill (ctx^.attrL) ' ' w h } + else result + mkRow (vAlign, height, rowCells) = + let paddedCells = flip map (zip3 allColAligns colWidths rowCells) $ \(hAlign, width, cell) -> + applyColAlignment width hAlign $ + applyRowAlignment height vAlign $ + toW $ + fillEmptyCell width height cell + in paddedCells + + let rows = mkRow <$> zip3 allRowAligns rowHeights cellResults + + return $ RenderedTableCells { renderedTableRows = rows + , renderedTableColumnWidths = colWidths + , renderedTableRowHeights = rowHeights + , borderConfiguration = tableBorderConfiguration t + } + +maybeIntersperse :: BorderConfiguration -> (BorderConfiguration -> Bool) -> Widget n -> [Widget n] -> [Widget n] +maybeIntersperse cfg f v | f cfg = intersperse v + | otherwise = id topLeftCorner :: Widget n topLeftCorner = joinableBorder $ Edges False True False True @@ -301,20 +359,20 @@ bottomRightCorner :: Widget n bottomRightCorner = joinableBorder $ Edges True False True False -cross :: Widget n -cross = joinableBorder $ Edges True True True True - -leftT :: Widget n -leftT = joinableBorder $ Edges True True False True - -rightT :: Widget n -rightT = joinableBorder $ Edges True True True False - -topT :: Widget n -topT = joinableBorder $ Edges False True True True - -bottomT :: Widget n -bottomT = joinableBorder $ Edges True False True True +-- | Given a "table row" of widgets, align each one according to the +-- list of specified column alignments in columns of the specified +-- widths. +alignColumns :: [ColumnAlignment] + -- ^ The column alignments to use for each widget, + -- respectively. + -> [Int] + -- ^ The width of each column in terminal columns, + -- respectively. + -> [Widget n] + -- ^ The column cells to align. + -> [Widget n] +alignColumns as widths cells = + (\(w, a, c) -> applyColAlignment w a c) <$> zip3 widths as cells applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n applyColAlignment width align w =
