Account for boot files in processDependencyInformation (#4913)

Fixes #4912

Author: martijnbastiaan

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

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)

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 []

ghcide-test/data/boot-linkable/Clash/XException.hs

@@ -0,0 +1,3 @@
+module Clash.XException () where
+
+import Clash.XException.Internal ()

ghcide-test/data/boot-linkable/Clash/XException.hs-boot

@@ -0,0 +1 @@
+module Clash.XException where

ghcide-test/data/boot-linkable/Clash/XException/Internal.hs

@@ -0,0 +1,3 @@
+module Clash.XException.Internal where
+
+import {-# SOURCE #-} Clash.XException ()

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"

ghcide-test/exe/BootTests.hs

@@ -56,4 +56,8 @@ tests = testGroup "boot"
       runWithExtraFiles "boot-qualified" $ \dir -> do
         _ <- openDoc (dir </> "B.hs") "haskell"
         expectNoMoreDiagnostics 5
+  , 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
   ]

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,25 @@ 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: callers like the 'GetLinkable' rule (via 'lookupModuleFile')
+        -- need the non-boot file because hs-boot files don't have linkables.
+        --
+        -- XXX: It's unclear whether this code can be called in a situation
+        --      where a module ONLY has a boot module. If that situation
+        --      can't occur, the snippet below can be simplified to simply
+        --      filter all boot entries.
+        (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:

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