From bdeb8b0abf35885b26b21e9eae8130615e7cac70 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 9 Feb 2021 08:58:13 +0000 Subject: [PATCH 1/5] Development.IDE.Main --- ghcide/exe/Main.hs | 281 ++++++++--------------------- ghcide/ghcide.cabal | 1 + ghcide/src/Development/IDE/Main.hs | 262 +++++++++++++++++++++++++++ 3 files changed, 334 insertions(+), 210 deletions(-) create mode 100644 ghcide/src/Development/IDE/Main.hs diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 7cf421a98f..21a616486e 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -5,61 +5,31 @@ module Main(main) where -import Arguments -import Control.Concurrent.Extra -import Control.Monad.Extra -import Control.Exception.Safe -import Control.Lens ( (^.) ) -import Data.Default -import Data.List.Extra -import Data.Maybe +import Arguments ( Arguments'(..), IdeCmd(..), getArguments ) +import Control.Concurrent.Extra ( newLock, withLock ) +import Control.Monad.Extra ( unless, when, whenJust ) +import Data.List.Extra ( upper ) import qualified Data.Text as T import qualified Data.Text.IO as T -import Data.Version -import Development.IDE.Core.Debouncer -import Development.IDE.Core.FileStore -import Development.IDE.Core.OfInterest -import Development.IDE.Core.Service -import Development.IDE.Core.Rules -import Development.IDE.Core.Shake -import Development.IDE.Core.RuleTypes -import Development.IDE.LSP.Protocol -import Development.IDE.Types.Location -import Development.IDE.Types.Diagnostics +import Data.Version ( showVersion ) +import Development.GitRev ( gitHash ) +import Development.IDE ( Logger(Logger), Priority(Info), action ) +import Development.IDE.Core.OfInterest (kick) +import Development.IDE.Core.Rules (mainRule) +import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde +import qualified Development.IDE.Plugin.Test as Test +import Development.IDE.Session (setInitialDynFlags, getHieDbLoc, runWithDb) import Development.IDE.Types.Options -import Development.IDE.Types.Logger -import Development.IDE.Plugin -import Development.IDE.Plugin.Test as Test -import Development.IDE.Session (loadSession, setInitialDynFlags, getHieDbLoc, runWithDb) -import Development.Shake (ShakeOptions (shakeThreads)) -import qualified Language.Haskell.LSP.Core as LSP -import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.Types -import Language.Haskell.LSP.Types.Lens (params, initializationOptions) -import Development.IDE.LSP.LanguageServer -import qualified System.Directory.Extra as IO -import System.Environment -import System.IO -import System.Info -import System.Exit -import System.FilePath -import System.Time.Extra -import Paths_ghcide -import Development.GitRev -import qualified Data.HashMap.Strict as HashMap -import qualified Data.Aeson as J - -import HIE.Bios.Cradle -import Development.IDE (action) -import Text.Printf -import Development.IDE.Core.Tracing -import Development.IDE.Types.Shake (Key(Key)) -import Development.IDE.Plugin.HLS (asGhcIdePlugin) -import Development.IDE.Plugin.HLS.GhcIde as GhcIde -import Ide.Plugin.Config -import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins) - +import qualified Development.IDE.Main as Main +import Development.Shake (ShakeOptions(shakeThreads)) +import Ide.PluginUtils (pluginDescToIdePlugins) import HieDb.Run (Options(..), runCommand) +import Paths_ghcide ( version ) +import qualified System.Directory.Extra as IO +import System.Environment ( getExecutablePath ) +import System.Exit ( ExitCode(ExitFailure), exitSuccess, exitWith ) +import System.Info ( compilerVersion ) +import System.IO ( stderr, hPutStrLn ) ghcideVersion :: IO String ghcideVersion = do @@ -83,171 +53,62 @@ main = do whenJust argsCwd IO.setCurrentDirectory - dir <- IO.getCurrentDirectory dbLoc <- getHieDbLoc dir + -- lock to avoid overlapping output on stdout + lock <- newLock + let logger = Logger $ \pri msg -> when (pri >= logLevel) $ withLock lock $ + T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg + logLevel = if argsVerbose then minBound else Info + case argFilesOrCmd of DbCmd opts cmd -> do mlibdir <- setInitialDynFlags case mlibdir of Nothing -> exitWith $ ExitFailure 1 - Just libdir -> - runCommand libdir opts{database = dbLoc} cmd - Typecheck (Just -> argFilesOrCmd) | not argLSP -> runWithDb dbLoc $ runIde Arguments{..} - _ -> let argFilesOrCmd = Nothing in runWithDb dbLoc $ runIde Arguments{..} - - -runIde :: Arguments' (Maybe [FilePath]) -> HieDb -> IndexQueue -> IO () -runIde Arguments{..} hiedb hiechan = do - -- lock to avoid overlapping output on stdout - lock <- newLock - let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $ - T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg - - dir <- IO.getCurrentDirectory - - let hlsPlugins = pluginDescToIdePlugins $ - GhcIde.descriptors ++ - [ Test.blockCommandDescriptor "block-command" | argsTesting] - - pid <- T.pack . show <$> getProcessID - let hlsPlugin = asGhcIdePlugin hlsPlugins - hlsCommands = allLspCmdIds' pid hlsPlugins - - let plugins = hlsPlugin - <> if argsTesting then Test.plugin else mempty - onInitialConfiguration :: InitializeRequest -> Either T.Text Config - onInitialConfiguration x = case x ^. params . initializationOptions of - Nothing -> Right def - Just v -> case J.fromJSON v of - J.Error err -> Left $ T.pack err - J.Success a -> Right a - onConfigurationChange = const $ Left "Updating Not supported" - options = def { LSP.executeCommandCommands = Just hlsCommands - , LSP.completionTriggerCharacters = Just "." + Just libdir -> runCommand libdir opts{database = dbLoc} cmd + + _ -> do + + case argFilesOrCmd of + LSP -> do + hPutStrLn stderr "Starting LSP server..." + hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" + _ -> return () + + runWithDb dbLoc $ \hiedb hiechan -> + Main.defaultMain (Main.defArguments hiedb hiechan) + {Main.argFiles = case argFilesOrCmd of + Typecheck x | not argLSP -> Just x + _ -> Nothing + + ,Main.argsLogger = logger + + ,Main.argsRules = do + -- install the main and ghcide-plugin rules + mainRule + -- install the kick action, which triggers a typecheck on every + -- Shake database restart, i.e. on every user edit. + unless argsDisableKick $ + action kick + + ,Main.argsHlsPlugins = + pluginDescToIdePlugins $ + GhcIde.descriptors + ++ [Test.blockCommandDescriptor "block-command" | argsTesting] + + ,Main.argsGhcidePlugin = if argsTesting + then Test.plugin + else mempty + + ,Main.argsIdeOptions = \sessionLoader -> + let defOptions = defaultIdeOptions sessionLoader + in defOptions + { optShakeProfiling = argsShakeProfiling + , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling + , optTesting = IdeTesting argsTesting + , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads} } - case argFilesOrCmd of - Nothing -> do - t <- offsetTime - hPutStrLn stderr "Starting LSP server..." - hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" - runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do - t <- t - hPutStrLn stderr $ "Started LSP server in " ++ showDuration t - - -- We want to set the global DynFlags right now, so that we can use - -- `unsafeGlobalDynFlags` even before the project is configured - -- We do it here since haskell-lsp changes our working directory to the correct place ('rootPath') - -- before calling this function - _mlibdir <- setInitialDynFlags - `catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing) - - sessionLoader <- loadSession $ fromMaybe dir rootPath - config <- fromMaybe def <$> getConfig - let options = defOptions - { optReportProgress = clientSupportsProgress caps - , optShakeProfiling = argsShakeProfiling - , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling - , optTesting = IdeTesting argsTesting - , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads} - , optCheckParents = checkParents config - , optCheckProject = checkProject config - } - defOptions = defaultIdeOptions sessionLoader - logLevel = if argsVerbose then minBound else Info - debouncer <- newAsyncDebouncer - let rules = do - -- install the main and ghcide-plugin rules - mainRule - pluginRules plugins - -- install the kick action, which triggers a typecheck on every - -- Shake database restart, i.e. on every user edit. - unless argsDisableKick $ - action kick - initialise caps rules - getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs hiedb hiechan - Just argFiles -> do - -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error - hSetEncoding stdout utf8 - hSetEncoding stderr utf8 - - putStrLn $ "Ghcide setup tester in " ++ dir ++ "." - putStrLn "Report bugs at https://github.com/haskell/ghcide/issues" - - putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir - files <- expandFiles (argFiles ++ ["." | null argFiles]) - -- LSP works with absolute file paths, so try and behave similarly - files <- nubOrd <$> mapM IO.canonicalizePath files - putStrLn $ "Found " ++ show (length files) ++ " files" - - putStrLn "\nStep 2/4: Looking for hie.yaml files that control setup" - cradles <- mapM findCradle files - let ucradles = nubOrd cradles - let n = length ucradles - putStrLn $ "Found " ++ show n ++ " cradle" ++ ['s' | n /= 1] - when (n > 0) $ putStrLn $ " (" ++ intercalate ", " (catMaybes ucradles) ++ ")" - putStrLn "\nStep 3/4: Initializing the IDE" - vfs <- makeVFSHandle - debouncer <- newAsyncDebouncer - let dummyWithProg _ _ f = f (const (pure ())) - sessionLoader <- loadSession dir - let options = defOptions - { optShakeProfiling = argsShakeProfiling - -- , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling - , optTesting = IdeTesting argsTesting - , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads} - , optCheckParents = NeverCheck - , optCheckProject = False - } - defOptions = defaultIdeOptions sessionLoader - logLevel = if argsVerbose then minBound else Info - ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs hiedb hiechan - - putStrLn "\nStep 4/4: Type checking the files" - setFilesOfInterest ide $ HashMap.fromList $ map ((, OnDisk) . toNormalizedFilePath') files - results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' files) - _results <- runAction "GetHie" ide $ uses GetHieAst (map toNormalizedFilePath' files) - _results <- runAction "GenerateCore" ide $ uses GenerateCore (map toNormalizedFilePath' files) - let (worked, failed) = partition fst $ zip (map isJust results) files - when (failed /= []) $ - putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed - - let nfiles xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files" - putStrLn $ "\nCompleted (" ++ nfiles worked ++ " worked, " ++ nfiles failed ++ " failed)" - - when argsOTMemoryProfiling $ do - let valuesRef = state $ shakeExtras ide - values <- readVar valuesRef - let consoleObserver Nothing = return $ \size -> printf "Total: %.2fMB\n" (fromIntegral @Int @Double size / 1e6) - consoleObserver (Just k) = return $ \size -> printf " - %s: %.2fKB\n" (show k) (fromIntegral @Int @Double size / 1e3) - - printf "# Shake value store contents(%d):\n" (length values) - let keys = nub - $ Key GhcSession : Key GhcSessionDeps - : [ k | (_,k) <- HashMap.keys values, k /= Key GhcSessionIO] - ++ [Key GhcSessionIO] - measureMemory (logger logLevel) [keys] consoleObserver valuesRef - - unless (null failed) (exitWith $ ExitFailure (length failed)) - -{-# ANN runIde ("HLint: ignore Use nubOrd" :: String) #-} - -expandFiles :: [FilePath] -> IO [FilePath] -expandFiles = concatMapM $ \x -> do - b <- IO.doesFileExist x - if b then return [x] else do - let recurse "." = True - recurse x | "." `isPrefixOf` takeFileName x = False -- skip .git etc - recurse x = takeFileName x `notElem` ["dist","dist-newstyle"] -- cabal directories - files <- filter (\x -> takeExtension x `elem` [".hs",".lhs"]) <$> IO.listFilesInside (return . recurse) x - when (null files) $ - fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x - return files - --- | Print an LSP event. -showEvent :: Lock -> FromServerMessage -> IO () -showEvent _ (EventFileDiagnostics _ []) = return () -showEvent lock (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) = - withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,ShowDiag,) diags -showEvent lock e = withLock lock $ print e + } + diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 034a700985..2a15a8464b 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -138,6 +138,7 @@ library include exposed-modules: Development.IDE + Development.IDE.Main Development.IDE.Core.Debouncer Development.IDE.Core.FileStore Development.IDE.Core.IdeConfiguration diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs new file mode 100644 index 0000000000..4d7e6a8f01 --- /dev/null +++ b/ghcide/src/Development/IDE/Main.hs @@ -0,0 +1,262 @@ +module Development.IDE.Main (Arguments(..), defArguments, defaultMain) where +import Control.Concurrent.Extra (readVar) +import Control.Exception.Safe ( + Exception (displayException), + catchAny, + ) +import Control.Lens ((^.)) +import Control.Monad.Extra (concatMapM, unless, when) +import qualified Data.Aeson as J +import Data.Default (Default (def)) +import qualified Data.HashMap.Strict as HashMap +import Data.List.Extra ( + intercalate, + isPrefixOf, + nub, + nubOrd, + partition, + ) +import Data.Maybe (catMaybes, fromMaybe, isJust) +import qualified Data.Text as T +import Development.IDE (Action, Rules, noLogging) +import Development.IDE.Core.Debouncer (newAsyncDebouncer) +import Development.IDE.Core.FileStore (makeVFSHandle) +import Development.IDE.Core.OfInterest ( + FileOfInterestStatus (OnDisk), + kick, + setFilesOfInterest, + ) +import Development.IDE.Core.RuleTypes ( + GenerateCore (GenerateCore), + GetHieAst (GetHieAst), + GhcSession (GhcSession), + GhcSessionDeps (GhcSessionDeps), + TypeCheck (TypeCheck), + ) +import Development.IDE.Core.Rules ( + GhcSessionIO (GhcSessionIO), + mainRule, + ) +import Development.IDE.Core.Service (initialise, runAction) +import Development.IDE.Core.Shake ( + HieDb, + IdeState (shakeExtras), + IndexQueue, + ShakeExtras (state), + uses, + ) +import Development.IDE.Core.Tracing (measureMemory) +import Development.IDE.LSP.LanguageServer (runLanguageServer) +import Development.IDE.LSP.Protocol +import Development.IDE.Plugin ( + Plugin (pluginHandler, pluginRules), + ) +import Development.IDE.Plugin.HLS (asGhcIdePlugin) +import Development.IDE.Session (SessionLoadingOptions, defaultLoadingOptions, loadSessionWithOptions, setInitialDynFlags) +import Development.IDE.Types.Diagnostics ( + ShowDiagnostic (ShowDiag), + showDiagnosticsColored, + ) +import Development.IDE.Types.Location (toNormalizedFilePath') +import Development.IDE.Types.Logger (Logger, logInfo) +import Development.IDE.Types.Options ( + IdeGhcSession, + IdeOptions (optCheckParents, optCheckProject, optReportProgress), + clientSupportsProgress, + defaultIdeOptions, + ) +import Development.IDE.Types.Shake (Key (Key)) +import Development.Shake (action) +import HIE.Bios.Cradle (findCradle) +import Ide.Plugin.Config ( + CheckParents (NeverCheck), + Config (checkParents, checkProject), + ) +import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins) +import Ide.Types (IdePlugins) +import qualified Language.Haskell.LSP.Core as LSP +import Language.Haskell.LSP.Messages (FromServerMessage) +import Language.Haskell.LSP.Types ( + InitializeRequest, + LspId (IdInt), + ) +import Language.Haskell.LSP.Types.Lens (initializationOptions, params) +import qualified System.Directory.Extra as IO +import System.Exit (ExitCode (ExitFailure), exitWith) +import System.FilePath (takeExtension, takeFileName) +import System.IO (hPutStrLn, hSetEncoding, stderr, stdout, utf8) +import System.Time.Extra (offsetTime, showDuration) +import Text.Printf (printf) +import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide +import Ide.Version (findProgramVersions, showProgramVersionOfInterest) + +data Arguments = Arguments + { argsOTMemoryProfiling :: Bool + , argFiles :: Maybe [FilePath] -- ^ Nothing: lsp server ; Just: typecheck and exit + , argsLogger :: Logger + , argsHiedb :: HieDb + , argsHieChan :: IndexQueue + , argsRules :: Rules () + , argsHlsPlugins :: IdePlugins IdeState + , argsGhcidePlugin :: Plugin Config -- ^ Deprecated + , argsSessionLoadingOptions :: SessionLoadingOptions + , argsIdeOptions :: Action IdeGhcSession -> IdeOptions + , argsLspOptions :: LSP.Options + } + +defArguments :: HieDb -> IndexQueue -> Arguments +defArguments hiedb hiechan = + Arguments + { argsOTMemoryProfiling = False + , argFiles = Nothing + , argsLogger = noLogging + , argsHiedb = hiedb + , argsHieChan = hiechan + , argsRules = mainRule >> action kick + , argsGhcidePlugin = mempty + , argsHlsPlugins = pluginDescToIdePlugins Ghcide.descriptors + , argsSessionLoadingOptions = defaultLoadingOptions + , argsIdeOptions = defaultIdeOptions + , argsLspOptions = def {LSP.completionTriggerCharacters = Just "."} + } + +defaultMain :: Arguments -> IO () +defaultMain Arguments{..} = do + dir <- IO.getCurrentDirectory + pid <- T.pack . show <$> getProcessID + + let hlsPlugin = asGhcIdePlugin argsHlsPlugins + hlsCommands = allLspCmdIds' pid argsHlsPlugins + plugins = hlsPlugin <> argsGhcidePlugin + onInitialConfiguration :: InitializeRequest -> Either T.Text Config + onInitialConfiguration x = case x ^. params . initializationOptions of + Nothing -> Right def + Just v -> case J.fromJSON v of + J.Error err -> Left $ T.pack err + J.Success a -> Right a + onConfigurationChange = const $ Left "Updating Not supported" + options = argsLspOptions + { LSP.executeCommandCommands = Just hlsCommands + } + case argFiles of + Nothing -> do + t <- offsetTime + runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do + t <- t + hPutStrLn stderr $ "Started LSP server in " ++ showDuration t + + -- We want to set the global DynFlags right now, so that we can use + -- `unsafeGlobalDynFlags` even before the project is configured + -- We do it here since haskell-lsp changes our working directory to the correct place ('rootPath') + -- before calling this function + _mlibdir <- + setInitialDynFlags + `catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing) + + sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions $ fromMaybe dir rootPath + config <- fromMaybe def <$> getConfig + let options = (argsIdeOptions sessionLoader) + { optReportProgress = clientSupportsProgress caps + , optCheckParents = checkParents config + , optCheckProject = checkProject config + } + rules = argsRules >> pluginRules plugins + debouncer <- newAsyncDebouncer + initialise + caps + rules + getLspId + event + wProg + wIndefProg + argsLogger + debouncer + options + vfs + argsHiedb + argsHieChan + Just argFiles -> do + -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error + hSetEncoding stdout utf8 + hSetEncoding stderr utf8 + + putStrLn $ "HLS setup tester in " ++ dir ++ "." + putStrLn "Report bugs at https://github.com/haskell/haskell-language-server/issues" + programsOfInterest <- findProgramVersions + putStrLn "" + putStrLn "Tool versions found on the $PATH" + putStrLn $ showProgramVersionOfInterest programsOfInterest + + putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir + files <- expandFiles (argFiles ++ ["." | null argFiles]) + -- LSP works with absolute file paths, so try and behave similarly + files <- nubOrd <$> mapM IO.canonicalizePath files + putStrLn $ "Found " ++ show (length files) ++ " files" + + putStrLn "\nStep 2/4: Looking for hie.yaml files that control setup" + cradles <- mapM findCradle files + let ucradles = nubOrd cradles + let n = length ucradles + putStrLn $ "Found " ++ show n ++ " cradle" ++ ['s' | n /= 1] + when (n > 0) $ putStrLn $ " (" ++ intercalate ", " (catMaybes ucradles) ++ ")" + putStrLn "\nStep 3/4: Initializing the IDE" + vfs <- makeVFSHandle + debouncer <- newAsyncDebouncer + let dummyWithProg _ _ f = f (const (pure ())) + sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir + let options = (argsIdeOptions sessionLoader) + { optCheckParents = NeverCheck + , optCheckProject = False + } + ide <- initialise def mainRule (pure $ IdInt 0) (showEvent argsLogger) dummyWithProg (const (const id)) argsLogger debouncer options vfs argsHiedb argsHieChan + + putStrLn "\nStep 4/4: Type checking the files" + setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files + results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' files) + _results <- runAction "GetHie" ide $ uses GetHieAst (map toNormalizedFilePath' files) + _results <- runAction "GenerateCore" ide $ uses GenerateCore (map toNormalizedFilePath' files) + let (worked, failed) = partition fst $ zip (map isJust results) files + when (failed /= []) $ + putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed + + let nfiles xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files" + putStrLn $ "\nCompleted (" ++ nfiles worked ++ " worked, " ++ nfiles failed ++ " failed)" + + when argsOTMemoryProfiling $ do + let valuesRef = state $ shakeExtras ide + values <- readVar valuesRef + let consoleObserver Nothing = return $ \size -> printf "Total: %.2fMB\n" (fromIntegral @Int @Double size / 1e6) + consoleObserver (Just k) = return $ \size -> printf " - %s: %.2fKB\n" (show k) (fromIntegral @Int @Double size / 1e3) + + printf "# Shake value store contents(%d):\n" (length values) + let keys = + nub $ + Key GhcSession : + Key GhcSessionDeps : + [k | (_, k) <- HashMap.keys values, k /= Key GhcSessionIO] + ++ [Key GhcSessionIO] + measureMemory argsLogger [keys] consoleObserver valuesRef + + unless (null failed) (exitWith $ ExitFailure (length failed)) +{-# ANN defaultMain ("HLint: ignore Use nubOrd" :: String) #-} + +expandFiles :: [FilePath] -> IO [FilePath] +expandFiles = concatMapM $ \x -> do + b <- IO.doesFileExist x + if b + then return [x] + else do + let recurse "." = True + recurse x | "." `isPrefixOf` takeFileName x = False -- skip .git etc + recurse x = takeFileName x `notElem` ["dist", "dist-newstyle"] -- cabal directories + files <- filter (\x -> takeExtension x `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x + when (null files) $ + fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x + return files + +-- | Print an LSP event. +showEvent :: Logger -> FromServerMessage -> IO () +showEvent _ (EventFileDiagnostics _ []) = return () +showEvent argsLogger (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) = + logInfo argsLogger $ showDiagnosticsColored $ map (file,ShowDiag,) diags +showEvent argsLogger e = logInfo argsLogger $ T.pack $ show e From 21cc46a66039ad00edaea545c79c27fe27e7fc86 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 9 Feb 2021 20:05:41 +0000 Subject: [PATCH 2/5] Reuse Development.IDE.Main in HLS --- ghcide/src/Development/IDE/Main.hs | 9 +- src/Ide/Main.hs | 150 ++++------------------------- 2 files changed, 23 insertions(+), 136 deletions(-) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 4d7e6a8f01..daba3aeae4 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -88,7 +88,6 @@ import System.IO (hPutStrLn, hSetEncoding, stderr, stdout, utf8) import System.Time.Extra (offsetTime, showDuration) import Text.Printf (printf) import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide -import Ide.Version (findProgramVersions, showProgramVersionOfInterest) data Arguments = Arguments { argsOTMemoryProfiling :: Bool @@ -141,6 +140,8 @@ defaultMain Arguments{..} = do case argFiles of Nothing -> do t <- offsetTime + hPutStrLn stderr "Starting LSP server..." + hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do t <- t hPutStrLn stderr $ "Started LSP server in " ++ showDuration t @@ -180,12 +181,8 @@ defaultMain Arguments{..} = do hSetEncoding stdout utf8 hSetEncoding stderr utf8 - putStrLn $ "HLS setup tester in " ++ dir ++ "." + putStrLn $ "ghcide setup tester in " ++ dir ++ "." putStrLn "Report bugs at https://github.com/haskell/haskell-language-server/issues" - programsOfInterest <- findProgramVersions - putStrLn "" - putStrLn "Tool versions found on the $PATH" - putStrLn $ showProgramVersionOfInterest programsOfInterest putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir files <- expandFiles (argFiles ++ ["." | null argFiles]) diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index e83cd25a78..475031a8f4 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -12,52 +12,25 @@ module Ide.Main(defaultMain, runLspMode) where -import Control.Concurrent.Extra import Control.Monad.Extra -import Control.Exception.Safe -import Data.Default -import Data.List.Extra import qualified Data.Map.Strict as Map -import qualified Data.HashMap.Strict as HashMap -import Data.Maybe import qualified Data.Text as T -import qualified Data.Text.IO as T -import Development.IDE.Core.Debouncer -import Development.IDE.Core.FileStore -import Development.IDE.Core.OfInterest -import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules -import Development.IDE.Core.Service -import Development.IDE.Core.Shake -import Development.IDE.LSP.LanguageServer -import Development.IDE.LSP.Protocol -import Development.IDE.Plugin -import Development.IDE.Plugin.HLS -import Development.IDE.Session (loadSession, findCradle, defaultLoadingOptions, setInitialDynFlags, getHieDbLoc, runWithDb) -import Development.IDE.Types.Diagnostics -import Development.IDE.Types.Location +import Development.IDE.Session (setInitialDynFlags, getHieDbLoc, runWithDb) import Development.IDE.Types.Logger as G -import Development.IDE.Types.Options import qualified Language.Haskell.LSP.Core as LSP import Ide.Arguments import Ide.Logger import Ide.Version -import Ide.Plugin.Config -import Ide.PluginUtils import Ide.Types (IdePlugins, ipMap) -import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.Types import qualified System.Directory.Extra as IO import System.Exit -import System.FilePath import System.IO import qualified System.Log.Logger as L -import System.Time.Extra -import Development.Shake (ShakeOptions (shakeThreads), action) import HieDb.Run - -ghcIdePlugins :: T.Text -> IdePlugins IdeState -> (Plugin Config, [T.Text]) -ghcIdePlugins pid ps = (asGhcIdePlugin ps, allLspCmdIds' pid ps) +import qualified Development.IDE.Main as Main +import qualified Development.IDE.Types.Options as Ghcide +import Development.Shake (ShakeOptions(shakeThreads)) defaultMain :: Arguments -> IdePlugins IdeState -> IO () defaultMain args idePlugins = do @@ -107,114 +80,31 @@ hlsLogger = G.Logger $ \pri txt -> -- --------------------------------------------------------------------- runLspMode :: LspArguments -> IdePlugins IdeState -> IO () -runLspMode lspArgs@LspArguments{argsCwd} idePlugins = do +runLspMode lspArgs@LspArguments{..} idePlugins = do whenJust argsCwd IO.setCurrentDirectory dir <- IO.getCurrentDirectory dbLoc <- getHieDbLoc dir - runWithDb dbLoc $ runLspMode' lspArgs idePlugins - -runLspMode' :: LspArguments -> IdePlugins IdeState -> HieDb -> IndexQueue -> IO () -runLspMode' lspArgs@LspArguments{..} idePlugins hiedb hiechan = do LSP.setupLogger argsLogFile ["hls", "hie-bios"] $ if argsDebugOn then L.DEBUG else L.INFO - -- lock to avoid overlapping output on stdout - lock <- newLock - let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $ - T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg - - dir <- IO.getCurrentDirectory - - pid <- T.pack . show <$> getProcessID - let - (plugins, commandIds) = ghcIdePlugins pid idePlugins - options = def { LSP.executeCommandCommands = Just commandIds - , LSP.completionTriggerCharacters = Just "." - } - - if argLSP then do - t <- offsetTime + when argLSP $ do hPutStrLn stderr "Starting (haskell-language-server)LSP server..." hPutStrLn stderr $ " with arguments: " <> show lspArgs hPutStrLn stderr $ " with plugins: " <> show (Map.keys $ ipMap idePlugins) 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!" - runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps wProg wIndefProg _getConfig _rootPath -> do - t <- t - hPutStrLn stderr $ "Started LSP server in " ++ showDuration t - - _libdir <- setInitialDynFlags - `catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing) - sessionLoader <- loadSession dir - -- config <- fromMaybe defaultLspConfig <$> getConfig - let options = defOptions - { optReportProgress = clientSupportsProgress caps - , optShakeProfiling = argsShakeProfiling - , optTesting = IdeTesting argsTesting - , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads} - } - defOptions = defaultIdeOptions sessionLoader - debouncer <- newAsyncDebouncer - initialise caps (mainRule >> pluginRules plugins >> action kick) - getLspId event wProg wIndefProg hlsLogger debouncer options vfs - hiedb hiechan - else do - -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error - hSetEncoding stdout utf8 - hSetEncoding stderr utf8 - - putStrLn $ "(haskell-language-server)Ghcide setup tester in " ++ dir ++ "." - putStrLn "Report bugs at https://github.com/haskell/haskell-language-server/issues" - programsOfInterest <- findProgramVersions - putStrLn "" - putStrLn "Tool versions found on the $PATH" - putStrLn $ showProgramVersionOfInterest programsOfInterest - - putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir - files <- expandFiles (argFiles ++ ["." | null argFiles]) - -- LSP works with absolute file paths, so try and behave similarly - files <- nubOrd <$> mapM IO.canonicalizePath files - putStrLn $ "Found " ++ show (length files) ++ " files" - - putStrLn "\nStep 2/4: Looking for hie.yaml files that control setup" - cradles <- mapM (findCradle defaultLoadingOptions) files - let ucradles = nubOrd cradles - let n = length ucradles - putStrLn $ "Found " ++ show n ++ " cradle" ++ ['s' | n /= 1] - putStrLn "\nStep 3/4: Initializing the IDE" - vfs <- makeVFSHandle - debouncer <- newAsyncDebouncer - let dummyWithProg _ _ f = f (const (pure ())) - sessionLoader <- loadSession dir - ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger Info) debouncer (defaultIdeOptions sessionLoader) vfs hiedb hiechan - - putStrLn "\nStep 4/4: Type checking the files" - setFilesOfInterest ide $ HashMap.fromList $ map ((, OnDisk) . toNormalizedFilePath') files - results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' files) - let (worked, failed) = partition fst $ zip (map isJust results) files - when (failed /= []) $ - putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed - - let files xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files" - putStrLn $ "\nCompleted (" ++ files worked ++ " worked, " ++ files failed ++ " failed)" - unless (null failed) (exitWith $ ExitFailure (length failed)) - -expandFiles :: [FilePath] -> IO [FilePath] -expandFiles = concatMapM $ \x -> do - b <- IO.doesFileExist x - if b then return [x] else do - let recurse "." = True - recurse x | "." `isPrefixOf` takeFileName x = False -- skip .git etc - recurse x = takeFileName x `notElem` ["dist","dist-newstyle"] -- cabal directories - files <- filter (\x -> takeExtension x `elem` [".hs",".lhs"]) <$> IO.listFilesInside (return . recurse) x - when (null files) $ - fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x - return files - --- | Print an LSP event. -showEvent :: Lock -> FromServerMessage -> IO () -showEvent _ (EventFileDiagnostics _ []) = return () -showEvent lock (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) = - withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,ShowDiag,) diags -showEvent lock e = withLock lock $ print e + runWithDb dbLoc $ \hiedb hiechan -> + Main.defaultMain (Main.defArguments hiedb hiechan) + { Main.argFiles = if argLSP then Nothing else Just [] + , Main.argsHlsPlugins = idePlugins + , Main.argsLogger = hlsLogger + , Main.argsIdeOptions = \sessionLoader -> + let defOptions = Ghcide.defaultIdeOptions sessionLoader + in defOptions + { Ghcide.optShakeProfiling = argsShakeProfiling + , Ghcide.optTesting = Ghcide.IdeTesting argsTesting + , Ghcide.optShakeOptions = (Ghcide.optShakeOptions defOptions) + {shakeThreads = argsThreads} + } + } From 701979349ce9afe1d0b8e8e6c5cb0aeb5460d7fd Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 9 Feb 2021 20:07:25 +0000 Subject: [PATCH 3/5] Bump ghcide version number and HLS minbound Seems like now is the best moment to do it and avoid later accidents --- ghcide/CHANGELOG.md | 3 +++ ghcide/ghcide.cabal | 2 +- haskell-language-server.cabal | 2 +- 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/ghcide/CHANGELOG.md b/ghcide/CHANGELOG.md index cd47b13e38..41d1d7c2e1 100644 --- a/ghcide/CHANGELOG.md +++ b/ghcide/CHANGELOG.md @@ -1,3 +1,6 @@ +### 0.7.5 (2021-02-??) +* Added Development.IDE.Main (#1338) - Pepe Iborra + ### 0.7.4 (2021-02-08) * Support for references via hiedb (#704) - wz1000 * Fix space leak on cradle reloads (#1316) - Pepe Iborra diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 2a15a8464b..f13f3898ea 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -2,7 +2,7 @@ cabal-version: 1.20 build-type: Simple category: Development name: ghcide -version: 0.7.4.0 +version: 0.7.5.0 license: Apache-2.0 license-file: LICENSE author: Digital Asset and Ghcide contributors diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 70649d0457..9eb9f0ef69 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -64,7 +64,7 @@ library , cryptohash-sha1 , data-default , ghc - , ghcide >=0.7 + , ghcide >=0.7.5 , gitrev , haskell-lsp ^>=0.23 , hls-plugin-api >=0.7 From b385c013d18ec3334946c5865121904a42ac900f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 10 Feb 2021 14:22:12 +0000 Subject: [PATCH 4/5] (unrelated) disable cradle experiments in ghcide test suite ``` benchmark experiments 674 hover: OK (30.50s) 675 hover after edit: OK (65.67s) 676 getDefinition: OK (12.24s) 677 getDefinition after edit: OK (62.37s) 678 documentSymbols: OK (13.95s) 679 documentSymbols after edit: OK (16.87s) 680 completions: OK (13.64s) 681 completions after edit: OK (66.82s) 682 code actions: OK (13.80s) 683 code actions after edit: OK (58.70s) 684 code actions after cradle edit: OK (1244.46s) 685 hover after cradle edit: OK (1230.61s) ``` --- ghcide/test/exe/Main.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 877ddd1f9c..de6c7876d9 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4498,6 +4498,8 @@ benchmarkTests = assertBool "did not successfully complete 5 repetitions" $ Bench.success res | e <- Bench.experiments , Bench.name e /= "edit" -- the edit experiment does not ever fail + -- the cradle experiments are way too slow + , not ("cradle" `isInfixOf` Bench.name e) ] -- | checks if we use InitializeParams.rootUri for loading session From e87fb93feb138d9c30adcff6ceed1dccfc4200ec Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 11 Feb 2021 18:07:54 +0000 Subject: [PATCH 5/5] Fix config --- ghcide/exe/Main.hs | 7 +++++- ghcide/src/Development/IDE/Main.hs | 40 ++++++++++++++---------------- src/Ide/Main.hs | 5 +++- 3 files changed, 28 insertions(+), 24 deletions(-) diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 21a616486e..1898824bc0 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -8,7 +8,9 @@ module Main(main) where import Arguments ( Arguments'(..), IdeCmd(..), getArguments ) import Control.Concurrent.Extra ( newLock, withLock ) import Control.Monad.Extra ( unless, when, whenJust ) +import Data.Default ( Default(def) ) import Data.List.Extra ( upper ) +import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Version ( showVersion ) @@ -22,6 +24,7 @@ import Development.IDE.Session (setInitialDynFlags, getHieDbLoc, runWithDb) import Development.IDE.Types.Options import qualified Development.IDE.Main as Main import Development.Shake (ShakeOptions(shakeThreads)) +import Ide.Plugin.Config (Config(checkParents, checkProject)) import Ide.PluginUtils (pluginDescToIdePlugins) import HieDb.Run (Options(..), runCommand) import Paths_ghcide ( version ) @@ -102,13 +105,15 @@ main = do then Test.plugin else mempty - ,Main.argsIdeOptions = \sessionLoader -> + ,Main.argsIdeOptions = \(fromMaybe def -> config) sessionLoader -> let defOptions = defaultIdeOptions sessionLoader in defOptions { optShakeProfiling = argsShakeProfiling , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling , optTesting = IdeTesting argsTesting , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads} + , optCheckParents = checkParents config + , optCheckProject = checkProject config } } diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index daba3aeae4..804a121341 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -68,15 +68,13 @@ import Development.IDE.Types.Options ( import Development.IDE.Types.Shake (Key (Key)) import Development.Shake (action) import HIE.Bios.Cradle (findCradle) -import Ide.Plugin.Config ( - CheckParents (NeverCheck), - Config (checkParents, checkProject), - ) +import Ide.Plugin.Config (CheckParents (NeverCheck), Config) import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins) import Ide.Types (IdePlugins) import qualified Language.Haskell.LSP.Core as LSP import Language.Haskell.LSP.Messages (FromServerMessage) import Language.Haskell.LSP.Types ( + DidChangeConfigurationNotification, InitializeRequest, LspId (IdInt), ) @@ -99,8 +97,10 @@ data Arguments = Arguments , argsHlsPlugins :: IdePlugins IdeState , argsGhcidePlugin :: Plugin Config -- ^ Deprecated , argsSessionLoadingOptions :: SessionLoadingOptions - , argsIdeOptions :: Action IdeGhcSession -> IdeOptions + , argsIdeOptions :: Maybe Config -> Action IdeGhcSession -> IdeOptions , argsLspOptions :: LSP.Options + , argsGetInitialConfig :: InitializeRequest -> Either T.Text Config + , argsOnConfigChange :: DidChangeConfigurationNotification -> Either T.Text Config } defArguments :: HieDb -> IndexQueue -> Arguments @@ -115,8 +115,14 @@ defArguments hiedb hiechan = , argsGhcidePlugin = mempty , argsHlsPlugins = pluginDescToIdePlugins Ghcide.descriptors , argsSessionLoadingOptions = defaultLoadingOptions - , argsIdeOptions = defaultIdeOptions + , argsIdeOptions = const defaultIdeOptions , argsLspOptions = def {LSP.completionTriggerCharacters = Just "."} + , argsOnConfigChange = const $ Left "Updating Not supported" + , argsGetInitialConfig = \x -> case x ^. params . initializationOptions of + Nothing -> Right def + Just v -> case J.fromJSON v of + J.Error err -> Left $ T.pack err + J.Success a -> Right a } defaultMain :: Arguments -> IO () @@ -127,22 +133,14 @@ defaultMain Arguments{..} = do let hlsPlugin = asGhcIdePlugin argsHlsPlugins hlsCommands = allLspCmdIds' pid argsHlsPlugins plugins = hlsPlugin <> argsGhcidePlugin - onInitialConfiguration :: InitializeRequest -> Either T.Text Config - onInitialConfiguration x = case x ^. params . initializationOptions of - Nothing -> Right def - Just v -> case J.fromJSON v of - J.Error err -> Left $ T.pack err - J.Success a -> Right a - onConfigurationChange = const $ Left "Updating Not supported" - options = argsLspOptions - { LSP.executeCommandCommands = Just hlsCommands - } + options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands } + case argFiles of Nothing -> do t <- offsetTime hPutStrLn stderr "Starting LSP server..." hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" - runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do + runLanguageServer options (pluginHandler plugins) argsGetInitialConfig argsOnConfigChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do t <- t hPutStrLn stderr $ "Started LSP server in " ++ showDuration t @@ -155,11 +153,9 @@ defaultMain Arguments{..} = do `catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing) sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions $ fromMaybe dir rootPath - config <- fromMaybe def <$> getConfig - let options = (argsIdeOptions sessionLoader) + config <- getConfig + let options = (argsIdeOptions config sessionLoader) { optReportProgress = clientSupportsProgress caps - , optCheckParents = checkParents config - , optCheckProject = checkProject config } rules = argsRules >> pluginRules plugins debouncer <- newAsyncDebouncer @@ -201,7 +197,7 @@ defaultMain Arguments{..} = do debouncer <- newAsyncDebouncer let dummyWithProg _ _ f = f (const (pure ())) sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir - let options = (argsIdeOptions sessionLoader) + let options = (argsIdeOptions Nothing sessionLoader) { optCheckParents = NeverCheck , optCheckProject = False } diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index 475031a8f4..12a3824bb7 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 Ide.Plugin.Config (getInitialConfig, getConfigFromNotification) defaultMain :: Arguments -> IdePlugins IdeState -> IO () defaultMain args idePlugins = do @@ -99,7 +100,9 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do { Main.argFiles = if argLSP then Nothing else Just [] , Main.argsHlsPlugins = idePlugins , Main.argsLogger = hlsLogger - , Main.argsIdeOptions = \sessionLoader -> + , Main.argsGetInitialConfig = getInitialConfig + , Main.argsOnConfigChange = getConfigFromNotification + , Main.argsIdeOptions = \_config sessionLoader -> let defOptions = Ghcide.defaultIdeOptions sessionLoader in defOptions { Ghcide.optShakeProfiling = argsShakeProfiling