From e6ceb69ace29a1e39c16ab3411d7303a677d2538 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 23 Nov 2021 17:40:33 +0000 Subject: [PATCH] Boot files (#2377) * Prefer source modules when combining HPTs * add a direct import into a module's boot module * disable boot fake import dependency * Add a test Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- ghcide/src/Development/IDE/Core/Compile.hs | 8 +++- ghcide/src/Development/IDE/Core/Rules.hs | 19 ++++++++- ghcide/src/Development/IDE/GHC/Compat/Util.hs | 1 + ghcide/test/data/boot2/A.hs | 12 ++++++ ghcide/test/data/boot2/B.hs | 8 ++++ ghcide/test/data/boot2/B.hs-boot | 3 ++ ghcide/test/data/boot2/C.hs | 3 ++ ghcide/test/data/boot2/D.hs | 3 ++ ghcide/test/data/boot2/E.hs | 3 ++ ghcide/test/data/boot2/hie.yaml | 1 + ghcide/test/exe/Main.hs | 41 ++++++++++--------- 11 files changed, 79 insertions(+), 23 deletions(-) create mode 100644 ghcide/test/data/boot2/A.hs create mode 100644 ghcide/test/data/boot2/B.hs create mode 100644 ghcide/test/data/boot2/B.hs-boot create mode 100644 ghcide/test/data/boot2/C.hs create mode 100644 ghcide/test/data/boot2/D.hs create mode 100644 ghcide/test/data/boot2/E.hs create mode 100644 ghcide/test/data/boot2/hie.yaml diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 75d5870e24..df48f991ee 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -106,7 +106,7 @@ import Data.Map (Map) import Data.Tuple.Extra (dupe) import Data.Unique as Unique import Development.IDE.Core.Tracing (withTrace) -import Development.IDE.GHC.Compat.Util (emptyUDFM, plusUDFM) +import Development.IDE.GHC.Compat.Util (emptyUDFM, plusUDFM_C) import qualified Language.LSP.Server as LSP import qualified Language.LSP.Types as LSP import Unsafe.Coerce @@ -702,11 +702,15 @@ mergeEnvs env extraModSummaries extraMods envs = do (\fc (im, ifr) -> Compat.extendInstalledModuleEnv fc im ifr) prevFinderCache $ zip ims ifrs return $ loadModulesHome extraMods $ env{ - hsc_HPT = foldMapBy plusUDFM emptyUDFM hsc_HPT envs, + hsc_HPT = foldMapBy mergeUDFM emptyUDFM hsc_HPT envs, hsc_FC = newFinderCache, hsc_mod_graph = mkModuleGraph $ extraModSummaries ++ nubOrdOn ms_mod (concatMap (mgModSummaries . hsc_mod_graph) envs) } where + mergeUDFM = plusUDFM_C combineModules + combineModules a b + | HsSrcFile <- mi_hsc_src (hm_iface a) = a + | otherwise = b -- required because 'FinderCache': -- 1) doesn't have a 'Monoid' instance, -- 2) is abstract and doesn't export constructors diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 1052bc1ac2..a57ace4056 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -348,7 +348,22 @@ getLocatedImportsRule = Left diags -> pure (diags, Just (modName, Nothing)) Right (FileImport path) -> pure ([], Just (modName, Just path)) Right PackageImport -> pure ([], Nothing) - let moduleImports = catMaybes imports' + + {- IS THIS REALLY NEEDED? DOESNT SEEM SO + + -- does this module have an hs-boot file? If so add a direct dependency + let bootPath = toNormalizedFilePath' $ fromNormalizedFilePath file <.> "hs-boot" + boot <- use GetFileExists bootPath + bootArtifact <- if boot == Just True + then do + let modName = ms_mod_name ms + loc <- liftIO $ mkHomeModLocation dflags modName (fromNormalizedFilePath bootPath) + return $ Just (noLoc modName, Just (ArtifactsLocation bootPath (Just loc) True)) + else pure Nothing + -} + let bootArtifact = Nothing + + let moduleImports = catMaybes $ bootArtifact : imports' pure (concat diags, Just moduleImports) type RawDepM a = StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action a @@ -374,7 +389,7 @@ rawDependencyInformation fs = do go :: NormalizedFilePath -- ^ Current module being processed -> Maybe ModSummary -- ^ ModSummary of the module - -> StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action FilePathId + -> RawDepM FilePathId go f msum = do -- First check to see if we have already processed the FilePath -- If we have, just return its Id but don't update any of the state. diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index 0b1ff0f6c0..18403161f2 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -62,6 +62,7 @@ module Development.IDE.GHC.Compat.Util ( -- * UniqDFM emptyUDFM, plusUDFM, + plusUDFM_C, -- * String Buffer StringBuffer(..), hGetStringBuffer, diff --git a/ghcide/test/data/boot2/A.hs b/ghcide/test/data/boot2/A.hs new file mode 100644 index 0000000000..3b8b80d6ca --- /dev/null +++ b/ghcide/test/data/boot2/A.hs @@ -0,0 +1,12 @@ +module A where + +-- E source imports B +-- In interface file see source module dependencies: B {-# SOURCE #-} +import E +-- C imports B +-- In interface file see source module dependencies: B +import C + +-- Instance for B only available from B.hi not B.hi-boot, so tests we load +-- that. +main = print B diff --git a/ghcide/test/data/boot2/B.hs b/ghcide/test/data/boot2/B.hs new file mode 100644 index 0000000000..e8458aa739 --- /dev/null +++ b/ghcide/test/data/boot2/B.hs @@ -0,0 +1,8 @@ +module B where + +import D + +data B = B + +instance Show B where + show B = "B" diff --git a/ghcide/test/data/boot2/B.hs-boot b/ghcide/test/data/boot2/B.hs-boot new file mode 100644 index 0000000000..64e74c695a --- /dev/null +++ b/ghcide/test/data/boot2/B.hs-boot @@ -0,0 +1,3 @@ +module B where + +data B = B diff --git a/ghcide/test/data/boot2/C.hs b/ghcide/test/data/boot2/C.hs new file mode 100644 index 0000000000..158757ed80 --- /dev/null +++ b/ghcide/test/data/boot2/C.hs @@ -0,0 +1,3 @@ +module C where + +import B diff --git a/ghcide/test/data/boot2/D.hs b/ghcide/test/data/boot2/D.hs new file mode 100644 index 0000000000..01b53223f9 --- /dev/null +++ b/ghcide/test/data/boot2/D.hs @@ -0,0 +1,3 @@ +module D where + +import {-# SOURCE #-} B diff --git a/ghcide/test/data/boot2/E.hs b/ghcide/test/data/boot2/E.hs new file mode 100644 index 0000000000..a5f78cab2a --- /dev/null +++ b/ghcide/test/data/boot2/E.hs @@ -0,0 +1,3 @@ +module E(B(B)) where + +import {-# SOURCE #-} B diff --git a/ghcide/test/data/boot2/hie.yaml b/ghcide/test/data/boot2/hie.yaml new file mode 100644 index 0000000000..be8dca1601 --- /dev/null +++ b/ghcide/test/data/boot2/hie.yaml @@ -0,0 +1 @@ +cradle: {direct: {arguments: ["A.hs", "B.hs-boot", "B.hs", "C.hs", "D.hs", "E.hs"]}} diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 99909b479b..21f2939d5b 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -5277,25 +5277,28 @@ ifaceTests = testGroup "Interface loading tests" ] bootTests :: TestTree -bootTests = testCase "boot-def-test" $ runWithExtraFiles "boot" $ \dir -> do - let cPath = dir "C.hs" - cSource <- liftIO $ readFileUtf8 cPath - - -- Dirty the cache - liftIO $ runInDir dir $ do - cDoc <- createDoc cPath "haskell" cSource - _ <- getHover cDoc $ Position 4 3 - ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case - FromServerMess (SCustomMethod "ghcide/reference/ready") (NotMess NotificationMessage{_params = fp}) -> do - A.Success fp' <- pure $ fromJSON fp - if equalFilePath fp' cPath then pure () else Nothing - _ -> Nothing - closeDoc cDoc - - cdoc <- createDoc cPath "haskell" cSource - locs <- getDefinitions cdoc (Position 7 4) - let floc = mkR 9 0 9 1 - checkDefs locs (pure [floc]) +bootTests = testGroup "boot" + [ testCase "boot-def-test" $ runWithExtraFiles "boot" $ \dir -> do + let cPath = dir "C.hs" + cSource <- liftIO $ readFileUtf8 cPath + -- Dirty the cache + liftIO $ runInDir dir $ do + cDoc <- createDoc cPath "haskell" cSource + _ <- getHover cDoc $ Position 4 3 + ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case + FromServerMess (SCustomMethod "ghcide/reference/ready") (NotMess NotificationMessage{_params = fp}) -> do + A.Success fp' <- pure $ fromJSON fp + if equalFilePath fp' cPath then pure () else Nothing + _ -> Nothing + closeDoc cDoc + cdoc <- createDoc cPath "haskell" cSource + locs <- getDefinitions cdoc (Position 7 4) + let floc = mkR 9 0 9 1 + checkDefs locs (pure [floc]) + , testCase "graph with boot modules" $ runWithExtraFiles "boot2" $ \dir -> do + _ <- openDoc (dir "A.hs") "haskell" + expectNoMoreDiagnostics 2 + ] -- | test that TH reevaluates across interfaces ifaceTHTest :: TestTree