From a065cd66ee129b4f4c2484cfac23f43951587608 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Feb 2021 13:28:53 +0000 Subject: [PATCH] Configuration for initial ghc lib dir (#1378) * getInitialGhcLibDir * Fix build and use Data.Default consistently * Fix log line * Fix build * (unrelated) Honor the rules config in the setup tester --- exe/Wrapper.hs | 5 +-- ghcide/exe/Main.hs | 4 +-- .../session-loader/Development/IDE/Session.hs | 33 +++++++++++-------- ghcide/src/Development/IDE/Main.hs | 17 +++++----- haskell-language-server.cabal | 1 + src/Ide/Main.hs | 5 +-- 6 files changed, 37 insertions(+), 28 deletions(-) diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 104a060195..9801b54da2 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -4,10 +4,11 @@ module Main where import Control.Monad.Extra +import Data.Default import Data.Foldable import Data.List import Data.Void -import Development.IDE.Session (findCradle, defaultLoadingOptions) +import Development.IDE.Session (findCradle) import HIE.Bios hiding (findCradle) import HIE.Bios.Environment import HIE.Bios.Types @@ -140,7 +141,7 @@ getRuntimeGhcVersion' cradle = do -- of the project that may or may not be accurate. findLocalCradle :: FilePath -> IO (Cradle Void) findLocalCradle fp = do - cradleConf <- findCradle defaultLoadingOptions fp + cradleConf <- findCradle def fp crdl <- case cradleConf of Just yaml -> do hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\"" diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 09bae9405e..e706c645ba 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -66,7 +66,7 @@ main = do DbCmd opts cmd -> do dir <- IO.getCurrentDirectory dbLoc <- getHieDbLoc dir - mlibdir <- setInitialDynFlags + mlibdir <- setInitialDynFlags def case mlibdir of Nothing -> exitWith $ ExitFailure 1 Just libdir -> runCommand libdir opts{database = dbLoc} cmd @@ -79,7 +79,7 @@ main = do hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" _ -> return () - Main.defaultMain Main.defArguments + Main.defaultMain def {Main.argFiles = case argFilesOrCmd of Typecheck x | not argLSP -> Just x _ -> Nothing diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 8d702bcff8..2232ac3faa 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -8,7 +8,6 @@ The logic for setting up a ghcide session by tapping into hie-bios. module Development.IDE.Session (SessionLoadingOptions(..) ,CacheDirs(..) - ,defaultLoadingOptions ,loadSession ,loadSessionWithOptions ,setInitialDynFlags @@ -34,6 +33,7 @@ import qualified Data.Text as T import Data.Aeson import Data.Bifunctor import qualified Data.ByteString.Base16 as B16 +import Data.Default import Data.Either.Extra import Data.Function import Data.Hashable @@ -98,24 +98,26 @@ data SessionLoadingOptions = SessionLoadingOptions -- return the path for storing generated GHC artifacts, -- or 'Nothing' to respect the cradle setting , getCacheDirs :: String -> [String] -> IO CacheDirs + -- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags' + , getInitialGhcLibDir :: IO (Maybe LibDir) } -defaultLoadingOptions :: SessionLoadingOptions -defaultLoadingOptions = SessionLoadingOptions - {findCradle = HieBios.findCradle - ,loadCradle = HieBios.loadCradle - ,getCacheDirs = getCacheDirsDefault - } +instance Default SessionLoadingOptions where + def = SessionLoadingOptions + {findCradle = HieBios.findCradle + ,loadCradle = HieBios.loadCradle + ,getCacheDirs = getCacheDirsDefault + ,getInitialGhcLibDir = getInitialGhcLibDirDefault + } --- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir -setInitialDynFlags :: IO (Maybe LibDir) -setInitialDynFlags = do +getInitialGhcLibDirDefault :: IO (Maybe LibDir) +getInitialGhcLibDirDefault = do dir <- IO.getCurrentDirectory hieYaml <- runMaybeT $ yamlConfig dir cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) HieBios.loadCradle hieYaml hPutStrLn stderr $ "setInitialDynFlags cradle: " ++ show cradle libDirRes <- getRuntimeGhcLibDir cradle - libdir <- case libDirRes of + case libDirRes of CradleSuccess libdir -> pure $ Just $ LibDir libdir CradleFail err -> do hPutStrLn stderr $ "Couldn't load cradle for libdir: " ++ show (err,dir,hieYaml,cradle) @@ -123,6 +125,11 @@ setInitialDynFlags = do CradleNone -> do hPutStrLn stderr $ "Couldn't load cradle (CradleNone)" pure Nothing + +-- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir +setInitialDynFlags :: SessionLoadingOptions -> IO (Maybe LibDir) +setInitialDynFlags SessionLoadingOptions{..} = do + libdir <- getInitialGhcLibDir dynFlags <- mapM dynFlagsForPrinting libdir mapM_ setUnsafeGlobalDynFlags dynFlags pure libdir @@ -177,7 +184,7 @@ getHieDbLoc dir = do -- components mapping to the same hie.yaml file are mapped to the same -- HscEnv which is updated as new components are discovered. loadSession :: FilePath -> IO (Action IdeGhcSession) -loadSession = loadSessionWithOptions defaultLoadingOptions +loadSession = loadSessionWithOptions def loadSessionWithOptions :: SessionLoadingOptions -> FilePath -> IO (Action IdeGhcSession) loadSessionWithOptions SessionLoadingOptions{..} dir = do @@ -614,7 +621,7 @@ should be filtered out, such that we dont have to re-compile everything. -- For the exact reason, see Note [Avoiding bad interface files]. setCacheDirs :: MonadIO m => Logger -> CacheDirs -> DynFlags -> m DynFlags setCacheDirs logger CacheDirs{..} dflags = do - liftIO $ logInfo logger $ "Using interface files cache dir: " <> T.pack cacheDir + liftIO $ logInfo logger $ "Using interface files cache dir: " <> T.pack (fromMaybe cacheDir hiCacheDir) pure $ dflags & maybe id setHiDir hiCacheDir & maybe id setHieDir hieCacheDir diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 01e4a14743..8cd06f14a5 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -1,4 +1,4 @@ -module Development.IDE.Main (Arguments(..), defArguments, defaultMain) where +module Development.IDE.Main (Arguments(..), defaultMain) where import Control.Concurrent.Extra (readVar) import Control.Exception.Safe ( Exception (displayException), @@ -47,7 +47,7 @@ import Development.IDE.Plugin ( Plugin (pluginHandlers, pluginRules), ) import Development.IDE.Plugin.HLS (asGhcIdePlugin) -import Development.IDE.Session (SessionLoadingOptions, defaultLoadingOptions, loadSessionWithOptions, setInitialDynFlags, getHieDbLoc, runWithDb) +import Development.IDE.Session (SessionLoadingOptions, loadSessionWithOptions, setInitialDynFlags, getHieDbLoc, runWithDb) import Development.IDE.Types.Location (toNormalizedFilePath') import Development.IDE.Types.Logger (Logger) import Development.IDE.Types.Options ( @@ -85,16 +85,15 @@ data Arguments = Arguments , argsGetHieDbLoc :: FilePath -> IO FilePath -- ^ Map project roots to the location of the hiedb for the project } -defArguments :: Arguments -defArguments = - Arguments +instance Default Arguments where + def = Arguments { argsOTMemoryProfiling = False , argFiles = Nothing , argsLogger = noLogging , argsRules = mainRule >> action kick , argsGhcidePlugin = mempty , argsHlsPlugins = pluginDescToIdePlugins Ghcide.descriptors - , argsSessionLoadingOptions = defaultLoadingOptions + , argsSessionLoadingOptions = def , argsIdeOptions = const defaultIdeOptions , argsLspOptions = def {LSP.completionTriggerCharacters = Just "."} , argsDefaultHlsConfig = def @@ -110,6 +109,7 @@ defaultMain Arguments{..} = do plugins = hlsPlugin <> argsGhcidePlugin options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands } argsOnConfigChange _ide = pure . getConfigFromNotification argsDefaultHlsConfig + rules = argsRules >> pluginRules plugins case argFiles of Nothing -> do @@ -127,7 +127,7 @@ defaultMain Arguments{..} = do -- We do it here since haskell-lsp changes our working directory to the correct place ('rootPath') -- before calling this function _mlibdir <- - setInitialDynFlags + setInitialDynFlags argsSessionLoadingOptions `catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing) sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions $ fromMaybe dir rootPath @@ -135,7 +135,6 @@ defaultMain Arguments{..} = do let options = (argsIdeOptions config sessionLoader) { optReportProgress = clientSupportsProgress caps } - rules = argsRules >> pluginRules plugins caps = LSP.resClientCapabilities env debouncer <- newAsyncDebouncer initialise @@ -178,7 +177,7 @@ defaultMain Arguments{..} = do { optCheckParents = pure NeverCheck , optCheckProject = pure False } - ide <- initialise mainRule Nothing argsLogger debouncer options vfs hiedb hieChan + ide <- initialise rules Nothing argsLogger debouncer options vfs hiedb hieChan putStrLn "\nStep 4/4: Type checking the files" setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 49fbd7cc40..2e271b645a 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -365,6 +365,7 @@ executable haskell-language-server-wrapper ghc-options: -Werror build-depends: + , data-default , ghc , ghc-paths , ghcide diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index 09157fed9e..b5a6984f8a 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -31,6 +31,7 @@ import HieDb.Run import qualified Development.IDE.Main as Main import qualified Development.IDE.Types.Options as Ghcide import Development.Shake (ShakeOptions(shakeThreads)) +import Data.Default defaultMain :: Arguments -> IdePlugins IdeState -> IO () defaultMain args idePlugins = do @@ -55,7 +56,7 @@ defaultMain args idePlugins = do dir <- IO.getCurrentDirectory dbLoc <- getHieDbLoc dir hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc - mlibdir <- setInitialDynFlags + mlibdir <- setInitialDynFlags def case mlibdir of Nothing -> exitWith $ ExitFailure 1 Just libdir -> @@ -93,7 +94,7 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do hPutStrLn stderr $ " in directory: " <> dir hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" - Main.defaultMain Main.defArguments + Main.defaultMain def { Main.argFiles = if argLSP then Nothing else Just [] , Main.argsHlsPlugins = idePlugins , Main.argsLogger = hlsLogger