Pretty: Export realLength and use it in calculating offsets.

This should help fix setext headers and tables containing
asian wide characters and combining characters.

1 files changed, 16 insertions, 10 deletions

diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs
index c1d529888..c3979348e 100644
--- a/src/Text/Pandoc/Pretty.hs
+++ b/src/Text/Pandoc/Pretty.hs
@@ -68,6 +68,7 @@ module Text.Pandoc.Pretty (
      , quotes
      , doubleQuotes
      , charWidth
+     , realLength
      )
 
 where
@@ -195,7 +196,7 @@ outp off s | off <= 0 = do
   when (column st' == 0 && usePrefix st' && not (null rawpref)) $ do
     let pref = reverse $ dropWhile isSpace $ reverse rawpref
     modify $ \st -> st{ output = fromString pref : output st
-                      , column = column st + length pref }
+                      , column = column st + realLength pref }
   when (off < 0) $ do
      modify $ \st -> st { output = fromString s : output st
                         , column = 0
@@ -205,7 +206,7 @@ outp off s = do
   let pref = prefix st'
   when (column st' == 0 && usePrefix st' && not (null pref)) $ do
     modify $ \st -> st{ output = fromString pref : output st
-                      , column = column st + length pref }
+                      , column = column st + realLength pref }
   modify $ \st -> st{ output = fromString s : output st
                     , column = column st + off
                     , newlines = 0 }
@@ -312,7 +313,7 @@ renderList (b1@Block{} : BreakingSpace : b2@Block{} : xs) =
 renderList (Block width lns : xs) = do
   st <- get
   let oldPref = prefix st
-  case column st - length oldPref of
+  case column st - realLength oldPref of
         n | n > 0 -> modify $ \s -> s{ prefix = oldPref ++ replicate n ' ' }
         _         -> return ()
   renderDoc $ blockToDoc width lns
@@ -324,7 +325,7 @@ mergeBlocks addSpace (Block w1 lns1) (Block w2 lns2) =
   Block (w1 + w2 + if addSpace then 1 else 0) $
      zipWith (\l1 l2 -> pad w1 l1 ++ l2) (lns1 ++ empties) (map sp lns2 ++ empties)
     where empties = replicate (abs $ length lns1 - length lns2) ""
-          pad n s = s ++ replicate (n - length s) ' '
+          pad n s = s ++ replicate (n - realLength s) ' '
           sp "" = ""
           sp xs = if addSpace then (' ' : xs) else xs
 mergeBlocks _ _ _ = error "mergeBlocks tried on non-Block!"
@@ -345,9 +346,9 @@ text = Doc . toChunks
         toChunks [] = mempty
         toChunks s = case break (=='\n') s of
                           ([], _:ys) -> NewLine `cons` toChunks ys
-                          (xs, _:ys) -> Text (length xs) xs `cons`
+                          (xs, _:ys) -> Text (realLength xs) xs `cons`
                                             NewLine `cons` toChunks ys
-                          (xs, [])      -> singleton $ Text (length xs) xs
+                          (xs, [])      -> singleton $ Text (realLength xs) xs
 
 -- | A character.
 char :: Char -> Doc
@@ -401,7 +402,7 @@ nowrap doc = Doc $ fromList $ map replaceSpace $ toList $ unDoc doc
 
 -- | Returns the width of a 'Doc'.
 offset :: Doc -> Int
-offset d = case map length . lines . render Nothing $ d of
+offset d = case map realLength . lines . render Nothing $ d of
                 []    -> 0
                 os    -> maximum os
 
@@ -416,11 +417,11 @@ lblock = block id
 
 -- | Like 'lblock' but aligned to the right.
 rblock :: Int -> Doc -> Doc
-rblock w = block (\s -> replicate (w - length s) ' ' ++ s) w
+rblock w = block (\s -> replicate (w - realLength s) ' ' ++ s) w
 
 -- | Like 'lblock' but aligned centered.
 cblock :: Int -> Doc -> Doc
-cblock w = block (\s -> replicate ((w - length s) `div` 2) ' ' ++ s) w
+cblock w = block (\s -> replicate ((w - realLength s) `div` 2) ' ' ++ s) w
 
 -- | Returns the height of a block or other 'Doc'.
 height :: Doc -> Int
@@ -435,7 +436,7 @@ chop n cs = case break (=='\n') cs of
                                              (_:[]) -> [xs, ""]
                                              (_:zs) -> xs : chop n zs
                                      else take n xs : chop n (drop n xs ++ ys)
-                                   where len = length xs
+                                   where len = realLength xs
 
 -- | Encloses a 'Doc' inside a start and end 'Doc'.
 inside :: Doc -> Doc -> Doc -> Doc
@@ -498,3 +499,8 @@ charWidth c =
         | c >= '\xFE68' && c <= '\xFE6B'   -> 2
         | c >= '\x2F800' && c <= '\x2FA1D' -> 2
         | otherwise                        -> 1
+
+-- | Get real length of string, taking into account combining and double-wide
+-- characters.
+realLength :: String -> Int
+realLength = sum . map charWidth