diff --git a/exe/Main.hs b/exe/Main.hs index 21b9cdc774..7c0ef2f90b 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -4,7 +4,8 @@ {-# LANGUAGE RecordWildCards #-} module Main(main) where -import Ide.Arguments (Arguments (..), LspArguments (..), getArguments) +import Ide.Arguments (Arguments (..), GhcideArguments (..), + getArguments) import Ide.Main (defaultMain) import Plugins @@ -14,7 +15,7 @@ main = do let withExamples = case args of - LspMode LspArguments{..} -> argsExamplePlugin - _ -> False + Ghcide GhcideArguments{..} -> argsExamplePlugin + _ -> False defaultMain args (idePlugins withExamples) diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 975492f249..baa7d99764 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -49,8 +49,8 @@ main = do launchHaskellLanguageServer :: Arguments -> IO () launchHaskellLanguageServer parsedArgs = do case parsedArgs of - LspMode LspArguments{..} -> whenJust argsCwd setCurrentDirectory - _ -> pure () + Ghcide GhcideArguments{..} -> whenJust argsCwd setCurrentDirectory + _ -> pure () d <- getCurrentDirectory @@ -59,7 +59,7 @@ launchHaskellLanguageServer parsedArgs = do setCurrentDirectory $ cradleRootDir cradle case parsedArgs of - LspMode LspArguments{..} -> + Ghcide GhcideArguments{..} -> when argsProjectGhcVersion $ getRuntimeGhcVersion' cradle >>= putStrLn >> exitSuccess _ -> pure () diff --git a/ghcide/exe/Arguments.hs b/ghcide/exe/Arguments.hs index 125cf66961..2563fdccb8 100644 --- a/ghcide/exe/Arguments.hs +++ b/ghcide/exe/Arguments.hs @@ -1,18 +1,13 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -module Arguments(Arguments, Arguments'(..), getArguments, IdeCmd(..)) where +module Arguments(Arguments(..), getArguments) where -import HieDb.Run +import Development.IDE.Main (Command (..), commandP) import Options.Applicative -type Arguments = Arguments' IdeCmd - -data IdeCmd = Typecheck [FilePath] | DbCmd Options Command | LSP - -data Arguments' a = Arguments - {argLSP :: Bool - ,argsCwd :: Maybe FilePath +data Arguments = Arguments + {argsCwd :: Maybe FilePath ,argsVersion :: Bool ,argsVSCodeExtensionSchema :: Bool ,argsDefaultConfig :: Bool @@ -22,7 +17,7 @@ data Arguments' a = Arguments ,argsDisableKick :: Bool ,argsThreads :: Int ,argsVerbose :: Bool - ,argFilesOrCmd :: a + ,argsCommand :: Command } getArguments :: IO Arguments @@ -34,8 +29,7 @@ getArguments = execParser opts arguments :: Parser Arguments arguments = Arguments - <$> switch (long "lsp" <> help "Start talking to an LSP client") - <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory") + <$> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory") <*> switch (long "version" <> help "Show ghcide and GHC versions") <*> switch (long "vscode-extension-schema" <> help "Print generic config schema for plugins (used in the package.json of haskell vscode extension)") <*> switch (long "generate-default-config" <> help "Print config supported by the server with default values") @@ -45,12 +39,7 @@ arguments = Arguments <*> switch (long "test-no-kick" <> help "Disable kick. Useful for testing cancellation") <*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault) <*> switch (long "verbose" <> help "Include internal events in logging output") - <*> ( hsubparser (command "typecheck" (info (Typecheck <$> fileCmd) fileInfo) - <> command "hiedb" (info (DbCmd <$> optParser "" True <*> cmdParser <**> helper) hieInfo) - <> command "lsp" (info (pure LSP <**> helper) lspInfo) ) - <|> Typecheck <$> fileCmd ) - where - fileCmd = many (argument str (metavar "FILES/DIRS...")) - lspInfo = fullDesc <> progDesc "Start talking to an LSP client" - fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work" - hieInfo = fullDesc <> progDesc "Query .hie files" + <*> (commandP <|> lspCommand <|> checkCommand) + where + checkCommand = Check <$> many (argument str (metavar "FILES/DIRS...")) + lspCommand = LSP <$ switch (long "lsp" <> help "Start talking to an LSP client") diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 041c6a6186..2faa40b06f 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -5,8 +5,8 @@ module Main(main) where -import Arguments (Arguments' (..), - IdeCmd (..), getArguments) +import Arguments (Arguments (..), + getArguments) import Control.Concurrent.Extra (newLock, withLock) import Control.Monad.Extra (unless, when, whenJust) import qualified Data.Aeson.Encode.Pretty as A @@ -22,14 +22,12 @@ import Development.IDE (Logger (Logger), Priority (Info), action) import Development.IDE.Core.OfInterest (kick) import Development.IDE.Core.Rules (mainRule) +import Development.IDE.Main (Command (LSP)) import qualified Development.IDE.Main as Main import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde import qualified Development.IDE.Plugin.Test as Test -import Development.IDE.Session (getHieDbLoc, - setInitialDynFlags) import Development.IDE.Types.Options import Development.Shake (ShakeOptions (shakeThreads)) -import HieDb.Run (Options (..), runCommand) import Ide.Plugin.Config (Config (checkParents, checkProject)) import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, pluginsToVSCodeExtensionSchema) @@ -37,8 +35,7 @@ import Ide.PluginUtils (pluginDescToIdePlugins) import Paths_ghcide (version) import qualified System.Directory.Extra as IO import System.Environment (getExecutablePath) -import System.Exit (ExitCode (ExitFailure), - exitSuccess, exitWith) +import System.Exit (exitSuccess) import System.IO (hPutStrLn, stderr) import System.Info (compilerVersion) @@ -80,56 +77,43 @@ main = do T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg logLevel = if argsVerbose then minBound else Info - case argFilesOrCmd of - DbCmd opts cmd -> do - dir <- IO.getCurrentDirectory - dbLoc <- getHieDbLoc dir - mlibdir <- setInitialDynFlags def - case mlibdir of - Nothing -> exitWith $ ExitFailure 1 - 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 () - - Main.defaultMain def - {Main.argFiles = case argFilesOrCmd of - Typecheck x | not argLSP -> Just x - _ -> Nothing - - ,Main.argsLogger = pure 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 = \config sessionLoader -> - let defOptions = defaultIdeOptions sessionLoader - in defOptions - { optShakeProfiling = argsShakeProfiling - , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling - , optTesting = IdeTesting argsTesting - , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads} - , optCheckParents = pure $ checkParents config - , optCheckProject = pure $ checkProject config - } - } + case argsCommand 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 () + + Main.defaultMain def + {Main.argCommand = argsCommand + + ,Main.argsLogger = pure 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 = \config sessionLoader -> + let defOptions = defaultIdeOptions sessionLoader + in defOptions + { optShakeProfiling = argsShakeProfiling + , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling + , optTesting = IdeTesting argsTesting + , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads} + , optCheckParents = pure $ checkParents config + , optCheckProject = pure $ checkProject config + } + } diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 19cbb0fa3c..46e4ebdb4b 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -64,6 +64,7 @@ library lsp == 1.2.*, mtl, network-uri, + optparse-applicative, parallel, prettyprinter-ansi-terminal, prettyprinter-ansi-terminal, diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 91da4a09d0..7ef9e76df2 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -1,4 +1,12 @@ -module Development.IDE.Main (Arguments(..), defaultMain) where +{-# OPTIONS_GHC -Wno-orphans #-} +module Development.IDE.Main +(Arguments(..) +,Command(..) +,IdeCommand(..) +,isLSP +,commandP +,defaultMain +) where import Control.Concurrent.Extra (newLock, readVar, withLock) import Control.Exception.Safe (Exception (displayException), @@ -57,6 +65,7 @@ import Development.Shake (action) import GHC.IO.Encoding (setLocaleEncoding) import GHC.IO.Handle (hDuplicate) import HIE.Bios.Cradle (findCradle) +import qualified HieDb.Run as HieDb import Ide.Plugin.Config (CheckParents (NeverCheck), Config, getConfigFromNotification) @@ -65,6 +74,7 @@ import Ide.PluginUtils (allLspCmdIds', pluginDescToIdePlugins) import Ide.Types (IdePlugins) import qualified Language.LSP.Server as LSP +import Options.Applicative hiding (action) import qualified System.Directory.Extra as IO import System.Exit (ExitCode (ExitFailure), exitWith) @@ -80,9 +90,41 @@ import System.Time.Extra (offsetTime, showDuration) import Text.Printf (printf) +data Command + = Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures + | Db {projectRoot :: FilePath, hieOptions :: HieDb.Options, hieCommand :: HieDb.Command} + -- ^ Run a command in the hiedb + | LSP -- ^ Run the LSP server + | Custom {projectRoot :: FilePath, ideCommand :: IdeCommand} -- ^ User defined + deriving Show + +newtype IdeCommand = IdeCommand (IdeState -> IO ()) + +instance Show IdeCommand where show _ = "" + +-- TODO move these to hiedb +deriving instance Show HieDb.Command +deriving instance Show HieDb.Options + +isLSP :: Command -> Bool +isLSP LSP = True +isLSP _ = False + +commandP :: Parser Command +commandP = hsubparser (command "typecheck" (info (Check <$> fileCmd) fileInfo) + <> command "hiedb" (info (Db "." <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo) + <> command "lsp" (info (pure LSP <**> helper) lspInfo) + ) + where + fileCmd = many (argument str (metavar "FILES/DIRS...")) + lspInfo = fullDesc <> progDesc "Start talking to an LSP client" + fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work" + hieInfo = fullDesc <> progDesc "Query .hie files" + + data Arguments = Arguments { argsOTMemoryProfiling :: Bool - , argFiles :: Maybe [FilePath] -- ^ Nothing: lsp server ; Just: typecheck and exit + , argCommand :: Command , argsLogger :: IO Logger , argsRules :: Rules () , argsHlsPlugins :: IdePlugins IdeState @@ -100,7 +142,7 @@ data Arguments = Arguments instance Default Arguments where def = Arguments { argsOTMemoryProfiling = False - , argFiles = Nothing + , argCommand = LSP , argsLogger = stderrLogger , argsRules = mainRule >> action kick , argsGhcidePlugin = mempty @@ -153,8 +195,8 @@ defaultMain Arguments{..} = do inH <- argsHandleIn outH <- argsHandleOut - case argFiles of - Nothing -> do + case argCommand of + LSP -> 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!" @@ -188,7 +230,7 @@ defaultMain Arguments{..} = do vfs hiedb hieChan - Just argFiles -> do + Check argFiles -> do dir <- IO.getCurrentDirectory dbLoc <- getHieDbLoc dir runWithDb dbLoc $ \hiedb hieChan -> do @@ -249,8 +291,30 @@ defaultMain Arguments{..} = do measureMemory logger [keys] consoleObserver valuesRef unless (null failed) (exitWith $ ExitFailure (length failed)) + Db dir opts cmd -> do + dbLoc <- getHieDbLoc dir + hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc + mlibdir <- setInitialDynFlags def + case mlibdir of + Nothing -> exitWith $ ExitFailure 1 + Just libdir -> HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd + Custom projectRoot (IdeCommand c) -> do + dbLoc <- getHieDbLoc projectRoot + runWithDb dbLoc $ \hiedb hieChan -> do + vfs <- makeVFSHandle + sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions "." + let options = + (argsIdeOptions argsDefaultHlsConfig sessionLoader) + { optCheckParents = pure NeverCheck, + optCheckProject = pure False + } + ide <- initialise argsDefaultHlsConfig rules Nothing logger debouncer options vfs hiedb hieChan + registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing) + c ide + {-# ANN defaultMain ("HLint: ignore Use nubOrd" :: String) #-} + expandFiles :: [FilePath] -> IO [FilePath] expandFiles = concatMapM $ \x -> do b <- IO.doesFileExist x diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 712237a101..e02f13c709 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -36,7 +36,7 @@ import Development.IDE.Core.PositionMapping (PositionResult (..), positionResultToMaybe, toCurrent) import Development.IDE.Core.Shake (Q (..)) -import Development.IDE.Main as IDE +import qualified Development.IDE.Main as IDE import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types (extendImportCommandId) import Development.IDE.Plugin.TypeLenses (typeLensCommandId) @@ -1390,7 +1390,7 @@ extendImportTests = testGroup "extend import actions" ]) , expectFailBecause "importing pattern synonyms is unsupported" $ testSession "extend import list with pattern synonym" $ template - [("ModuleA.hs", T.unlines + [("ModuleA.hs", T.unlines [ "{-# LANGUAGE PatternSynonyms #-}" , "module ModuleA where" , "pattern Some x = Just x" @@ -5294,7 +5294,7 @@ unitTests = do | i <- [(1::Int)..20] ] ++ Ghcide.descriptors - testIde def{argsHlsPlugins = plugins} $ do + testIde def{IDE.argsHlsPlugins = plugins} $ do _ <- createDoc "haskell" "A.hs" "module A where" waitForProgressDone actualOrder <- liftIO $ readIORef orderRef @@ -5302,14 +5302,14 @@ unitTests = do liftIO $ actualOrder @?= reverse [(1::Int)..20] ] -testIde :: Arguments -> Session () -> IO () +testIde :: IDE.Arguments -> Session () -> IO () testIde arguments session = do config <- getConfigFromEnv (hInRead, hInWrite) <- createPipe (hOutRead, hOutWrite) <- createPipe let server = IDE.defaultMain arguments - { argsHandleIn = pure hInRead - , argsHandleOut = pure hOutWrite + { IDE.argsHandleIn = pure hInRead + , IDE.argsHandleOut = pure hOutWrite } withAsync server $ \_ -> diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index e72bf3e7eb..4877b7b7b8 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -190,7 +190,7 @@ rules plugin = do getIdeas :: NormalizedFilePath -> Action (Either ParseError [Idea]) getIdeas nfp = do - logm $ "hlint:getIdeas:file:" ++ show nfp + debugm $ "hlint:getIdeas:file:" ++ show nfp (flags, classify, hint) <- useNoFile_ GetHlintSettings let applyHints' (Just (Right modEx)) = Right $ applyHints classify hint [modEx] @@ -222,7 +222,7 @@ getIdeas nfp = do setExtensions flags = do hlintExts <- getExtensions flags nfp - logm $ "hlint:getIdeas:setExtensions:" ++ show hlintExts + debugm $ "hlint:getIdeas:setExtensions:" ++ show hlintExts return $ flags { enabledExtensions = hlintExts } getExtensions :: ParseFlags -> NormalizedFilePath -> Action [Extension] diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs index efbae93621..a8781152d8 100644 --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -8,7 +8,7 @@ module Ide.Arguments ( Arguments(..) - , LspArguments(..) + , GhcideArguments(..) , PrintVersion(..) , getArguments , haskellLanguageServerVersion @@ -17,7 +17,7 @@ module Ide.Arguments import Data.Version import Development.GitRev -import HieDb.Run +import Development.IDE.Main (Command (..), commandP) import Options.Applicative import Paths_haskell_language_server import System.Environment @@ -27,15 +27,13 @@ import System.Environment data Arguments = VersionMode PrintVersion | ProbeToolsMode - | DbCmd Options Command - | LspMode LspArguments + | Ghcide GhcideArguments | VSCodeExtensionSchemaMode | DefaultConfigurationMode -data LspArguments = LspArguments - {argLSP :: Bool +data GhcideArguments = GhcideArguments + {argsCommand :: Command ,argsCwd :: Maybe FilePath - ,argFiles :: [FilePath] ,argsShakeProfiling :: Maybe FilePath ,argsTesting :: Bool ,argsExamplePlugin :: Bool @@ -55,12 +53,10 @@ data PrintVersion getArguments :: String -> IO Arguments getArguments exeName = execParser opts where - hieInfo = fullDesc <> progDesc "Query .hie files" opts = info (( VersionMode <$> printVersionParser exeName <|> probeToolsParser exeName - <|> hsubparser (command "hiedb" (info (DbCmd <$> optParser "" True <*> cmdParser <**> helper) hieInfo)) - <|> LspMode <$> arguments + <|> Ghcide <$> arguments <|> vsCodeExtensionSchemaModeParser <|> defaultConfigurationModeParser) <**> helper) @@ -91,12 +87,11 @@ defaultConfigurationModeParser = flag' DefaultConfigurationMode (long "generate-default-config" <> help "Print config supported by the server with default values") -arguments :: Parser LspArguments -arguments = LspArguments - <$> switch (long "lsp" <> help "Start talking to an LSP server") +arguments :: Parser GhcideArguments +arguments = GhcideArguments + <$> (commandP <|> lspCommand <|> checkCommand) <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory") - <*> many (argument str (metavar "FILES/DIRS...")) <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory") <*> switch (long "test" @@ -124,6 +119,9 @@ arguments = LspArguments ) <*> switch (long "project-ghc-version" <> help "Work out the project GHC version and print it") + where + lspCommand = LSP <$ switch (long "lsp" <> help "Start talking to an LSP server") + checkCommand = Check <$> many (argument str (metavar "FILES/DIRS...")) -- --------------------------------------------------------------------- diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs index d662cced3b..d70ff3c0b4 100644 --- a/src/Ide/Main.hs +++ b/src/Ide/Main.hs @@ -15,12 +15,11 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Default import qualified Data.Text as T import Development.IDE.Core.Rules +import Development.IDE.Main (isLSP) import qualified Development.IDE.Main as Main -import Development.IDE.Session (getHieDbLoc, setInitialDynFlags) import Development.IDE.Types.Logger as G import qualified Development.IDE.Types.Options as Ghcide import Development.Shake (ShakeOptions (shakeThreads)) -import HieDb.Run import Ide.Arguments import Ide.Logger import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, @@ -29,7 +28,6 @@ import Ide.Types (IdePlugins, ipMap) import Ide.Version import qualified Language.LSP.Server as LSP import qualified System.Directory.Extra as IO -import System.Exit import System.IO import qualified System.Log.Logger as L @@ -52,20 +50,10 @@ defaultMain args idePlugins = do VersionMode PrintNumericVersion -> putStrLn haskellLanguageServerNumericVersion - DbCmd opts cmd -> do - dir <- IO.getCurrentDirectory - dbLoc <- getHieDbLoc dir - hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc - mlibdir <- setInitialDynFlags def - case mlibdir of - Nothing -> exitWith $ ExitFailure 1 - Just libdir -> - runCommand libdir opts{database = dbLoc} cmd - - LspMode lspArgs -> do + Ghcide ghcideArgs -> do {- see WARNING above -} hPutStrLn stderr hlsVer - runLspMode lspArgs idePlugins + runLspMode ghcideArgs idePlugins VSCodeExtensionSchemaMode -> do LBS.putStrLn $ A.encodePretty $ pluginsToVSCodeExtensionSchema idePlugins @@ -86,22 +74,22 @@ hlsLogger = G.Logger $ \pri txt -> -- --------------------------------------------------------------------- -runLspMode :: LspArguments -> IdePlugins IdeState -> IO () -runLspMode lspArgs@LspArguments{..} idePlugins = do +runLspMode :: GhcideArguments -> IdePlugins IdeState -> IO () +runLspMode ghcideArgs@GhcideArguments{..} idePlugins = do whenJust argsCwd IO.setCurrentDirectory dir <- IO.getCurrentDirectory LSP.setupLogger argsLogFile ["hls", "hie-bios"] $ if argsDebugOn then L.DEBUG else L.INFO - when argLSP $ do + when (isLSP argsCommand) $ do hPutStrLn stderr "Starting (haskell-language-server)LSP server..." - hPutStrLn stderr $ " with arguments: " <> show lspArgs + hPutStrLn stderr $ " with arguments: " <> show ghcideArgs hPutStrLn stderr $ " with plugins: " <> show (map fst $ 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!" Main.defaultMain def - { Main.argFiles = if argLSP then Nothing else Just argFiles + { Main.argCommand = argsCommand , Main.argsHlsPlugins = idePlugins , Main.argsLogger = pure hlsLogger , Main.argsIdeOptions = \_config sessionLoader ->