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 2021-02-16 22:38:10 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-brick (Old) and /work/SRC/openSUSE:Factory/.ghc-brick.new.28504 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-brick" Tue Feb 16 22:38:10 2021 rev:11 rq:870860 version:0.60.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-brick/ghc-brick.changes 2021-01-08 17:39:53.952984905 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-brick.new.28504/ghc-brick.changes 2021-02-16 22:48:19.126550764 +0100 @@ -1,0 +2,46 @@ +Mon Feb 8 05:05:28 UTC 2021 - [email protected] + +- Update brick to version 0.60.2. + 0.60.2 + ------ + + Bug fixes: + * Widgets reported as `clickable` are now reported as clickable even + when their renderings are cached with `cached` (#307; thanks Hari + Menon) + +------------------------------------------------------------------- +Wed Feb 3 20:26:11 UTC 2021 - [email protected] + +- Update brick to version 0.60.1. + 0.60.1 + ------ + + Bug fixes: + * `table []` no longer raises `TEUnequalRowSizes`. + + 0.60 + ---- + + New features: + * Added `Brick.Widgets.Table` to support drawing basic tables. See + `programs/TableDemo.hs` for a demonstration (`cabal new-run -f demos + brick-table-demo`). + +------------------------------------------------------------------- +Fri Jan 29 10:26:08 UTC 2021 - [email protected] + +- Update brick to version 0.59. + 0.59 + ---- + + API changes: + * `Brick.Widgets.List` got `listMoveToBeginning` and `listMoveToEnd` + functions + * `Extent`: removed the unused `extentOffset` field + + Bug fixes: + * Fixed a crash in the border rewriting code that attempted to rewrite + empty images (#305) (thanks @dmwit) + +------------------------------------------------------------------- Old: ---- brick-0.58.1.tar.gz New: ---- brick-0.60.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-brick.spec ++++++ --- /var/tmp/diff_new_pack.0Jd1Dx/_old 2021-02-16 22:48:19.722551229 +0100 +++ /var/tmp/diff_new_pack.0Jd1Dx/_new 2021-02-16 22:48:19.722551229 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-brick # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2021 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: 0.58.1 +Version: 0.60.2 Release: 0 Summary: A declarative terminal user interface library License: BSD-3-Clause ++++++ brick-0.58.1.tar.gz -> brick-0.60.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/CHANGELOG.md new/brick-0.60.2/CHANGELOG.md --- old/brick-0.58.1/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -2,6 +2,40 @@ Brick changelog --------------- +0.60.2 +------ + +Bug fixes: + * Widgets reported as `clickable` are now reported as clickable even + when their renderings are cached with `cached` (#307; thanks Hari + Menon) + +0.60.1 +------ + +Bug fixes: + * `table []` no longer raises `TEUnequalRowSizes`. + +0.60 +---- + +New features: + * Added `Brick.Widgets.Table` to support drawing basic tables. See + `programs/TableDemo.hs` for a demonstration (`cabal new-run -f demos + brick-table-demo`). + +0.59 +---- + +API changes: + * `Brick.Widgets.List` got `listMoveToBeginning` and `listMoveToEnd` + functions + * `Extent`: removed the unused `extentOffset` field + +Bug fixes: + * Fixed a crash in the border rewriting code that attempted to rewrite + empty images (#305) (thanks @dmwit) + 0.58.1 ------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/README.md new/brick-0.60.2/README.md --- old/brick-0.58.1/README.md 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/README.md 2001-09-09 03:46:40.000000000 +0200 @@ -69,6 +69,8 @@ | [`hascard`](https://github.com/Yvee1/hascard) | A program for reviewing "flash card" notes | | [`ttyme`](https://github.com/evuez/ttyme) | A TUI for [Harvest](https://www.getharvest.com/) | | [`ghcup`](https://www.haskell.org/ghcup/) | A TUI for `ghcup`, the Haskell toolchain manager | +| [`cbookview`](https://github.com/mlang/chessIO) | A TUI for exploring polyglot chess opening book files | +| [`thock`](https://github.com/rmehri01/thock) | A modern TUI typing game featuring online racing against friends | These third-party packages also extend `brick`: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/brick.cabal new/brick-0.60.2/brick.cabal --- old/brick-0.58.1/brick.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/brick.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: brick -version: 0.58.1 +version: 0.60.2 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You @@ -105,6 +105,7 @@ Brick.Widgets.FileBrowser Brick.Widgets.List Brick.Widgets.ProgressBar + Brick.Widgets.Table Data.IMap Data.Text.Markup other-modules: @@ -139,6 +140,19 @@ if impl(ghc < 8.0) build-depends: semigroups +executable brick-table-demo + if !flag(demos) + Buildable: False + hs-source-dirs: programs + ghc-options: -threaded -Wall -Wcompat -O2 + default-language: Haskell2010 + default-extensions: CPP + main-is: TableDemo.hs + build-depends: base, + brick, + text, + vty + executable brick-tail-demo if !flag(demos) Buildable: False diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/docs/guide.rst new/brick-0.60.2/docs/guide.rst --- old/brick-0.58.1/docs/guide.rst 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/docs/guide.rst 2001-09-09 03:46:40.000000000 +0200 @@ -620,7 +620,7 @@ that will always consume the same number of rows or columns no matter how many it is given. Widgets can advertise different vertical and horizontal growth policies for example, the -``Brick.Widgets.Border.hCenter`` function centers a widget and is +``Brick.Widgets.Center.hCenter`` function centers a widget and is ``Greedy`` horizontally and defers to the widget it centers for vertical growth behavior. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/programs/TableDemo.hs new/brick-0.60.2/programs/TableDemo.hs --- old/brick-0.58.1/programs/TableDemo.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/brick-0.60.2/programs/TableDemo.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +module Main where + +#if !(MIN_VERSION_base(4,11,0)) +import Data.Monoid ((<>)) +#endif +import Brick +import Brick.Widgets.Table +import Brick.Widgets.Center (center) + +ui :: Widget () +ui = center $ renderTable leftTable <+> + padLeft (Pad 5) (renderTable rightTableA <=> + renderTable rightTableB <=> + renderTable rightTableC) + +innerTable :: Table () +innerTable = + surroundingBorder False $ + table [ [txt "inner", txt "table"] + , [txt "is", txt "here"] + ] + +leftTable :: Table () +leftTable = + alignCenter 1 $ + alignRight 2 $ + alignMiddle 2 $ + table [ [txt "Left", txt "Center", txt "Right"] + , [txt "X", txt "Some things", txt "A"] + , [renderTable innerTable, txt "are", txt "B"] + , [txt "Z", txt "centered", txt "C"] + ] + +rightTableA :: Table () +rightTableA = + rowBorders False $ + setDefaultColAlignment AlignCenter $ + table [ [txt "A", txt "without"] + , [txt "table", txt "row borders"] + ] + +rightTableB :: Table () +rightTableB = + columnBorders False $ + setDefaultColAlignment AlignCenter $ + table [ [txt "A", txt "table"] + , [txt "without", txt "column borders"] + ] + +rightTableC :: Table () +rightTableC = + surroundingBorder False $ + rowBorders False $ + columnBorders False $ + setDefaultColAlignment AlignCenter $ + table [ [txt "A", txt "table"] + , [txt "without", txt "any borders"] + ] + +main :: IO () +main = simpleMain ui diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/src/Brick/Main.hs new/brick-0.60.2/src/Brick/Main.hs --- old/brick-0.58.1/src/Brick/Main.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/src/Brick/Main.hs 2001-09-09 03:46:40.000000000 +0200 @@ -309,15 +309,15 @@ VtyEvent (EvMouseDown c r button mods) -> do let matching = findClickedExtents_ (c, r) exts case matching of - (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) -> + (Extent n (Location (ec, er)) _:_) -> -- If the clicked extent was registered as -- clickable, send a click event. Otherwise, just -- send the raw mouse event case n `elem` firstRS^.clickableNamesL of True -> do let localCoords = Location (lc, lr) - lc = c - ec + oC - lr = r - er + oR + lc = c - ec + lr = r - er -- If the clicked extent was a viewport, -- adjust the local coordinates by @@ -334,15 +334,15 @@ VtyEvent (EvMouseUp c r button) -> do let matching = findClickedExtents_ (c, r) exts case matching of - (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) -> + (Extent n (Location (ec, er)) _:_) -> -- If the clicked extent was registered as -- clickable, send a click event. Otherwise, just -- send the raw mouse event case n `elem` firstRS^.clickableNamesL of True -> do let localCoords = Location (lc, lr) - lc = c - ec + oC - lr = r - er + oR + lc = c - ec + lr = r - er -- If the clicked extent was a viewport, -- adjust the local coordinates by -- adding the viewport upper-left corner @@ -386,7 +386,7 @@ -- | Did the specified mouse coordinates (column, row) intersect the -- specified extent? clickedExtent :: (Int, Int) -> Extent n -> Bool -clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h) _) = +clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h)) = c >= lc && c < (lc + w) && r >= lr && r < (lr + h) @@ -395,7 +395,7 @@ lookupExtent :: (Eq n) => n -> EventM n (Maybe (Extent n)) lookupExtent n = EventM $ asks (listToMaybe . filter f . latestExtents) where - f (Extent n' _ _ _) = n == n' + f (Extent n' _ _) = n == n' -- | Given a mouse click location, return the extents intersected by the -- click. The returned extents are sorted such that the first extent in diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/src/Brick/Types/Internal.hs new/brick-0.60.2/src/Brick/Types/Internal.hs --- old/brick-0.58.1/src/Brick/Types/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/src/Brick/Types/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -123,7 +123,6 @@ data Extent n = Extent { extentName :: n , extentUpperLeft :: Location , extentSize :: (Int, Int) - , extentOffset :: Location } deriving (Show, Read, Generic, NFData) @@ -250,7 +249,7 @@ RS { viewportMap :: !(M.Map n Viewport) , rsScrollRequests :: ![(n, ScrollRequest)] , observedNames :: !(S.Set n) - , renderCache :: !(M.Map n (Result n)) + , renderCache :: !(M.Map n ([n], Result n)) , clickableNames :: ![n] } deriving (Read, Show, Generic, NFData) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/src/Brick/Widgets/Core.hs new/brick-0.60.2/src/Brick/Widgets/Core.hs --- old/brick-0.58.1/src/Brick/Widgets/Core.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/src/Brick/Widgets/Core.hs 2001-09-09 03:46:40.000000000 +0200 @@ -196,7 +196,7 @@ addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>) addExtentOffset :: Location -> Result n -> Result n -addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz o) -> Extent n (off <> l) sz o) +addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz) -> Extent n (off <> l) sz) addDynBorderOffset :: Location -> Result n -> Result n addDynBorderOffset off r = r & bordersL %~ BM.translate off @@ -207,7 +207,7 @@ reportExtent n p = Widget (hSize p) (vSize p) $ do result <- render p - let ext = Extent n (Location (0, 0)) sz (Location (0, 0)) + let ext = Extent n (Location (0, 0)) sz sz = ( result^.imageL.to V.imageWidth , result^.imageL.to V.imageHeight ) @@ -753,13 +753,13 @@ size = imagePrimary br old go = rewriteEdge (splitLoSecondary br) (splitHiSecondary br) (concatenateSecondary br) rewriteLo img - | I.null loRewrite = img + | I.null loRewrite || size == 0 = img | otherwise = concatenatePrimary br [ go loRewrite (splitLoPrimary br 1 img) , splitHiPrimary br 1 img ] rewriteHi img - | I.null hiRewrite = img + | I.null hiRewrite || size == 0 = img | otherwise = concatenatePrimary br [ splitLoPrimary br (size-1) img , go hiRewrite (splitHiPrimary br (size-1) img) @@ -958,10 +958,14 @@ withReaderT (& availHeightL .~ unrestricted) (render p) Greedy -> Nothing --- | Render the specified widget. If the widget has an entry in the --- rendering cache using the specified name as the cache key, use the --- rendered version from the cache instead. If not, render the widget --- and update the cache. +-- | If the specified resource name has an entry in the rendering cache, +-- use the rendered version from the cache. If not, render the specified +-- widget and update the cache with the result. +-- +-- To ensure that mouse events are emitted correctly for cached widgets, +-- in addition to the rendered widget, we also cache (the names of) +-- any clickable extents that were rendered and restore that when utilizing +-- the cache. -- -- See also 'invalidateCacheEntry'. cached :: (Ord n) => n -> Widget n -> Widget n @@ -969,18 +973,29 @@ Widget (hSize w) (vSize w) $ do result <- cacheLookup n case result of - Just prevResult -> return prevResult + Just (clickables, prevResult) -> do + clickableNamesL %= (clickables ++) + return prevResult Nothing -> do wResult <- render w - cacheUpdate n wResult + clickables <- renderedClickables wResult + cacheUpdate n (clickables, wResult) return wResult + where + -- Given the rendered result of a Widget, collect the list of "clickable" names + -- from the extents that were in the result. + renderedClickables :: (Ord n) => Result n -> RenderM n [n] + renderedClickables renderResult = do + allClickables <- use clickableNamesL + return [extentName e | e <- renderResult^.extentsL, extentName e `elem` allClickables] + -cacheLookup :: (Ord n) => n -> RenderM n (Maybe (Result n)) +cacheLookup :: (Ord n) => n -> RenderM n (Maybe ([n], Result n)) cacheLookup n = do cache <- lift $ gets (^.renderCacheL) return $ M.lookup n cache -cacheUpdate :: (Ord n) => n -> Result n -> RenderM n () +cacheUpdate :: (Ord n) => n -> ([n], Result n) -> RenderM n () cacheUpdate n r = lift $ modify (& renderCacheL %~ M.insert n r) -- | Render the specified widget in a named viewport with the diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/src/Brick/Widgets/Internal.hs new/brick-0.60.2/src/Brick/Widgets/Internal.hs --- old/brick-0.58.1/src/Brick/Widgets/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/src/Brick/Widgets/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -97,14 +97,10 @@ -- -- Otherwise its size and upper left corner are adjusted so that -- they are contained within the context region. - cropExtent (Extent n (Location (c, r)) (w, h) (Location (oC, oR))) = + cropExtent (Extent n (Location (c, r)) (w, h)) = -- First, clamp the upper-left corner to at least (0, 0). let c' = max c 0 r' = max r 0 - -- Compute deltas for the offset since if the upper-left - -- corner moved, so should the offset. - dc = c' - c - dr = r' - r -- Then, determine the new lower-right corner based on -- the clamped corner. endCol = c' + w @@ -117,7 +113,7 @@ -- clamped lower-right corner. w' = endCol' - c' h' = endRow' - r' - e = Extent n (Location (c', r')) (w', h') (Location (oC + dc, oR + dr)) + e = Extent n (Location (c', r')) (w', h') in if w' < 0 || h' < 0 then Nothing else Just e diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/src/Brick/Widgets/List.hs new/brick-0.60.2/src/Brick/Widgets/List.hs --- old/brick-0.58.1/src/Brick/Widgets/List.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/brick-0.60.2/src/Brick/Widgets/List.hs 2001-09-09 03:46:40.000000000 +0200 @@ -55,6 +55,8 @@ , listMoveByPages , listMovePageUp , listMovePageDown + , listMoveToBeginning + , listMoveToEnd , listInsert , listRemove , listReplace @@ -203,8 +205,8 @@ case e of EvKey KUp [] -> return $ listMoveUp theList EvKey KDown [] -> return $ listMoveDown theList - EvKey KHome [] -> return $ listMoveTo 0 theList - EvKey KEnd [] -> return $ listMoveTo (length $ listElements theList) theList + EvKey KHome [] -> return $ listMoveToBeginning theList + EvKey KEnd [] -> return $ listMoveToEnd theList EvKey KPageDown [] -> listMovePageDown theList EvKey KPageUp [] -> listMovePageUp theList _ -> return theList @@ -233,14 +235,26 @@ case e of EvKey (KChar 'k') [] -> return $ listMoveUp theList EvKey (KChar 'j') [] -> return $ listMoveDown theList - EvKey (KChar 'g') [] -> return $ listMoveTo 0 theList - EvKey (KChar 'G') [] -> return $ listMoveTo (length $ listElements theList) theList + EvKey (KChar 'g') [] -> return $ listMoveToBeginning theList + EvKey (KChar 'G') [] -> return $ listMoveToEnd theList EvKey (KChar 'f') [MCtrl] -> listMovePageDown theList EvKey (KChar 'b') [MCtrl] -> listMovePageUp theList EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double) theList EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double) theList _ -> fallback e theList +-- | Move the list selection to the first element in the list. +listMoveToBeginning :: (Foldable t, Splittable t) + => GenericList n t e + -> GenericList n t e +listMoveToBeginning = listMoveTo 0 + +-- | Move the list selection to the last element in the list. +listMoveToEnd :: (Foldable t, Splittable t) + => GenericList n t e + -> GenericList n t e +listMoveToEnd l = listMoveTo (length $ listElements l) l + -- | The top-level attribute used for the entire list. listAttr :: AttrName listAttr = "list" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/brick-0.58.1/src/Brick/Widgets/Table.hs new/brick-0.60.2/src/Brick/Widgets/Table.hs --- old/brick-0.58.1/src/Brick/Widgets/Table.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/brick-0.60.2/src/Brick/Widgets/Table.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,250 @@ +-- | Support for basic table drawing. +module Brick.Widgets.Table + ( + -- * Types + Table + , ColumnAlignment(..) + , RowAlignment(..) + , TableException(..) + + -- * Construction + , table + + -- * Configuration + , alignLeft + , alignRight + , alignCenter + , alignTop + , alignMiddle + , alignBottom + , setColAlignment + , setRowAlignment + , setDefaultColAlignment + , setDefaultRowAlignment + , surroundingBorder + , rowBorders + , columnBorders + + -- * Rendering + , renderTable + ) +where + +import Control.Monad (forM) +import qualified Control.Exception as E +import Data.List (transpose, intersperse, nub) +import qualified Data.Map as M +import Graphics.Vty (imageHeight, imageWidth) + +import Brick.Types +import Brick.Widgets.Core +import Brick.Widgets.Center +import Brick.Widgets.Border + +-- | Column alignment modes. +data ColumnAlignment = + AlignLeft + -- ^ Align all cells to the left. + | AlignCenter + -- ^ Center the content horizontally in all cells in the column. + | AlignRight + -- ^ Align all cells to the right. + deriving (Eq, Show, Read) + +-- | Row alignment modes. +data RowAlignment = + AlignTop + -- ^ Align all cells to the top. + | AlignMiddle + -- ^ Center the content vertically in all cells in the row. + | AlignBottom + -- ^ Align all cells to the bottom. + deriving (Eq, Show, Read) + +-- | A table creation exception. +data TableException = + TEUnequalRowSizes + -- ^ Rows did not all have the same number of cells. + | TEInvalidCellSizePolicy + -- ^ Some cells in the table did not use the 'Fixed' size policy for + -- both horizontal and vertical sizing. + deriving (Eq, Show, Read) + +instance E.Exception TableException where + +-- | A table data structure. +data Table n = + Table { columnAlignments :: M.Map Int ColumnAlignment + , rowAlignments :: M.Map Int RowAlignment + , tableRows :: [[Widget n]] + , defaultColumnAlignment :: ColumnAlignment + , defaultRowAlignment :: RowAlignment + , drawSurroundingBorder :: Bool + , drawRowBorders :: Bool + , drawColumnBorders :: Bool + } + +-- | Construct a new table. +-- +-- The argument is the list of rows, with each element of the argument +-- list being the columns of the respective row. +-- +-- By default, all columns are left-aligned. Use the alignment functions +-- in this module to change that behavior. +-- +-- By default, all rows are top-aligned. Use the alignment functions in +-- this module to change that behavior. +-- +-- By default, the table will draw borders between columns, between +-- rows, and around the outside of the table. Border-drawing behavior +-- can be configured with the API in this module. Note that tables +-- always draw with 'joinBorders' enabled. +-- +-- All cells of all rows MUST use the 'Fixed' growth policy for both +-- horizontal and vertical growth. If the argument list contains +-- any cells that use the 'Greedy' policy, this will raise a +-- 'TableException'. +-- +-- All rows must have the same number of cells. If not, this will raise +-- a 'TableException'. +table :: [[Widget n]] -> Table n +table rows = + if not allFixed + then E.throw TEInvalidCellSizePolicy + else if not allSameLength + then E.throw TEUnequalRowSizes + else t + where + allSameLength = length (nub (length <$> rows)) <= 1 + allFixed = all fixedRow rows + fixedRow = all fixedCell + fixedCell w = hSize w == Fixed && vSize w == Fixed + t = Table { columnAlignments = mempty + , rowAlignments = mempty + , tableRows = rows + , drawSurroundingBorder = True + , drawRowBorders = True + , drawColumnBorders = True + , defaultColumnAlignment = AlignLeft + , defaultRowAlignment = AlignTop + } + +-- | Configure whether the table draws a border on its exterior. +surroundingBorder :: Bool -> Table n -> Table n +surroundingBorder b t = + t { drawSurroundingBorder = b } + +-- | Configure whether the table draws borders between its rows. +rowBorders :: Bool -> Table n -> Table n +rowBorders b t = + t { drawRowBorders = b } + +-- | Configure whether the table draws borders between its columns. +columnBorders :: Bool -> Table n -> Table n +columnBorders b t = + t { drawColumnBorders = b } + +-- | Align the specified column to the right. The argument is the column +-- index, starting with zero. +alignRight :: Int -> Table n -> Table n +alignRight = setColAlignment AlignRight + +-- | Align the specified column to the left. The argument is the column +-- index, starting with zero. +alignLeft :: Int -> Table n -> Table n +alignLeft = setColAlignment AlignLeft + +-- | Align the specified column to center. The argument is the column +-- index, starting with zero. +alignCenter :: Int -> Table n -> Table n +alignCenter = setColAlignment AlignCenter + +-- | Align the specified row to the top. The argument is the row index, +-- starting with zero. +alignTop :: Int -> Table n -> Table n +alignTop = setRowAlignment AlignTop + +-- | Align the specified row to the middle. The argument is the row +-- index, starting with zero. +alignMiddle :: Int -> Table n -> Table n +alignMiddle = setRowAlignment AlignMiddle + +-- | Align the specified row to bottom. The argument is the row index, +-- starting with zero. +alignBottom :: Int -> Table n -> Table n +alignBottom = setRowAlignment AlignBottom + +-- | Set the alignment for the specified column index (starting at +-- zero). +setColAlignment :: ColumnAlignment -> Int -> Table n -> Table n +setColAlignment a col t = + t { columnAlignments = M.insert col a (columnAlignments t) } + +-- | Set the alignment for the specified row index (starting at +-- zero). +setRowAlignment :: RowAlignment -> Int -> Table n -> Table n +setRowAlignment a row t = + t { rowAlignments = M.insert row a (rowAlignments t) } + +-- | Set the default column alignment for columns with no explicitly +-- configured alignment. +setDefaultColAlignment :: ColumnAlignment -> Table n -> Table n +setDefaultColAlignment a t = + t { defaultColumnAlignment = a } + +-- | Set the default row alignment for rows with no explicitly +-- configured alignment. +setDefaultRowAlignment :: RowAlignment -> Table n -> Table n +setDefaultRowAlignment a t = + t { defaultRowAlignment = a } + +-- | Render the table. +renderTable :: Table n -> Widget n +renderTable t = + joinBorders $ + (if drawSurroundingBorder t then border else id) $ + Widget Fixed Fixed $ do + let rows = tableRows t + cellResults <- forM rows $ mapM render + let 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 + totalHeight = sum rowHeights + applyColAlignment align width w = + Widget Fixed Fixed $ do + result <- render w + case align of + AlignLeft -> return result + AlignCenter -> render $ hLimit width $ hCenter $ toW result + AlignRight -> render $ + padLeft (Pad (width - imageWidth (image result))) $ + toW result + applyRowAlignment rHeight align result = + case align of + AlignTop -> toW result + AlignMiddle -> vLimit rHeight $ vCenter $ toW result + AlignBottom -> vLimit rHeight $ padTop Max $ toW result + mkColumn (hAlign, width, colCells) = do + let paddedCells = flip map (zip3 allRowAligns rowHeights colCells) $ \(vAlign, rHeight, cell) -> + applyColAlignment hAlign width $ + applyRowAlignment rHeight vAlign cell + maybeRowBorders = if drawRowBorders t + then intersperse (hLimit width hBorder) + else id + render $ vBox $ maybeRowBorders paddedCells + columns <- mapM mkColumn $ zip3 allColAligns colWidths byColumn + let maybeColumnBorders = + if drawColumnBorders t + then let rowBorderHeight = if drawRowBorders t + then length rows - 1 + else 0 + in intersperse (vLimit (totalHeight + rowBorderHeight) vBorder) + else id + render $ hBox $ maybeColumnBorders $ toW <$> columns
