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

@@ -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
 

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

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'

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"

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

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

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

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

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

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

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

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

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

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: