lib,cli,ui: Use WideBuilder for Tabular.AsciiWide.

Move WideBuilder to Text.WideString.

hledger-lib/Hledger/Reports/BudgetReport.hs

@@ -259,11 +259,14 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
     -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells
     showcell :: (Int, Int, Int) -> BudgetDisplayCell -> Cell
     showcell (actualwidth, budgetwidth, percentwidth) ((actual,wa), mbudget) =
-        Cell TopRight [(T.replicate (actualwidth - wa) " " <> actual <> budgetstr, actualwidth + totalbudgetwidth)]
+        Cell TopRight [WideBuilder ( TB.fromText (T.replicate (actualwidth - wa) " ")
+                                   <> TB.fromText actual
+                                   <> budgetstr
+                                   ) (actualwidth + totalbudgetwidth)]
       where
         totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
         totalbudgetwidth  = if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3
-        budgetstr = case mbudget of
+        budgetstr = TB.fromText $ case mbudget of
           Nothing                             -> T.replicate totalbudgetwidth " "
           Just ((budget, wb), Nothing)        -> " [" <> T.replicate totalpercentwidth " " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"
           Just ((budget, wb), Just (pct, wp)) -> " [" <> T.replicate (percentwidth - wp) " " <> pct <> "% of " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"

hledger-lib/Hledger/Utils/String.hs

@@ -64,8 +64,8 @@ import Text.Printf (printf)
 import Hledger.Utils.Parse
 import Hledger.Utils.Regex (toRegex', regexReplace)
 import Text.Tabular (Header(..), Properties(..))
-import Text.Tabular.AsciiWide (Align(..), Cell(..), TableOpts(..), renderRow)
+import Text.Tabular.AsciiWide (Align(..), TableOpts(..), alignCell, renderRow)
-import Text.WideString (charWidth, strWidth, textWidth)
+import Text.WideString (charWidth, strWidth)
 
 
 -- | Take elements from the end of a list.
@@ -188,14 +188,14 @@ unbracket s
 concatTopPadded :: [String] -> String
 concatTopPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}
                 . Group NoLine . map (Header . cell)
-  where cell = Cell BottomLeft . map (\x -> (x, textWidth x)) . T.lines . T.pack
+  where cell = alignCell BottomLeft . T.pack
 
 -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.
 -- Treats wide characters as double width.
 concatBottomPadded :: [String] -> String
 concatBottomPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}
                    . Group NoLine . map (Header . cell)
-  where cell = Cell TopLeft . map (\x -> (x, textWidth x)) . T.lines . T.pack
+  where cell = alignCell TopLeft . T.pack
 
 
 -- | Join multi-line strings horizontally, after compressing each of

hledger-lib/Hledger/Utils/Text.hs

@@ -47,6 +47,7 @@ module Hledger.Utils.Text
   fitText,
  -- -- * wide-character-aware layout
   WideBuilder(..),
+  wbToText,
   wbUnpack,
   textWidth,
   textTakeWidth,
@@ -68,32 +69,13 @@ import Data.Monoid
 #endif
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Builder as TB
 -- import Text.Parsec
 -- import Text.Printf (printf)
 
 -- import Hledger.Utils.Parse
 -- import Hledger.Utils.Regex
 import Hledger.Utils.Test
-import Text.WideString (charWidth, textWidth)
+import Text.WideString (WideBuilder(..), wbToText, wbUnpack, charWidth, textWidth)
-
-
--- | Helper for constructing Builders while keeping track of text width.
-data WideBuilder = WideBuilder
-  { wbBuilder :: !TB.Builder
-  , wbWidth   :: !Int
-  }
-
-instance Semigroup WideBuilder where
-  WideBuilder x i <> WideBuilder y j = WideBuilder (x <> y) (i + j)
-
-instance Monoid WideBuilder where
-  mempty = WideBuilder mempty 0
-
--- | Unpack a WideBuilder to a String.
-wbUnpack :: WideBuilder -> String
-wbUnpack = TL.unpack . TB.toLazyText . wbBuilder
 
 
 -- lowercase, uppercase :: String -> String

hledger-lib/Text/Tabular/AsciiWide.hs

@@ -15,7 +15,7 @@ import qualified Data.Text.Lazy as TL
 import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText)
 import Safe (maximumMay)
 import Text.Tabular
-import Text.WideString (textWidth)
+import Text.WideString (WideBuilder(..), textWidth)
 
 
 -- | The options to use for rendering a table.
@@ -32,8 +32,7 @@ instance Default TableOpts where
                   }
 
 -- | Cell contents along an alignment
-data Cell = Cell Align [(Text, Int)]
+data Cell = Cell Align [WideBuilder]
-    deriving (Show)
 
 -- | How to align text in a cell
 data Align = TopRight | BottomRight | BottomLeft | TopLeft
@@ -44,11 +43,11 @@ emptyCell = Cell TopRight []
 
 -- | Create a single-line cell from the given contents with its natural width.
 alignCell :: Align -> Text -> Cell
-alignCell a x = Cell a [(x, textWidth x)]
+alignCell a x = Cell a . map (\x -> WideBuilder (fromText x) (textWidth x)) $ if T.null x then [""] else T.lines x
 
 -- | Return the width of a Cell.
 cellWidth :: Cell -> Int
-cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map snd xs
+cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map wbWidth xs
 
 
 -- | Render a table according to common options, for backwards compatibility
@@ -57,7 +56,7 @@ render pretty fr fc f = renderTable def{prettyTable=pretty} (cell . fr) (cell .
   where cell = alignCell TopRight
 
 -- | Render a table according to various cell specifications>
-renderTable :: TableOpts         -- ^ Options controlling Table rendering
+renderTable :: TableOpts       -- ^ Options controlling Table rendering
             -> (rh -> Cell)  -- ^ Rendering function for row headers
             -> (ch -> Cell)  -- ^ Rendering function for column headers
             -> (a -> Cell)   -- ^ Function determining the string and width of a cell
@@ -66,7 +65,7 @@ renderTable :: TableOpts         -- ^ Options controlling Table rendering
 renderTable topts fr fc f = toLazyText . renderTableB topts fr fc f
 
 -- | A version of renderTable which returns the underlying Builder.
-renderTableB :: TableOpts         -- ^ Options controlling Table rendering
+renderTableB :: TableOpts       -- ^ Options controlling Table rendering
              -> (rh -> Cell)  -- ^ Rendering function for row headers
              -> (ch -> Cell)  -- ^ Rendering function for column headers
              -> (a -> Cell)   -- ^ Function determining the string and width of a cell
@@ -109,7 +108,7 @@ renderRow topts = toLazyText . renderRowB topts
 -- | A version of renderRow which returns the underlying Builder.
 renderRowB:: TableOpts -> Header Cell -> Builder
 renderRowB topts h = renderColumns topts is h
-  where is = map (\(Cell _ xs) -> fromMaybe 0 . maximumMay $ map snd xs) $ headerContents h
+  where is = map cellWidth $ headerContents h
 
 
 verticalBar :: Bool -> Char
@@ -143,16 +142,16 @@ renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=s
     . zipHeader 0 is $ padRow <$> h  -- Pad cell height and add width marker
   where
     -- Pad each cell to have the appropriate width
-    padCell (w, Cell TopLeft     ls) = map (\(x,xw) -> fromText x <> fromText (T.replicate (w - xw) " ")) ls
+    padCell (w, Cell TopLeft     ls) = map (\x -> wbBuilder x <> fromText (T.replicate (w - wbWidth x) " ")) ls
-    padCell (w, Cell BottomLeft  ls) = map (\(x,xw) -> fromText x <> fromText (T.replicate (w - xw) " ")) ls
+    padCell (w, Cell BottomLeft  ls) = map (\x -> wbBuilder x <> fromText (T.replicate (w - wbWidth x) " ")) ls
-    padCell (w, Cell TopRight    ls) = map (\(x,xw) -> fromText (T.replicate (w - xw) " ") <> fromText x) ls
+    padCell (w, Cell TopRight    ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls
-    padCell (w, Cell BottomRight ls) = map (\(x,xw) -> fromText (T.replicate (w - xw) " ") <> fromText x) ls
+    padCell (w, Cell BottomRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls
 
     -- Pad each cell to have the same number of lines
-    padRow (Cell TopLeft     ls) = Cell TopLeft     $ ls ++ replicate (nLines - length ls) ("",0)
+    padRow (Cell TopLeft     ls) = Cell TopLeft     $ ls ++ replicate (nLines - length ls) mempty
-    padRow (Cell TopRight    ls) = Cell TopRight    $ ls ++ replicate (nLines - length ls) ("",0)
+    padRow (Cell TopRight    ls) = Cell TopRight    $ ls ++ replicate (nLines - length ls) mempty
-    padRow (Cell BottomLeft  ls) = Cell BottomLeft  $ replicate (nLines - length ls) ("",0) ++ ls
+    padRow (Cell BottomLeft  ls) = Cell BottomLeft  $ replicate (nLines - length ls) mempty ++ ls
-    padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) ("",0) ++ ls
+    padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) mempty ++ ls
 
     hsep :: Properties -> [Builder]
     hsep NoLine     = replicate nLines $ if spaces then "  " else ""

hledger-lib/Text/WideString.hs

@@ -4,11 +4,38 @@ module Text.WideString (
   -- * wide-character-aware layout
   strWidth,
   textWidth,
-  charWidth
+  charWidth,
+  -- * Text Builders which keep track of length
+  WideBuilder(..),
+  wbUnpack,
+  wbToText
   ) where
 
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
+
+
+-- | Helper for constructing Builders while keeping track of text width.
+data WideBuilder = WideBuilder
+  { wbBuilder :: !TB.Builder
+  , wbWidth   :: !Int
+  }
+
+instance Semigroup WideBuilder where
+  WideBuilder x i <> WideBuilder y j = WideBuilder (x <> y) (i + j)
+
+instance Monoid WideBuilder where
+  mempty = WideBuilder mempty 0
+
+-- | Convert a WideBuilder to a strict Text.
+wbToText :: WideBuilder -> Text
+wbToText = TL.toStrict . TB.toLazyText . wbBuilder
+
+-- | Convert a WideBuilder to a String.
+wbUnpack :: WideBuilder -> String
+wbUnpack = TL.unpack . TB.toLazyText . wbBuilder
 
 
 -- | Calculate the render width of a string, considering

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -97,7 +97,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec
                             ,rsItemBalanceAmount = showamt bal
                             ,rsItemTransaction   = t
                             }
-            where showamt = \((WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w))
+            where showamt = (\wb -> (wbUnpack wb, wbWidth wb))
                           . showMixed oneLine{displayMaxWidth=Just 32}
     -- blank items are added to allow more control of scroll position; we won't allow movement over these.
     -- XXX Ugly. Changing to 0 helps when debugging.

hledger/Hledger/Cli/Commands/Balance.hs

@@ -420,27 +420,25 @@ renderBalanceReportItem opts (acctname, depth, total) =
                     , map cellWidth is )
 
     render topaligned oneline = map (maybeConcat . renderComponent topaligned opts (acctname, depth, total))
-      where maybeConcat (Cell a xs) = if oneline then Cell a [(T.intercalate ", " strs, width)]
+      where maybeConcat (Cell a xs) =
-                                                 else Cell a xs
+                if oneline then Cell a [WideBuilder (mconcat . intersperse (TB.fromText ", ") $ map wbBuilder xs) width]
-              where
+                           else Cell a xs
-                (strs, ws) = unzip xs
+              where width = sumStrict (map ((+2) . wbWidth) xs) -2
-                width = sumStrict (map (+2) ws) -2
 
 
 -- | Render one StringFormat component for a balance report item.
 renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell
-renderComponent _ _ _ (FormatLiteral s) = Cell TopLeft . map (\x -> (x, textWidth x)) $ T.lines s
+renderComponent _ _ _ (FormatLiteral s) = alignCell TopLeft s
 renderComponent topaligned opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of
-    DepthSpacerField -> Cell align [(T.replicate d " ", d)]
+    DepthSpacerField -> Cell align [WideBuilder (TB.fromText $ T.replicate d " ") d]
                         where d = maybe id min mmax $ depth * fromMaybe 1 mmin
-    AccountField     -> Cell align [(t, textWidth t)] where t = formatText ljust mmin mmax acctname
+    AccountField     -> alignCell align $ formatText ljust mmin mmax acctname
     TotalField       -> Cell align . pure $ showamt total
-    _                -> Cell align [("", 0)]
+    _                -> Cell align [mempty]
   where
     align = if topaligned then (if ljust then TopLeft    else TopRight)
                           else (if ljust then BottomLeft else BottomRight)
-    showamt = (\(WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w))
+    showamt = showMixed noPrice{displayColour=color_ opts, displayMinWidth=mmin, displayMaxWidth=mmax}
-            . showMixed noPrice{displayColour=color_ opts, displayMinWidth=mmin, displayMaxWidth=mmax}
 
 -- rendering multi-column balance reports
 
@@ -629,7 +627,7 @@ balanceReportTableAsText ReportOpts{..} =
     Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_}
         (Tab.alignCell TopLeft) (Tab.alignCell TopRight) showamt
   where
-    showamt = Cell TopRight . (\(WideBuilder b w) -> [(TL.toStrict $ TB.toLazyText b, w)]) . showMixed oneLine{displayColour=color_, displayMaxWidth=mmax}
+    showamt = Cell TopRight . pure . showMixed oneLine{displayColour=color_, displayMaxWidth=mmax}
     mmax = if no_elide_ then Nothing else Just 32