diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 11 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 11 |
3 files changed, 16 insertions, 10 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index f6ad9808..42887834 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -245,8 +245,8 @@ ppCtor dflags dat subdocs con f (PrefixCon args) = [typeSig name $ args ++ [resType]] f (InfixCon a1 a2) = f $ PrefixCon [a1,a2] f (RecCon (L _ recs)) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat - [(concatMap (lookupCon dflags subdocs) (cd_fld_names r)) ++ - [out dflags (map unL $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]] + [(concatMap (lookupCon dflags subdocs . noLoc . selectorFieldOcc . unLoc) (cd_fld_names r)) ++ + [out dflags (map (selectorFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]] | r <- map unLoc recs] funs = foldr1 (\x y -> reL $ HsFunTy (makeExplicitL x) (makeExplicitL y)) diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 75ad51ab..eae450a4 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -25,9 +25,10 @@ import qualified Pretty import GHC import OccName import Name ( nameOccName ) -import RdrName ( rdrNameOcc ) +import RdrName ( rdrNameOcc, mkRdrUnqual ) import FastString ( unpackFS, unpackLitString, zString ) import Outputable ( panic) +import PrelNames ( mkUnboundName ) import qualified Data.Map as Map import System.Directory @@ -688,12 +689,12 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName -> LaTeX ppSideBySideField subdocs unicode (ConDeclField names ltype _) = - decltt (cat (punctuate comma (map (ppBinder . nameOccName . getName . unL) names)) + decltt (cat (punctuate comma (map (ppBinder . rdrNameOcc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode ltype) <-> rDoc mbDoc where -- don't use cd_fld_doc for same reason we don't use con_doc above -- Where there is more than one name, they all have the same documentation - mbDoc = lookup (unL $ head names) subdocs >>= fmap _doc . combineDocumentation . fst + mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= fmap _doc . combineDocumentation . fst -- {- -- ppHsFullConstr :: HsConDecl -> LaTeX @@ -902,7 +903,9 @@ ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode = maybeParen ctxt_prec pREC_FUN $ hsep [ppForAll expl tvs ctxt' unicode, ppr_mono_lty pREC_TOP ty unicode] where - anonWC = HsWildCardTy (AnonWildCard PlaceHolder) + anonWC :: HsType DocName + anonWC = HsWildCardTy (AnonWildCard (Undocumented underscore)) + underscore = mkUnboundName (mkRdrUnqual (mkTyVarOcc "_")) ctxt' | Just loc <- extra = (++ [L loc anonWC]) `fmap` ctxt | otherwise = ctxt diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index bc16bdcd..89b822d6 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -38,6 +38,8 @@ import GHC import GHC.Exts import Name import BooleanFormula +import RdrName ( rdrNameOcc, mkRdrUnqual ) +import PrelNames ( mkUnboundName ) ppDecl :: Bool -> LinksInfo -> LHsDecl DocName -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)] @@ -848,18 +850,18 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification -> ConDeclField DocName -> SubDecl ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) = - (hsep (punctuate comma (map ((ppBinder False) . nameOccName . getName . unL) names)) <+> dcolon unicode <+> ppLType unicode qual ltype, + (hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode qual ltype, mbDoc, []) where -- don't use cd_fld_doc for same reason we don't use con_doc above -- Where there is more than one name, they all have the same documentation - mbDoc = lookup (unL $ head names) subdocs >>= combineDocumentation . fst + mbDoc = lookup (selectorFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocName -> Html ppShortField summary unicode qual (ConDeclField names ltype _) - = hsep (punctuate comma (map ((ppBinder summary) . nameOccName . getName . unL) names)) + = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode qual ltype @@ -981,7 +983,8 @@ ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode qual = maybeParen ctxt_prec pREC_FUN $ ppForAllCon expl tvs ctxt' unicode qual <+> ppr_mono_lty pREC_TOP ty unicode qual where - anonWC = HsWildCardTy (AnonWildCard PlaceHolder) + anonWC = HsWildCardTy (AnonWildCard (Undocumented underscore)) + underscore = mkUnboundName (mkRdrUnqual (mkTyVarOcc "_")) ctxt' | Just loc <- extra = (++ [L loc anonWC]) `fmap` ctxt | otherwise = ctxt |