Favor lookupPathToId over pathToId (#926)

* Favor `lookupPathToId` over `pathToId`

* Fix `typecheckParentsAction`

* Fix `needsCompilationRule`

src/Development/IDE/Core/FileStore.hs

@@ -239,10 +239,12 @@ typecheckParentsAction nfp = do
     revs <- transitiveReverseDependencies nfp <$> useNoFile_ GetModuleGraph
     logger <- logger <$> getShakeExtras
     let log = L.logInfo logger . T.pack
-    liftIO $ do
-      (log $ "Typechecking reverse dependencies for" ++ show nfp ++ ": " ++ show revs)
-        `catch` \(e :: SomeException) -> log (show e)
-    () <$ uses GetModIface revs
+    case revs of
+      Nothing -> liftIO $ log $ "Could not identify reverse dependencies for " ++ show nfp
+      Just rs -> do
+        liftIO $ (log $ "Typechecking reverse dependencies for " ++ show nfp ++ ": " ++ show revs)
+          `catch` \(e :: SomeException) -> log (show e)
+        () <$ uses GetModIface rs
 
 -- | Note that some buffer somewhere has been modified, but don't say what.
 --   Only valid if the virtual file system was initialised by LSP, as that

src/Development/IDE/Core/Rules.hs

@@ -905,13 +905,20 @@ getLinkableType f = do
 needsCompilationRule :: Rules ()
 needsCompilationRule = defineEarlyCutoff $ \NeedsCompilation file -> do
   ((ms,_),_) <- useWithStale_ GetModSummaryWithoutTimestamps file
-  -- A file needs object code if it uses TH or any file that depends on it uses TH
+  -- A file needs object code if it uses TemplateHaskell or any file that depends on it uses TemplateHaskell
   res <-
     if uses_th_qq ms
     then pure True
-    -- Treat as False if some reverse dependency header fails to parse
-    else anyM (fmap (fromMaybe False) . use NeedsCompilation) . maybe [] (immediateReverseDependencies file)
-           =<< useNoFile GetModuleGraph
+    else do
+      graph <- useNoFile GetModuleGraph
+      case graph of
+          -- Treat as False if some reverse dependency header fails to parse
+          Nothing -> pure False
+          Just depinfo -> case immediateReverseDependencies file depinfo of
+            -- If we fail to get immediate reverse dependencies, fail with an error message
+            Nothing -> fail $ "Failed to get the immediate reverse dependencies of " ++ show file
+            Just revdeps -> anyM (fmap (fromMaybe False) . use NeedsCompilation) revdeps
+
   pure (Just $ BS.pack $ show $ hash res, ([], Just res))
   where
     uses_th_qq (ms_hspp_opts -> dflags) =

src/Development/IDE/Import/DependencyInformation.hs

@@ -317,23 +317,23 @@ partitionSCC (AcyclicSCC x:rest) = first (x:)   $ partitionSCC rest
 partitionSCC []                  = ([], [])
 
 -- | Transitive reverse dependencies of a file
-transitiveReverseDependencies :: NormalizedFilePath -> DependencyInformation -> [NormalizedFilePath]
-transitiveReverseDependencies file DependencyInformation{..} =
-  let FilePathId cur_id = pathToId depPathIdMap file
-  in map (idToPath depPathIdMap . FilePathId) (IntSet.toList (go cur_id IntSet.empty))
+transitiveReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath]
+transitiveReverseDependencies file DependencyInformation{..} = do
+    FilePathId cur_id <- lookupPathToId depPathIdMap file
+    return $ map (idToPath depPathIdMap . FilePathId) (IntSet.toList (go cur_id IntSet.empty))
   where
     go :: Int -> IntSet -> IntSet
     go k i =
-      let outwards = fromMaybe IntSet.empty (IntMap.lookup k depReverseModuleDeps  )
+      let outwards = fromMaybe IntSet.empty (IntMap.lookup k depReverseModuleDeps)
           res = IntSet.union i outwards
           new = IntSet.difference i outwards
       in IntSet.foldr go res new
 
 -- | Immediate reverse dependencies of a file
-immediateReverseDependencies :: NormalizedFilePath -> DependencyInformation -> [NormalizedFilePath]
-immediateReverseDependencies file DependencyInformation{..} =
-  let FilePathId cur_id = pathToId depPathIdMap file
-  in map (idToPath depPathIdMap . FilePathId) (maybe mempty IntSet.toList (IntMap.lookup cur_id depReverseModuleDeps))
+immediateReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath]
+immediateReverseDependencies file DependencyInformation{..} = do
+  FilePathId cur_id <- lookupPathToId depPathIdMap file
+  return $ map (idToPath depPathIdMap . FilePathId) (maybe mempty IntSet.toList (IntMap.lookup cur_id depReverseModuleDeps))
 
 transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies
 transitiveDeps DependencyInformation{..} file = do
@@ -401,4 +401,3 @@ instance NFData NamedModuleDep where
 
 instance Show NamedModuleDep where
   show NamedModuleDep{..} = show nmdFilePath
-