diff options
author | John MacFarlane <jgm@berkeley.edu> | 2015-03-28 12:12:48 -0700 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2015-03-28 12:12:48 -0700 |
commit | 6a3a04c4280817df39519bf1d73eee3b9e0b3841 (patch) | |
tree | 304a696d66d3d8cfb6f1441086947c12f2cb1cb8 /src/Text/Pandoc/Pretty.hs | |
parent | d744b83b61bc635419339b73b687b9280ee757fc (diff) | |
parent | ad39bc7009e320b3afb91a5683521eb1eccf0ef7 (diff) | |
download | pandoc-6a3a04c4280817df39519bf1d73eee3b9e0b3841.tar.gz |
Merge branch 'errortype' of https://github.com/mpickering/pandoc into mpickering-errortype
Conflicts:
benchmark/benchmark-pandoc.hs
src/Text/Pandoc/Readers/Markdown.hs
src/Text/Pandoc/Readers/Org.hs
src/Text/Pandoc/Readers/RST.hs
tests/Tests/Readers/LaTeX.hs
Diffstat (limited to 'src/Text/Pandoc/Pretty.hs')
-rw-r--r-- | src/Text/Pandoc/Pretty.hs | 18 |
1 files changed, 11 insertions, 7 deletions
diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs index 2f2656086..9a97dfc21 100644 --- a/src/Text/Pandoc/Pretty.hs +++ b/src/Text/Pandoc/Pretty.hs @@ -250,6 +250,11 @@ renderDoc :: (IsString a, Monoid a) => Doc -> DocState a renderDoc = renderList . toList . unDoc +data IsBlock = IsBlock Int [String] + +-- This would be nicer with a pattern synonym +-- pattern VBlock i s <- mkIsBlock -> Just (IsBlock ..) + renderList :: (IsString a, Monoid a) => [D] -> DocState a renderList [] = return () @@ -323,11 +328,11 @@ renderList (BreakingSpace : xs) = do outp 1 " " renderList xs' -renderList (b1@Block{} : b2@Block{} : xs) = - renderList (mergeBlocks False b1 b2 : xs) +renderList (Block i1 s1 : Block i2 s2 : xs) = + renderList (mergeBlocks False (IsBlock i1 s1) (IsBlock i2 s2) : xs) -renderList (b1@Block{} : BreakingSpace : b2@Block{} : xs) = - renderList (mergeBlocks True b1 b2 : 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 st <- get @@ -339,15 +344,14 @@ renderList (Block width lns : xs) = do modify $ \s -> s{ prefix = oldPref } renderList xs -mergeBlocks :: Bool -> D -> D -> D -mergeBlocks addSpace (Block w1 lns1) (Block w2 lns2) = +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) "" pad n s = s ++ replicate (n - realLength s) ' ' sp "" = "" sp xs = if addSpace then (' ' : xs) else xs -mergeBlocks _ _ _ = error "mergeBlocks tried on non-Block!" blockToDoc :: Int -> [String] -> Doc blockToDoc _ lns = text $ intercalate "\n" lns |