@@ -250,6 +250,11 @@ renderDoc :: (IsString a, Monoid a)
250250 => Doc -> DocState a
251251renderDoc = renderList . toList . unDoc
252252
253+data IsBlock = IsBlock Int [String]
254+
255+-- This would be nicer with a pattern synonym
256+-- pattern VBlock i s <- mkIsBlock -> Just (IsBlock ..)
257+
253258renderList :: (IsString a, Monoid a)
254259 => [D] -> DocState a
255260renderList [] = return ()
@@ -323,11 +328,11 @@ renderList (BreakingSpace : xs) = do
323328 outp 1 " "
324329 renderList xs'
325330
326−renderList (b1@Block{} : b2@Block{} : xs) =
327− renderList (mergeBlocks False b1 b2 : xs)
331+renderList (Block i1 s1 : Block i2 s2 : xs) =
332+ renderList (mergeBlocks False (IsBlock i1 s1) (IsBlock i2 s2) : xs)
328333
329−renderList (b1@Block{} : BreakingSpace : b2@Block{} : xs) =
330− renderList (mergeBlocks True b1 b2 : xs)
334+renderList (Block i1 s1 : BreakingSpace : Block i2 s2 : xs) =
335+ renderList (mergeBlocks True (IsBlock i1 s1) (IsBlock i2 s2) : xs)
331336
332337renderList (Block width lns : xs) = do
333338 st <- get
@@ -339,15 +344,14 @@ renderList (Block width lns : xs) = do
339344 modify $ \s -> s{ prefix = oldPref }
340345 renderList xs
341346
342−mergeBlocks :: Bool -> D -> D -> D
343−mergeBlocks addSpace (Block w1 lns1) (Block w2 lns2) =
347+mergeBlocks :: Bool -> IsBlock -> IsBlock -> D
348+mergeBlocks addSpace (IsBlock w1 lns1) (IsBlock w2 lns2) =
344349 Block (w1 + w2 + if addSpace then 1 else 0) $
345350 zipWith (\l1 l2 -> pad w1 l1 ++ l2) (lns1 ++ empties) (map sp lns2 ++ empties)
346351 where empties = replicate (abs $ length lns1 - length lns2) ""
347352 pad n s = s ++ replicate (n - realLength s) ' '
348353 sp "" = ""
349354 sp xs = if addSpace then (' ' : xs) else xs
350−mergeBlocks _ _ _ = error "mergeBlocks tried on non-Block!"
351355
352356blockToDoc :: Int -> [String] -> Doc
353357blockToDoc _ lns = text $ intercalate "\n" lns