Prepare modules for parser split.

We have to generalise the Doc (now DocH) slightly to remove the
dependency on GHC-supplied type.

10 files changed, 206 insertions, 169 deletions

diff --git a/src/Haddock.hs b/src/Haddock.hs
index 78844c96..66dfb168 100644
--- a/src/Haddock.hs
+++ b/src/Haddock.hs
@@ -25,7 +25,7 @@ import Haddock.Backends.Xhtml.Themes (getThemes)
 import Haddock.Backends.LaTeX
 import Haddock.Backends.Hoogle
 import Haddock.Interface
-import Haddock.Parser
+import Haddock.Parser.Util
 import Haddock.Types
 import Haddock.Version
 import Haddock.InterfaceFile
diff --git a/src/Haddock/Doc.hs b/src/Haddock/Doc.hs
index 55d4e303..d812aee2 100644
--- a/src/Haddock/Doc.hs
+++ b/src/Haddock/Doc.hs
@@ -12,7 +12,7 @@ import Data.Char (isSpace)
 
 -- We put it here so that we can avoid a circular import
 -- anything relevant imports this module anyway
-instance Monoid (Doc id) where
+instance Monoid (DocH mod id) where
   mempty  = DocEmpty
   mappend = docAppend
 
@@ -20,7 +20,7 @@ combineDocumentation :: Documentation name -> Maybe (Doc name)
 combineDocumentation (Documentation Nothing Nothing) = Nothing
 combineDocumentation (Documentation mDoc mWarning)   = Just (fromMaybe mempty mWarning `mappend` fromMaybe mempty mDoc)
 
-docAppend :: Doc id -> Doc id -> Doc id
+docAppend :: DocH mod id -> DocH mod id -> DocH mod id
 docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2)
 docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d
 docAppend (DocOrderedList ds1) (DocOrderedList ds2) = DocOrderedList (ds1 ++ ds2)
@@ -34,7 +34,7 @@ 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
-docParagraph :: Doc id -> Doc id
+docParagraph :: DocH mod id -> DocH mod id
 docParagraph (DocMonospaced p)
   = DocCodeBlock (docCodeBlock p)
 docParagraph (DocAppend (DocString s1) (DocMonospaced p))
@@ -61,7 +61,7 @@ docParagraph p
 -- gives an extra vertical space after the code block.  The single space
 -- on the final line seems to trigger the extra vertical space.
 --
-docCodeBlock :: Doc id -> Doc id
+docCodeBlock :: DocH mod id -> DocH mod id
 docCodeBlock (DocString s)
   = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)
 docCodeBlock (DocAppend l r)
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index c302e4f0..01276310 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -20,7 +20,7 @@ module Haddock.Interface.LexParseRn
 
 import qualified Data.IntSet as IS
 import Haddock.Types
-import Haddock.Parser
+import Haddock.Parser.Util
 import Haddock.Interface.ParseModuleHeader
 import Haddock.Doc
 
diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs
index 0be2511f..c155a83b 100644
--- a/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/src/Haddock/Interface/ParseModuleHeader.hs
@@ -12,7 +12,7 @@
 module Haddock.Interface.ParseModuleHeader (parseModuleHeader) where
 
 import Haddock.Types
-import Haddock.Parser
+import Haddock.Parser.Util
 
 import RdrName
 import DynFlags
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 924829d7..7e4f6c10 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -456,7 +456,7 @@ instance Binary a => Binary (Header a) where
         return (Header l t)
 
 {-* Generated by DrIFT : Look, but Don't Touch. *-}
-instance (Binary id) => Binary (Doc id) where
+instance (Binary mod, Binary id) => Binary (DocH mod id) where
     put_ bh DocEmpty = do
             putByte bh 0
     put_ bh (DocAppend aa ab) = do
diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs
index ece9291f..1489ae84 100644
--- a/src/Haddock/Parser.hs
+++ b/src/Haddock/Parser.hs
@@ -13,7 +13,10 @@
 -- Stability   :  experimental
 -- Portability :  portable
 
-module Haddock.Parser (parseString, parseParas, parseStringMaybe, parseParasMaybe) where
+module Haddock.Parser ( parseString, parseParas
+                      , overIdentifier, toRegular
+                      , takeUntil
+                      ) where
 
 import           Prelude hiding (takeWhile)
 import           Control.Arrow (first)
@@ -25,25 +28,51 @@ import           Data.Char (chr, isAsciiUpper)
 import           Data.List (stripPrefix, intercalate, unfoldr)
 import           Data.Maybe (fromMaybe)
 import           Data.Monoid
-import           DynFlags
-import           FastString (mkFastString)
 import           Haddock.Doc
-import           Haddock.Types
-import           Lexer (mkPState, unP, ParseResult(POk))
-import           Parser (parseIdentifier)
-import           RdrName
-import           SrcLoc (mkRealSrcLoc, unLoc)
-import           StringBuffer (stringToStringBuffer)
+import           Haddock.Types hiding (Doc)
 import           Haddock.Utf8
-import           Haddock.Parser.Util
-
-{-# DEPRECATED parseParasMaybe "use `parseParas` instead" #-}
-parseParasMaybe :: DynFlags -> String -> Maybe (Doc RdrName)
-parseParasMaybe d = Just . parseParas d
-
-{-# DEPRECATED parseStringMaybe "use `parseString` instead" #-}
-parseStringMaybe :: DynFlags -> String -> Maybe (Doc RdrName)
-parseStringMaybe d = Just . parseString d
+import           Data.ByteString.Char8 (ByteString)
+
+-- | Identifier string surrounded with opening and closing quotes/backticks.
+type IString = (Char, String, Char)
+
+-- | Drops the quotes/backticks around all identifiers, as if they
+-- were valid but still 'String's.
+toRegular :: DocH mod IString -> DocH mod String
+toRegular = fmap (\(_, x, _) -> x)
+
+-- | Maps over 'DocIdentifier's over 'String' with potentially failing
+-- conversion using user-supplied function. If the conversion fails,
+-- the identifier is deemed to not be valid and is treated as a
+-- regular string.
+overIdentifier :: (String -> Maybe a)
+               -> DocH mod IString
+               -> DocH mod a
+overIdentifier f d = g d
+  where
+    g (DocIdentifier (o, x, e)) = case f x of
+      Nothing -> DocString $ o : x ++ [e]
+      Just x' -> DocIdentifier x'
+    g DocEmpty = DocEmpty
+    g (DocAppend x x') = DocAppend (g x) (g x')
+    g (DocString x) = DocString x
+    g (DocParagraph x) = DocParagraph $ g x
+    g (DocIdentifierUnchecked x) = DocIdentifierUnchecked x
+    g (DocModule x) = DocModule x
+    g (DocWarning x) = DocWarning $ g x
+    g (DocEmphasis x) = DocEmphasis $ g x
+    g (DocMonospaced x) = DocMonospaced $ g x
+    g (DocBold x) = DocBold $ g x
+    g (DocUnorderedList x) = DocUnorderedList $ fmap g x
+    g (DocOrderedList x) = DocOrderedList $ fmap g x
+    g (DocDefList x) = DocDefList $ fmap (\(y, z) -> (g y, g z)) x
+    g (DocCodeBlock x) = DocCodeBlock $ g x
+    g (DocHyperlink x) = DocHyperlink x
+    g (DocPic x) = DocPic x
+    g (DocAName x) = DocAName x
+    g (DocProperty x) = DocProperty x
+    g (DocExamples x) = DocExamples x
+    g (DocHeader (Header l x)) = DocHeader . Header l $ g x
 
 parse :: Parser a -> BS.ByteString -> a
 parse p = either err id . parseOnly (p <* endOfInput)
@@ -52,33 +81,32 @@ parse p = either err id . parseOnly (p <* endOfInput)
 
 -- | Main entry point to the parser. Appends the newline character
 -- to the input string.
-parseParas :: DynFlags
-              -> String -- ^ String to parse
-              -> Doc RdrName
-parseParas d = parse (p <* skipSpace) . encodeUtf8 . (++ "\n")
+parseParas :: String -- ^ String to parse
+           -> DocH mod IString
+parseParas = parse (p <* skipSpace) . encodeUtf8 . (++ "\n")
   where
-    p :: Parser (Doc RdrName)
-    p = mconcat <$> paragraph d `sepBy` many (skipHorizontalSpace *> "\n")
+    p :: Parser (DocH mod IString)
+    p = mconcat <$> paragraph `sepBy` many (skipHorizontalSpace *> "\n")
 
 -- | Parse a text paragraph. Actually just a wrapper over 'parseStringBS' which
 -- drops leading whitespace and encodes the string to UTF8 first.
-parseString :: DynFlags -> String -> Doc RdrName
-parseString d = parseStringBS d . encodeUtf8 . dropWhile isSpace
+parseString :: String -> DocH mod IString
+parseString = parseStringBS . encodeUtf8 . dropWhile isSpace
 
-parseStringBS :: DynFlags -> BS.ByteString -> Doc RdrName
-parseStringBS d = parse p
+parseStringBS :: BS.ByteString -> DocH mod IString
+parseStringBS = parse p
   where
-    p :: Parser (Doc RdrName)
-    p = mconcat <$> many (monospace d <|> anchor <|> identifier d
-                          <|> moduleName <|> picture <|> hyperlink <|> autoUrl <|> bold d
-                          <|> emphasis d <|> encodedChar <|> string' <|> skipSpecialChar)
+    p :: Parser (DocH mod IString)
+    p = mconcat <$> many (monospace <|> anchor <|> identifier
+                          <|> moduleName <|> picture <|> hyperlink <|> autoUrl <|> bold
+                          <|> emphasis <|> encodedChar <|> string' <|> skipSpecialChar)
 
 -- | Parses and processes
 -- <https://en.wikipedia.org/wiki/Numeric_character_reference Numeric character references>
 --
 -- >>> parseOnly encodedChar "&#65;&#66;&#67;"
 -- Right (DocString "ABC")
-encodedChar :: Parser (Doc a)
+encodedChar :: Parser (DocH mod a)
 encodedChar = "&#" *> c <* ";"
   where
     c = DocString . return . chr <$> num
@@ -91,7 +119,7 @@ specialChar = "_/<@\"&'`"
 -- | Plain, regular parser for text. Called as one of the last parsers
 -- to ensure that we have already given a chance to more meaningful parsers
 -- before capturing their characers.
-string' :: Parser (Doc a)
+string' :: Parser (DocH mod a)
 string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialChar)
   where
     unescape "" = ""
@@ -101,23 +129,23 @@ string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialCh
 -- | Skips a single special character and treats it as a plain string.
 -- This is done to skip over any special characters belonging to other
 -- elements but which were not deemed meaningful at their positions.
-skipSpecialChar :: Parser (Doc a)
+skipSpecialChar :: Parser (DocH mod a)
 skipSpecialChar = DocString . return <$> satisfy (`elem` specialChar)
 
 -- | Emphasis parser.
 --
 -- >>> parseOnly emphasis "/Hello world/"
 -- Right (DocEmphasis (DocString "Hello world"))
-emphasis :: DynFlags -> Parser (Doc RdrName)
-emphasis d = DocEmphasis . parseStringBS d <$>
+emphasis :: Parser (DocH mod IString)
+emphasis = DocEmphasis . parseStringBS <$>
   mfilter ('\n' `BS.notElem`) ("/" *> takeWhile1_ (/= '/') <* "/")
 
 -- | Bold parser.
 --
 -- >>> parseOnly bold "__Hello world__"
 -- Right (DocBold (DocString "Hello world"))
-bold :: DynFlags -> Parser (Doc RdrName)
-bold d = DocBold . parseStringBS d <$> disallowNewline ("__" *> takeUntil "__")
+bold :: Parser (DocH mod IString)
+bold = DocBold . parseStringBS <$> disallowNewline ("__" *> takeUntil "__")
 
 disallowNewline :: Parser BS.ByteString -> Parser BS.ByteString
 disallowNewline = mfilter ('\n' `BS.notElem`)
@@ -139,17 +167,17 @@ takeWhile1_ = mfilter (not . BS.null) . takeWhile_
 --
 -- >>> parseOnly anchor "#Hello world#"
 -- Right (DocAName "Hello world")
-anchor :: Parser (Doc a)
+anchor :: Parser (DocH mod a)
 anchor = DocAName . decodeUtf8 <$> ("#" *> takeWhile1 (`notElem` "#\n") <* "#")
 
 -- | Monospaced strings.
 --
--- >>> parseOnly (monospace dynflags) "@cruel@"
+-- >>> parseOnly monospace "@cruel@"
 -- Right (DocMonospaced (DocString "cruel"))
-monospace :: DynFlags -> Parser (Doc RdrName)
-monospace d = DocMonospaced . parseStringBS d <$> ("@" *> takeWhile1_ (/= '@') <* "@")
+monospace :: Parser (DocH mod IString)
+monospace = DocMonospaced . parseStringBS <$> ("@" *> takeWhile1_ (/= '@') <* "@")
 
-moduleName :: Parser (Doc a)
+moduleName :: Parser (DocH mod a)
 moduleName = DocModule <$> (char '"' *> modid <* char '"')
   where
     modid = intercalate "." <$> conid `sepBy1` "."
@@ -167,41 +195,41 @@ moduleName = DocModule <$> (char '"' *> modid <* char '"')
 -- Right (DocPic (Picture "hello.png" Nothing))
 -- >>> parseOnly picture "<<hello.png world>>"
 -- Right (DocPic (Picture "hello.png" (Just "world")))
-picture :: Parser (Doc a)
+picture :: Parser (DocH mod a)
 picture = DocPic . makeLabeled Picture . decodeUtf8
           <$> disallowNewline ("<<" *> takeUntil ">>")
 
 -- | Paragraph parser, called by 'parseParas'.
-paragraph :: DynFlags -> Parser (Doc RdrName)
-paragraph d = examples <|> skipSpace *> (list d <|> birdtracks <|> codeblock d
-                                         <|> property <|> header d
-                                         <|> textParagraph d)
+paragraph :: Parser (DocH mod IString)
+paragraph = examples <|> skipSpace *> (list <|> birdtracks <|> codeblock
+                                       <|> property <|> header
+                                       <|> textParagraph)
 
-header :: DynFlags -> Parser (Doc RdrName)
-header d = do
+header :: Parser (DocH mod IString)
+header = do
   let psers = map (string . encodeUtf8 . concat . flip replicate "=") [6, 5 .. 1]
       pser = foldl1 (<|>) psers
   delim <- decodeUtf8 <$> pser
-  line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseString d
-  rest <- paragraph d <|> return mempty
+  line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseString
+  rest <- paragraph <|> return mempty
   return $ docAppend (DocParagraph (DocHeader (Header (length delim) line))) rest
 
-textParagraph :: DynFlags -> Parser (Doc RdrName)
-textParagraph d = docParagraph . parseString d . intercalate "\n" <$> many1 nonEmptyLine
+textParagraph :: Parser (DocH mod IString)
+textParagraph = docParagraph . parseString . intercalate "\n" <$> many1 nonEmptyLine
 
 -- | List parser, called by 'paragraph'.
-list :: DynFlags -> Parser (Doc RdrName)
-list d = DocUnorderedList <$> unorderedList d
-         <|> DocOrderedList <$> orderedList d
-         <|> DocDefList <$> definitionList d
+list :: Parser (DocH mod IString)
+list = DocUnorderedList <$> unorderedList
+       <|> DocOrderedList <$> orderedList
+       <|> DocDefList <$> definitionList
 
 -- | Parses unordered (bullet) lists.
-unorderedList :: DynFlags -> Parser [Doc RdrName]
-unorderedList d = ("*" <|> "-") *> innerList (unorderedList d) d
+unorderedList :: Parser [DocH mod IString]
+unorderedList = ("*" <|> "-") *> innerList unorderedList
 
 -- | Parses ordered lists (numbered or dashed).
-orderedList :: DynFlags -> Parser [Doc RdrName]
-orderedList d = (paren <|> dot) *> innerList (orderedList d) d
+orderedList :: Parser [DocH mod IString]
+orderedList = (paren <|> dot) *> innerList orderedList
   where
     dot = (decimal :: Parser Int) <* "."
     paren = "(" *> decimal <* ")"
@@ -210,23 +238,23 @@ orderedList d = (paren <|> dot) *> innerList (orderedList d) d
 -- list entry and recursively collecting any further lists in the
 -- same paragraph. Usually used as
 --
--- > someListFunction dynflags = listBeginning *> innerList someListFunction dynflags
-innerList :: Parser [Doc RdrName] -> DynFlags -> Parser [Doc RdrName]
-innerList item d = do
+-- > someListFunction = listBeginning *> innerList someListFunction
+innerList :: Parser [DocH mod IString] -> Parser [DocH mod IString]
+innerList item = do
   c <- takeLine
-  (cs, items) <- more item d
-  let contents = docParagraph . parseString d . dropNLs . unlines $ c : cs
+  (cs, items) <- more item
+  let contents = docParagraph . parseString . dropNLs . unlines $ c : cs
   return $ case items of
     Left p -> [contents `joinPara` p]
     Right i -> contents : i
 
 -- | Parses definition lists.
-definitionList :: DynFlags -> Parser [(Doc RdrName, Doc RdrName)]
-definitionList d = do
-  label <- "[" *> (parseStringBS d <$> takeWhile1 (`notElem` "]\n")) <* "]"
+definitionList :: Parser [(DocH mod IString, DocH mod IString)]
+definitionList = do
+  label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` "]\n")) <* "]"
   c <- takeLine
-  (cs, items) <- more (definitionList d) d
-  let contents = parseString d . dropNLs . unlines $ c : cs
+  (cs, items) <- more definitionList
+  let contents = parseString . dropNLs . unlines $ c : cs
   return $ case items of
     Left p -> [(label, contents `joinPara` p)]
     Right i -> (label, contents) : i
@@ -239,7 +267,7 @@ definitionList d = do
 -- rather than
 --
 -- @DocAppend (DocParagraph …) …@
-joinPara :: Doc id -> Doc id -> Doc id
+joinPara :: DocH mod id -> DocH mod id -> DocH mod id
 joinPara (DocParagraph p) c = docParagraph $ docAppend p c
 joinPara d p = docAppend d p
 
@@ -250,33 +278,32 @@ dropNLs = reverse . dropWhile (== '\n') . reverse
 -- | Main worker for 'innerList' and 'definitionList'.
 -- We need the 'Either' here to be able to tell in the respective functions
 -- whether we're dealing with the next list or a nested paragraph.
-more :: Monoid a => Parser a -> DynFlags
-     -> Parser ([String], Either (Doc RdrName) a)
-more item d = innerParagraphs d <|> moreListItems item
-              <|> moreContent item d <|> pure ([], Right mempty)
+more :: Monoid a => Parser a
+     -> Parser ([String], Either (DocH mod IString) a)
+more item = innerParagraphs <|> moreListItems item
+            <|> moreContent item <|> pure ([], Right mempty)
 
 -- | Use by 'innerList' and 'definitionList' to parse any nested paragraphs.
-innerParagraphs :: DynFlags
-                -> Parser ([String], Either (Doc RdrName) a)
-innerParagraphs d = (,) [] . Left <$> ("\n" *> indentedParagraphs d)
+innerParagraphs :: Parser ([String], Either (DocH mod IString) a)
+innerParagraphs = (,) [] . Left <$> ("\n" *> indentedParagraphs)
 
 -- | Attemps to fetch the next list if possibly. Used by 'innerList' and
 -- 'definitionList' to recursivly grab lists that aren't separated by a whole
 -- paragraph.
 moreListItems :: Parser a
-              -> Parser ([String], Either (Doc RdrName) a)
+              -> Parser ([String], Either (DocH mod IString) a)
 moreListItems item = (,) [] . Right <$> (skipSpace *> item)
 
 -- | Helper for 'innerList' and 'definitionList' which simply takes
 -- a line of text and attempts to parse more list content with 'more'.
-moreContent :: Monoid a => Parser a -> DynFlags
-            -> Parser ([String], Either (Doc RdrName) a)
-moreContent item d = first . (:) <$> nonEmptyLine <*> more item d
+moreContent :: Monoid a => Parser a
+            -> Parser ([String], Either (DocH mod IString) a)
+moreContent item = first . (:) <$> nonEmptyLine <*> more item
 
 -- | Runs the 'parseParas' parser on an indented paragraph.
 -- The indentation is 4 spaces.
-indentedParagraphs :: DynFlags -> Parser (Doc RdrName)
-indentedParagraphs d = parseParas d . concat <$> dropFrontOfPara "    "
+indentedParagraphs :: Parser (DocH mod IString)
+indentedParagraphs = parseParas . concat <$> dropFrontOfPara "    "
 
 -- | Grab as many fully indented paragraphs as we can.
 dropFrontOfPara :: Parser BS.ByteString -> Parser [String]
@@ -303,7 +330,7 @@ takeNonEmptyLine :: Parser String
 takeNonEmptyLine = do
     (++ "\n") . decodeUtf8 <$> (takeWhile1 (/= '\n') >>= nonSpace) <* "\n"
 
-birdtracks :: Parser (Doc a)
+birdtracks :: Parser (DocH mod a)
 birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 line
   where
     line = skipHorizontalSpace *> ">" *> takeLine
@@ -317,7 +344,7 @@ stripSpace = fromMaybe <*> mapM strip'
 
 -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line).
 -- Consecutive examples are accepted.
-examples :: Parser (Doc a)
+examples :: Parser (DocH mod a)
 examples = DocExamples <$> (many (skipHorizontalSpace *> "\n") *> go)
   where
     go :: Parser [Example]
@@ -360,15 +387,15 @@ endOfLine = void "\n" <|> endOfInput
 --
 -- >>> parseOnly property "prop> hello world"
 -- Right (DocProperty "hello world")
-property :: Parser (Doc a)
+property :: Parser (DocH mod a)
 property = DocProperty . strip . decodeUtf8 <$> ("prop>" *> takeWhile1 (/= '\n'))
 
 -- |
 -- Paragraph level codeblock. Anything between the two delimiting @ is parsed
 -- for markup.
-codeblock :: DynFlags -> Parser (Doc RdrName)
-codeblock d =
-  DocCodeBlock . parseStringBS d . dropSpaces
+codeblock :: Parser (DocH mod IString)
+codeblock =
+  DocCodeBlock . parseStringBS . dropSpaces
   <$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@")
   where
     dropSpaces xs =
@@ -386,7 +413,7 @@ codeblock d =
     -- text which we need to decide whether we actually want to be dropping
     -- anything at all.
     splitByNl = unfoldr (\case '\n':s -> Just (span (/= '\n') s)
-                               _ -> Nothing)
+                               _      -> Nothing)
                 . ('\n' :)
 
     dropSpace "" = Just ""
@@ -400,16 +427,16 @@ codeblock d =
           | isNewline && isSpace c = Just isNewline
           | otherwise = Just $ c == '\n'
 
-hyperlink :: Parser (Doc a)
+hyperlink :: Parser (DocH mod a)
 hyperlink = DocHyperlink . makeLabeled Hyperlink . decodeUtf8
               <$> disallowNewline ("<" *> takeUntil ">")
             <|> autoUrl
 
-autoUrl :: Parser (Doc a)
+autoUrl :: Parser (DocH mod a)
 autoUrl = mkLink <$> url
   where
     url = mappend <$> ("http://" <|> "https://" <|> "ftp://") <*> takeWhile1 (not . isSpace)
-    mkLink :: BS.ByteString -> Doc a
+    mkLink :: BS.ByteString -> DocH mod a
     mkLink s = case BS.unsnoc s of
       Just (xs, x) | x `elem` ",.!?" -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) <> DocString [x]
       _ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing)
@@ -435,28 +462,16 @@ parseValid = do
 utf8String :: String -> Parser String
 utf8String x = decodeUtf8 <$> string (encodeUtf8 x)
 
--- | Parses identifiers with help of 'parseValid'. Asks GHC for 'RdrName' from the
+-- | Parses identifiers with help of 'parseValid'. Asks GHC for 'String' from the
 -- string it deems valid.
-identifier :: DynFlags -> Parser (Doc RdrName)
-identifier dflags = do
+identifier :: Parser (DocH mod IString)
+identifier = do
   o <- idDelim
   vid <- parseValid
   e <- idDelim
-  return $ validIdentifier o vid e
+  return $ DocIdentifier (o, vid, e)
   where
     idDelim = char '\'' <|> char '`'
-    validIdentifier o ident e = case parseIdent ident of
-      Just identName -> DocIdentifier identName
-      Nothing -> DocString $ o : ident ++ [e]
-
-    parseIdent :: String -> Maybe RdrName
-    parseIdent str0 =
-      let buffer = stringToStringBuffer str0
-          realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0
-          pstate = mkPState dflags buffer realSrcLc
-      in case unP parseIdentifier pstate of
-        POk _ name -> Just (unLoc name)
-        _ -> Nothing
 
 -- | Remove all leading and trailing whitespace
 strip :: String -> String
@@ -480,3 +495,22 @@ makeLabeled f input = case break isSpace $ removeEscapes $ strip input of
     removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs
     removeEscapes ('\\':xs) = removeEscapes xs
     removeEscapes (x:xs) = x : removeEscapes xs
+
+takeUntil :: ByteString -> Parser ByteString
+takeUntil end_ = dropEnd <$> requireEnd (scan (False, end) p) >>= gotSome
+  where
+    end = BS.unpack end_
+
+    p :: (Bool, String) -> Char -> Maybe (Bool, String)
+    p acc c = case acc of
+      (True, _) -> Just (False, end)
+      (_, []) -> Nothing
+      (_, x:xs) | x == c -> Just (False, xs)
+      _ -> Just (c == '\\', end)
+
+    dropEnd = BS.reverse . BS.drop (length end) . BS.reverse
+    requireEnd = mfilter (BS.isSuffixOf end_)
+
+    gotSome xs
+      | BS.null xs = fail "didn't get any content"
+      | otherwise = return xs
diff --git a/src/Haddock/Parser/Util.hs b/src/Haddock/Parser/Util.hs
index 92fa7448..29da91c0 100644
--- a/src/Haddock/Parser/Util.hs
+++ b/src/Haddock/Parser/Util.hs
@@ -1,26 +1,28 @@
 module Haddock.Parser.Util where
 
-import           Control.Applicative
-import           Control.Monad
-import           Data.Attoparsec.ByteString.Char8
-import           Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as BS
+import DynFlags (DynFlags)
+import FastString (mkFastString)
+import Haddock.Types
+import Haddock.Parser
+import Lexer (mkPState, unP, ParseResult(POk))
+import Parser (parseIdentifier)
+import RdrName (RdrName)
+import SrcLoc (mkRealSrcLoc, unLoc)
+import StringBuffer (stringToStringBuffer)
 
-takeUntil :: ByteString -> Parser ByteString
-takeUntil end_ = dropEnd <$> requireEnd (scan (False, end) p) >>= gotSome
-  where
-    end = BS.unpack end_
+{-# DEPRECATED parseParasMaybe "use `parseParas` instead" #-}
+parseParasMaybe :: DynFlags -> String -> Maybe (Doc RdrName)
+parseParasMaybe d = Just . overIdentifier (parseIdent d) . parseParas
 
-    p :: (Bool, String) -> Char -> Maybe (Bool, String)
-    p acc c = case acc of
-      (True, _) -> Just (False, end)
-      (_, []) -> Nothing
-      (_, x:xs) | x == c -> Just (False, xs)
-      _ -> Just (c == '\\', end)
+{-# DEPRECATED parseStringMaybe "use `parseString` instead" #-}
+parseStringMaybe :: DynFlags -> String -> Maybe (Doc RdrName)
+parseStringMaybe d = Just . overIdentifier (parseIdent d) . parseString
 
-    dropEnd = BS.reverse . BS.drop (length end) . BS.reverse
-    requireEnd = mfilter (BS.isSuffixOf end_)
-
-    gotSome xs
-      | BS.null xs = fail "didn't get any content"
-      | otherwise = return xs
+parseIdent :: DynFlags -> String -> Maybe RdrName
+parseIdent dflags str0 =
+  let buffer = stringToStringBuffer str0
+      realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0
+      pstate = mkPState dflags buffer realSrcLc
+  in case unP parseIdentifier pstate of
+    POk _ name -> Just (unLoc name)
+    _ -> Nothing
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 5930c930..cd615bf4 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -314,29 +314,30 @@ type InstHead name = (name, [HsType name], [HsType name], InstType name)
 
 type LDoc id = Located (Doc id)
 
+type Doc id = DocH (ModuleName, OccName) id
 
-data Doc id
+data DocH mod id
   = DocEmpty
-  | DocAppend (Doc id) (Doc id)
+  | DocAppend (DocH mod id) (DocH mod id)
   | DocString String
-  | DocParagraph (Doc id)
+  | DocParagraph (DocH mod id)
   | DocIdentifier id
-  | DocIdentifierUnchecked (ModuleName, OccName)
+  | DocIdentifierUnchecked mod
   | DocModule String
-  | DocWarning (Doc id)
-  | DocEmphasis (Doc id)
-  | DocMonospaced (Doc id)
-  | DocBold (Doc id)
-  | DocUnorderedList [Doc id]
-  | DocOrderedList [Doc id]
-  | DocDefList [(Doc id, Doc id)]
-  | DocCodeBlock (Doc id)
+  | DocWarning (DocH mod id)
+  | DocEmphasis (DocH mod id)
+  | DocMonospaced (DocH mod id)
+  | DocBold (DocH mod id)
+  | DocUnorderedList [DocH mod id]
+  | DocOrderedList [DocH mod id]
+  | DocDefList [(DocH mod id, DocH mod id)]
+  | DocCodeBlock (DocH mod id)
   | DocHyperlink Hyperlink
   | DocPic Picture
   | DocAName String
   | DocProperty String
   | DocExamples [Example]
-  | DocHeader (Header (Doc id))
+  | DocHeader (Header (DocH mod id))
   deriving (Functor, Foldable, Traversable)
 
 instance Foldable Header where
@@ -345,7 +346,8 @@ instance Foldable Header where
 instance Traversable Header where
   traverse f (Header l a) = Header l `fmap` f a
 
-instance NFData a => NFData (Doc a) where
+instance (NFData a, NFData mod)
+         => NFData (DocH mod a) where
   rnf doc = case doc of
     DocEmpty                  -> ()
     DocAppend a b             -> a `deepseq` b `deepseq` ()
diff --git a/test/Haddock/Parser/UtilSpec.hs b/test/Haddock/Parser/UtilSpec.hs
index acb88220..9e1e8de1 100644
--- a/test/Haddock/Parser/UtilSpec.hs
+++ b/test/Haddock/Parser/UtilSpec.hs
@@ -5,7 +5,7 @@ import           Test.Hspec
 import           Data.Either
 
 import           Data.Attoparsec.ByteString.Char8
-import           Haddock.Parser.Util
+import           Haddock.Parser
 
 main :: IO ()
 main = hspec spec
diff --git a/test/Haddock/ParserSpec.hs b/test/Haddock/ParserSpec.hs
index f44b7d0f..53fef943 100644
--- a/test/Haddock/ParserSpec.hs
+++ b/test/Haddock/ParserSpec.hs
@@ -26,20 +26,19 @@ deriving instance Show a => Show (Doc a)
 deriving instance Eq a => Eq (Header a)
 deriving instance Eq a => Eq (Doc a)
 
-instance IsString RdrName where
-  fromString = mkVarUnqual . fsLit
-
-instance IsString (Doc RdrName) where
+instance IsString (Doc String) where
   fromString = DocString
 
 instance IsString a => IsString (Maybe a) where
   fromString = Just . fromString
 
-parseParas :: String -> Doc RdrName
-parseParas = Parse.parseParas dynFlags
+parseParas :: String -> Doc String
+parseParas = Parse.toRegular . Parse.parseParas
+
+parseString :: String -> Doc String
+parseString = Parse.toRegular . Parse.parseString
+
 
-parseString :: String -> Doc RdrName
-parseString = Parse.parseString dynFlags
 
 main :: IO ()
 main = hspec spec
@@ -48,7 +47,7 @@ spec :: Spec
 spec = before initStaticOpts $ do
   describe "parseString" $ do
     let infix 1 `shouldParseTo`
-        shouldParseTo :: String -> Doc RdrName -> Expectation
+        shouldParseTo :: String -> Doc String -> Expectation
         shouldParseTo input ast = parseString input `shouldBe` ast
 
     it "is total" $ do
@@ -96,7 +95,7 @@ spec = before initStaticOpts $ do
           "don't use apostrophe's in the wrong place's"
 
     context "when parsing URLs" $ do
-      let hyperlink :: String -> Maybe String -> Doc RdrName
+      let hyperlink :: String -> Maybe String -> Doc String
           hyperlink url = DocHyperlink . Hyperlink url
 
       it "parses a URL" $ do
@@ -154,7 +153,7 @@ spec = before initStaticOpts $ do
             hyperlink "http://example.com/" Nothing <> "? Some other sentence."
 
     context "when parsing pictures" $ do
-      let picture :: String -> Maybe String -> Doc RdrName
+      let picture :: String -> Maybe String -> Doc String
           picture uri = DocPic . Picture uri
 
       it "parses a simple picture" $ do
@@ -310,7 +309,7 @@ spec = before initStaticOpts $ do
 
   describe "parseParas" $ do
     let infix 1 `shouldParseTo`
-        shouldParseTo :: String -> Doc RdrName -> Expectation
+        shouldParseTo :: String -> Doc String -> Expectation
         shouldParseTo input ast = parseParas input `shouldBe` ast
 
     it "is total" $ do