Skip to content
This repository has been archived by the owner on Jan 2, 2021. It is now read-only.

Simplify and deduplicate ModSummary logic #884

Merged
merged 4 commits into from
Oct 27, 2020
Merged

Simplify and deduplicate ModSummary logic #884

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
b78a54c
Simplify and dedup parsing logic
wz1000 Oct 25, 2020
dfa358a
delete removePackageImports
wz1000 Oct 25, 2020
55ffb2f
add dependencies on included files
wz1000 Oct 25, 2020
be9ab5c
hlint
wz1000 Oct 25, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
96 changes: 17 additions & 79 deletions src/Development/IDE/Core/Compile.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ module Development.IDE.Core.Compile
, RunSimplifier(..)
, compileModule
, parseModule
, parseHeader
, typecheckModule
, computePackageDeps
, addRelativeImport
Expand Down Expand Up @@ -41,7 +40,6 @@ import Development.IDE.GHC.Warnings
import Development.IDE.Types.Diagnostics
import Development.IDE.GHC.Orphans()
import Development.IDE.GHC.Util
import qualified GHC.LanguageExtensions.Type as GHC
import Development.IDE.Types.Options
import Development.IDE.Types.Location

Expand All @@ -67,7 +65,6 @@ import qualified Development.IDE.GHC.Compat as GHC
import qualified Development.IDE.GHC.Compat as Compat
import GhcMonad
import GhcPlugins as GHC hiding (fst3, (<>))
import qualified HeaderInfo as Hdr
import HscMain (makeSimpleDetails, hscDesugar, hscTypecheckRename, hscSimplify, hscGenHardCode, hscInteractive)
import MkIface
import StringBuffer as SB
Expand Down Expand Up @@ -104,15 +101,13 @@ parseModule
-> HscEnv
-> [PackageName]
-> FilePath
-> UTCTime
-> Maybe SB.StringBuffer
-> IO (IdeResult (StringBuffer, ParsedModule))
parseModule IdeOptions{..} env comp_pkgs filename modTime mbContents =
-> ModSummary
-> IO (IdeResult ParsedModule)
parseModule IdeOptions{..} env comp_pkgs filename ms =
fmap (either (, Nothing) id) $
runExceptT $ do
(contents, dflags) <- preprocessor env filename mbContents
(diag, modu) <- parseFileContents env optPreprocessor dflags comp_pkgs filename modTime contents
return (diag, Just (contents, modu))
(diag, modu) <- parseFileContents env optPreprocessor comp_pkgs filename ms
return (diag, Just modu)


-- | Given a package identifier, what packages does it depend on
Expand Down Expand Up @@ -483,70 +478,10 @@ loadModulesHome mod_infos e =
where
mod_name = moduleName . mi_module . hm_iface

-- | GhcMonad function to chase imports of a module given as a StringBuffer. Returns given module's
-- name and its imports.
getImportsParsed :: DynFlags ->
GHC.ParsedSource ->
Either [FileDiagnostic] (GHC.ModuleName, [(Bool, (Maybe FastString, Located GHC.ModuleName))])
getImportsParsed dflags (L loc parsed) = do
let modName = maybe (GHC.mkModuleName "Main") GHC.unLoc $ GHC.hsmodName parsed

-- most of these corner cases are also present in https://hackage.haskell.org/package/ghc-8.6.1/docs/src/HeaderInfo.html#getImports
-- but we want to avoid parsing the module twice
let implicit_prelude = xopt GHC.ImplicitPrelude dflags
implicit_imports = Hdr.mkPrelImports modName loc implicit_prelude $ GHC.hsmodImports parsed

-- filter out imports that come from packages
return (modName, [(ideclSource i, (fmap sl_fs $ ideclPkgQual i, ideclName i))
| i <- map GHC.unLoc $ implicit_imports ++ GHC.hsmodImports parsed
, GHC.moduleNameString (GHC.unLoc $ ideclName i) /= "GHC.Prim"
])

withBootSuffix :: HscSource -> ModLocation -> ModLocation
withBootSuffix HsBootFile = addBootSuffixLocnOut
withBootSuffix _ = id

-- | Produce a module summary from a StringBuffer.
getModSummaryFromBuffer
:: FilePath
-> UTCTime
-> DynFlags
-> GHC.ParsedSource
-> StringBuffer
-> ExceptT [FileDiagnostic] IO ModSummary
getModSummaryFromBuffer fp modTime dflags parsed contents = do
(modName, imports) <- liftEither $ getImportsParsed dflags parsed

modLoc <- liftIO $ mkHomeModLocation dflags modName fp
let InstalledUnitId unitId = thisInstalledUnitId dflags
return $ ModSummary
{ ms_mod = mkModule (fsToUnitId unitId) modName
, ms_location = withBootSuffix sourceType modLoc
, ms_hs_date = modTime
, ms_textual_imps = [imp | (False, imp) <- imports]
, ms_hspp_file = fp
, ms_hspp_opts = dflags
-- NOTE: It's /vital/ we set the 'StringBuffer' here, to give any
-- registered GHC plugins access to the /updated/ in-memory content
-- of a module being edited. Without this line, any plugin wishing to
-- parse an input module and perform operations on the /current/ state
-- of a file wouldn't work properly, as it would \"see\" a stale view of
-- the file (i.e., the on-disk content of the latter).
, ms_hspp_buf = Just contents

-- defaults:
, ms_hsc_src = sourceType
, ms_obj_date = Nothing
, ms_iface_date = Nothing
#if MIN_GHC_API_VERSION(8,8,0)
, ms_hie_date = Nothing
#endif
, ms_srcimps = [imp | (True, imp) <- imports]
, ms_parsed_mod = Nothing
}
where
sourceType = if "-boot" `isSuffixOf` takeExtension fp then HsBootFile else HsSrcFile

-- | Given a buffer, env and filepath, produce a module summary by parsing only the imports.
-- Runs preprocessors as needed.
getModSummaryFromImports
Expand Down Expand Up @@ -650,17 +585,18 @@ parseHeader dflags filename contents = do

-- | Given a buffer, flags, and file path, produce a
-- parsed module (or errors) and any parse warnings. Does not run any preprocessors
-- ModSummary must contain the (preprocessed) contents of the buffer
parseFileContents
:: HscEnv
-> (GHC.ParsedSource -> IdePreprocessedSource)
-> DynFlags -- ^ flags to use
-> [PackageName] -- ^ The package imports to ignore
-> FilePath -- ^ the filename (for source locations)
-> UTCTime -- ^ the modification timestamp
-> SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
-> ModSummary
-> ExceptT [FileDiagnostic] IO ([FileDiagnostic], ParsedModule)
parseFileContents env customPreprocessor dflags comp_pkgs filename modTime contents = do
parseFileContents env customPreprocessor comp_pkgs filename ms = do
let loc = mkRealSrcLoc (mkFastString filename) 1 1
dflags = ms_hspp_opts ms
contents = fromJust $ ms_hspp_buf ms
case unP Parser.parseModule (mkPState dflags contents loc) of
#if MIN_GHC_API_VERSION(8,10,0)
PFailed pst -> throwE $ diagFromErrMsgs "parser" dflags $ getErrorMessages pst dflags
Expand Down Expand Up @@ -690,11 +626,13 @@ parseFileContents env customPreprocessor dflags comp_pkgs filename modTime conte

-- Ok, we got here. It's safe to continue.
let IdePreprocessedSource preproc_warns errs parsed = customPreprocessor rdr_module
unless (null errs) $ throwE $ diagFromStrings "parser" DsError errs
let parsed' = removePackageImports comp_pkgs parsed

unless (null errs) $
throwE $ diagFromStrings "parser" DsError errs

let preproc_warnings = diagFromStrings "parser" DsWarning preproc_warns
ms <- getModSummaryFromBuffer filename modTime dflags parsed' contents
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@mpickering need your help here. Does removePackageImports need to be called before we compute the ModSummary? Because we don't recompute the ModSummary here anymore, we just re-use the one we computed before.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

My take on this: since we don't allow GHC to resolve imports anymore, the only place where import resolution happens is in our code, namely in GetLocatedImportsRule. So the removal of package imports can be inlined there in order to preserve the AST and original imports as much as possible. Otherwise plugins like the HLS import lens or code actions which use the AST might end up "losing" package imports accidentally.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

OK, but I'm confused. GetLocatedImportsRule uses GetModSummaryWithoutTimestamps, which doesn't call removePackageImports, so it should never have been affected by it. The only things which are affected by removePackageImports are things which use the modsummary from the parsed module.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Back in the day when removePackageImports was added, GetModSummary didn't exist and GetLocatedImportsRule still used the parsed AST to extract the imports.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sounds like we need a testcase. How do I invoke this code path? Will a multi-cradle with a file using PackageImports to import a conflicting module from two different packages do it?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looks like we can just remove it, since the logic is already present in findImports: https://github.com/haskell/ghcide/blob/master/src/Development/IDE/Import/FindImports.hs#L126

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Test case is the generic-lens repo. I think the situation was as you described (conflicting module from two different packages)

parsed'' <- liftIO $ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed
parsed' = removePackageImports comp_pkgs parsed
parsed'' <- liftIO $ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed'
let pm =
ParsedModule {
pm_mod_summary = ms
Expand All @@ -716,7 +654,7 @@ removePackageImports pkgs (L l h@HsModule {hsmodImports} ) = L l (h { hsmodImpor
Just pn | pn `elem` pkgs -> L l (i { ideclPkgQual = Nothing })
_ -> L l i
do_one_import l = l

loadHieFile :: Compat.NameCacheUpdater -> FilePath -> IO GHC.HieFile
loadHieFile ncu f = do
GHC.hie_file_result <$> GHC.readHieFile ncu f
Expand Down
38 changes: 17 additions & 21 deletions src/Development/IDE/Core/Rules.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -266,24 +266,23 @@ priorityFilesOfInterest = Priority (-2)
-- and https://github.com/mpickering/ghcide/pull/22#issuecomment-625070490
getParsedModuleRule :: Rules ()
getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do
_ <- use_ GetModSummaryWithoutTimestamps file -- Fail if we can't even parse the ModSummary
(ms, _) <- use_ GetModSummary file
sess <- use_ GhcSession file
let hsc = hscEnv sess
-- These packages are used when removing PackageImports from a
-- parsed module
comp_pkgs = mapMaybe (fmap fst . mkImportDirs (hsc_dflags hsc)) (deps sess)
opt <- getIdeOptions
(modTime, contents) <- getFileContents file

let dflags = hsc_dflags hsc
mainParse = getParsedModuleDefinition hsc opt comp_pkgs file modTime contents
mainParse = getParsedModuleDefinition hsc opt comp_pkgs file ms

-- Parse again (if necessary) to capture Haddock parse errors
if gopt Opt_Haddock dflags
then
liftIO mainParse
else do
let haddockParse = getParsedModuleDefinition (withOptHaddock hsc) opt comp_pkgs file modTime contents
let haddockParse = getParsedModuleDefinition hsc opt comp_pkgs file (withOptHaddock ms)

-- parse twice, with and without Haddocks, concurrently
-- we cannot ignore Haddock parse errors because files of
Expand All @@ -307,8 +306,8 @@ getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do
_ -> pure (fp, (diagsM, res))


withOptHaddock :: HscEnv -> HscEnv
withOptHaddock hsc = hsc{hsc_dflags = gopt_set (hsc_dflags hsc) Opt_Haddock}
withOptHaddock :: ModSummary -> ModSummary
withOptHaddock ms = ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) Opt_Haddock}


-- | Given some normal parse errors (first) and some from Haddock (second), merge them.
Expand All @@ -323,17 +322,14 @@ mergeParseErrorsHaddock normal haddock = normal ++
fixMessage x | "parse error " `T.isPrefixOf` x = "Haddock " <> x
| otherwise = "Haddock: " <> x

getParsedModuleDefinition :: HscEnv -> IdeOptions -> [PackageName] -> NormalizedFilePath -> UTCTime -> Maybe T.Text -> IO (Maybe ByteString, ([FileDiagnostic], Maybe ParsedModule))
getParsedModuleDefinition packageState opt comp_pkgs file modTime contents = do
getParsedModuleDefinition :: HscEnv -> IdeOptions -> [PackageName] -> NormalizedFilePath -> ModSummary -> IO (Maybe ByteString, ([FileDiagnostic], Maybe ParsedModule))
getParsedModuleDefinition packageState opt comp_pkgs file ms = do
let fp = fromNormalizedFilePath file
buffer = textToStringBuffer <$> contents
(diag, res) <- parseModule opt packageState comp_pkgs fp modTime buffer
(diag, res) <- parseModule opt packageState comp_pkgs fp ms
case res of
Nothing -> pure (Nothing, (diag, Nothing))
Just (contents, modu) -> do
mbFingerprint <- if isNothing $ optShakeFiles opt
then pure Nothing
else Just . fingerprintToBS <$> fingerprintFromStringBuffer contents
Just modu -> do
mbFingerprint <- traverse (fmap fingerprintToBS . fingerprintFromStringBuffer) (ms_hspp_buf ms)
pure (mbFingerprint, (diag, Just modu))

getLocatedImportsRule :: Rules ()
Expand Down Expand Up @@ -710,7 +706,7 @@ getModIfaceFromDiskRule = defineEarlyCutoff $ \GetModIfaceFromDisk f -> do
Just session -> do
sourceModified <- use_ IsHiFileStable f
linkableType <- getLinkableType f
r <- loadInterface (hscEnv session) ms sourceModified linkableType (regenerateHiFile session f)
r <- loadInterface (hscEnv session) ms sourceModified linkableType (regenerateHiFile session f ms)
case r of
(diags, Just x) -> do
let fp = Just (hiFileFingerPrint x)
Expand Down Expand Up @@ -837,22 +833,21 @@ getModIfaceWithoutLinkableRule = defineEarlyCutoff $ \GetModIfaceWithoutLinkable
msg = "tried to look at linkable for GetModIfaceWithoutLinkable for " ++ show f
pure (fingerprintToBS . getModuleHash . hirModIface <$> mhfr', ([],mhfr'))

regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult)
regenerateHiFile sess f compNeeded = do
regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> ModSummary -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult)
regenerateHiFile sess f ms compNeeded = do
let hsc = hscEnv sess
-- After parsing the module remove all package imports referring to
-- these packages as we have already dealt with what they map to.
comp_pkgs = mapMaybe (fmap fst . mkImportDirs (hsc_dflags hsc)) (deps sess)
opt <- getIdeOptions
(modTime, contents) <- getFileContents f

-- Embed haddocks in the interface file
(_, (diags, mb_pm)) <- liftIO $ getParsedModuleDefinition (withOptHaddock hsc) opt comp_pkgs f modTime contents
(_, (diags, mb_pm)) <- liftIO $ getParsedModuleDefinition hsc opt comp_pkgs f (withOptHaddock ms)
(diags, mb_pm) <- case mb_pm of
Just _ -> return (diags, mb_pm)
Nothing -> do
-- if parsing fails, try parsing again with Haddock turned off
(_, (diagsNoHaddock, mb_pm)) <- liftIO $ getParsedModuleDefinition hsc opt comp_pkgs f modTime contents
(_, (diagsNoHaddock, mb_pm)) <- liftIO $ getParsedModuleDefinition hsc opt comp_pkgs f ms
return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm)
case mb_pm of
Nothing -> return (diags, Nothing)
Expand All @@ -879,8 +874,9 @@ regenerateHiFile sess f compNeeded = do

-- Write hie file
(gDiags, masts) <- liftIO $ generateHieAsts hsc tmr
source <- getSourceFileSource f
wDiags <- forM masts $ \asts ->
liftIO $ writeHieFile hsc (tmrModSummary tmr) (tcg_exports $ tmrTypechecked tmr) asts $ maybe "" T.encodeUtf8 contents
liftIO $ writeHieFile hsc (tmrModSummary tmr) (tcg_exports $ tmrTypechecked tmr) asts source

return (diags <> diags' <> diags'' <> hiDiags <> gDiags <> concat wDiags, res)

Expand Down