@@ -10,57 +10,26 @@
1010--
1111-- * Call setSessionDynFlags, use modifyDynFlags instead. It's faster and avoids loading packages.
1212module Development.IDE.UtilGHC(
13− PackageDynFlags(..), setPackageDynFlags, getPackageDynFlags,
1413 lookupPackageConfig,
1514 modifyDynFlags,
16− setPackageImports,
17− setPackageDbs,
1815 fakeDynFlags,
1916 prettyPrint,
20− runGhcFast,
2117 runGhcEnv
2218 ) where
2319
24−import Config
25−import Fingerprint
26−import GHC hiding (convertLit)
27−import GhcMonad
28−import GhcPlugins as GHC hiding (fst3, (<>))
29−import HscMain
30−import qualified Packages
31−import Platform
32−import qualified EnumSet
33−import Data.IORef
34−import System.FilePath
35−import GHC.Generics (Generic)
20+import Config
21+import Fingerprint
22+import GHC
23+import GhcMonad
24+import GhcPlugins
25+import Platform
26+import Data.IORef
27+import Control.Exception
28+import FileCleanup
3629
3730----------------------------------------------------------------------
3831-- GHC setup
3932
40−setPackageDbs :: [FilePath] -> DynFlags -> DynFlags
41−setPackageDbs paths dflags =
42− dflags
43− { packageDBFlags =
44− [PackageDB $ PkgConfFile $ path </> "package.conf.d" | path <- paths] ++ [NoGlobalPackageDB, ClearPackageDBs]
45− , pkgDatabase = if null paths then Just [] else Nothing
46− -- if we don't load any packages set the package database to empty and loaded.
47− , settings = (settings dflags)
48− {sTopDir = case paths of p:_ -> p; _ -> error "No package db path available but used $topdir"
49− , sSystemPackageConfig = case paths of p:_ -> p; _ -> error "No package db path available but used system package config"
50− }
51− }
52−
53−setPackageImports :: Bool -> [(String, ModRenaming)] -> DynFlags -> DynFlags
54−setPackageImports hideAllPkgs pkgImports dflags = dflags {
55− packageFlags = packageFlags dflags ++
56− [ExposePackage pkgName (UnitIdArg $ stringToUnitId pkgName) renaming
57− | (pkgName, renaming) <- pkgImports
58− ]
59− , generalFlags = if hideAllPkgs
60− then Opt_HideAllPackages `EnumSet.insert` generalFlags dflags
61− else generalFlags dflags
62− }
63−
6433modifyDynFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m ()
6534modifyDynFlags f = do
6635 newFlags <- f <$> getSessionDynFlags
@@ -69,27 +38,6 @@ modifyDynFlags f = do
6938 modifySession $ \h ->
7039 h { hsc_dflags = newFlags, hsc_IC = (hsc_IC h) {ic_dflags = newFlags} }
7140
72−-- | The subset of @DynFlags@ computed by package initialization.
73−data PackageDynFlags = PackageDynFlags
74− { pdfPkgDatabase :: !(Maybe [(FilePath, [Packages.PackageConfig])])
75− , pdfPkgState :: !Packages.PackageState
76− , pdfThisUnitIdInsts :: !(Maybe [(ModuleName, Module)])
77− } deriving (Generic)
78−
79−setPackageDynFlags :: PackageDynFlags -> DynFlags -> DynFlags
80−setPackageDynFlags PackageDynFlags{..} dflags = dflags
81− { pkgDatabase = pdfPkgDatabase
82− , pkgState = pdfPkgState
83− , thisUnitIdInsts_ = pdfThisUnitIdInsts
84− }
85−
86−getPackageDynFlags :: DynFlags -> PackageDynFlags
87−getPackageDynFlags DynFlags{..} = PackageDynFlags
88− { pdfPkgDatabase = pkgDatabase
89− , pdfPkgState = pkgState
90− , pdfThisUnitIdInsts = thisUnitIdInsts_
91− }
92−
9341lookupPackageConfig :: UnitId -> HscEnv -> Maybe PackageConfig
9442lookupPackageConfig unitId env =
9543 lookupPackage' False pkgConfigMap unitId
@@ -106,22 +54,14 @@ prettyPrint = showSDoc fakeDynFlags . ppr
10654
10755runGhcEnv :: HscEnv -> Ghc a -> IO a
10856runGhcEnv env act = do
109− ref <- newIORef env
110− unGhc act $ Session ref
111−
57+ filesToClean <- newIORef emptyFilesToClean
58+ dirsToClean <- newIORef mempty
59+ let dflags = (hsc_dflags env){filesToClean=filesToClean, dirsToClean=dirsToClean}
60+ ref <- newIORef env{hsc_dflags=dflags}
61+ unGhc act (Session ref) `finally` do
62+ cleanTempFiles dflags
63+ cleanTempDirs dflags
11264
113−-- | Like 'runGhc' but much faster (400x), with less IO and no file dependency
114−runGhcFast :: Ghc a -> IO a
115−-- copied from GHC with the nasty bits dropped
116−runGhcFast act = do
117− ref <- newIORef (error "empty session")
118− let session = Session ref
119− flip unGhc session $ do
120− dflags <- liftIO $ initDynFlags fakeDynFlags
121− liftIO $ setUnsafeGlobalDynFlags dflags
122− env <- liftIO $ newHscEnv dflags
123− setSession env
124− withCleanupSession act
12565
12666-- Fake DynFlags which are mostly undefined, but define enough to do a little bit
12767fakeDynFlags :: DynFlags