Fix totality, unicode, examples, paragraph parsing

Also simplify specs and parsers while we're at it. Some parsers were
made more generic.

This commit is a part of GHC pre-merge squash, email
fuuzetsu@fuuzetsu.co.uk if you need the full commit history.

1 files changed, 10 insertions, 47 deletions

diff --git a/src/Haddock/Doc.hs b/src/Haddock/Doc.hs
index 4d68c554..69b2dd6f 100644
--- a/src/Haddock/Doc.hs
+++ b/src/Haddock/Doc.hs
@@ -1,16 +1,14 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Haddock.Doc (
-  docAppend,
-  docParagraph,
-  combineStringNodes,
-  combineDocumentation
-  ) where
+  docAppend
+, docParagraph
+, combineDocumentation
+) where
 
 import Data.Maybe
 import Data.Monoid
 import Haddock.Types
 import Data.Char (isSpace)
-import Control.Arrow ((***))
 
 -- We put it here so that we can avoid a circular import
 -- anything relevant imports this module anyway
@@ -22,25 +20,15 @@ combineDocumentation :: Documentation name -> Maybe (Doc name)
 combineDocumentation (Documentation Nothing Nothing) = Nothing
 combineDocumentation (Documentation mDoc mWarning)   = Just (fromMaybe mempty mWarning `mappend` fromMaybe mempty mDoc)
 
--- used to make parsing easier; we group the list items later
 docAppend :: Doc id -> Doc id -> Doc id
-docAppend (DocUnorderedList ds1) (DocUnorderedList ds2)
-  = DocUnorderedList (ds1++ds2)
-docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d)
-  = DocAppend (DocUnorderedList (ds1++ds2)) d
-docAppend (DocOrderedList ds1) (DocOrderedList ds2)
-  = DocOrderedList (ds1++ds2)
-docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d)
-  = DocAppend (DocOrderedList (ds1++ds2)) d
-docAppend (DocDefList ds1) (DocDefList ds2)
-  = DocDefList (ds1++ds2)
-docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d)
-  = DocAppend (DocDefList (ds1++ds2)) d
+docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2)
+docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d
 docAppend DocEmpty d = d
 docAppend d DocEmpty = d
-docAppend d1 d2
-  = DocAppend d1 d2
-
+docAppend (DocString s1) (DocString s2) = DocString (s1 ++ s2)
+docAppend (DocAppend d (DocString s1)) (DocString s2) = DocAppend d (DocString (s1 ++ s2))
+docAppend (DocString s1) (DocAppend (DocString s2) d) = DocAppend (DocString (s1 ++ s2)) d
+docAppend d1 d2 = DocAppend d1 d2
 
 -- again to make parsing easier - we spot a paragraph whose only item
 -- is a DocMonospaced and make it into a DocCodeBlock
@@ -77,28 +65,3 @@ docCodeBlock (DocString s)
 docCodeBlock (DocAppend l r)
   = DocAppend l (docCodeBlock r)
 docCodeBlock d = d
-
--- | This is a hack that joins neighbouring 'DocString's into a single one.
--- This is done to ease up the testing and doesn't change the final result
--- as this would be done later anyway.
-combineStringNodes :: Doc id -> Doc id
-combineStringNodes (DocAppend (DocString x) (DocString y)) = DocString (x ++ y)
-combineStringNodes (DocAppend (DocString x) (DocAppend (DocString y) z)) =
-  tryjoin (DocAppend (DocString (x ++ y)) (combineStringNodes z))
-combineStringNodes (DocAppend x y) = tryjoin (DocAppend (combineStringNodes x) (combineStringNodes y))
-combineStringNodes (DocParagraph x) = DocParagraph (combineStringNodes x)
-combineStringNodes (DocWarning x) = DocWarning (combineStringNodes x)
-combineStringNodes (DocEmphasis x) = DocEmphasis (combineStringNodes x)
-combineStringNodes (DocMonospaced x) = DocMonospaced (combineStringNodes x)
-combineStringNodes (DocUnorderedList xs) = DocUnorderedList (map combineStringNodes xs)
-combineStringNodes (DocOrderedList x) = DocOrderedList (map combineStringNodes x)
-combineStringNodes (DocDefList xs) = DocDefList (map (combineStringNodes *** combineStringNodes) xs)
-combineStringNodes (DocCodeBlock x) = DocCodeBlock (combineStringNodes x)
-combineStringNodes x = x
-
-tryjoin :: Doc id -> Doc id
-tryjoin (DocAppend (DocString x) (DocString y)) = DocString (x ++ y)
-tryjoin (DocAppend (DocString x) (DocAppend (DocString y) z)) = DocAppend (DocString (x ++ y)) z
-tryjoin (DocAppend (DocAppend x (DocString y)) (DocString z))
-  = tryjoin (DocAppend (combineStringNodes x) (DocString $ y ++ z))
-tryjoin x = x