@@ -15,7 +15,8 @@ module Development.IDE.Types.HscEnvEq
15
15
import Control.Concurrent.Async (Async , async , waitCatch )
16
16
import Control.Concurrent.Strict (modifyVar , newVar )
17
17
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 )
19
20
import Control.Monad.Extra (eitherM , join , mapMaybeM , void )
20
21
import Data.Either (fromRight )
21
22
import Data.Foldable (traverse_ )
@@ -123,34 +124,42 @@ newHscEnvEqWithImportPaths envImportPaths se hscEnv deps = do
123
124
return HscEnvEq {.. }
124
125
where
125
126
indexDependencyHieFiles :: IO ()
126
- indexDependencyHieFiles = do
127
- packagesWithModIfaces <- loadPackagesWithModIFaces
128
- void $ Map. traverseWithKey indexPackageHieFiles packagesWithModIfaces
127
+ indexDependencyHieFiles = void
128
+ $ Map. traverseWithKey indexPackageHieFiles packagesWithModules
129
129
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
135
136
let pkgLibDir :: FilePath
136
137
pkgLibDir = case unitLibraryDirs package of
137
138
[] -> " "
138
139
(libraryDir : _) -> libraryDir
139
140
hieDir :: FilePath
140
141
hieDir = pkgLibDir </> " extra-compilation-artifacts"
141
142
logPackage package
143
+ modIfaces <- mapMaybeM loadModIFace modules
142
144
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 "
145
147
<> 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 !!!!!!!!!!!!!!!!!!!!!!"
147
153
indexModuleHieFile :: FilePath -> ModIface -> IO ()
148
154
indexModuleHieFile hieDir modIface = do
149
155
let hiePath :: FilePath
150
156
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
154
163
toFilePath :: ModuleName -> FilePath
155
164
toFilePath = separateDirectories . prettyModuleName
156
165
where
@@ -177,22 +186,13 @@ newHscEnvEqWithImportPaths envImportPaths se hscEnv deps = do
177
186
return $ case modIface of
178
187
Maybes. Failed _r -> Nothing
179
188
Maybes. Succeeded mi -> Just mi
180
- loadPackagesWithModIFaces :: IO (Map. Map Package [ModIface ])
181
- loadPackagesWithModIFaces = Map. traverseWithKey
182
- (const $ mapMaybeM loadModIFace) packagesWithModules
183
189
packagesWithModules :: Map. Map Package [Module ]
184
190
packagesWithModules = Map. fromSet getModulesForPackage packages
185
- packageState :: UnitState
186
- packageState = unitState hscEnv
187
- dependencies :: [Unit ]
188
- dependencies = explicitUnits packageState
189
191
packages :: Set Package
190
192
packages = Set. fromList
191
193
$ map Package
192
- [ package
193
- | d <- dependencies
194
- , Just package <- [lookupPackageConfig d hscEnv]
195
- ]
194
+ $ Map. elems
195
+ $ getUnitInfoMap hscEnv
196
196
getModulesForPackage :: Package -> [Module ]
197
197
getModulesForPackage (Package package) =
198
198
map makeModule allModules
0 commit comments