From ff0132df285bce8ccde7915fe7ab720682ecfa56 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 12 Nov 2021 12:49:26 +1100 Subject: [PATCH] dev: Use realLength from doclayout instead of strWidth and textWidth. (#895) This gives us more accurate string length calculations. In particular, it handles emoji and other scripts properly. --- hledger-lib/Hledger/Data/AccountName.hs | 3 +- hledger-lib/Hledger/Data/Amount.hs | 7 ++- hledger-lib/Hledger/Data/Posting.hs | 3 +- hledger-lib/Hledger/Utils/String.hs | 6 ++- hledger-lib/Hledger/Utils/Text.hs | 8 +-- hledger-lib/Text/Tabular/AsciiWide.hs | 4 +- hledger-lib/Text/WideString.hs | 67 +------------------------ hledger-lib/hledger-lib.cabal | 3 ++ hledger-lib/package.yaml | 1 + hledger-ui/Hledger/UI/AccountsScreen.hs | 3 +- hledger-ui/hledger-ui.cabal | 1 + hledger-ui/package.yaml | 1 + stack8.6.yaml | 2 + stack8.8.yaml | 2 + 14 files changed, 32 insertions(+), 79 deletions(-) diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index d5d3289ac..1ccfbf6aa 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -46,6 +46,7 @@ import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Tree (Tree(..)) +import Text.DocLayout (realLength) import Hledger.Data.Types import Hledger.Utils @@ -186,7 +187,7 @@ elideAccountName width s where elideparts :: Int -> [Text] -> [Text] -> [Text] elideparts width done ss - | textWidth (accountNameFromComponents $ done++ss) <= width = done++ss + | realLength (accountNameFromComponents $ done++ss) <= width = done++ss | length ss > 1 = elideparts width (done++[textTakeWidth 2 $ head ss]) (tail ss) | otherwise = done++ss diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index c7d1155e8..3f506f241 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -171,7 +171,7 @@ import Test.Tasty.HUnit ((@?=), assertBool, testCase) import Hledger.Data.Types import Hledger.Utils (colorB) import Hledger.Utils.Text (textQuoteIfNeeded) -import Text.WideString (WideBuilder(..), textWidth, wbToText, wbUnpack) +import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack) -- A 'Commodity' is a symbol representing a currency or some other kind of @@ -469,14 +469,13 @@ showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder showAmountB _ Amount{acommodity="AUTO"} = mempty showAmountB opts a@Amount{astyle=style} = color $ case ascommodityside style of - L -> showC c' space <> quantity' <> price - R -> quantity' <> showC space c' <> price + L -> showC (wbFromText c) space <> quantity' <> price + R -> quantity' <> showC space (wbFromText c) <> price where quantity = showamountquantity a (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"") | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a) space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty - c' = WideBuilder (TB.fromText c) (textWidth c) showC l r = if isJust (displayOrder opts) then mempty else l <> r price = if displayPrice opts then showAmountPrice a else mempty color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 17ec66d44..cd23917d5 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -89,6 +89,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day) import Safe (headDef, maximumDef) +import Text.DocLayout (realLength) import Text.Tabular.AsciiWide @@ -255,7 +256,7 @@ postingAsLines elideamount onelineamounts acctwidth amtwidth p = assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned statusandaccount = lineIndent . fitText (Just $ 2 + acctwidth) Nothing False True $ pstatusandacct p - thisacctwidth = textWidth $ pacctstr p + thisacctwidth = realLength $ pacctstr p pacctstr p' = showAccountName Nothing (ptype p') (paccount p') pstatusandacct p' = pstatusprefix p' <> pacctstr p' diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index 097a326b9..eca20c59a 100644 --- a/hledger-lib/Hledger/Utils/String.hs +++ b/hledger-lib/Hledger/Utils/String.hs @@ -42,7 +42,7 @@ import Text.Printf (printf) import Hledger.Utils.Parse import Hledger.Utils.Regex (toRegex', regexReplace) -import Text.WideString (charWidth, strWidth) +import Text.DocLayout (charWidth, realLength) -- | Take elements from the end of a list. @@ -174,6 +174,10 @@ takeWidth w (c:cs) | cw <= w = c:takeWidth (w-cw) cs strWidthAnsi :: String -> Int strWidthAnsi = strWidth . stripAnsi +-- | Alias for 'realLength'. +strWidth :: String -> Int +strWidth = realLength + -- | Strip ANSI escape sequences from a string. -- -- >>> stripAnsi "\ESC[31m-1\ESC[m" diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index 76dd2754c..e14517699 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -43,7 +43,6 @@ module Hledger.Utils.Text wbToText, wbFromText, wbUnpack, - textWidth, textTakeWidth, -- * Reading readDecimal, @@ -58,12 +57,13 @@ 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.DocLayout (charWidth, realLength) import Test.Tasty (testGroup) import Test.Tasty.HUnit ((@?=), testCase) import Text.Tabular.AsciiWide (Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell) -import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack, charWidth, textWidth) +import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack) -- lowercase, uppercase :: String -> String @@ -206,7 +206,7 @@ fitText mminwidth mmaxwidth ellipsify rightside = clip . pad clip s = case mmaxwidth of Just w - | textWidth s > w -> + | realLength s > w -> if rightside then textTakeWidth (w - T.length ellipsis) s <> ellipsis else ellipsis <> T.reverse (textTakeWidth (w - T.length ellipsis) $ T.reverse s) @@ -224,7 +224,7 @@ fitText mminwidth mmaxwidth ellipsify rightside = clip . pad else T.replicate (w - sw) " " <> s | otherwise -> s Nothing -> s - where sw = textWidth s + where sw = realLength s -- | Double-width-character-aware string truncation. Take as many -- characters as possible from a string without exceeding the diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs index 0a268076a..4af4548df 100644 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -35,7 +35,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 (WideBuilder(..), wbFromText, textWidth) +import Text.WideString (WideBuilder(..), wbFromText) -- | The options to use for rendering a table. @@ -63,7 +63,7 @@ emptyCell = Cell TopRight [] -- | Create a single-line cell from the given contents with its natural width. textCell :: Align -> Text -> Cell -textCell a x = Cell a . map (\x -> WideBuilder (fromText x) (textWidth x)) $ if T.null x then [""] else T.lines x +textCell a x = Cell a . map wbFromText $ if T.null x then [""] else T.lines x -- | Create a multi-line cell from the given contents with its natural width. textsCell :: Align -> [Text] -> Cell diff --git a/hledger-lib/Text/WideString.hs b/hledger-lib/Text/WideString.hs index 2e101a59a..df3701392 100644 --- a/hledger-lib/Text/WideString.hs +++ b/hledger-lib/Text/WideString.hs @@ -1,10 +1,6 @@ -- | Calculate the width of String and Text, being aware of wide characters. module Text.WideString ( - -- * wide-character-aware layout - strWidth, - textWidth, - charWidth, -- * Text Builders which keep track of length WideBuilder(..), wbUnpack, @@ -16,6 +12,7 @@ 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.DocLayout (realLength) -- | Helper for constructing Builders while keeping track of text width. @@ -36,68 +33,8 @@ wbToText = TL.toStrict . TB.toLazyText . wbBuilder -- | Convert a strict Text to a WideBuilder. wbFromText :: Text -> WideBuilder -wbFromText t = WideBuilder (TB.fromText t) (textWidth t) +wbFromText t = WideBuilder (TB.fromText t) (realLength t) -- | Convert a WideBuilder to a String. wbUnpack :: WideBuilder -> String wbUnpack = TL.unpack . TB.toLazyText . wbBuilder - - --- | Calculate the render width of a string, considering --- wide characters (counted as double width) -strWidth :: String -> Int -strWidth = foldr (\a b -> charWidth a + b) 0 - --- | Calculate the render width of a string, considering --- wide characters (counted as double width) -textWidth :: Text -> Int -textWidth = T.foldr (\a b -> charWidth a + b) 0 - --- from Pandoc (copyright John MacFarlane, GPL) --- see also http://unicode.org/reports/tr11/#Description - --- | Get the designated render width of a character: 0 for a combining --- character, 1 for a regular character, 2 for a wide character. --- (Wide characters are rendered as exactly double width in apps and --- fonts that support it.) (From Pandoc.) -charWidth :: Char -> Int -charWidth c - | c < '\x0300' = 1 - | c >= '\x0300' && c <= '\x036F' = 0 -- combining - | c >= '\x0370' && c <= '\x10FC' = 1 - | c >= '\x1100' && c <= '\x115F' = 2 - | c >= '\x1160' && c <= '\x11A2' = 1 - | c >= '\x11A3' && c <= '\x11A7' = 2 - | c >= '\x11A8' && c <= '\x11F9' = 1 - | c >= '\x11FA' && c <= '\x11FF' = 2 - | c >= '\x1200' && c <= '\x2328' = 1 - | c >= '\x2329' && c <= '\x232A' = 2 - | c >= '\x232B' && c <= '\x2E31' = 1 - | c >= '\x2E80' && c <= '\x303E' = 2 - | c == '\x303F' = 1 - | c >= '\x3041' && c <= '\x3247' = 2 - | c >= '\x3248' && c <= '\x324F' = 1 -- ambiguous - | c >= '\x3250' && c <= '\x4DBF' = 2 - | c >= '\x4DC0' && c <= '\x4DFF' = 1 - | c >= '\x4E00' && c <= '\xA4C6' = 2 - | c >= '\xA4D0' && c <= '\xA95F' = 1 - | c >= '\xA960' && c <= '\xA97C' = 2 - | c >= '\xA980' && c <= '\xABF9' = 1 - | c >= '\xAC00' && c <= '\xD7FB' = 2 - | c >= '\xD800' && c <= '\xDFFF' = 1 - | c >= '\xE000' && c <= '\xF8FF' = 1 -- ambiguous - | c >= '\xF900' && c <= '\xFAFF' = 2 - | c >= '\xFB00' && c <= '\xFDFD' = 1 - | c >= '\xFE00' && c <= '\xFE0F' = 1 -- ambiguous - | c >= '\xFE10' && c <= '\xFE19' = 2 - | c >= '\xFE20' && c <= '\xFE26' = 1 - | c >= '\xFE30' && c <= '\xFE6B' = 2 - | c >= '\xFE70' && c <= '\xFEFF' = 1 - | c >= '\xFF01' && c <= '\xFF60' = 2 - | c >= '\xFF61' && c <= '\x16A38' = 1 - | c >= '\x1B000' && c <= '\x1B001' = 2 - | c >= '\x1D000' && c <= '\x1F1FF' = 1 - | c >= '\x1F200' && c <= '\x1F251' = 2 - | c >= '\x1F300' && c <= '\x1F773' = 1 - | c >= '\x20000' && c <= '\x3FFFD' = 2 - | otherwise = 1 diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 7c4b8ab87..061bf9d3e 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -109,6 +109,7 @@ library , containers >=0.5.9 , data-default >=0.5 , directory + , doclayout ==0.3.* , extra >=1.6.3 , file-embed >=0.0.10 , filepath @@ -158,6 +159,7 @@ test-suite doctest , containers >=0.5.9 , data-default >=0.5 , directory + , doclayout ==0.3.* , doctest >=0.18.1 , extra >=1.6.3 , file-embed >=0.0.10 @@ -210,6 +212,7 @@ test-suite unittest , containers >=0.5.9 , data-default >=0.5 , directory + , doclayout ==0.3.* , extra >=1.6.3 , file-embed >=0.0.10 , filepath diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index f8a0d542f..7146b54a2 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -47,6 +47,7 @@ dependencies: - data-default >=0.5 - Decimal >=0.5.1 - directory +- doclayout >=0.3 && <0.4 - file-embed >=0.0.10 - filepath - hashtables >=1.2.3.1 diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 6d7f98c2f..ff884484e 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -26,6 +26,7 @@ import Lens.Micro.Platform import Safe import System.Console.ANSI import System.FilePath (takeFileName) +import Text.DocLayout (realLength) import Hledger import Hledger.Cli hiding (progname,prognameandversion) @@ -122,7 +123,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) displayitems = s ^. asList . listElementsL - acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + Hledger.Cli.textWidth asItemDisplayAccountName) displayitems + acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems preferredacctwidth = V.maximum acctwidths totalacctwidthseen = V.sum acctwidths diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index e9bfd2b91..9365f2204 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -73,6 +73,7 @@ executable hledger-ui , containers >=0.5.9 , data-default , directory + , doclayout ==0.3.* , extra >=1.6.3 , filepath , fsnotify >=0.2.1.2 && <0.4 diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index cb2cec52d..c0579482b 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -50,6 +50,7 @@ dependencies: - containers >=0.5.9 - data-default - directory +- doclayout >=0.3 && <0.4 - extra >=1.6.3 - filepath - fsnotify >=0.2.1.2 && <0.4 diff --git a/stack8.6.yaml b/stack8.6.yaml index 7e25ed254..1285e761e 100644 --- a/stack8.6.yaml +++ b/stack8.6.yaml @@ -15,6 +15,8 @@ packages: extra-deps: # for Shake.hs (regex doesn't support base-compat-0.11): - regex-1.0.2.0@rev:1 +- doclayout-0.3.1.1 +- emojis-0.1.2 # for testing base-compat 0.11 compatibility (mutually exclusive with the above): # - aeson-1.4.6.0 # - aeson-compat-0.3.9 diff --git a/stack8.8.yaml b/stack8.8.yaml index 39e1d8bd3..7f7fe5569 100644 --- a/stack8.8.yaml +++ b/stack8.8.yaml @@ -17,6 +17,8 @@ extra-deps: - pretty-simple-4.0.0.0 - prettyprinter-1.7.0 - doctest-0.18.1 +- doclayout-0.3.1.1 +- emojis-0.1.2 # for hledger: # for hledger-ui: # for hledger-web: