diff options
| -rw-r--r-- | src/Text/Pandoc/Pretty.hs | 30 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 2 |
2 files changed, 20 insertions, 12 deletions
diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs index e81f4012b..b9f646282 100644 --- a/src/Text/Pandoc/Pretty.hs +++ b/src/Text/Pandoc/Pretty.hs @@ -76,8 +76,9 @@ module Text.Pandoc.Pretty ( where import Data.Sequence (Seq, fromList, (<|), singleton, mapWithIndex, viewl, ViewL(..)) +import qualified Data.Sequence as Seq import Data.Foldable (toList) -import Data.List (intercalate) +import Data.List (intersperse) import Data.String import Control.Monad.State import Data.Char (isSpace) @@ -121,7 +122,7 @@ isBlank _ = False -- | True if the document is empty. isEmpty :: Doc -> Bool -isEmpty = null . toList . unDoc +isEmpty = Seq.null . unDoc -- | The empty document. empty :: Doc @@ -271,10 +272,15 @@ renderList (BeforeNonBlank d : xs) = | otherwise -> renderDoc d >> renderList xs [] -> renderList xs +renderList [BlankLines _] = return () + +renderList (BlankLines m : BlankLines n : xs) = + renderList (BlankLines (max m n) : xs) + renderList (BlankLines num : xs) = do st <- get case output st of - _ | newlines st > num || null xs -> return () + _ | newlines st > num -> return () | otherwise -> replicateM_ (1 + num - newlines st) (outp (-1) "\n") renderList xs @@ -321,28 +327,30 @@ renderList (Block i1 s1 : Block i2 s2 : xs) = renderList (Block i1 s1 : BreakingSpace : Block i2 s2 : xs) = renderList (mergeBlocks True (IsBlock i1 s1) (IsBlock i2 s2) : xs) -renderList (Block width lns : xs) = do +renderList (Block _width lns : xs) = do st <- get let oldPref = prefix st case column st - realLength oldPref of n | n > 0 -> modify $ \s -> s{ prefix = oldPref ++ replicate n ' ' } _ -> return () - renderDoc $ blockToDoc width lns + renderList $ intersperse CarriageReturn (map (Text 0) lns) modify $ \s -> s{ prefix = oldPref } renderList xs mergeBlocks :: Bool -> IsBlock -> IsBlock -> D mergeBlocks addSpace (IsBlock w1 lns1) (IsBlock 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) "" + zipWith (\l1 l2 -> pad w1 l1 ++ l2) lns1' (map sp lns2') + where (lns1', lns2') = case (length lns1, length lns2) of + (x, y) | x > y -> (lns1, + lns2 ++ replicate (x - y) "") + | x < y -> (lns1 ++ replicate (y - x) "", + lns2) + | otherwise -> (lns1, lns2) pad n s = s ++ replicate (n - realLength s) ' ' sp "" = "" sp xs = if addSpace then (' ' : xs) else xs -blockToDoc :: Int -> [String] -> Doc -blockToDoc _ lns = text $ intercalate "\n" lns - offsetOf :: D -> Int offsetOf (Text o _) = o offsetOf (Block w _) = w @@ -453,7 +461,7 @@ chop n cs = case break (=='\n') cs of (xs, ys) -> if len <= n then case ys of [] -> [xs] - (_:[]) -> [xs, ""] + ['\n'] -> [xs] (_:zs) -> xs : chop n zs else take n xs : chop n (drop n xs ++ ys) where len = realLength xs diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 21f1acd6e..c438cb322 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -268,7 +268,7 @@ blockToRST (Table caption _ widths headers rows) = do then map ((+2) . numChars) $ transpose (headers' : rawRows) else map (floor . (fromIntegral (writerColumns opts) *)) widths let hpipeBlocks blocks = hcat [beg, middle, end] - where h = maximum (1 : map height blocks) + where h = height (hcat blocks) sep' = lblock 3 $ vcat (map text $ replicate h " | ") beg = lblock 2 $ vcat (map text $ replicate h "| ") end = lblock 2 $ vcat (map text $ replicate h " |") |