diff options
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 5 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 18 | ||||
| -rw-r--r-- | src/Haddock/Lex.x | 3 |
3 files changed, 13 insertions, 13 deletions
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 7c2375cf..274078a6 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -52,7 +52,10 @@ ppDocName qual docName = case docName of Documented name mdl -> linkIdOcc mdl (Just (nameOccName name)) << ppQualifyName qual name mdl - Undocumented name -> ppQualifyName qual name (nameModule name) + Undocumented name + | isExternalName name || isWiredInName name -> + ppQualifyName qual name (nameModule name) + | otherwise -> ppName name -- | Render a name depending on the selected qualification mode diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index ed51734d..94575209 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -35,7 +35,7 @@ import HscTypes import Name import Bag import RdrName -import TcRnTypes (tcg_warns) +import TcRnTypes import FastString (unpackFS) @@ -51,7 +51,8 @@ createInterface tm flags modMap instIfaceMap = do dflags = ms_hspp_opts ms instances = modInfoInstances mi exportedNames = modInfoExports mi - warnings = tcg_warns . fst . tm_internals_ $ tm + + (TcGblEnv {tcg_rdr_env = gre, tcg_warns = warnings}, _) = tm_internals_ tm -- The renamed source should always be available to us, but it's best -- to be on the safe side. @@ -62,10 +63,6 @@ createInterface tm flags modMap instIfaceMap = do return (emptyRnGroup, Nothing, Nothing) Just (x, _, y, z) -> return (x, y, z) - -- The pattern-match should not fail, because createInterface is only - -- done on loaded modules. - Just gre <- liftGhcToErrMsgGhc $ lookupLoadedHomeModuleGRE (moduleName mdl) - opts0 <- liftErrMsg $ mkDocOpts (haddockOptions dflags) flags mdl let opts | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0 @@ -80,7 +77,7 @@ createInterface tm flags modMap instIfaceMap = do localInsts = filter (nameIsLocalOrFrom mdl . getName) instances (docMap0, argMap, subMap, declMap) <- - liftErrMsg $ mkMaps dflags gre localInsts exportedNames declsWithDocs + liftErrMsg $ mkMaps dflags gre localInsts declsWithDocs let docMap = addWarnings warnings gre exportedNames docMap0 maps = (docMap, argMap, subMap, declMap) @@ -206,10 +203,9 @@ type Maps = (DocMap Name, ArgMap Name, SubMap, DeclMap) mkMaps :: DynFlags -> GlobalRdrEnv -> [Instance] - -> [Name] -> [(LHsDecl Name, [HsDocString])] -> ErrMsgM Maps -mkMaps dflags gre instances exports decls = do +mkMaps dflags gre instances decls = do (a, b, c, d) <- unzip4 <$> mapM mappings decls return (f a, f b, f c, f d) where @@ -223,7 +219,7 @@ mkMaps dflags gre instances exports decls = do m' <- M.mapMaybe id <$> T.mapM (processDocStringParas dflags gre) m return (doc, m') (doc, args) <- declDoc docStrs (typeDocs decl) - let subs = [ s | s@(n, _, _) <- subordinates decl, n `elem` exports ] + let subs = subordinates decl (subDocs, subArgs) <- unzip <$> mapM (\(_, strs, m) -> declDoc strs m) subs let ns = names decl subNs = [ n | (n, _, _) <- subs ] @@ -238,7 +234,7 @@ mkMaps dflags gre instances exports decls = do names :: HsDecl Name -> [Name] names (InstD (InstDecl (L l _) _ _ _)) = maybeToList (M.lookup l instanceMap) -- See note [2]. - names decl = filter (`elem` exports) (getMainDeclBinder decl) + names decl = getMainDeclBinder decl -- Note [2]: diff --git a/src/Haddock/Lex.x b/src/Haddock/Lex.x index f65aee8c..b9ebe688 100644 --- a/src/Haddock/Lex.x +++ b/src/Haddock/Lex.x @@ -34,6 +34,7 @@ import Data.Char import Data.Word (Word8) import Numeric import System.IO.Unsafe +import Debug.Trace } $ws = $white # \n @@ -181,7 +182,7 @@ tokenise dflags str (line, col) = let toks = go (posn, '\n', eofHack str) para i go inp@(pos, _, str) sc = case alexScan inp sc of AlexEOF -> [] - AlexError _ -> error "lexical error" + AlexError _ -> [] AlexSkip inp' _ -> go inp' sc AlexToken inp'@(pos',_,_) len act -> act pos (take len str) sc (\sc -> go inp' sc) dflags |