diff options
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/ghci/GHCi/Message.hs | 3 | ||||
| -rw-r--r-- | libraries/ghci/GHCi/TH.hs | 1 | ||||
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 25 | ||||
| -rw-r--r-- | libraries/template-haskell/template-haskell.cabal.in | 1 |
4 files changed, 30 insertions, 0 deletions
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs index d5f8e84520..6b23f913cb 100644 --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -259,6 +259,7 @@ data THMessage a where ReifyModule :: TH.Module -> THMessage (THResult TH.ModuleInfo) ReifyConStrictness :: TH.Name -> THMessage (THResult [TH.DecidedStrictness]) + GetPackageRoot :: THMessage (THResult FilePath) AddDependentFile :: FilePath -> THMessage (THResult ()) AddTempFile :: String -> THMessage (THResult FilePath) AddModFinalizer :: RemoteRef (TH.Q ()) -> THMessage (THResult ()) @@ -311,6 +312,7 @@ getTHMessage = do 22 -> THMsg <$> ReifyType <$> get 23 -> THMsg <$> (PutDoc <$> get <*> get) 24 -> THMsg <$> GetDoc <$> get + 25 -> THMsg <$> return GetPackageRoot n -> error ("getTHMessage: unknown message " ++ show n) putTHMessage :: THMessage a -> Put @@ -340,6 +342,7 @@ putTHMessage m = case m of ReifyType a -> putWord8 22 >> put a PutDoc l s -> putWord8 23 >> put l >> put s GetDoc l -> putWord8 24 >> put l + GetPackageRoot -> putWord8 25 data EvalOpts = EvalOpts diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs index f2325db1e1..723e966095 100644 --- a/libraries/ghci/GHCi/TH.hs +++ b/libraries/ghci/GHCi/TH.hs @@ -194,6 +194,7 @@ instance TH.Quasi GHCiQ where qReifyModule m = ghcCmd (ReifyModule m) qReifyConStrictness name = ghcCmd (ReifyConStrictness name) qLocation = fromMaybe noLoc . qsLocation <$> getState + qGetPackageRoot = ghcCmd GetPackageRoot qAddDependentFile file = ghcCmd (AddDependentFile file) qAddTempFile suffix = ghcCmd (AddTempFile suffix) qAddTopDecls decls = ghcCmd (AddTopDecls decls) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index fd03edb872..f30bb0ef87 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -31,6 +31,7 @@ module Language.Haskell.TH.Syntax import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) +import System.FilePath import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) @@ -103,6 +104,7 @@ class (MonadIO m, MonadFail m) => Quasi m where qRunIO :: IO a -> m a qRunIO = liftIO -- ^ Input/output (dangerous) + qGetPackageRoot :: m FilePath qAddDependentFile :: FilePath -> m () @@ -154,6 +156,7 @@ instance Quasi IO where qReifyConStrictness _ = badIO "reifyConStrictness" qLocation = badIO "currentLocation" qRecover _ _ = badIO "recover" -- Maybe we could fix this? + qGetPackageRoot = badIO "getProjectRoot" qAddDependentFile _ = badIO "addDependentFile" qAddTempFile _ = badIO "addTempFile" qAddTopDecls _ = badIO "addTopDecls" @@ -708,6 +711,27 @@ location = Q qLocation runIO :: IO a -> Q a runIO m = Q (qRunIO m) +-- | Get the package root for the current package which is being compiled. +-- This can be set explicitly with the -package-root flag but is normally +-- just the current working directory. +-- +-- The motivation for this flag is to provide a principled means to remove the +-- assumption from splices that they will be executed in the directory where the +-- cabal file resides. Projects such as haskell-language-server can't and don't +-- change directory when compiling files but instead set the -package-root flag +-- appropiately. +getPackageRoot :: Q FilePath +getPackageRoot = Q qGetPackageRoot + +-- | The input is a filepath, which if relative is offset by the package root. +makeRelativeToProject :: FilePath -> Q FilePath +makeRelativeToProject fp | isRelative fp = do + root <- getPackageRoot + return (root </> fp) +makeRelativeToProject fp = return fp + + + -- | Record external files that runIO is using (dependent upon). -- The compiler can then recognize that it should re-compile the Haskell file -- when an external file changes. @@ -858,6 +882,7 @@ instance Quasi Q where qReifyConStrictness = reifyConStrictness qLookupName = lookupName qLocation = location + qGetPackageRoot = getPackageRoot qAddDependentFile = addDependentFile qAddTempFile = addTempFile qAddTopDecls = addTopDecls diff --git a/libraries/template-haskell/template-haskell.cabal.in b/libraries/template-haskell/template-haskell.cabal.in index 963e547a58..097e5bae24 100644 --- a/libraries/template-haskell/template-haskell.cabal.in +++ b/libraries/template-haskell/template-haskell.cabal.in @@ -58,6 +58,7 @@ Library base >= 4.11 && < 4.17, ghc-boot-th == @ProjectVersionMunged@, ghc-prim, + filepath, pretty == 1.1.* ghc-options: -Wall |