diff options
Diffstat (limited to 'src/CabalHelper/Compiletime/Program')
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/CabalInstall.hs | 107 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/GHC.hs | 65 |
2 files changed, 125 insertions, 47 deletions
diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs index afc3f1a..49bc7f2 100644 --- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs +++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs @@ -25,7 +25,6 @@ License : GPL-3 module CabalHelper.Compiletime.Program.CabalInstall where import qualified Cabal.Plan as CP -import Control.Arrow import Control.Monad import Data.Coerce import Data.Either @@ -33,6 +32,7 @@ import Data.Maybe import Data.Version import System.IO import System.IO.Temp +import System.Directory import System.Environment import System.FilePath import Text.Printf @@ -45,9 +45,9 @@ import qualified Data.Text as Text import qualified CabalHelper.Compiletime.Cabal as Cabal import CabalHelper.Compiletime.Types import CabalHelper.Compiletime.Program.GHC - ( ghcVersion, createPkgDb ) + ( GhcVersion(..), createPkgDb ) import CabalHelper.Compiletime.Cabal - ( CabalSourceDir(..), CabalVersion(..), unpackCabalHEAD, unpackPatchedCabal ) + ( CabalSourceDir(..), UnpackedCabalVersion, CabalVersion'(..), unpackCabalV1 ) import CabalHelper.Compiletime.Process import CabalHelper.Shared.Common ( parseVer, trim, appCacheDir, panicIO ) @@ -61,10 +61,11 @@ cabalInstallVersion = do CabalInstallVersion . parseVer . trim <$> readProcess' (cabalProgram ?progs) ["--numeric-version"] "" -installCabalLib :: Env => Either HEAD Version -> IO (PackageDbDir, CabalVersion) -installCabalLib ever = do +installCabalLibV1 :: Env => GhcVersion -> UnpackedCabalVersion -> IO PackageDbDir +installCabalLibV1 ghcVer cabalVer = do appdir <- appCacheDir - let message ver = do + let message (CabalHEAD {}) = return () + message (CabalVersion ver) = do let sver = showVersion ver hPutStr stderr $ printf "\ \cabal-helper: Installing a private copy of Cabal because we couldn't\n\ @@ -79,23 +80,29 @@ installCabalLib ever = do \ $ cabal install Cabal --constraint \"Cabal == %s\"\n\ \\n\ \Installing Cabal %s ...\n" appdir sver sver sver - withSystemTempDirectory "cabal-helper-Cabal-source" $ \tmpdir -> do - (srcdir, cabalVer) <- case ever of - Left HEAD -> do - second CabalHEAD <$> unpackCabalHEAD tmpdir - Right ver -> do - message ver - (,) <$> unpackPatchedCabal ver tmpdir <*> pure (CabalVersion ver) + withSystemTempDirectory "cabal-helper.install-cabal-tmp" $ \tmpdir -> do + message cabalVer + srcdir <- unpackCabalV1 cabalVer tmpdir db <- createPkgDb cabalVer - callCabalInstall db srcdir ever + callCabalInstall db srcdir ghcVer cabalVer - return (db, cabalVer) + return db callCabalInstall - :: Env => PackageDbDir -> CabalSourceDir -> Either HEAD Version-> IO () -callCabalInstall (PackageDbDir db) (CabalSourceDir srcdir) ever = do + :: Env + => PackageDbDir + -> CabalSourceDir + -> GhcVersion + -> UnpackedCabalVersion + -> IO () +callCabalInstall + (PackageDbDir db) + (CabalSourceDir srcdir) + ghcVer + unpackedCabalVer + = do civ@CabalInstallVersion {..} <- cabalInstallVersion cabal_opts <- return $ concat [ @@ -117,30 +124,34 @@ callCabalInstall (PackageDbDir db) (CabalSourceDir srcdir) ever = do callProcessStderr (Just "/") (cabalProgram ?progs) cabal_opts - runSetupHs db srcdir ever civ + runSetupHs ghcVer db srcdir unpackedCabalVer civ hPutStrLn stderr "done" runSetupHs :: Env - => FilePath + => GhcVersion + -> FilePath -> FilePath - -> Either HEAD Version + -> UnpackedCabalVersion -> CabalInstallVersion -> IO () -runSetupHs db srcdir ever CabalInstallVersion {..} +runSetupHs ghcVer db srcdir iCabalVer CabalInstallVersion {..} | cabalInstallVer >= parseVer "1.24" = do go $ \args -> callProcessStderr (Just srcdir) (cabalProgram ?progs) $ [ "act-as-setup", "--" ] ++ args | otherwise = do - SetupProgram {..} <- compileSetupHs db srcdir + SetupProgram {..} <- compileSetupHs ghcVer db srcdir go $ callProcessStderr (Just srcdir) setupProgram where parmake_opt :: Maybe Int -> [String] parmake_opt nproc' - | Left _ <- ever = ["-j"++nproc] - | Right ver <- ever, ver >= Version [1,20] [] = ["-j"++nproc] - | otherwise = [] + | CabalHEAD _ <- iCabalVer = + ["-j"++nproc] + | CabalVersion ver <- iCabalVer, ver >= Version [1,20] [] = + ["-j"++nproc] + | otherwise = + [] where nproc = fromMaybe "" $ show <$> nproc' go :: ([String] -> IO ()) -> IO () @@ -153,12 +164,11 @@ runSetupHs db srcdir ever CabalInstallVersion {..} run [ "register" ] newtype SetupProgram = SetupProgram { setupProgram :: FilePath } -compileSetupHs :: Env => FilePath -> FilePath -> IO SetupProgram -compileSetupHs db srcdir = do - ver <- ghcVersion +compileSetupHs :: Env => GhcVersion -> FilePath -> FilePath -> IO SetupProgram +compileSetupHs (GhcVersion ghcVer) db srcdir = do let no_version_macros - | ver >= Version [8] [] = [ "-fno-version-macros" ] - | otherwise = [] + | ghcVer >= Version [8] [] = [ "-fno-version-macros" ] + | otherwise = [] file = srcdir </> "Setup" @@ -183,6 +193,43 @@ cabalWithGHCProgOpts = concat else [] ] +installCabalLibV2 :: Env => GhcVersion -> UnpackedCabalVersion -> PackageEnvFile -> IO () +installCabalLibV2 _ (CabalHEAD _) _ = error "TODO: `installCabalLibV2 _ CabalHEAD _` is unimplemented" +installCabalLibV2 _ghcVer (CabalVersion cabalVer) (PackageEnvFile env_file) = do + exists <- doesFileExist env_file + if exists + then return () + else do + CabalInstallVersion {..} <- cabalInstallVersion + cabal_opts <- return $ concat + [ if cabalInstallVer >= Version [1,20] [] + then ["--no-require-sandbox"] + else [] + , [ if cabalInstallVer >= Version [2,4] [] + then "v2-install" + else "new-install" + ] + , cabalV2WithGHCProgOpts + , [ "--package-env=" ++ env_file + , "--lib" + , "Cabal-"++showVersion cabalVer + ] + , if ?verbose + then ["-v"] + else [] + ] + tmp <- getTemporaryDirectory + callProcessStderr (Just tmp) (cabalProgram ?progs) cabal_opts + hPutStrLn stderr "done" + +cabalV2WithGHCProgOpts :: Progs => [String] +cabalV2WithGHCProgOpts = concat + [ [ "--with-compiler=" ++ ghcProgram ?cprogs ] + , if ghcPkgProgram ?cprogs /= ghcPkgProgram defaultCompPrograms + then error "cabalV2WithGHCProgOpts: ghc-pkg path was changed from default but cabal v2-install does not support passing --with-ghc-pkg!" + else [] + ] + planUnits :: CP.PlanJson -> IO [Unit 'V2] planUnits plan = do units <- fmap catMaybes $ mapM takeunit $ Map.elems $ CP.pjUnits plan diff --git a/src/CabalHelper/Compiletime/Program/GHC.hs b/src/CabalHelper/Compiletime/Program/GHC.hs index 8c77f62..4565a37 100644 --- a/src/CabalHelper/Compiletime/Program/GHC.hs +++ b/src/CabalHelper/Compiletime/Program/GHC.hs @@ -38,24 +38,35 @@ import CabalHelper.Shared.Common (parseVer, trim, appCacheDir, parsePkgId) import CabalHelper.Compiletime.Types import CabalHelper.Compiletime.Cabal - (CabalVersion(..), showCabalVersion) + ( ResolvedCabalVersion, showResolvedCabalVersion, UnpackedCabalVersion + , unpackedToResolvedCabalVersion, CabalVersion'(..) ) import CabalHelper.Compiletime.Process import CabalHelper.Compiletime.Log +data GhcPackageSource + = GPSAmbient + | GPSPackageDBs ![PackageDbDir] + | GPSPackageEnv !PackageEnvFile + data GhcInvocation = GhcInvocation { giOutDir :: FilePath , giOutput :: FilePath , giCPPOptions :: [String] - , giPackageDBs :: [PackageDbDir] , giIncludeDirs :: [FilePath] , giHideAllPackages :: Bool , giPackages :: [String] , giWarningFlags :: [String] , giInputs :: [String] + , giPackageSource :: !GhcPackageSource } -ghcVersion :: (Verbose, CProgs) => IO Version -ghcVersion = +newtype GhcVersion = GhcVersion { unGhcVersion :: Version } + +showGhcVersion :: GhcVersion -> String +showGhcVersion (GhcVersion v) = showVersion v + +ghcVersion :: (Verbose, CProgs) => IO GhcVersion +ghcVersion = GhcVersion . parseVer . trim <$> readProcess' (ghcProgram ?cprogs) ["--numeric-version"] "" ghcPkgVersion :: (Verbose, CProgs) => IO Version @@ -63,23 +74,33 @@ ghcPkgVersion = parseVer . trim . dropWhile (not . isDigit) <$> readProcess' (ghcPkgProgram ?cprogs) ["--version"] "" -createPkgDb :: (Verbose, CProgs) => CabalVersion -> IO PackageDbDir +createPkgDb :: (Verbose, CProgs) => UnpackedCabalVersion -> IO PackageDbDir createPkgDb cabalVer = do - db@(PackageDbDir db_path) <- getPrivateCabalPkgDb cabalVer + db@(PackageDbDir db_path) + <- getPrivateCabalPkgDb $ unpackedToResolvedCabalVersion cabalVer exists <- doesDirectoryExist db_path when (not exists) $ callProcessStderr Nothing (ghcPkgProgram ?cprogs) ["init", db_path] return db -getPrivateCabalPkgDb :: (Verbose, CProgs) => CabalVersion -> IO PackageDbDir +getPrivateCabalPkgDb :: (Verbose, CProgs) => ResolvedCabalVersion -> IO PackageDbDir getPrivateCabalPkgDb cabalVer = do appdir <- appCacheDir ghcVer <- ghcVersion let db_path = - appdir </> "ghc-" ++ showVersion ghcVer ++ ".package-db" - </> "Cabal-" ++ showCabalVersion cabalVer + appdir </> "ghc-" ++ showGhcVersion ghcVer ++ ".package-dbs" + </> "Cabal-" ++ showResolvedCabalVersion cabalVer return $ PackageDbDir db_path +getPrivateCabalPkgEnv + :: Verbose => GhcVersion -> Version -> IO PackageEnvFile +getPrivateCabalPkgEnv ghcVer cabalVer = do + appdir <- appCacheDir + let env_path = + appdir </> "ghc-" ++ showGhcVersion ghcVer ++ ".package-envs" + </> "Cabal-" ++ showVersion cabalVer ++ ".package-env" + return $ PackageEnvFile env_path + listCabalVersions :: (Verbose, Progs) => Maybe PackageDbDir -> MaybeT IO [Version] listCabalVersions mdb = do @@ -95,14 +116,21 @@ listCabalVersions mdb = do _ -> mzero cabalVersionExistsInPkgDb - :: (Verbose, Progs) => Version -> PackageDbDir -> IO Bool + :: (Verbose, Progs) => CabalVersion' a -> PackageDbDir -> IO Bool cabalVersionExistsInPkgDb cabalVer db@(PackageDbDir db_path) = do - exists <- doesDirectoryExist db_path - case exists of - False -> return False - True -> fromMaybe False <$> runMaybeT (do - vers <- listCabalVersions (Just db) - return $ cabalVer `elem` vers) + fromMaybe False <$> runMaybeT (do + vers <- listCabalVersions (Just db) + return $ + case (cabalVer, vers) of + (CabalVersion ver, _) -> ver `elem` vers + (CabalHEAD _, [_headver]) -> True + (CabalHEAD _, _) -> + error $ msg ++ db_path) + where + msg = "\ +\Multiple Cabal versions in a HEAD package-db!\n\ +\This shouldn't happen. However you can manually delete the following\n\ +\directory to resolve this:\n " invokeGhc :: Env => GhcInvocation -> IO (Either ExitCode FilePath) invokeGhc GhcInvocation {..} = do @@ -111,7 +139,10 @@ invokeGhc GhcInvocation {..} = do , "-o", giOutput ] , map ("-optP"++) giCPPOptions - , map ("-package-conf="++) $ unPackageDbDir <$> giPackageDBs + , case giPackageSource of + GPSAmbient -> [] + GPSPackageDBs dbs -> map ("-package-conf="++) $ unPackageDbDir <$> dbs + GPSPackageEnv env -> [ "-package-env=" ++ unPackageEnvFile env ] , map ("-i"++) $ nub $ "" : giIncludeDirs , if giHideAllPackages then ["-hide-all-packages"] else [] , concatMap (\p -> ["-package", p]) giPackages |