aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CabalHelper/Main.hs2
-rw-r--r--CabalHelper/Wrapper.hs32
-rw-r--r--Distribution/Helper.hs20
3 files changed, 34 insertions, 20 deletions
diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs
index 39cab5d..c0443e8 100644
--- a/CabalHelper/Main.hs
+++ b/CabalHelper/Main.hs
@@ -118,7 +118,7 @@ main :: IO ()
main = do
args <- getArgs
- distdir:args' <- case args of
+ projdir:distdir:args' <- case args of
[] -> usage >> exitFailure
_ -> return args
diff --git a/CabalHelper/Wrapper.hs b/CabalHelper/Wrapper.hs
index ef20a2e..a4c058b 100644
--- a/CabalHelper/Wrapper.hs
+++ b/CabalHelper/Wrapper.hs
@@ -46,6 +46,7 @@ import Paths_cabal_helper (version)
import CabalHelper.Data
import CabalHelper.Common
import CabalHelper.GuessGhc
+import CabalHelper.Sandbox (getSandboxPkgDb)
usage :: IO ()
usage = do
@@ -59,7 +60,7 @@ usage = do
\ [--with-ghc=GHC_PATH]\n\
\ [--with-ghc-pkg=GHC_PKG_PATH]\n\
\ [--with-cabal=CABAL_PATH]\n\
-\ DIST_DIR ( print-exe | [CABAL_HELPER_ARGS...] ) )\n"
+\ PROJ_DIR DIST_DIR ( print-exe | [CABAL_HELPER_ARGS...] ) )\n"
data Options = Options {
verbose :: Bool
@@ -122,7 +123,7 @@ main = handlePanic $ do
"version":[] -> putStrLn $ showVersion version
"print-appdatadir":[] -> putStrLn =<< appDataDir
"print-build-platform":[] -> putStrLn $ display buildPlatform
- distdir:args' -> do
+ projdir:distdir:args' -> do
cfgf <- canonicalizePath (distdir </> "setup-config")
mhdr <- getCabalConfigHeader cfgf
case mhdr of
@@ -131,7 +132,7 @@ main = handlePanic $ do
\- Check first line of: %s\n\
\- Maybe try: $ cabal configure" cfgf
Just (hdrCabalVersion, _) -> do
- eexe <- compileHelper opts hdrCabalVersion distdir
+ eexe <- compileHelper opts hdrCabalVersion projdir distdir
case eexe of
Left e -> exitWith e
Right exe ->
@@ -144,17 +145,18 @@ main = handlePanic $ do
appDataDir :: IO FilePath
appDataDir = (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"
-compileHelper :: Options -> Version -> FilePath -> IO (Either ExitCode FilePath)
-compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do
+compileHelper :: Options -> Version -> FilePath -> FilePath -> IO (Either ExitCode FilePath)
+compileHelper opts cabalVer projdir distdir = withHelperSources $ \chdir -> do
run [ compileCabalSource chdir -- TODO: here ghc's caching fails and it always
-- recompiles, probably because we write the
-- sources to a tempdir and they always look
-- newer than the Cabal sources, not sure if we
-- can fix this
, Right <$> MaybeT (cachedExe cabalVer)
+ , compileSandbox chdir
, compileGlobal chdir
, cachedCabalPkg chdir
- , MaybeT (Just <$> compileSandbox chdir)
+ , MaybeT (Just <$> compilePrivatePkgDb chdir)
]
where
@@ -175,6 +177,15 @@ compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do
vLog opts $ logMsg ++ "user/global package-db"
liftIO $ compileWithPkg chdir Nothing ver
+ -- | Check if this version is available in the project sandbox
+ compileSandbox :: FilePath -> MaybeT IO (Either ExitCode FilePath)
+ compileSandbox chdir = do
+ sandbox <- MaybeT $ getSandboxPkgDb projdir (display buildPlatform) =<< ghcVersion opts
+ ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions' opts (Just sandbox)
+ vLog opts $ logMsg ++ "sandbox package-db"
+ liftIO $ compileWithPkg chdir (Just sandbox) ver
+
+
-- | Check if we already compiled this version of cabal into a private
-- package-db
cachedCabalPkg :: FilePath -> MaybeT IO (Either ExitCode FilePath)
@@ -190,8 +201,7 @@ compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do
-- | See if we're in a cabal source tree
compileCabalSource :: FilePath -> MaybeT IO (Either ExitCode FilePath)
compileCabalSource chdir = do
- let couldBeSrcDir = takeDirectory distdir
- cabalFile = couldBeSrcDir </> "Cabal.cabal"
+ let cabalFile = projdir </> "Cabal.cabal"
isCabalMagicVer = cabalVer == Version [1,9999] []
cabalSrc <- liftIO $ doesFileExist cabalFile
@@ -206,11 +216,11 @@ compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do
True -> liftIO $ do
ver <- cabalFileVersion <$> readFile cabalFile
vLog opts $ "compiling helper with local Cabal source tree"
- compileWithCabalTree chdir ver couldBeSrcDir
+ compileWithCabalTree chdir ver projdir
-- | Compile the requested cabal version into an isolated package-db
- compileSandbox :: FilePath -> IO (Either ExitCode FilePath)
- compileSandbox chdir = do
+ compilePrivatePkgDb :: FilePath -> IO (Either ExitCode FilePath)
+ compilePrivatePkgDb chdir = do
db <- installCabal opts cabalVer `E.catch`
\(SomeException _) -> errorInstallCabal cabalVer distdir
compileWithPkg chdir (Just db) cabalVer
diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs
index f591b28..05f5b3c 100644
--- a/Distribution/Helper.hs
+++ b/Distribution/Helper.hs
@@ -106,31 +106,35 @@ data SomeLocalBuildInfo = SomeLocalBuildInfo {
-- as reading in Cabal's @LocalBuildInfo@ datatype from disk is very slow but
-- running all possible queries against it at once is cheap.
newtype Query m a = Query { unQuery :: StateT (Maybe SomeLocalBuildInfo)
- (ReaderT (Programs, FilePath) m) a }
+ (ReaderT (Programs, FilePath, FilePath) m) a }
deriving (Functor, Applicative, Monad, MonadIO)
type MonadQuery m = ( MonadIO m
, MonadState (Maybe SomeLocalBuildInfo) m
- , MonadReader (Programs, FilePath) m)
+ , MonadReader (Programs, FilePath, FilePath) m)
run :: Monad m
- => (Programs, FilePath) -> Maybe SomeLocalBuildInfo -> Query m a -> m a
+ => (Programs, FilePath, FilePath) -> Maybe SomeLocalBuildInfo -> Query m a -> m a
run r s action = flip runReaderT r (flip evalStateT s (unQuery action))
-- | @runQuery query distdir@. Run a 'Query'. @distdir@ is where Cabal's
-- @setup-config@ file is located.
runQuery :: Monad m
- => FilePath -- ^ Path to @dist/@
+ => FilePath -- ^ Path to project directory, i.e. the one containing the
+ -- @project.cabal@ file
+ -> FilePath -- ^ Path to @dist/@
-> Query m a
-> m a
-runQuery fp action = run (def, fp) Nothing action
+runQuery pd dd action = run (def, pd, dd) Nothing action
runQuery' :: Monad m
=> Programs
+ -> FilePath -- ^ Path to project directory, i.e. the one containing the
+ -- @project.cabal@ file
-> FilePath -- ^ Path to @dist/@
-> Query m a
-> m a
-runQuery' progs fp action = run (progs, fp) Nothing action
+runQuery' progs pd dd action = run (progs, pd, dd) Nothing action
getSlbi :: MonadQuery m => m SomeLocalBuildInfo
getSlbi = do
@@ -196,7 +200,7 @@ reconfigure progs cabalOpts = do
return ()
getSomeConfigState :: MonadQuery m => m SomeLocalBuildInfo
-getSomeConfigState = ask >>= \(progs, distdir) -> do
+getSomeConfigState = ask >>= \(progs, projdir, distdir) -> do
let progArgs = [ "--with-ghc=" ++ ghcProgram progs
, "--with-ghc-pkg=" ++ ghcPkgProgram progs
, "--with-cabal=" ++ cabalProgram progs
@@ -214,7 +218,7 @@ getSomeConfigState = ask >>= \(progs, distdir) -> do
res <- liftIO $ do
exe <- findLibexecExe "cabal-helper-wrapper"
- out <- readProcess exe (distdir:args) ""
+ out <- readProcess exe (projdir:distdir:args) ""
evaluate (read out) `E.catch` \(SomeException _) ->
error $ concat ["getSomeConfigState", ": ", exe, " "
, intercalate " " (map show $ distdir:args)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-01 06:28:54 +0000