Skip to content

Commit 89ed1a6

Browse files
drsoochdrsooch
committed
Add new Ghcide Argument to track Project Root
This commit provides an alternate way to grab the project root/current working directory. Prior to this commit the relative filepath "." was hard-coded for both Db and Custom Commands. This results in inconsistent behaviour with how HLS derives it's hiedb location. This new argument to the internal Ghcide Arguments, maps from the executable Arguments `argsCwd` or by grabbing the current working directory. If the user provides an option to `--cwd` we need to make sure we make that filepath absolute. Finally, inside the command handler, if necessary, we will grab the current working directory. We cannot provide a suitable default for this argument, therefore we leave it as a `Maybe FilePath`, even though this path should never be taken.
1 parent b354202 commit 89ed1a6

File tree

2 files changed

+27
-18
lines changed

2 files changed

+27
-18
lines changed

‎ghcide/exe/Main.hs‎

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ module Main(main) where
77

88
import Arguments (Arguments (..),
99
getArguments)
10-
import Control.Monad.Extra (unless, whenJust)
10+
import Control.Monad.Extra (unless)
1111
import Data.Default (def)
1212
import Data.Version (showVersion)
1313
import Development.GitRev (gitHash)
@@ -50,13 +50,18 @@ main = withTelemetryLogger $ \telemetryLogger -> do
5050
if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
5151
else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
5252

53-
whenJust argsCwd IO.setCurrentDirectory
53+
-- getHieDbLoc takes a directory path (the project root) and hashes it to find the location of the hiedb
54+
-- when running commands directly from GHCIDE we need to provide the ABSOLUTE path to the project root (that's what HLS uses)
55+
argsCwd <-case argsCwd of
56+
Nothing -> IO.getCurrentDirectory
57+
Just root -> IO.setCurrentDirectory root >> IO.getCurrentDirectory
5458

5559
let logPriority = if argsVerbose then Debug else Info
5660
arguments = if argsTesting then Main.testing else Main.defaultArguments logPriority
5761

5862
Main.defaultMain arguments
59-
{Main.argCommand = argsCommand
63+
{ Main.argsProjectRoot = Just argsCwd
64+
, Main.argCommand = argsCommand
6065
,Main.argsLogger = Main.argsLogger arguments <> pure telemetryLogger
6166

6267
,Main.argsRules = do

‎ghcide/src/Development/IDE/Main.hs‎

Lines changed: 19 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,8 @@ module Development.IDE.Main
1111
,testing) where
1212
import Control.Concurrent.Extra (newLock, withLock,
1313
withNumCapabilities)
14-
import Control.Concurrent.STM.Stats (atomically, dumpSTMStats)
14+
import Control.Concurrent.STM.Stats (atomically,
15+
dumpSTMStats)
1516
import Control.Exception.Safe (Exception (displayException),
1617
catchAny)
1718
import Control.Monad.Extra (concatMapM, unless,
@@ -56,6 +57,7 @@ import Development.IDE.Core.Shake (IdeState (shakeExtras),
5657
import Development.IDE.Core.Tracing (measureMemory)
5758
import Development.IDE.Graph (action)
5859
import Development.IDE.LSP.LanguageServer (runLanguageServer)
60+
import Development.IDE.Main.HeapStats (withHeapStats)
5961
import Development.IDE.Plugin (Plugin (pluginHandlers, pluginModifyDynflags, pluginRules))
6062
import Development.IDE.Plugin.HLS (asGhcIdePlugin)
6163
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
@@ -77,12 +79,10 @@ import Development.IDE.Types.Options (IdeGhcSession,
7779
defaultIdeOptions,
7880
optModifyDynFlags,
7981
optTesting)
80-
import Development.IDE.Types.Shake (Key(Key),
81-
fromKeyType)
82+
import Development.IDE.Types.Shake (Key (Key), fromKeyType)
8283
import GHC.Conc (getNumProcessors)
8384
import GHC.IO.Encoding (setLocaleEncoding)
8485
import GHC.IO.Handle (hDuplicate)
85-
import Development.IDE.Main.HeapStats (withHeapStats)
8686
import HIE.Bios.Cradle (findCradle)
8787
import qualified HieDb.Run as HieDb
8888
import Ide.Plugin.Config (CheckParents (NeverCheck),
@@ -122,12 +122,12 @@ import Text.Printf (printf)
122122

123123
data Command
124124
= Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures
125-
| Db {projectRoot :: FilePath, hieOptions :: HieDb.Options, hieCommand :: HieDb.Command}
125+
| Db {hieOptions :: HieDb.Options, hieCommand :: HieDb.Command}
126126
-- ^ Run a command in the hiedb
127127
| LSP -- ^ Run the LSP server
128128
| PrintExtensionSchema
129129
| PrintDefaultConfig
130-
| Custom {projectRoot :: FilePath, ideCommand :: IdeCommand IdeState} -- ^ User defined
130+
| Custom {ideCommand :: IdeCommand IdeState} -- ^ User defined
131131
deriving Show
132132

133133

@@ -142,7 +142,7 @@ isLSP _ = False
142142
commandP :: IdePlugins IdeState -> Parser Command
143143
commandP plugins =
144144
hsubparser(command "typecheck" (info (Check <$> fileCmd) fileInfo)
145-
<> command "hiedb" (info (Db "." <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo)
145+
<> command "hiedb" (info (Db <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo)
146146
<> command "lsp" (info (pure LSP <**> helper) lspInfo)
147147
<> command "vscode-extension-schema" extensionSchemaCommand
148148
<> command "generate-default-config" generateDefaultConfigCommand
@@ -161,13 +161,14 @@ commandP plugins =
161161
(fullDesc <> progDesc "Print config supported by the server with default values")
162162

163163
pluginCommands = mconcat
164-
[ command (T.unpack pId) (Custom "." <$> p)
164+
[ command (T.unpack pId) (Custom <$> p)
165165
| (PluginId pId, PluginDescriptor{pluginCli = Just p}) <- ipMap plugins
166166
]
167167

168168

169169
data Arguments = Arguments
170-
{ argsOTMemoryProfiling :: Bool
170+
{ argsProjectRoot :: Maybe FilePath
171+
, argsOTMemoryProfiling :: Bool
171172
, argCommand :: Command
172173
, argsLogger :: IO Logger
173174
, argsRules :: Rules ()
@@ -189,7 +190,8 @@ instance Default Arguments where
189190

190191
defaultArguments :: Priority -> Arguments
191192
defaultArguments priority = Arguments
192-
{ argsOTMemoryProfiling = False
193+
{ argsProjectRoot = Nothing
194+
, argsOTMemoryProfiling = False
193195
, argCommand = LSP
194196
, argsLogger = stderrLogger priority
195197
, argsRules = mainRule def >> action kick
@@ -380,16 +382,18 @@ defaultMain Arguments{..} = flip withHeapStats fun =<< argsLogger
380382
measureMemory logger [keys] consoleObserver values
381383

382384
unless (null failed) (exitWith $ ExitFailure (length failed))
383-
Db dir opts cmd -> do
384-
dbLoc <- getHieDbLoc dir
385+
Db opts cmd -> do
386+
root <- maybe IO.getCurrentDirectory return argsProjectRoot
387+
dbLoc <- getHieDbLoc root
385388
hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc
386-
mlibdir <- setInitialDynFlags logger dir def
389+
mlibdir <- setInitialDynFlags logger root def
387390
case mlibdir of
388391
Nothing -> exitWith $ ExitFailure 1
389392
Just libdir -> HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd
390393

391-
Custom projectRoot (IdeCommand c) -> do
392-
dbLoc <- getHieDbLoc projectRoot
394+
Custom (IdeCommand c) -> do
395+
root <- maybe IO.getCurrentDirectory return argsProjectRoot
396+
dbLoc <- getHieDbLoc root
393397
runWithDb logger dbLoc $ \hiedb hieChan -> do
394398
vfs <- makeVFSHandle
395399
sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions "."

0 commit comments

Comments
 (0)