diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 1e4f367140..c743231255 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -7,7 +7,7 @@ module Main(main) where import Arguments (Arguments (..), getArguments) -import Control.Monad.Extra (unless, whenJust) +import Control.Monad.Extra (unless) import Data.Default (def) import Data.Version (showVersion) import Development.GitRev (gitHash) @@ -50,13 +50,17 @@ main = withTelemetryLogger $ \telemetryLogger -> do if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion - whenJust argsCwd IO.setCurrentDirectory + -- if user uses --cwd option we need to make this path absolute (and set the current directory to it) + argsCwd <- case argsCwd of + Nothing -> IO.getCurrentDirectory + Just root -> IO.setCurrentDirectory root >> IO.getCurrentDirectory let logPriority = if argsVerbose then Debug else Info arguments = if argsTesting then Main.testing else Main.defaultArguments logPriority Main.defaultMain arguments - {Main.argCommand = argsCommand + { Main.argsProjectRoot = Just argsCwd + , Main.argCommand = argsCommand ,Main.argsLogger = Main.argsLogger arguments <> pure telemetryLogger ,Main.argsRules = do diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index e708670810..74929b3673 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -124,12 +124,12 @@ 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} + | Db {hieOptions :: HieDb.Options, hieCommand :: HieDb.Command} -- ^ Run a command in the hiedb | LSP -- ^ Run the LSP server | PrintExtensionSchema | PrintDefaultConfig - | Custom {projectRoot :: FilePath, ideCommand :: IdeCommand IdeState} -- ^ User defined + | Custom {ideCommand :: IdeCommand IdeState} -- ^ User defined deriving Show @@ -144,7 +144,7 @@ isLSP _ = False commandP :: IdePlugins IdeState -> Parser Command commandP plugins = hsubparser(command "typecheck" (info (Check <$> fileCmd) fileInfo) - <> command "hiedb" (info (Db "." <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo) + <> command "hiedb" (info (Db <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo) <> command "lsp" (info (pure LSP <**> helper) lspInfo) <> command "vscode-extension-schema" extensionSchemaCommand <> command "generate-default-config" generateDefaultConfigCommand @@ -163,13 +163,14 @@ commandP plugins = (fullDesc <> progDesc "Print config supported by the server with default values") pluginCommands = mconcat - [ command (T.unpack pId) (Custom "." <$> p) + [ command (T.unpack pId) (Custom <$> p) | (PluginId pId, PluginDescriptor{pluginCli = Just p}) <- ipMap plugins ] data Arguments = Arguments - { argsOTMemoryProfiling :: Bool + { argsProjectRoot :: Maybe FilePath + , argsOTMemoryProfiling :: Bool , argCommand :: Command , argsLogger :: IO Logger , argsRules :: Rules () @@ -191,7 +192,8 @@ instance Default Arguments where defaultArguments :: Priority -> Arguments defaultArguments priority = Arguments - { argsOTMemoryProfiling = False + { argsProjectRoot = Nothing + , argsOTMemoryProfiling = False , argCommand = LSP , argsLogger = stderrLogger priority , argsRules = mainRule def >> action kick @@ -319,7 +321,7 @@ defaultMain Arguments{..} = flip withHeapStats fun =<< argsLogger hieChan dumpSTMStats Check argFiles -> do - dir <- IO.getCurrentDirectory + dir <- maybe IO.getCurrentDirectory return argsProjectRoot dbLoc <- getHieDbLoc dir runWithDb logger dbLoc $ \hiedb hieChan -> do -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error @@ -382,17 +384,19 @@ defaultMain Arguments{..} = flip withHeapStats fun =<< argsLogger measureMemory logger [keys] consoleObserver values unless (null failed) (exitWith $ ExitFailure (length failed)) - Db dir opts cmd -> do - dbLoc <- getHieDbLoc dir + Db opts cmd -> do + root <- maybe IO.getCurrentDirectory return argsProjectRoot + dbLoc <- getHieDbLoc root hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc - mlibdir <- setInitialDynFlags logger dir def + mlibdir <- setInitialDynFlags logger root def rng <- newStdGen case mlibdir of Nothing -> exitWith $ ExitFailure 1 Just libdir -> retryOnSqliteBusy logger rng (HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd) - Custom projectRoot (IdeCommand c) -> do - dbLoc <- getHieDbLoc projectRoot + Custom (IdeCommand c) -> do + root <- maybe IO.getCurrentDirectory return argsProjectRoot + dbLoc <- getHieDbLoc root runWithDb logger dbLoc $ \hiedb hieChan -> do vfs <- makeVFSHandle sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions "."