1 files changed, 14 insertions, 12 deletions

diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index 56ed1b42..d68f78f8 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -61,7 +61,7 @@ process parse dflags gre (HsDocString fs) = do
      Nothing -> do
        tell [ "doc comment parse failed: " ++ str ]
        return Nothing
-     Just doc -> return (Just (rename gre doc))
+     Just doc -> return (Just (rename dflags gre doc))
 
 
 processModuleHeader :: DynFlags -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString
@@ -69,6 +69,7 @@ processModuleHeader :: DynFlags -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsD
 processModuleHeader dflags gre safety mayStr = do
   (hmi, doc) <-
     case mayStr of
+
       Nothing -> return failure
       Just (L _ (HsDocString fs)) -> do
         let str = unpackFS fs
@@ -77,16 +78,16 @@ processModuleHeader dflags gre safety mayStr = do
             tell ["haddock module header parse failed: " ++ msg]
             return failure
           Right (hmi, doc) -> do
-            let hmi' = hmi { hmi_description = rename gre <$> hmi_description hmi }
-                doc' = rename gre doc
+            let hmi' = hmi { hmi_description = rename dflags gre <$> hmi_description hmi }
+                doc' = rename dflags gre doc
             return (hmi', Just doc')
-  return (hmi { hmi_safety = Just $ showPpr safety }, doc)
+  return (hmi { hmi_safety = Just $ showPpr dflags safety }, doc)
   where
     failure = (emptyHaddockModInfo, Nothing)
 
 
-rename :: GlobalRdrEnv -> Doc RdrName -> Doc Name
-rename gre = rn
+rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> Doc Name
+rename dflags gre = rn
   where
     rn d = case d of
       DocAppend a b -> DocAppend (rn a) (rn b)
@@ -97,9 +98,10 @@ rename gre = rn
         case names of
           [] ->
             case choices of
-              [] -> DocMonospaced (DocString (showSDoc $ ppr x))
-              [a] -> outOfScope a
-              a:b:_ | isRdrTc a -> outOfScope a | otherwise -> outOfScope b
+              [] -> DocMonospaced (DocString (showPpr dflags x))
+              [a] -> outOfScope dflags a
+              a:b:_ | isRdrTc a -> outOfScope dflags a
+                    | otherwise -> outOfScope dflags b
           [a] -> DocIdentifier a
           a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b
               -- If an id can refer to multiple things, we give precedence to type
@@ -121,12 +123,12 @@ rename gre = rn
       DocString str -> DocString str
 
 
-outOfScope :: RdrName -> Doc a
-outOfScope x =
+outOfScope :: DynFlags -> RdrName -> Doc a
+outOfScope dflags x =
   case x of
     Unqual occ -> monospaced occ
     Qual mdl occ -> DocIdentifierUnchecked (mdl, occ)
     Orig _ occ -> monospaced occ
     Exact name -> monospaced name  -- Shouldn't happen since x is out of scope
   where
-    monospaced a = DocMonospaced (DocString (showSDoc $ ppr a))
+    monospaced a = DocMonospaced (DocString (showPpr dflags a))