Add .hie files support for home modules (#440)

* Add .hie files support for home modules

This is required for goto definition when using interface files.

.hie files are never stored in the Shake graph, as they are
- expensive in space
- quick to load
- only used for go to definition

While there, we remove package module .hie files from the Shake graph too

* Review feedbacks

Author: pepeiborra

src/Development/IDE/Core/Compile.hs

@@ -16,6 +16,7 @@ module Development.IDE.Core.Compile
   , addRelativeImport
   , mkTcModuleResult
   , generateByteCode
+  , loadHieFile
   ) where
 
 import Development.IDE.Core.RuleTypes
@@ -43,12 +44,13 @@ import ErrUtils
 #endif
 
 import           Finder
-import qualified GHC
+import qualified Development.IDE.GHC.Compat     as GHC
 import           GhcMonad
 import           GhcPlugins                     as GHC hiding (fst3, (<>))
 import qualified HeaderInfo                     as Hdr
 import           HscMain                        (hscInteractive, hscSimplify)
 import           MkIface
+import           NameCache
 import           StringBuffer                   as SB
 import           TcRnMonad (tcg_th_coreplugins)
 import           TidyPgm
@@ -406,3 +408,9 @@ parseFileContents customPreprocessor dflags filename contents = do
                       }
                    warnings = diagFromErrMsgs "parser" dflags warns
                pure (warnings ++ preproc_warnings, pm)
+
+loadHieFile :: FilePath -> IO GHC.HieFile
+loadHieFile f = do
+        u <- mkSplitUniqSupply 'a'
+        let nameCache = initNameCache u []
+        fmap (GHC.hie_file_result . fst) $ GHC.readHieFile nameCache f

src/Development/IDE/Core/RuleTypes.hs

@@ -24,7 +24,6 @@ import           GHC.Generics                             (Generic)
 import           GHC
 import Module (InstalledUnitId)
 import HscTypes (CgGuts, Linkable, HomeModInfo, ModDetails)
-import Development.IDE.GHC.Compat
 
 import           Development.IDE.Spans.Type
 import           Development.IDE.Import.FindImports (ArtifactsLocation)
@@ -82,10 +81,6 @@ type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe Artifa
 -- we can only report diagnostics for the current file.
 type instance RuleResult ReportImportCycles = ()
 
--- | Read the given HIE file.
-type instance RuleResult GetHieFile = HieFile
-
-
 data GetParsedModule = GetParsedModule
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable GetParsedModule
@@ -145,11 +140,3 @@ data GhcSession = GhcSession
 instance Hashable GhcSession
 instance NFData   GhcSession
 instance Binary   GhcSession
-
--- Note that we embed the filepath here instead of using the filepath associated with Shake keys.
--- Otherwise we will garbage collect the result since files in package dependencies will not be declared reachable.
-data GetHieFile = GetHieFile FilePath
-    deriving (Eq, Show, Typeable, Generic)
-instance Hashable GetHieFile
-instance NFData   GetHieFile
-instance Binary   GetHieFile

src/Development/IDE/Core/Rules.hs

@@ -29,7 +29,7 @@ import Fingerprint
 
 import Data.Binary
 import Data.Bifunctor (second)
-import Control.Monad
+import Control.Monad.Extra
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Maybe
 import Development.IDE.Core.Compile
@@ -50,6 +50,7 @@ import           Data.Foldable
 import qualified Data.IntMap.Strict as IntMap
 import qualified Data.IntSet as IntSet
 import Data.List
+import Data.Ord
 import qualified Data.Set                                 as Set
 import qualified Data.Text                                as T
 import           Development.IDE.GHC.Error
@@ -58,8 +59,6 @@ import Development.IDE.Core.RuleTypes
 import Development.IDE.Spans.Type
 
 import qualified GHC.LanguageExtensions as LangExt
-import           UniqSupply
-import NameCache
 import HscTypes
 import DynFlags (xopt)
 import GHC.Generics(Generic)
@@ -112,9 +111,60 @@ getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)
 getDefinition file pos = fmap join $ runMaybeT $ do
     opts <- lift getIdeOptions
     spans <- useE GetSpanInfo file
-    pkgState <- hscEnv <$> useE GhcSession file
-    let getHieFile x = useNoFile (GetHieFile x)
-    lift $ AtPoint.gotoDefinition getHieFile opts pkgState (spansExprs spans) pos
+    lift $ AtPoint.gotoDefinition (getHieFile file) opts (spansExprs spans) pos
+
+getHieFile
+  :: NormalizedFilePath -- ^ file we're editing
+  -> Module -- ^ module dep we want info for
+  -> Action (Maybe (HieFile, FilePath)) -- ^ hie stuff for the module
+getHieFile file mod = do
+  TransitiveDependencies {transitiveNamedModuleDeps} <- use_ GetDependencies file
+  case find (\x -> nmdModuleName x == moduleName mod) transitiveNamedModuleDeps of
+    Just NamedModuleDep{nmdFilePath=nfp} -> do
+        let modPath = fromNormalizedFilePath nfp
+        (_diags, hieFile) <- getHomeHieFile nfp
+        return $ (, modPath) <$> hieFile
+    _ -> getPackageHieFile mod file
+
+
+getHomeHieFile :: NormalizedFilePath -> Action ([a], Maybe HieFile)
+getHomeHieFile f = do
+  pm <- use_ GetParsedModule f
+  let normal_hie_f = toNormalizedFilePath hie_f
+      hie_f = ml_hie_file $ ms_location $ pm_mod_summary pm
+  mbHieTimestamp <- use GetModificationTime normal_hie_f
+  srcTimestamp   <- use_ GetModificationTime f
+
+  let isUpToDate
+        | Just d <- mbHieTimestamp = comparing modificationTime d srcTimestamp == GT
+        | otherwise = False
+
+-- In the future, TypeCheck will emit .hie files as a side effect
+--   unless isUpToDate $
+--       void $ use_ TypeCheck f
+
+  hf <- liftIO $ if isUpToDate then Just <$> loadHieFile hie_f else pure Nothing
+  return ([], hf)
+
+getPackageHieFile :: Module             -- ^ Package Module to load .hie file for
+                  -> NormalizedFilePath -- ^ Path of home module importing the package module
+                  -> Action (Maybe (HieFile, FilePath))
+getPackageHieFile mod file = do
+    pkgState  <- hscEnv <$> use_ GhcSession file
+    IdeOptions {..} <- getIdeOptions
+    let unitId = moduleUnitId mod
+    case lookupPackageConfig unitId pkgState of
+        Just pkgConfig -> do
+            -- 'optLocateHieFile' returns Nothing if the file does not exist
+            hieFile <- liftIO $ optLocateHieFile optPkgLocationOpts pkgConfig mod
+            path    <- liftIO $ optLocateSrcFile optPkgLocationOpts pkgConfig mod
+            case (hieFile, path) of
+                (Just hiePath, Just modPath) ->
+                    -- deliberately loaded outside the Shake graph
+                    -- to avoid dependencies on non-workspace files
+                        liftIO $ Just . (, modPath) <$> loadHieFile hiePath
+                _ -> return Nothing
+        _ -> return Nothing
 
 -- | Parse the contents of a daml file.
 getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
@@ -348,14 +398,6 @@ loadGhcSession = do
         opts <- getIdeOptions
         return ("" <$ optShakeFiles opts, ([], Just val))
 
-
-getHieFileRule :: Rules ()
-getHieFileRule =
-    defineNoFile $ \(GetHieFile f) -> do
-        u <- liftIO $ mkSplitUniqSupply 'a'
-        let nameCache = initNameCache u []
-        liftIO $ fmap (hie_file_result . fst) $ readHieFile nameCache f
-
 -- | A rule that wires per-file rules together
 mainRule :: Rules ()
 mainRule = do
@@ -369,4 +411,3 @@ mainRule = do
     generateCoreRule
     generateByteCodeRule
     loadGhcSession
-    getHieFileRule

src/Development/IDE/GHC/Compat.hs

@@ -14,6 +14,9 @@ module Development.IDE.GHC.Compat(
     readHieFile,
     setDefaultHieDir,
     dontWriteHieFiles,
+#if !MIN_GHC_API_VERSION(8,8,0)
+    ml_hie_file,
+#endif
     hPutStringBuffer,
     includePathsGlobal,
     includePathsQuote,
@@ -52,12 +55,10 @@ import System.IO
 import Foreign.ForeignPtr
 
 
-#if !MIN_GHC_API_VERSION(8,8,0)
 hPutStringBuffer :: Handle -> StringBuffer -> IO ()
 hPutStringBuffer hdl (StringBuffer buf len cur)
     = withForeignPtr (plusForeignPtr buf cur) $ \ptr ->
              hPutBuf hdl ptr len
-#endif
 
 mkHieFile :: ModSummary -> TcGblEnv -> RenamedSource -> Hsc HieFile
 mkHieFile _ _ _ = return (HieFile () [])
@@ -68,6 +69,9 @@ writeHieFile _ _ = return ()
 readHieFile :: NameCache -> FilePath -> IO (HieFileResult, ())
 readHieFile _ _ = return (HieFileResult (HieFile () []), ())
 
+ml_hie_file :: GHC.ModLocation -> FilePath
+ml_hie_file _ = ""
+
 data HieFile = HieFile {hie_module :: (), hie_exports :: [AvailInfo]}
 data HieFileResult = HieFileResult { hie_file_result :: HieFile }
 #endif

src/Development/IDE/Spans/AtPoint.hs

@@ -13,8 +13,6 @@ import Development.IDE.GHC.Orphans()
 import Development.IDE.Types.Location
 
 -- DAML compiler and infrastructure
-import Development.Shake
-import Development.IDE.GHC.Util
 import Development.IDE.GHC.Compat
 import Development.IDE.Types.Options
 import Development.IDE.Spans.Type as SpanInfo
@@ -40,14 +38,13 @@ import qualified Data.Text as T
 -- | Locate the definition of the name at a given position.
 gotoDefinition
   :: MonadIO m
-  => (FilePath -> m (Maybe HieFile))
+  => (Module -> m (Maybe (HieFile, FilePath)))
   -> IdeOptions
-  -> HscEnv
   -> [SpanInfo]
   -> Position
   -> m (Maybe Location)
-gotoDefinition getHieFile ideOpts pkgState srcSpans pos =
-  listToMaybe <$> locationsAtPoint getHieFile ideOpts pkgState pos srcSpans
+gotoDefinition getHieFile ideOpts srcSpans pos =
+  listToMaybe <$> locationsAtPoint getHieFile ideOpts pos srcSpans
 
 -- | Synopsis for the name at a given position.
 atPoint
@@ -119,8 +116,15 @@ atPoint IdeOptions{..} (SpansInfo srcSpans cntsSpans) pos = do
         Just name -> any (`isInfixOf` getOccString name) ["==", "showsPrec"]
         Nothing -> False
 
-locationsAtPoint :: forall m . MonadIO m => (FilePath -> m (Maybe HieFile)) -> IdeOptions -> HscEnv -> Position -> [SpanInfo] -> m [Location]
-locationsAtPoint getHieFile IdeOptions{..} pkgState pos =
+locationsAtPoint
+  :: forall m
+   . MonadIO m
+  => (Module -> m (Maybe (HieFile, FilePath)))
+  -> IdeOptions
+  -> Position
+  -> [SpanInfo]
+  -> m [Location]
+locationsAtPoint getHieFile IdeOptions{..} pos =
     fmap (map srcSpanToLocation) . mapMaybeM (getSpan . spaninfoSource) . spansAtPoint pos
   where getSpan :: SpanSource -> m (Maybe SrcSpan)
         getSpan NoSource = pure Nothing
@@ -134,12 +138,8 @@ locationsAtPoint getHieFile IdeOptions{..} pkgState pos =
                 -- In this case the interface files contain garbage source spans
                 -- so we instead read the .hie files to get useful source spans.
                 mod <- MaybeT $ return $ nameModule_maybe name
-                let unitId = moduleUnitId mod
-                pkgConfig <- MaybeT $ pure $ lookupPackageConfig unitId pkgState
-                hiePath <- MaybeT $ liftIO $ optLocateHieFile optPkgLocationOpts pkgConfig mod
-                hieFile <- MaybeT $ getHieFile hiePath
+                (hieFile, srcPath) <- MaybeT $ getHieFile mod
                 avail <- MaybeT $ pure $ listToMaybe (filterAvails (eqName name) $ hie_exports hieFile)
-                srcPath <- MaybeT $ liftIO $ optLocateSrcFile optPkgLocationOpts pkgConfig mod
                 -- The location will point to the source file used during compilation.
                 -- This file might no longer exists and even if it does the path will be relative
                 -- to the compilation directory which we don’t know.