session-loader: Set working directory on GHC 9.4+

We set the working directory appropriately so that TH code can access it and read files relative to the root of the current component. Fixes #481
haskell · Dec 6, 2023 · 1f6f517 · 1f6f517
1 parent 6d6907a
commit 1f6f517
Show file tree

Hide file tree

Showing 8 changed files with 42 additions and 2 deletions.
diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs
@@ -1115,6 +1115,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
               Nothing -> compRoot
               Just wdir -> compRoot </> wdir
         let dflags''' =
+              setWorkingDirectory root $
               disableWarningsAsErrors $
               -- disabled, generated directly by ghcide instead
               flip gopt_unset Opt_WriteInterface $
@@ -1125,7 +1126,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
               setBytecodeLinkerOptions $
               disableOptimisation $
               Compat.setUpTypedHoles $
-              makeDynFlagsAbsolute compRoot
+              makeDynFlagsAbsolute root
               dflags''
         -- initPackages parses the -package flags and
         -- sets up the visibility for each component.

diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs
@@ -55,7 +55,8 @@ module Development.IDE.GHC.Compat.Env (
     setBackend,
     ghciBackend,
     Development.IDE.GHC.Compat.Env.platformDefaultBackend,
-    workingDirectory
+    workingDirectory,
+    setWorkingDirectory,
     ) where
 
 import           GHC                 (setInteractiveDynFlags)
@@ -91,6 +92,12 @@ hsc_EPS = Env.hsc_unit_env
 #if !MIN_VERSION_ghc(9,3,0)
 workingDirectory :: a -> Maybe b
 workingDirectory _ = Nothing
+
+setWorkingDirectory :: FilePath -> DynFlags -> DynFlags
+setWorkingDirectory = const id
+#else
+setWorkingDirectory :: FilePath -> DynFlags -> DynFlags
+setWorkingDirectory p d = d { workingDirectory =  Just p }
 #endif
 
 setHomeUnitId_ :: UnitId -> DynFlags -> DynFlags

diff --git a/ghcide/test/data/working-dir/a/A.hs b/ghcide/test/data/working-dir/a/A.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+module A(th_a) where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Control.Monad.IO.Class
+
+th_a :: DecsQ
+th_a = do
+  str <- makeRelativeToProject "wdtest" >>= liftIO . readFile
+  [d| a = $(lift str) |]
diff --git a/ghcide/test/data/working-dir/a/B.hs b/ghcide/test/data/working-dir/a/B.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+module B() where
+
+import A
+
+$th_a
diff --git a/ghcide/test/data/working-dir/a/a.cabal b/ghcide/test/data/working-dir/a/a.cabal
@@ -0,0 +1,11 @@
+name: a
+version: 1.0.0
+build-type: Simple
+cabal-version: >= 1.2
+extra-source-files: wdtest
+
+library
+  build-depends: base, template-haskell
+  exposed-modules: A B
+  ghc-options: -Wmissing-signatures
+  hs-source-dirs: .
diff --git a/ghcide/test/data/working-dir/a/wdtest b/ghcide/test/data/working-dir/a/wdtest
@@ -0,0 +1 @@
+test
diff --git a/ghcide/test/data/working-dir/cabal.project b/ghcide/test/data/working-dir/cabal.project
@@ -0,0 +1 @@
+packages: a
diff --git a/ghcide/test/data/working-dir/hie.yaml b/ghcide/test/data/working-dir/hie.yaml
@@ -0,0 +1,2 @@
+cradle:
+  cabal: