@@ -1,3 +1,4 @@
1+{-# LANGUAGE TemplateHaskell #-}
12module Rules
23 ( loadGhcSession
34 , cradleToSession
@@ -13,8 +14,8 @@ import qualified Crypto.Hash.SHA1 as H
1314import Data.ByteString.Base16 (encode)
1415import qualified Data.ByteString.Char8 as B
1516import Data.Functor ((<&>))
16−import Data.Maybe (fromMaybe)
17−import Data.Text (pack, Text)
17+import Data.Text (Text, pack)
18+import Data.Version (Version)
1819import Development.IDE.Core.Rules (defineNoFile)
1920import Development.IDE.Core.Service (getIdeOptions)
2021import Development.IDE.Core.Shake (actionLogger, sendEvent, define, useNoFile_)
@@ -22,10 +23,8 @@ import Development.IDE.GHC.Util
2223import Development.IDE.Types.Location (fromNormalizedFilePath)
2324import Development.IDE.Types.Options (IdeOptions(IdeOptions, optTesting))
2425import Development.Shake
25−import DynFlags (gopt_set, gopt_unset,
26− updOptLevel)
2726import GHC
28−import qualified GHC.Paths
27+import GHC.Check (runTimeVersion, compileTimeVersionFromLibdir)
2928import HIE.Bios
3029import HIE.Bios.Cradle
3130import HIE.Bios.Environment (addCmdOpts)
@@ -33,13 +32,13 @@ import HIE.Bios.Types
3332import Linker (initDynLinker)
3433import RuleTypes
3534import qualified System.Directory.Extra as IO
36−import System.Environment (lookupEnv)
3735import System.FilePath.Posix (addTrailingPathSeparator,
3836 (</>))
3937import qualified Language.Haskell.LSP.Messages as LSP
4038import qualified Language.Haskell.LSP.Types as LSP
4139import Data.Aeson (ToJSON(toJSON))
4240import Development.IDE.Types.Logger (logDebug)
41+import Util
4342
4443-- Prefix for the cache path
4544cacheDir :: String
@@ -103,55 +102,33 @@ getComponentOptions cradle = do
103102 -- That will require some more changes.
104103 CradleNone -> fail "'none' cradle is not yet supported"
105104
105+compileTimeGhcVersion :: Version
106+compileTimeGhcVersion = $$(compileTimeVersionFromLibdir getLibdir)
107+
108+checkGhcVersion :: Ghc (Maybe HscEnvEq)
109+checkGhcVersion = do
110+ v <- runTimeVersion
111+ return $ if v == Just compileTimeGhcVersion
112+ then Nothing
113+ else Just GhcVersionMismatch {compileTime = compileTimeGhcVersion, runTime = v}
114+
106115createSession :: ComponentOptions -> IO HscEnvEq
107116createSession (ComponentOptions theOpts _) = do
108117 libdir <- getLibdir
109118
110119 cacheDir <- getCacheDir theOpts
111120
112− env <- runGhc (Just libdir) $ do
121+ runGhc (Just libdir) $ do
113122 dflags <- getSessionDynFlags
114123 (dflags', _targets) <- addCmdOpts theOpts dflags
115− _ <- setSessionDynFlags $
116− -- disabled, generated directly by ghcide instead
117− flip gopt_unset Opt_WriteInterface $
118− -- disabled, generated directly by ghcide instead
119− -- also, it can confuse the interface stale check
120− dontWriteHieFiles $
121− setHiDir cacheDir $
122− setDefaultHieDir cacheDir $
123− setIgnoreInterfacePragmas $
124− setLinkerOptions $
125− disableOptimisation dflags'
126− getSession
127− initDynLinker env
128− newHscEnvEq env
129−
130−-- Set the GHC libdir to the nix libdir if it's present.
131−getLibdir :: IO FilePath
132−getLibdir = fromMaybe GHC.Paths.libdir <$> lookupEnv "NIX_GHC_LIBDIR"
133−
134−-- we don't want to generate object code so we compile to bytecode
135−-- (HscInterpreted) which implies LinkInMemory
136−-- HscInterpreted
137−setLinkerOptions :: DynFlags -> DynFlags
138−setLinkerOptions df = df {
139− ghcLink = LinkInMemory
140− , hscTarget = HscNothing
141− , ghcMode = CompManager
142− }
143−
144−setIgnoreInterfacePragmas :: DynFlags -> DynFlags
145−setIgnoreInterfacePragmas df =
146− gopt_set (gopt_set df Opt_IgnoreInterfacePragmas) Opt_IgnoreOptimChanges
147−
148−disableOptimisation :: DynFlags -> DynFlags
149−disableOptimisation df = updOptLevel 0 df
150−
151−setHiDir :: FilePath -> DynFlags -> DynFlags
152−setHiDir f d =
153− -- override user settings to avoid conflicts leading to recompilation
154− d { hiDir = Just f}
124+ setupDynFlags cacheDir dflags'
125+ versionMismatch <- checkGhcVersion
126+ case versionMismatch of
127+ Just mismatch -> return mismatch
128+ Nothing -> do
129+ env <- getSession
130+ liftIO $ initDynLinker env
131+ liftIO $ newHscEnvEq env
155132
156133getCacheDir :: [String] -> IO FilePath
157134getCacheDir opts = IO.getXdgDirectory IO.XdgCache (cacheDir </> opts_hash)