From 0c76d0a64e625ddd43e9a2aa5ebb5214bae816a6 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Mon, 15 Feb 2021 20:03:27 +0000 Subject: [PATCH 1/5] getInitialGhcLibDir --- ghcide/session-loader/Development/IDE/Session.hs | 15 +++++++++++---- ghcide/src/Development/IDE/Main.hs | 2 +- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 8d702bcff8..6d2e9833a8 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -98,6 +98,8 @@ 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 @@ -105,17 +107,17 @@ defaultLoadingOptions = 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 diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 01e4a14743..17ce3417be 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -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 From d39417f8d5d1dba715284ce92d8143d8fc14e1d6 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 16 Feb 2021 12:33:21 +0000 Subject: [PATCH 2/5] Fix build and use Data.Default consistently --- exe/Wrapper.hs | 5 +++-- ghcide/exe/Main.hs | 2 +- .../session-loader/Development/IDE/Session.hs | 18 +++++++++--------- ghcide/src/Development/IDE/Main.hs | 11 +++++------ haskell-language-server.cabal | 1 + src/Ide/Main.hs | 5 +++-- 6 files changed, 22 insertions(+), 20 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..fd9e9bbd75 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 diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 6d2e9833a8..bb18f826d3 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 @@ -102,13 +102,13 @@ data SessionLoadingOptions = SessionLoadingOptions , getInitialGhcLibDir :: IO (Maybe LibDir) } -defaultLoadingOptions :: SessionLoadingOptions -defaultLoadingOptions = SessionLoadingOptions - {findCradle = HieBios.findCradle - ,loadCradle = HieBios.loadCradle - ,getCacheDirs = getCacheDirsDefault - ,getInitialGhcLibDir = getInitialGhcLibDirDefault - } +instance Default SessionLoadingOptions where + def = SessionLoadingOptions + {findCradle = HieBios.findCradle + ,loadCradle = HieBios.loadCradle + ,getCacheDirs = getCacheDirsDefault + ,getInitialGhcLibDir = getInitialGhcLibDirDefault + } getInitialGhcLibDirDefault :: IO (Maybe LibDir) getInitialGhcLibDirDefault = do @@ -184,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 diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 17ce3417be..c62be7bb83 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 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 From 6b3e9dbeaf0f29664dcfca4d8790d3913e79f41f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 16 Feb 2021 12:45:55 +0000 Subject: [PATCH 3/5] Fix log line --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index bb18f826d3..2232ac3faa 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -621,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 From 22529c2e39b12936560a0a440d2605af89df06ee Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 16 Feb 2021 15:50:54 +0000 Subject: [PATCH 4/5] Fix build --- ghcide/exe/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index fd9e9bbd75..e706c645ba 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -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 From 7b4aee5316176e9d7d9f1f3f43e0267a47f66d39 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 16 Feb 2021 16:16:43 +0000 Subject: [PATCH 5/5] (unrelated) Honor the rules config in the setup tester --- ghcide/src/Development/IDE/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index c62be7bb83..8cd06f14a5 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -109,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 @@ -134,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 @@ -177,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