1c27ffe · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Clean up the IDE (#961)

1c27ffeNeil Mitchell7 years ago

src/Development/IDE/Functions/Compile.hs+23−42

compare with master

unifiedsplit

@@ -8,9 +8,7 @@

8-- | Based on https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/API.

9-- Given a list of paths to find libraries, and a file to compile, produce a list of 'CoreModule' values.

10module Development.IDE.Functions.Compile

11− ( CompileOpts(..)

12− , PackageState(..)

13− , GhcModule(..)

11+ ( GhcModule(..)

14 , TcModuleResult(..)

12 , TcModuleResult(..)

15 , LoadPackageResult(..)

13 , LoadPackageResult(..)

16 , getGhcDynFlags

14 , getGhcDynFlags

@@ -29,6 +27,7 @@ import qualified Development.IDE.Functions.FindImports as FindImports

29import Development.IDE.Functions.GHCError

27import Development.IDE.Functions.GHCError

30import Development.IDE.Functions.SpanInfo

28import Development.IDE.Functions.SpanInfo

31import Development.IDE.UtilGHC

29import Development.IDE.UtilGHC

30+import Development.IDE.Types.Options

33import GHC hiding (parseModule, typecheckModule)

32import GHC hiding (parseModule, typecheckModule)

34import qualified Parser

33import qualified Parser

@@ -38,7 +37,7 @@ import Bag

38import qualified GHC

37import qualified GHC

39import Panic

38import Panic

40import GhcMonad

39import GhcMonad

41−import GhcPlugins as GHC hiding (PackageState, fst3, (<>))

40+import GhcPlugins as GHC hiding (fst3, (<>))

42import qualified HeaderInfo as Hdr

41import qualified HeaderInfo as Hdr

43import MkIface

42import MkIface

44import NameCache

43import NameCache

@@ -61,24 +60,6 @@ import Development.IDE.Types.SpanInfo

61import GHC.Generics (Generic)

60import GHC.Generics (Generic)

62import System.FilePath

61import System.FilePath

64−-- TODO (MK) Move to a separate Options module

65−data CompileOpts = CompileOpts

66− { optPreprocessor :: GHC.ParsedSource -> ([(GHC.SrcSpan, String)], GHC.ParsedSource)

67− , optRunGhcSession :: forall a. Maybe ParsedModule -> PackageState -> Ghc a -> IO a

68− -- ^ Setup a GHC session using a given package state. If a `ParsedModule` is supplied,

69− -- the import path should be setup for that module.

70− , optWriteIface :: Bool

71−

72− , optMbPackageName :: Maybe String

73−

74− , optPackageDbs :: [FilePath]

75− , optHideAllPkgs :: Bool

76− , optPackageImports :: [(String, ModRenaming)]

77−

78− , optThreads :: Int

79− , optShakeProfiling :: Maybe FilePath

80− }

81−

82-- | 'CoreModule' together with some additional information required for the

63-- | 'CoreModule' together with some additional information required for the

83-- conversion to DAML-LF.

64-- conversion to DAML-LF.

84data GhcModule = GhcModule

65data GhcModule = GhcModule

@@ -106,9 +87,9 @@ data LoadPackageResult = LoadPackageResult

106

107-- | Get source span info, used for e.g. AtPoint and Goto Definition.

88-- | Get source span info, used for e.g. AtPoint and Goto Definition.

108getSrcSpanInfos

89getSrcSpanInfos

109− :: CompileOpts

90+ :: IdeOptions

110 -> ParsedModule

91 -> ParsedModule

111− -> PackageState

92+ -> PackageDynFlags

112 -> [(Located ModuleName, Maybe FilePath)]

93 -> [(Located ModuleName, Maybe FilePath)]

113 -> TcModuleResult

94 -> TcModuleResult

114 -> IO [SpanInfo]

95 -> IO [SpanInfo]

@@ -120,18 +101,18 @@ getSrcSpanInfos opt mod packageState imports tc =

120

101

121-- | Given a string buffer, return a pre-processed @ParsedModule@.

102-- | Given a string buffer, return a pre-processed @ParsedModule@.

122parseModule

103parseModule

123− :: CompileOpts

104+ :: IdeOptions

124− -> PackageState

105+ -> PackageDynFlags

125 -> FilePath

106 -> FilePath

126 -> (UTCTime, SB.StringBuffer)

107 -> (UTCTime, SB.StringBuffer)

127 -> IO ([FileDiagnostic], Maybe ParsedModule)

108 -> IO ([FileDiagnostic], Maybe ParsedModule)

128−parseModule opt@CompileOpts{..} packageState file =

109+parseModule opt@IdeOptions{..} packageState file =

129 fmap (either (, Nothing) (second Just)) . Ex.runExceptT .

110 fmap (either (, Nothing) (second Just)) . Ex.runExceptT .

130 -- We need packages since imports fail to resolve otherwise.

111 -- We need packages since imports fail to resolve otherwise.

131 runGhcSessionExcept opt Nothing packageState . parseFileContents optPreprocessor file

112 runGhcSessionExcept opt Nothing packageState . parseFileContents optPreprocessor file

132

113

133computePackageDeps ::

114computePackageDeps ::

134− CompileOpts -> PackageState -> InstalledUnitId -> IO (Either [FileDiagnostic] [InstalledUnitId])

115+ IdeOptions -> PackageDynFlags -> InstalledUnitId -> IO (Either [FileDiagnostic] [InstalledUnitId])

135computePackageDeps opts packageState iuid =

116computePackageDeps opts packageState iuid =

136 Ex.runExceptT $

117 Ex.runExceptT $

137 runGhcSessionExcept opts Nothing packageState $

118 runGhcSessionExcept opts Nothing packageState $

@@ -149,9 +130,9 @@ getPackage dflags p =

149

130

150-- | Typecheck a single module using the supplied dependencies and packages.

131-- | Typecheck a single module using the supplied dependencies and packages.

151typecheckModule

132typecheckModule

152− :: CompileOpts

133+ :: IdeOptions

153 -> ParsedModule

134 -> ParsedModule

154− -> PackageState

135+ -> PackageDynFlags

155 -> UniqSupply

136 -> UniqSupply

156 -> [TcModuleResult]

137 -> [TcModuleResult]

157 -> [LoadPackageResult]

138 -> [LoadPackageResult]

@@ -169,8 +150,8 @@ typecheckModule opt mod packageState uniqSupply deps pkgs pm =

169

150

170-- | Load a pkg and populate the name cache and external package state.

151-- | Load a pkg and populate the name cache and external package state.

171loadPackage ::

152loadPackage ::

172− CompileOpts

153+ IdeOptions

173− -> PackageState

154+ -> PackageDynFlags

174 -> UniqSupply

155 -> UniqSupply

175 -> [LoadPackageResult]

156 -> [LoadPackageResult]

176 -> InstalledUnitId

157 -> InstalledUnitId

@@ -196,9 +177,9 @@ loadPackage opt packageState us lps p =

196-- | Compile a single type-checked module to a 'CoreModule' value, or

177-- | Compile a single type-checked module to a 'CoreModule' value, or

197-- provide errors.

178-- provide errors.

198compileModule

179compileModule

199− :: CompileOpts

180+ :: IdeOptions

200 -> ParsedModule

181 -> ParsedModule

201− -> PackageState

182+ -> PackageDynFlags

202 -> UniqSupply

183 -> UniqSupply

203 -> [TcModuleResult]

184 -> [TcModuleResult]

204 -> [LoadPackageResult]

185 -> [LoadPackageResult]

@@ -233,27 +214,27 @@ compileModule opt mod packageState uniqSupply deps pkgs tmr =

233-- | Evaluate a GHC session using a new environment constructed with

214-- | Evaluate a GHC session using a new environment constructed with

234-- the supplied options.

215-- the supplied options.

235runGhcSessionExcept

216runGhcSessionExcept

236− :: CompileOpts

217+ :: IdeOptions

237 -> Maybe ParsedModule

218 -> Maybe ParsedModule

238− -> PackageState

219+ -> PackageDynFlags

239 -> Ex.ExceptT e Ghc a

220 -> Ex.ExceptT e Ghc a

240 -> Ex.ExceptT e IO a

221 -> Ex.ExceptT e IO a

241runGhcSessionExcept opts mbMod pkg m =

222runGhcSessionExcept opts mbMod pkg m =

242 Ex.ExceptT $ runGhcSession opts mbMod pkg $ Ex.runExceptT m

223 Ex.ExceptT $ runGhcSession opts mbMod pkg $ Ex.runExceptT m

243

224

244

225

245−getGhcDynFlags :: CompileOpts -> ParsedModule -> PackageState -> IO DynFlags

226+getGhcDynFlags :: IdeOptions -> ParsedModule -> PackageDynFlags -> IO DynFlags

246getGhcDynFlags opts mod pkg = runGhcSession opts (Just mod) pkg getSessionDynFlags

227getGhcDynFlags opts mod pkg = runGhcSession opts (Just mod) pkg getSessionDynFlags

247

228

248-- | Evaluate a GHC session using a new environment constructed with

229-- | Evaluate a GHC session using a new environment constructed with

249-- the supplied options.

230-- the supplied options.

250runGhcSession

231runGhcSession

251− :: CompileOpts

232+ :: IdeOptions

252 -> Maybe ParsedModule

233 -> Maybe ParsedModule

253− -> PackageState

234+ -> PackageDynFlags

254 -> Ghc a

235 -> Ghc a

255 -> IO a

236 -> IO a

256−runGhcSession CompileOpts{..} = optRunGhcSession

237+runGhcSession IdeOptions{..} = optRunGhcSession

257

238

258-- When we make a fresh GHC environment, the OrigNameCache comes already partially

239-- When we make a fresh GHC environment, the OrigNameCache comes already partially

259-- populated. So to be safe, we simply extend this one.

240-- populated. So to be safe, we simply extend this one.

@@ -496,11 +477,11 @@ parsePragmasIntoDynFlags fp contents = catchSrcErrors $ do

496 (dflags, _, _) <- parseDynamicFilePragma dflags0 opts

477 (dflags, _, _) <- parseDynamicFilePragma dflags0 opts

497 return dflags

478 return dflags

498

479

499−generatePackageState :: [FilePath] -> Bool -> [(String, ModRenaming)] -> IO PackageState

480+generatePackageState :: [FilePath] -> Bool -> [(String, ModRenaming)] -> IO PackageDynFlags

500generatePackageState paths hideAllPkgs pkgImports = do

481generatePackageState paths hideAllPkgs pkgImports = do

501 let dflags = setPackageImports hideAllPkgs pkgImports $ setPackageDbs paths (defaultDynFlags fakeSettings fakeLlvmConfig)

482 let dflags = setPackageImports hideAllPkgs pkgImports $ setPackageDbs paths (defaultDynFlags fakeSettings fakeLlvmConfig)

502 (newDynFlags, _) <- initPackages dflags

483 (newDynFlags, _) <- initPackages dflags

503− pure $ PackageState (pkgDatabase newDynFlags) (pkgState newDynFlags) (thisUnitIdInsts_ newDynFlags)

484+ pure $ getPackageDynFlags newDynFlags

504

485

505-- | Run something in a Ghc monad and catch the errors (SourceErrors and

486-- | Run something in a Ghc monad and catch the errors (SourceErrors and

506-- compiler-internal exceptions like Panic or InstallationError).

487-- compiler-internal exceptions like Panic or InstallationError).

src/Development/IDE/Logger.hs+5−7

@@ -13,13 +13,11 @@ module Development.IDE.Logger

13import qualified Data.Text as T

14import GHC.Stack

16−data Handle m = Handle {

16+data Handle = Handle {

17− logError :: HasCallStack => T.Text -> m ()

17+ logSeriousError :: HasCallStack => T.Text -> IO ()

18− , logWarning :: HasCallStack => T.Text -> m ()

19− , logInfo :: HasCallStack => T.Text -> m ()

20− , logDebug :: HasCallStack => T.Text -> m ()

18+ , logDebug :: HasCallStack => T.Text -> IO ()

21 }

19 }

23−makeNopHandle :: Monad m => Handle m

21+makeNopHandle :: Handle

24−makeNopHandle = Handle e e e e where

22+makeNopHandle = Handle e e where

25 e _ = pure ()

23 e _ = pure ()

src/Development/IDE/State/FileStore.hs+9−2

@@ -12,6 +12,7 @@ module Development.IDE.State.FileStore(

14import StringBuffer

15+import Development.IDE.UtilGHC()

16import qualified Data.Map.Strict as Map

17import qualified Data.Map.Strict as Map

17import qualified Data.Text as T

18import qualified Data.Text as T

@@ -21,12 +22,12 @@ import qualified System.Directory as Dir

21import Development.Shake

22import Development.Shake

22import Development.Shake.Classes

23import Development.Shake.Classes

23import Development.IDE.State.Shake

24import Development.IDE.State.Shake

24−import Development.IDE.UtilGHC

25import Control.Concurrent.Extra

26import Control.Exception

27import GHC.Generics

28import System.IO.Error

29import qualified Data.ByteString.Char8 as BS

30+import qualified StringBuffer as SB

30import Development.IDE.Types.Diagnostics

31import Development.IDE.Types.Diagnostics

31import Data.Time

32import Data.Time

@@ -141,7 +142,13 @@ setBufferModified state absFile (mcontents, !time) = do

141 -- update vars synchronously

142 -- update vars synchronously

142 modifyVar_ envDirtyFiles $ evaluate . case mcontents of

143 modifyVar_ envDirtyFiles $ evaluate . case mcontents of

143 Nothing -> Map.delete absFile

144 Nothing -> Map.delete absFile

144− Just contents -> Map.insert absFile $ strictPair time (textToStringBuffer contents)

145+ Just contents -> Map.insert absFile $ strictPair time $ textToStringBuffer contents

145

146

146 -- run shake to update results regarding the files of interest

147 -- run shake to update results regarding the files of interest

147 void $ shakeRun state []

148 void $ shakeRun state []

149+

150+

151+-- would be nice to do this more efficiently...

152+textToStringBuffer :: T.Text -> SB.StringBuffer

153+-- would be nice to do this more efficiently...

154+textToStringBuffer = SB.stringToStringBuffer . T.unpack

src/Development/IDE/State/RuleTypes.hs+2−1

@@ -15,6 +15,7 @@ module Development.IDE.State.RuleTypes(

15import Control.DeepSeq

16import Development.IDE.Functions.Compile (TcModuleResult, GhcModule, LoadPackageResult(..))

17import qualified Development.IDE.Functions.Compile as Compile

18+import qualified Development.IDE.UtilGHC as Compile

18import Development.IDE.Functions.FindImports (Import(..))

19import Development.IDE.Functions.FindImports (Import(..))

19import Development.IDE.Functions.DependencyInformation

20import Development.IDE.Functions.DependencyInformation

20import Data.Hashable

21import Data.Hashable

@@ -61,7 +62,7 @@ type instance RuleResult GenerateCore = GhcModule

62-- | We capture the subset of `DynFlags` that is computed by package initialization in a rule to

63-- | We capture the subset of `DynFlags` that is computed by package initialization in a rule to

63-- make session initialization cheaper by reusing it.

64-- make session initialization cheaper by reusing it.

64−type instance RuleResult LoadPackageState = Compile.PackageState

65+type instance RuleResult LoadPackageState = Compile.PackageDynFlags

66-- | Resolve the imports in a module to the list of either external packages or absolute file paths

67-- | Resolve the imports in a module to the list of either external packages or absolute file paths

67-- for modules in the same package.

68-- for modules in the same package.

src/Development/IDE/State/Rules.hs+2−1

@@ -28,6 +28,7 @@ import Control.Exception (evaluate)

28import Control.Monad.Except

29import Control.Monad.Extra (whenJust)

30import qualified Development.IDE.Functions.Compile as Compile

31+import qualified Development.IDE.Types.Options as Compile

31import Development.IDE.Functions.DependencyInformation

32import Development.IDE.Functions.DependencyInformation

32import Development.IDE.Functions.FindImports

33import Development.IDE.Functions.FindImports

33import Development.IDE.State.FileStore

34import Development.IDE.State.FileStore

@@ -152,7 +153,7 @@ getDefinitionForFile file pos = do

152 spans <- useE GetSpanInfo file

153 spans <- useE GetSpanInfo file

153 return $ AtPoint.gotoDefinition spans pos

154 return $ AtPoint.gotoDefinition spans pos

154

155

155−getOpts :: Action Compile.CompileOpts

156+getOpts :: Action Compile.IdeOptions

156getOpts = envOptions <$> getServiceEnv

157getOpts = envOptions <$> getServiceEnv

157

158

158------------------------------------------------------------

159------------------------------------------------------------

src/Development/IDE/State/Service.hs+7−14

@@ -16,18 +16,17 @@ module Development.IDE.State.Service(

16 setFilesOfInterest,

17 writeProfile,

18 getDiagnostics, unsafeClearDiagnostics,

19− logDebug, logInfo, logWarning, logError

19+ logDebug, logSeriousError

20 ) where

22import Control.Concurrent.Extra

23import Control.Monad.Except

24−import Development.IDE.Functions.Compile (CompileOpts(..))

24+import Development.IDE.Types.Options (IdeOptions(..))

25import Development.IDE.State.FileStore

26import qualified Development.IDE.Logger as Logger

27import Data.Maybe

28import Data.Set (Set)

29import qualified Data.Set as Set

30−import qualified Data.Text as T

31import Development.IDE.Functions.GHCError

30import Development.IDE.Functions.GHCError

32import Development.Shake hiding (Diagnostic, Env, newCache)

31import Development.Shake hiding (Diagnostic, Env, newCache)

33import Development.IDE.Types.LSP as Compiler

32import Development.IDE.Types.LSP as Compiler

@@ -39,7 +38,7 @@ import Development.IDE.State.Shake

40-- | Environment threaded through the Shake actions.

39-- | Environment threaded through the Shake actions.

41data Env = Env

40data Env = Env

42− { envOptions :: CompileOpts

41+ { envOptions :: IdeOptions

43 -- ^ Compiler options.

42 -- ^ Compiler options.

44 , envOfInterestVar :: Var (Set FilePath)

43 , envOfInterestVar :: Var (Set FilePath)

45 -- ^ The files of interest.

44 -- ^ The files of interest.

@@ -49,7 +48,7 @@ data Env = Env

49instance IsIdeGlobal Env

48instance IsIdeGlobal Env

52−mkEnv :: CompileOpts -> IO Env

51+mkEnv :: IdeOptions -> IO Env

53mkEnv options = do

52mkEnv options = do

54 ofInterestVar <- newVar Set.empty

53 ofInterestVar <- newVar Set.empty

55 uniqSupplyVar <- mkSplitUniqSupply 'a' >>= newVar

54 uniqSupplyVar <- mkSplitUniqSupply 'a' >>= newVar

@@ -72,8 +71,8 @@ unsafeClearDiagnostics = unsafeClearAllDiagnostics

72-- | Initialise the Compiler Service.

71-- | Initialise the Compiler Service.

73initialise :: Rules ()

72initialise :: Rules ()

74 -> Maybe (Event -> IO ())

73 -> Maybe (Event -> IO ())

75− -> Logger.Handle IO

74+ -> Logger.Handle

76− -> CompileOpts

75+ -> IdeOptions

77 -> IO IdeState

76 -> IO IdeState

78initialise mainRule toDiags logger options =

77initialise mainRule toDiags logger options =

79 shakeOpen

78 shakeOpen

@@ -90,7 +89,7 @@ initialise mainRule toDiags logger options =

90writeProfile :: IdeState -> FilePath -> IO ()

89writeProfile :: IdeState -> FilePath -> IO ()

91writeProfile = shakeProfile

90writeProfile = shakeProfile

93−setProfiling :: CompileOpts -> ShakeOptions -> ShakeOptions

92+setProfiling :: IdeOptions -> ShakeOptions -> ShakeOptions

94setProfiling opts shakeOpts =

93setProfiling opts shakeOpts =

95 maybe shakeOpts (\p -> shakeOpts { shakeReport = [p], shakeTimings = True }) (optShakeProfiling opts)

94 maybe shakeOpts (\p -> shakeOpts { shakeReport = [p], shakeTimings = True }) (optShakeProfiling opts)

@@ -119,9 +118,3 @@ setFilesOfInterest state files = do

119

118

120getServiceEnv :: Action Env

119getServiceEnv :: Action Env

121getServiceEnv = getIdeGlobalAction

120getServiceEnv = getIdeGlobalAction

122−

123−logDebug, logInfo, logWarning, logError :: IdeState -> T.Text -> IO ()

124−logDebug = shakeLogDebug

125−logInfo = shakeLogInfo

126−logWarning = shakeLogWarning

127−logError = shakeLogError

src/Development/IDE/State/Shake.hs+12−16

@@ -38,10 +38,8 @@ module Development.IDE.State.Shake(

38 garbageCollect,

39 setPriority,

40 sendEvent,

41− shakeLogDebug,

41+ Development.IDE.State.Shake.logDebug,

42− shakeLogInfo,

42+ Development.IDE.State.Shake.logSeriousError,

43− shakeLogWarning,

44− shakeLogError,

45 ) where

43 ) where

47import Development.Shake

45import Development.Shake

@@ -78,7 +76,7 @@ import Numeric.Extra

78-- information we stash inside the shakeExtra field

76-- information we stash inside the shakeExtra field

79data ShakeExtras = ShakeExtras

77data ShakeExtras = ShakeExtras

80 {eventer :: Event -> IO ()

78 {eventer :: Event -> IO ()

81− ,logger :: Logger.Handle IO

79+ ,logger :: Logger.Handle

82 ,globals :: Var (Map.HashMap TypeRep Dynamic)

80 ,globals :: Var (Map.HashMap TypeRep Dynamic)

83 ,state :: Var Values

81 ,state :: Var Values

84 }

82 }

@@ -221,7 +219,7 @@ getValues state key file = do

221

219

222-- | Open a 'IdeState', should be shut using 'shakeShut'.

220-- | Open a 'IdeState', should be shut using 'shakeShut'.

223shakeOpen :: (Event -> IO ()) -- ^ diagnostic handler

221shakeOpen :: (Event -> IO ()) -- ^ diagnostic handler

224− -> Logger.Handle IO

222+ -> Logger.Handle

225 -> ShakeOptions

223 -> ShakeOptions

226 -> Rules ()

224 -> Rules ()

227 -> IO IdeState

225 -> IO IdeState

@@ -245,13 +243,13 @@ shakeRun :: IdeState -> [Action a] -> IO (IO [a])

245-- not even start, which would make issues with async exceptions less problematic.

243-- not even start, which would make issues with async exceptions less problematic.

246shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $ \stop -> do

244shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $ \stop -> do

247 (stopTime,_) <- duration stop

245 (stopTime,_) <- duration stop

248− Logger.logInfo logger $ T.pack $ "Starting shakeRun (aborting the previous one took " ++ showDuration stopTime ++ ")"

246+ Logger.logDebug logger $ T.pack $ "Starting shakeRun (aborting the previous one took " ++ showDuration stopTime ++ ")"

249 bar <- newBarrier

247 bar <- newBarrier

250 start <- offsetTime

248 start <- offsetTime

251 thread <- forkFinally (shakeRunDatabaseProfile shakeDb acts) $ \res -> do

249 thread <- forkFinally (shakeRunDatabaseProfile shakeDb acts) $ \res -> do

252 signalBarrier bar res

250 signalBarrier bar res

253 runTime <- start

251 runTime <- start

254− Logger.logInfo logger $ T.pack $

252+ Logger.logDebug logger $ T.pack $

255 "Finishing shakeRun (took " ++ showDuration runTime ++ ", " ++ (if isLeft res then "exception" else "completed") ++ ")"

253 "Finishing shakeRun (took " ++ showDuration runTime ++ ", " ++ (if isLeft res then "exception" else "completed") ++ ")"

256 -- important: we send an async exception to the thread, then wait for it to die, before continuing

254 -- important: we send an async exception to the thread, then wait for it to die, before continuing

257 return (do killThread thread; void $ waitBarrier bar, either throwIO return =<< waitBarrier bar)

255 return (do killThread thread; void $ waitBarrier bar, either throwIO return =<< waitBarrier bar)

@@ -302,12 +300,12 @@ uses_ key files = do

302reportSeriousError :: String -> Action ()

300reportSeriousError :: String -> Action ()

303reportSeriousError t = do

301reportSeriousError t = do

304 ShakeExtras{logger} <- getShakeExtras

302 ShakeExtras{logger} <- getShakeExtras

305− liftIO $ Logger.logError logger $ T.pack t

303+ liftIO $ Logger.logSeriousError logger $ T.pack t

306

304

307reportSeriousErrorDie :: String -> Action a

305reportSeriousErrorDie :: String -> Action a

308reportSeriousErrorDie t = do

306reportSeriousErrorDie t = do

309 ShakeExtras{logger} <- getShakeExtras

307 ShakeExtras{logger} <- getShakeExtras

310− liftIO $ Logger.logError logger $ T.pack t

308+ liftIO $ Logger.logSeriousError logger $ T.pack t

311 fail t

309 fail t

312

310

313

311

@@ -419,12 +417,10 @@ sendEvent e = do

419 liftIO $ eventer e

417 liftIO $ eventer e

420

418

421-- | bit of an odd signature because we're trying to remove priority

419-- | bit of an odd signature because we're trying to remove priority

422−sl :: (Handle IO -> T.Text -> IO ()) -> IdeState -> T.Text -> IO ()

420+sl :: (Handle -> T.Text -> IO ()) -> IdeState -> T.Text -> IO ()

423sl f IdeState{shakeExtras=ShakeExtras{logger}} p = f logger p

421sl f IdeState{shakeExtras=ShakeExtras{logger}} p = f logger p

424

422

425−shakeLogDebug, shakeLogInfo, shakeLogWarning, shakeLogError

423+logDebug, logSeriousError

426 :: IdeState -> T.Text -> IO ()

424 :: IdeState -> T.Text -> IO ()

427−shakeLogDebug = sl logDebug

425+logDebug = sl Logger.logDebug

428−shakeLogInfo = sl logInfo

426+logSeriousError = sl Logger.logSeriousError

429−shakeLogWarning = sl logWarning

430−shakeLogError = sl logError

src/Development/IDE/Types/Options.hsnew file+31

@@ -0,0 +1,31 @@

2+-- SPDX-License-Identifier: Apache-2.0

4+{-# LANGUAGE RankNTypes #-}

6+-- | Options

7+module Development.IDE.Types.Options

8+ ( IdeOptions(..)

9+ ) where

10+

11+import Development.IDE.UtilGHC

12+import GHC hiding (parseModule, typecheckModule)

13+import GhcPlugins as GHC hiding (fst3, (<>))

14+

15+

16+data IdeOptions = IdeOptions

17+ { optPreprocessor :: GHC.ParsedSource -> ([(GHC.SrcSpan, String)], GHC.ParsedSource)

18+ , optRunGhcSession :: forall a. Maybe ParsedModule -> PackageDynFlags -> Ghc a -> IO a

19+ -- ^ Setup a GHC session using a given package state. If a `ParsedModule` is supplied,

20+ -- the import path should be setup for that module.

21+ , optWriteIface :: Bool

22+

23+ , optMbPackageName :: Maybe String

24+

25+ , optPackageDbs :: [FilePath]

26+ , optHideAllPkgs :: Bool

27+ , optPackageImports :: [(String, ModRenaming)]

28+

29+ , optThreads :: Int

30+ , optShakeProfiling :: Maybe FilePath

31+ }

src/Development/IDE/UtilGHC.hs+25−26

@@ -12,9 +12,8 @@

12--

13-- * Call setSessionDynFlags, use modifyDynFlags instead. It's faster and avoids loading packages.

14module Development.IDE.UtilGHC(

15− PackageState(..),

15+ PackageDynFlags(..), setPackageDynFlags, getPackageDynFlags,

16 modifyDynFlags,

17− textToStringBuffer,

18 removeTypeableInfo,

17 removeTypeableInfo,

19 setPackageImports,

18 setPackageImports,

20 setPackageDbs,

19 setPackageDbs,

@@ -25,7 +24,6 @@ module Development.IDE.UtilGHC(

25 mkImport,

24 mkImport,

26 runGhcFast,

25 runGhcFast,

27 setImports,

26 setImports,

28− setPackageState,

29 setThisInstalledUnitId,

27 setThisInstalledUnitId,

30 modIsInternal

28 modIsInternal

31 ) where

29 ) where

@@ -34,18 +32,17 @@ import Config

34import Fingerprint

32import Fingerprint

35import GHC hiding (convertLit)

33import GHC hiding (convertLit)

36import GhcMonad

34import GhcMonad

37−import GhcPlugins as GHC hiding (PackageState, fst3, (<>))

35+import GhcPlugins as GHC hiding (fst3, (<>))

38import HscMain

36import HscMain

39import qualified Packages

37import qualified Packages

40import Platform

38import Platform

41−import qualified StringBuffer as SB

42import qualified EnumSet

39import qualified EnumSet

44import Control.DeepSeq

41import Control.DeepSeq

45import Data.IORef

42import Data.IORef

46import Data.List

43import Data.List

47−import qualified Data.Text as T

48import GHC.Generics (Generic)

44import GHC.Generics (Generic)

45+import qualified StringBuffer as SB

50----------------------------------------------------------------------

47----------------------------------------------------------------------

51-- GHC setup

48-- GHC setup

@@ -82,15 +79,29 @@ modifyDynFlags f = do

82 modifySession $ \h ->

79 modifySession $ \h ->

83 h { hsc_dflags = newFlags, hsc_IC = (hsc_IC h) {ic_dflags = newFlags} }

80 h { hsc_dflags = newFlags, hsc_IC = (hsc_IC h) {ic_dflags = newFlags} }

85−-- | This is the subset of `DynFlags` that is computed by package initialization.

82+-- | The subset of @DynFlags@ computed by package initialization.

86−data PackageState = PackageState

83+data PackageDynFlags = PackageDynFlags

87− { pkgStateDb :: !(Maybe [(FilePath, [Packages.PackageConfig])])

84+ { pdfPkgDatabase :: !(Maybe [(FilePath, [Packages.PackageConfig])])

88− , pkgStateState :: !Packages.PackageState

85+ , pdfPkgState :: !Packages.PackageState

89− , pkgThisUnitIdInsts :: !(Maybe [(ModuleName, Module)])

86+ , pdfThisUnitIdInsts :: !(Maybe [(ModuleName, Module)])

90− } deriving (Generic, Show)

87+ } deriving (Generic, Show)

88+

89+instance NFData PackageDynFlags where

90+ rnf (PackageDynFlags db state insts) = db `seq` state `seq` rnf insts

91+

92+setPackageDynFlags :: PackageDynFlags -> DynFlags -> DynFlags

93+setPackageDynFlags PackageDynFlags{..} dflags = dflags

94+ { pkgDatabase = pdfPkgDatabase

95+ , pkgState = pdfPkgState

96+ , thisUnitIdInsts_ = pdfThisUnitIdInsts

97+ }

92−instance NFData PackageState where

99+getPackageDynFlags :: DynFlags -> PackageDynFlags

93− rnf (PackageState db state insts) = db `seq` state `seq` rnf insts

100+getPackageDynFlags DynFlags{..} = PackageDynFlags

101+ { pdfPkgDatabase = pkgDatabase

102+ , pdfPkgState = pkgState

103+ , pdfThisUnitIdInsts = thisUnitIdInsts_

104+ }

105

106

96-- | A version of `showSDoc` that uses default flags (to avoid uses of

107-- | A version of `showSDoc` that uses default flags (to avoid uses of

@@ -102,10 +113,6 @@ showSDocDefault = showSDoc dynFlags

102prettyPrint :: Outputable a => a -> String

113prettyPrint :: Outputable a => a -> String

103prettyPrint = showSDocDefault . ppr

114prettyPrint = showSDocDefault . ppr

104

115

105−textToStringBuffer :: T.Text -> SB.StringBuffer

106−-- would be nice to do this more efficiently...

107−textToStringBuffer = SB.stringToStringBuffer . T.unpack

108−

109-- FIXME(#1203): This must move out of `haskell-ide-core` and into `damlc`.

116-- FIXME(#1203): This must move out of `haskell-ide-core` and into `damlc`.

110internalModules :: [String]

117internalModules :: [String]

111internalModules =

118internalModules =

@@ -177,14 +184,6 @@ setThisInstalledUnitId unitId dflags =

177setImports :: [FilePath] -> DynFlags -> DynFlags

184setImports :: [FilePath] -> DynFlags -> DynFlags

178setImports paths dflags = dflags { importPaths = paths }

185setImports paths dflags = dflags { importPaths = paths }

179

186

180−setPackageState :: PackageState -> DynFlags -> DynFlags

181−setPackageState state dflags =

182− dflags

183− { pkgDatabase = pkgStateDb state

184− , pkgState = pkgStateState state

185− , thisUnitIdInsts_ = pkgThisUnitIdInsts state

186− }

187−

188

187

189

188

190-- Orphan instances for types from the GHC API.

189-- Orphan instances for types from the GHC API.