Alternate implementation of selecting Project Root

Author: drsooch

ghcide/exe/Main.hs

@@ -50,17 +50,14 @@ main = withTelemetryLogger $ \telemetryLogger -> do
     if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
     else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
 
-    -- getHieDbLoc takes a directory path (the project root) and hashes it to find the location of the hiedb
-    -- when running commands directly from GHCIDE we need to provide the ABSOLUTE path to the project root (that's what HLS uses)
-    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.argsProjectRoot = Just argsCwd
+        { Main.argsProjectRoot = case argsCwd of
+            Nothing   -> IO.getCurrentDirectory
+            -- if passed a directory we must set it
+            Just root -> IO.setCurrentDirectory root >> IO.getCurrentDirectory
         , Main.argCommand = argsCommand
         ,Main.argsLogger = Main.argsLogger arguments <> pure telemetryLogger
 

ghcide/src/Development/IDE/Main.hs

@@ -167,7 +167,7 @@ commandP plugins =
 
 
 data Arguments = Arguments
-    { argsProjectRoot           :: Maybe FilePath
+    { argsProjectRoot           :: IO FilePath
     , argsOTMemoryProfiling     :: Bool
     , argCommand                :: Command
     , argsLogger                :: IO Logger
@@ -190,7 +190,7 @@ instance Default Arguments where
 
 defaultArguments :: Priority -> Arguments
 defaultArguments priority = Arguments
-        { argsProjectRoot = Nothing
+        { argsProjectRoot = IO.getCurrentDirectory
         , argsOTMemoryProfiling = False
         , argCommand = LSP
         , argsLogger = stderrLogger priority
@@ -383,7 +383,7 @@ defaultMain Arguments{..} = flip withHeapStats fun =<< argsLogger
 
             unless (null failed) (exitWith $ ExitFailure (length failed))
         Db opts cmd -> do
-            root <-  maybe IO.getCurrentDirectory return argsProjectRoot
+            root <-  argsProjectRoot
             dbLoc <- getHieDbLoc root
             hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc
             mlibdir <- setInitialDynFlags logger root def
@@ -392,8 +392,7 @@ defaultMain Arguments{..} = flip withHeapStats fun =<< argsLogger
                 Just libdir -> HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd
 
         Custom (IdeCommand c) -> do
-          root <-  maybe IO.getCurrentDirectory return argsProjectRoot
-          dbLoc <- getHieDbLoc root
+          dbLoc <- argsProjectRoot >>= getHieDbLoc
           runWithDb logger dbLoc $ \hiedb hieChan -> do
             vfs <- makeVFSHandle
             sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions "."