diff --git a/ghcide-test/data/boot-linkable/Clash/Promoted/Nat.hs b/ghcide-test/data/boot-linkable/Clash/Promoted/Nat.hs new file mode 100644 index 0000000000..588f2a93d7 --- /dev/null +++ b/ghcide-test/data/boot-linkable/Clash/Promoted/Nat.hs @@ -0,0 +1,5 @@ +module Clash.Promoted.Nat (SNat) where + +import Clash.XException () + +data SNat = SNat diff --git a/ghcide-test/data/boot-linkable/Clash/Promoted/Nat/Literals.hs b/ghcide-test/data/boot-linkable/Clash/Promoted/Nat/Literals.hs new file mode 100644 index 0000000000..3a36e5220e --- /dev/null +++ b/ghcide-test/data/boot-linkable/Clash/Promoted/Nat/Literals.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Clash.Promoted.Nat.Literals where + +import Clash.Promoted.Nat.TH + +$(snatSplice) diff --git a/ghcide-test/data/boot-linkable/Clash/Promoted/Nat/TH.hs b/ghcide-test/data/boot-linkable/Clash/Promoted/Nat/TH.hs new file mode 100644 index 0000000000..7126b83534 --- /dev/null +++ b/ghcide-test/data/boot-linkable/Clash/Promoted/Nat/TH.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +module Clash.Promoted.Nat.TH (snatSplice) where + +import Language.Haskell.TH (Q, Dec) +import Clash.Promoted.Nat () + +snatSplice :: Q [Dec] +snatSplice = pure [] diff --git a/ghcide-test/data/boot-linkable/Clash/XException.hs b/ghcide-test/data/boot-linkable/Clash/XException.hs new file mode 100644 index 0000000000..666e86c896 --- /dev/null +++ b/ghcide-test/data/boot-linkable/Clash/XException.hs @@ -0,0 +1,3 @@ +module Clash.XException () where + +import Clash.XException.Internal () diff --git a/ghcide-test/data/boot-linkable/Clash/XException.hs-boot b/ghcide-test/data/boot-linkable/Clash/XException.hs-boot new file mode 100644 index 0000000000..394250d4c8 --- /dev/null +++ b/ghcide-test/data/boot-linkable/Clash/XException.hs-boot @@ -0,0 +1 @@ +module Clash.XException where diff --git a/ghcide-test/data/boot-linkable/Clash/XException/Internal.hs b/ghcide-test/data/boot-linkable/Clash/XException/Internal.hs new file mode 100644 index 0000000000..43ee66b27e --- /dev/null +++ b/ghcide-test/data/boot-linkable/Clash/XException/Internal.hs @@ -0,0 +1,3 @@ +module Clash.XException.Internal where + +import {-# SOURCE #-} Clash.XException () diff --git a/ghcide-test/data/boot-linkable/hie.yaml b/ghcide-test/data/boot-linkable/hie.yaml new file mode 100644 index 0000000000..2f8004954a --- /dev/null +++ b/ghcide-test/data/boot-linkable/hie.yaml @@ -0,0 +1,8 @@ +cradle: + direct: + arguments: + - "Clash.XException" + - "Clash.XException.Internal" + - "Clash.Promoted.Nat" + - "Clash.Promoted.Nat.Literals" + - "Clash.Promoted.Nat.TH" diff --git a/ghcide-test/exe/BootTests.hs b/ghcide-test/exe/BootTests.hs index a2b73a88be..831618cdb5 100644 --- a/ghcide-test/exe/BootTests.hs +++ b/ghcide-test/exe/BootTests.hs @@ -52,4 +52,8 @@ tests = testGroup "boot" , testCase "graph with boot modules" $ runWithExtraFiles "boot2" $ \dir -> do _ <- openDoc (dir "A.hs") "haskell" expectNoMoreDiagnostics 2 + , testCase "GetLinkable on hs-boot via TH splice (clash-compiler reproducer)" $ + runWithExtraFiles "boot-linkable" $ \dir -> do + _ <- openDoc (dir "Clash" "Promoted" "Nat.hs") "haskell" + expectNoMoreDiagnostics 10 ] diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 471cf52eab..37e5d15a00 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -53,7 +53,8 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util (Fingerprint) import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Orphans () -import Development.IDE.Import.FindImports (ArtifactsLocation (..)) +import Development.IDE.Import.FindImports (ArtifactsLocation (..), + isBootLocation) import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import GHC.Generics (Generic) @@ -273,7 +274,23 @@ processDependencyInformation RawDependencyInformation{..} rawBootMap mg shallowF foldr (\(p, cs) res -> let new = IntMap.fromList (map (, IntSet.singleton (coerce p)) (coerce cs)) in IntMap.unionWith IntSet.union new res ) IntMap.empty successEdges - reverseModuleMap = mkModuleEnv $ map (\(i,sm) -> (showableModule sm, FilePathId i)) $ IntMap.toList rawModuleMap + -- Map 'Module' to 'FilePathId'. A 'Module' does not distinguish boot + -- from non-boot, so a real source file and its hs-boot share the same + -- key. We list boot entries first and non-boot entries second so that + -- 'mkModuleEnv' (right-biased on duplicates) makes the non-boot entry + -- win when both exist: callers like the 'GetLinkable' rule (via + -- 'lookupModuleFile') need the non-boot file because hs-boot files + -- don't have linkables. Boot-only modules still resolve to the boot + -- file, which is required for the home-unit finder cache used during + -- compilation of SOURCE imports. + (bootEntries, srcEntries) = partitionEithers + [ if isBootLocation al + then Left (showableModule sm, FilePathId i) + else Right (showableModule sm, FilePathId i) + | (i, sm) <- IntMap.toList rawModuleMap + , Just al <- [IntMap.lookup i (idToPathMap rawPathIdMap)] + ] + reverseModuleMap = mkModuleEnv (bootEntries ++ srcEntries) -- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows: diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 7c4046a63a..dfda9a6b6c 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -41,7 +41,8 @@ data Import data ArtifactsLocation = ArtifactsLocation { artifactFilePath :: !NormalizedFilePath , artifactModLocation :: !(Maybe ModLocation) - , artifactIsSource :: !Bool -- ^ True if a module is a source input + , artifactIsSource :: !Bool -- ^ 'True' for a real Haskell source file ('HsSrcFile'); + -- 'False' for a boot ('HsBootFile') or signature ('HsigFile') file. , artifactModule :: !(Maybe Module) } deriving Show