@@ -76,8 +76,9 @@ module Text.Pandoc.Pretty (
7676
7777where
7878import Data.Sequence (Seq, fromList, (<|), singleton, mapWithIndex, viewl, ViewL(..))
79+import qualified Data.Sequence as Seq
7980import Data.Foldable (toList)
80−import Data.List (intercalate)
81+import Data.List (intersperse)
8182import Data.String
8283import Control.Monad.State
8384import Data.Char (isSpace)
@@ -121,7 +122,7 @@ isBlank _ = False
121122
122123-- | True if the document is empty.
123124isEmpty :: Doc -> Bool
124−isEmpty = null . toList . unDoc
125+isEmpty = Seq.null . unDoc
125126
126127-- | The empty document.
127128empty :: Doc
@@ -271,10 +272,15 @@ renderList (BeforeNonBlank d : xs) =
271272 | otherwise -> renderDoc d >> renderList xs
272273 [] -> renderList xs
273274
275+renderList [BlankLines _] = return ()
276+
277+renderList (BlankLines m : BlankLines n : xs) =
278+ renderList (BlankLines (max m n) : xs)
279+
274280renderList (BlankLines num : xs) = do
275281 st <- get
276282 case output st of
277− _ | newlines st > num || null xs -> return ()
283+ _ | newlines st > num -> return ()
278284 | otherwise -> replicateM_ (1 + num - newlines st) (outp (-1) "\n")
279285 renderList xs
280286
@@ -321,28 +327,30 @@ renderList (Block i1 s1 : Block i2 s2 : xs) =
321327renderList (Block i1 s1 : BreakingSpace : Block i2 s2 : xs) =
322328 renderList (mergeBlocks True (IsBlock i1 s1) (IsBlock i2 s2) : xs)
323329
324−renderList (Block width lns : xs) = do
330+renderList (Block _width lns : xs) = do
325331 st <- get
326332 let oldPref = prefix st
327333 case column st - realLength oldPref of
328334 n | n > 0 -> modify $ \s -> s{ prefix = oldPref ++ replicate n ' ' }
329335 _ -> return ()
330− renderDoc $ blockToDoc width lns
336+ renderList $ intersperse CarriageReturn (map (Text 0) lns)
331337 modify $ \s -> s{ prefix = oldPref }
332338 renderList xs
333339
334340mergeBlocks :: Bool -> IsBlock -> IsBlock -> D
335341mergeBlocks addSpace (IsBlock w1 lns1) (IsBlock w2 lns2) =
336342 Block (w1 + w2 + if addSpace then 1 else 0) $
337− zipWith (\l1 l2 -> pad w1 l1 ++ l2) (lns1 ++ empties) (map sp lns2 ++ empties)
338− where empties = replicate (abs $ length lns1 - length lns2) ""
343+ zipWith (\l1 l2 -> pad w1 l1 ++ l2) lns1' (map sp lns2')
344+ where (lns1', lns2') = case (length lns1, length lns2) of
345+ (x, y) | x > y -> (lns1,
346+ lns2 ++ replicate (x - y) "")
347+ | x < y -> (lns1 ++ replicate (y - x) "",
348+ lns2)
349+ | otherwise -> (lns1, lns2)
339350 pad n s = s ++ replicate (n - realLength s) ' '
340351 sp "" = ""
341352 sp xs = if addSpace then (' ' : xs) else xs
342353
343−blockToDoc :: Int -> [String] -> Doc
344−blockToDoc _ lns = text $ intercalate "\n" lns
345−
346354offsetOf :: D -> Int
347355offsetOf (Text o _) = o
348356offsetOf (Block w _) = w
@@ -453,7 +461,7 @@ chop n cs = case break (=='\n') cs of
453461 (xs, ys) -> if len <= n
454462 then case ys of
455463 [] -> [xs]
456− (_:[]) -> [xs, ""]
464+ ['\n'] -> [xs]
457465 (_:zs) -> xs : chop n zs
458466 else take n xs : chop n (drop n xs ++ ys)
459467 where len = realLength xs