diff options
author | Ian Lynagh <igloo@earth.li> | 2012-06-12 18:52:16 +0100 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2012-06-12 18:52:16 +0100 |
commit | 1b774aef07ad33b667fbf33e01c2dc9ed0e039f4 (patch) | |
tree | 75a8ce5ab45784b7d4e7b71ccae33da2cdbb5c4f /src/Haddock/Interface/LexParseRn.hs | |
parent | 315338287ea84b525da7d8fa8252cc9ec99597bb (diff) |
Follow changes in GHC
Diffstat (limited to 'src/Haddock/Interface/LexParseRn.hs')
-rw-r--r-- | src/Haddock/Interface/LexParseRn.hs | 25 |
1 files changed, 13 insertions, 12 deletions
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs index 0871c560..c13e57be 100644 --- a/src/Haddock/Interface/LexParseRn.hs +++ b/src/Haddock/Interface/LexParseRn.hs @@ -58,7 +58,7 @@ lexParseRnHaddockComment dflags hty 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)) lexParseRnMbHaddockComment :: DynFlags -> HaddockCommentType -> GlobalRdrEnv -> Maybe HsDocString -> ErrMsgM (Maybe (Doc Name)) @@ -79,18 +79,18 @@ lexParseRnHaddockModHeader dflags gre safety mbStr = do Left mess -> do tell ["haddock module header parse failed: " ++ mess] return failure - Right (info, doc) -> return (renameHmi gre info, Just (rename gre doc)) + Right (info, doc) -> return (renameHmi dflags gre info, Just (rename dflags gre doc)) return (hmi { hmi_safety = Just $ showPpr dflags safety }, docn) where failure = (emptyHaddockModInfo, Nothing) -renameHmi :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name -renameHmi gre hmi = hmi { hmi_description = rename gre <$> hmi_description hmi } +renameHmi :: DynFlags -> GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name +renameHmi dflags gre hmi = hmi { hmi_description = rename dflags gre <$> hmi_description hmi } -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) @@ -101,9 +101,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 @@ -124,12 +125,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)) |