@@ -250,6 +250,11 @@ renderDoc :: (IsString a, Monoid a)
250 => Doc -> DocState a
250 => Doc -> DocState a
251renderDoc = renderList . toList . unDoc
251renderDoc = renderList . toList . unDoc
253+data IsBlock = IsBlock Int [String]
255+-- This would be nicer with a pattern synonym
256+-- pattern VBlock i s <- mkIsBlock -> Just (IsBlock ..)
253renderList :: (IsString a, Monoid a)
258renderList :: (IsString a, Monoid a)
254 => [D] -> DocState a
259 => [D] -> DocState a
255renderList [] = return ()
260renderList [] = return ()
@@ -323,11 +328,11 @@ renderList (BreakingSpace : xs) = do
323 outp 1 " "
328 outp 1 " "
324 renderList xs'
329 renderList xs'
326−renderList (b1@Block{} : b2@Block{} : xs) =
331+renderList (Block i1 s1 : Block i2 s2 : xs) =
327− renderList (mergeBlocks False b1 b2 : xs)
332+ renderList (mergeBlocks False (IsBlock i1 s1) (IsBlock i2 s2) : xs)
329−renderList (b1@Block{} : BreakingSpace : b2@Block{} : xs) =
334+renderList (Block i1 s1 : BreakingSpace : Block i2 s2 : xs) =
330− renderList (mergeBlocks True b1 b2 : xs)
335+ renderList (mergeBlocks True (IsBlock i1 s1) (IsBlock i2 s2) : xs)
332renderList (Block width lns : xs) = do
337renderList (Block width lns : xs) = do
333 st <- get
338 st <- get
@@ -339,15 +344,14 @@ renderList (Block width lns : xs) = do
339 modify $ \s -> s{ prefix = oldPref }
344 modify $ \s -> s{ prefix = oldPref }
340 renderList xs
345 renderList xs
342−mergeBlocks :: Bool -> D -> D -> D
347+mergeBlocks :: Bool -> IsBlock -> IsBlock -> D
343−mergeBlocks addSpace (Block w1 lns1) (Block w2 lns2) =
348+mergeBlocks addSpace (IsBlock w1 lns1) (IsBlock w2 lns2) =
344 Block (w1 + w2 + if addSpace then 1 else 0) $
349 Block (w1 + w2 + if addSpace then 1 else 0) $
345 zipWith (\l1 l2 -> pad w1 l1 ++ l2) (lns1 ++ empties) (map sp lns2 ++ empties)
350 zipWith (\l1 l2 -> pad w1 l1 ++ l2) (lns1 ++ empties) (map sp lns2 ++ empties)
346 where empties = replicate (abs $ length lns1 - length lns2) ""
351 where empties = replicate (abs $ length lns1 - length lns2) ""
347 pad n s = s ++ replicate (n - realLength s) ' '
352 pad n s = s ++ replicate (n - realLength s) ' '
348 sp "" = ""
353 sp "" = ""
349 sp xs = if addSpace then (' ' : xs) else xs
354 sp xs = if addSpace then (' ' : xs) else xs
350−mergeBlocks _ _ _ = error "mergeBlocks tried on non-Block!"
352blockToDoc :: Int -> [String] -> Doc
356blockToDoc :: Int -> [String] -> Doc
353blockToDoc _ lns = text $ intercalate "\n" lns
357blockToDoc _ lns = text $ intercalate "\n" lns