Fix .hie file location for .hs-boot files (#690)

* Find source for boot files

* fix modlocs for boot files

* Add test

* Fix build on 8.6

Author: wz1000

src/Development/IDE/Core/Compile.hs

@@ -303,11 +303,7 @@ writeHiFile hscEnv tc =
       writeIfaceFile dflags fp modIface
   where
     modIface = hm_iface $ tmrModInfo tc
-    modSummary = tmrModSummary tc
-    targetPath = withBootSuffix $ ml_hi_file $ ms_location $ tmrModSummary tc
-    withBootSuffix = case ms_hsc_src modSummary of
-                HsBootFile -> addBootSuffix
-                _ -> id
+    targetPath = ml_hi_file $ ms_location $ tmrModSummary tc
     dflags = hsc_dflags hscEnv
 
 handleGenerationErrors :: DynFlags -> T.Text -> IO () -> IO [FileDiagnostic]
@@ -409,6 +405,10 @@ getImportsParsed dflags (L loc parsed) = do
     , 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
     :: GhcMonad m
@@ -425,7 +425,7 @@ getModSummaryFromBuffer fp modTime dflags parsed contents = do
   let InstalledUnitId unitId = thisInstalledUnitId dflags
   return $ ModSummary
     { ms_mod          = mkModule (fsToUnitId unitId) modName
-    , ms_location     = modLoc
+    , ms_location     = withBootSuffix sourceType modLoc
     , ms_hs_date      = modTime
     , ms_textual_imps = [imp | (False, imp) <- imports]
     , ms_hspp_file    = fp
@@ -485,7 +485,7 @@ getModSummaryFromImports fp modTime contents = do
                 , ms_hspp_file    = fp
                 , ms_hspp_opts    = dflags
                 , ms_iface_date   = Nothing
-                , ms_location     = modLoc
+                , ms_location     = withBootSuffix sourceType modLoc
                 , ms_obj_date     = Nothing
                 , ms_parsed_mod   = Nothing
                 , ms_srcimps      = srcImports

src/Development/IDE/Core/Rules.hs

@@ -685,9 +685,7 @@ isHiFileStableRule :: Rules ()
 isHiFileStableRule = define $ \IsHiFileStable f -> do
     ms <- use_ GetModSummaryWithoutTimestamps f
     let hiFile = toNormalizedFilePath'
-                $ case ms_hsc_src ms of
-                    HsBootFile -> addBootSuffix (ml_hi_file $ ms_location ms)
-                    _ -> ml_hi_file $ ms_location ms
+                $ ml_hi_file $ ms_location ms
     mbHiVersion <- use  GetModificationTime_{missingFileDiagnostics=False} hiFile
     modVersion  <- use_ GetModificationTime f
     sourceModified <- case mbHiVersion of

src/Development/IDE/GHC/Compat.hs

@@ -23,6 +23,7 @@ module Development.IDE.GHC.Compat(
     dontWriteHieFiles,
 #if !MIN_GHC_API_VERSION(8,8,0)
     ml_hie_file,
+    addBootSuffixLocnOut,
 #endif
     hPutStringBuffer,
     includePathsGlobal,
@@ -122,6 +123,7 @@ import System.FilePath ((-<.>))
 
 #if MIN_GHC_API_VERSION(8,6,0)
 import GhcPlugins (srcErrorMessages)
+import Data.List (isSuffixOf)
 #else
 import System.IO.Error
 import IfaceEnv
@@ -153,7 +155,9 @@ hieExportNames = nameListFromAvails . hie_exports
 
 #if !MIN_GHC_API_VERSION(8,8,0)
 ml_hie_file :: GHC.ModLocation -> FilePath
-ml_hie_file ml = ml_hi_file ml -<.> ".hie"
+ml_hie_file ml
+  | "boot" `isSuffixOf ` ml_hi_file ml = ml_hi_file ml -<.> ".hie-boot"
+  | otherwise  = ml_hi_file ml -<.> ".hie"
 #endif
 
 #endif
@@ -380,6 +384,14 @@ instance HasSrcSpan (GenLocated SrcSpan a) where
 getHeaderImports a b c d =
     catch (Right <$> Hdr.getImports a b c d)
           (return . Left . srcErrorMessages)
+
+-- | Add the @-boot@ suffix to all output file paths associated with the
+-- module, not including the input file itself
+addBootSuffixLocnOut :: GHC.ModLocation -> GHC.ModLocation
+addBootSuffixLocnOut locn
+  = locn { ml_hi_file  = Module.addBootSuffix (ml_hi_file locn)
+         , ml_obj_file = Module.addBootSuffix (ml_obj_file locn)
+         }
 #endif
 
 getModuleHash :: ModIface -> Fingerprint

test/data/boot/A.hs

@@ -0,0 +1,8 @@
+module A where
+
+import B( TB(..) )
+
+newtype TA = MkTA Int
+
+f :: TB -> TA
+f (MkTB x) = MkTA x

test/data/boot/A.hs-boot

@@ -0,0 +1,2 @@
+module A where
+newtype TA = MkTA Int

test/data/boot/B.hs

@@ -0,0 +1,7 @@
+module B(TA(..), TB(..)) where
+import {-# SOURCE #-} A( TA(..) )
+
+data TB = MkTB !Int
+
+g :: TA -> TB
+g (MkTA x) = MkTB x

test/data/boot/C.hs

@@ -0,0 +1,8 @@
+module C where
+
+import B
+import A hiding (MkTA(..))
+
+x = MkTA
+y = MkTB
+z = f

test/data/boot/hie.yaml

@@ -0,0 +1 @@
+cradle: {direct: {arguments: ["A", "B", "C"]}}

test/exe/Main.hs

@@ -87,6 +87,7 @@ main = do
     , nonLspCommandLine
     , benchmarkTests
     , ifaceTests
+    , bootTests
     ]
 
 initializeResponseTests :: TestTree
@@ -2796,6 +2797,22 @@ ifaceTests = testGroup "Interface loading tests"
     , ifaceTHTest
     ]
 
+bootTests :: TestTree
+bootTests = testCase "boot-def-test" $ withoutStackEnv $ 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
+    closeDoc cDoc
+
+  cdoc <- createDoc cPath "haskell" cSource
+  locs <- getDefinitions cdoc (Position 7 4)
+  let floc = mkR 7 0 7 1
+  checkDefs locs (pure [floc])
+
 -- | test that TH reevaluates across interfaces
 ifaceTHTest :: TestTree
 ifaceTHTest = testCase "iface-th-test" $ withoutStackEnv $ runWithExtraFiles "TH" $ \dir -> do