Skip to content

Commit cbb9999

Browse files
committed
Handle loadHieFile error
1 parent 6ef98f6 commit cbb9999

File tree

1 file changed

+26
-26
lines changed

1 file changed

+26
-26
lines changed

ghcide/src/Development/IDE/Types/HscEnvEq.hs

Lines changed: 26 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,8 @@ module Development.IDE.Types.HscEnvEq
1515
import Control.Concurrent.Async (Async, async, waitCatch)
1616
import Control.Concurrent.Strict (modifyVar, newVar)
1717
import Control.DeepSeq (force)
18-
import Control.Exception (evaluate, mask, throwIO)
18+
import Control.Exception (SomeException, evaluate, mask, throwIO)
19+
import Control.Exception.Safe (tryAny)
1920
import Control.Monad.Extra (eitherM, join, mapMaybeM, void)
2021
import Data.Either (fromRight)
2122
import Data.Foldable (traverse_)
@@ -123,34 +124,42 @@ newHscEnvEqWithImportPaths envImportPaths se hscEnv deps = do
123124
return HscEnvEq{..}
124125
where
125126
indexDependencyHieFiles :: IO ()
126-
indexDependencyHieFiles = do
127-
packagesWithModIfaces <- loadPackagesWithModIFaces
128-
void $ Map.traverseWithKey indexPackageHieFiles packagesWithModIfaces
127+
indexDependencyHieFiles = void
128+
$ Map.traverseWithKey indexPackageHieFiles packagesWithModules
129129
logPackage :: UnitInfo -> IO ()
130-
logPackage package = Logger.logDebug (logger se) $ "\n\n\n!!!!!!!!!!!! hscEnvEq :\n"
131-
<> T.pack (concatMap show $ unitLibraryDirs package)
132-
<> "\n!!!!!!!!!!!!!!!!!!!!!!\n\n\n"
133-
indexPackageHieFiles :: Package -> [ModIface] -> IO ()
134-
indexPackageHieFiles (Package package) modIfaces = do
130+
logPackage package = Logger.logDebug (logger se) $ "!!!!!!!!!!!! hscEnvEq :\n"
131+
<> T.pack (concatMap show $ unitLibraryDirs package) <> "\n"
132+
<> T.pack (show $ unitId package)
133+
<> "\n!!!!!!!!!!!!!!!!!!!!!!"
134+
indexPackageHieFiles :: Package -> [Module] -> IO ()
135+
indexPackageHieFiles (Package package) modules = do
135136
let pkgLibDir :: FilePath
136137
pkgLibDir = case unitLibraryDirs package of
137138
[] -> ""
138139
(libraryDir : _) -> libraryDir
139140
hieDir :: FilePath
140141
hieDir = pkgLibDir </> "extra-compilation-artifacts"
141142
logPackage package
143+
modIfaces <- mapMaybeM loadModIFace modules
142144
traverse_ (indexModuleHieFile hieDir) modIfaces
143-
logModule :: FilePath -> IO ()
144-
logModule hiePath = Logger.logDebug (logger se) $ "\n\n\n!!!!!!!!!!!! hscEnvEq :\n"
145+
logModule :: FilePath -> Either SomeException HieFile -> IO ()
146+
logModule hiePath hieResults = Logger.logDebug (logger se) $ "!!!!!!!!!!!! hscEnvEq :\n"
145147
<> T.pack hiePath
146-
<> "\n!!!!!!!!!!!!!!!!!!!!!!\n\n\n"
148+
<> (case hieResults of
149+
Left e -> "\n" <> T.pack (show e)
150+
Right _ -> ""
151+
)
152+
<> "\n!!!!!!!!!!!!!!!!!!!!!!"
147153
indexModuleHieFile :: FilePath -> ModIface -> IO ()
148154
indexModuleHieFile hieDir modIface = do
149155
let hiePath :: FilePath
150156
hiePath = hieDir </> toFilePath (moduleName $ mi_module modIface) ++ ".hie"
151-
logModule hiePath
152-
hie <- loadHieFile (mkUpdater $ ideNc se) hiePath
153-
indexHieFile se (toNormalizedFilePath' hiePath) (FakeFile Nothing) (mi_src_hash modIface) hie
157+
hieResults <- tryAny $ loadHieFile (mkUpdater $ ideNc se) hiePath
158+
logModule hiePath hieResults
159+
case hieResults of
160+
Left _ -> return ()
161+
Right hie ->
162+
indexHieFile se (toNormalizedFilePath' hiePath) (FakeFile Nothing) (mi_src_hash modIface) hie
154163
toFilePath :: ModuleName -> FilePath
155164
toFilePath = separateDirectories . prettyModuleName
156165
where
@@ -177,22 +186,13 @@ newHscEnvEqWithImportPaths envImportPaths se hscEnv deps = do
177186
return $ case modIface of
178187
Maybes.Failed _r -> Nothing
179188
Maybes.Succeeded mi -> Just mi
180-
loadPackagesWithModIFaces :: IO (Map.Map Package [ModIface])
181-
loadPackagesWithModIFaces = Map.traverseWithKey
182-
(const $ mapMaybeM loadModIFace) packagesWithModules
183189
packagesWithModules :: Map.Map Package [Module]
184190
packagesWithModules = Map.fromSet getModulesForPackage packages
185-
packageState :: UnitState
186-
packageState = unitState hscEnv
187-
dependencies :: [Unit]
188-
dependencies = explicitUnits packageState
189191
packages :: Set Package
190192
packages = Set.fromList
191193
$ map Package
192-
[ package
193-
| d <- dependencies
194-
, Just package <- [lookupPackageConfig d hscEnv]
195-
]
194+
$ Map.elems
195+
$ getUnitInfoMap hscEnv
196196
getModulesForPackage :: Package -> [Module]
197197
getModulesForPackage (Package package) =
198198
map makeModule allModules

0 commit comments

Comments
 (0)