diff options
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Create.hs')
-rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 39 |
1 files changed, 2 insertions, 37 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index c9290ed0..36cfeaca 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -20,27 +20,21 @@ module Haddock.Interface.Create (createInterface) where import Documentation.Haddock.Doc (metaDocAppend) -import Documentation.Haddock.Utf8 as Utf8 import Haddock.Types import Haddock.Options import Haddock.GhcUtils import Haddock.Utils import Haddock.Convert import Haddock.Interface.LexParseRn -import Haddock.Backends.Hyperlinker.Types -import Haddock.Backends.Hyperlinker.Ast as Hyperlinker -import Haddock.Backends.Hyperlinker.Parser as Hyperlinker import Data.Bifunctor import Data.Bitraversable -import qualified Data.ByteString as BS import qualified Data.Map as M import Data.Map (Map) import Data.List import Data.Maybe import Data.Ord import Control.Applicative -import Control.Exception (evaluate) import Control.Monad import Data.Traversable @@ -169,8 +163,6 @@ createInterface tm flags modMap instIfaceMap = do modWarn <- liftErrMsg (moduleWarning dflags gre warnings) - tokenizedSrc <- mkMaybeTokenizedSrc dflags flags tm - return $! Interface { ifaceMod = mdl , ifaceIsSig = is_sig @@ -196,7 +188,8 @@ createInterface tm flags modMap instIfaceMap = do , ifaceRnOrphanInstances = [] -- Filled in `renameInterface` , ifaceHaddockCoverage = coverage , ifaceWarningMap = warningMap - , ifaceTokenizedSrc = tokenizedSrc + , ifaceHieFile = Just $ ml_hie_file $ ms_location ms + , ifaceDynFlags = dflags } @@ -1200,34 +1193,6 @@ seqList :: [a] -> () seqList [] = () seqList (x : xs) = x `seq` seqList xs -mkMaybeTokenizedSrc :: DynFlags -> [Flag] -> TypecheckedModule - -> ErrMsgGhc (Maybe [RichToken]) -mkMaybeTokenizedSrc dflags flags tm - | Flag_HyperlinkedSource `elem` flags = case renamedSource tm of - Just src -> do - tokens <- liftGhcToErrMsgGhc (liftIO (mkTokenizedSrc dflags summary src)) - return $ Just tokens - Nothing -> do - liftErrMsg . tell . pure $ concat - [ "Warning: Cannot hyperlink module \"" - , moduleNameString . ms_mod_name $ summary - , "\" because renamed source is not available" - ] - return Nothing - | otherwise = return Nothing - where - summary = pm_mod_summary . tm_parsed_module $ tm - -mkTokenizedSrc :: DynFlags -> ModSummary -> RenamedSource -> IO [RichToken] -mkTokenizedSrc dflags ms src = do - -- make sure to read the whole file at once otherwise - -- we run out of file descriptors (see #495) - rawSrc <- BS.readFile (msHsFilePath ms) >>= evaluate - let tokens = Hyperlinker.parse dflags filepath (Utf8.decodeUtf8 rawSrc) - return $ Hyperlinker.enrich src tokens - where - filepath = msHsFilePath ms - -- | Find a stand-alone documentation comment by its name. findNamedDoc :: String -> [HsDecl GhcRn] -> ErrMsgM (Maybe HsDocString) findNamedDoc name = search |