diff options
| -rw-r--r-- | cabal-helper.cabal | 1 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Cabal.hs | 69 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Compile.hs | 34 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/CabalInstall.hs | 22 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/GHC.hs | 4 |
5 files changed, 93 insertions, 37 deletions
diff --git a/cabal-helper.cabal b/cabal-helper.cabal index 9c8e995..ff393d6 100644 --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -115,6 +115,7 @@ common build-deps , text < 1.3 && >= 1.0.0.0 , template-haskell < 2.15 && >= 2.7.0.0 , temporary < 1.3 && >= 1.2.1 + , time < 1.9 && >= 1.5.0.1 , transformers < 0.6 && >= 0.3.0.0 if !os(windows) build-depends: unix < 2.8 && >= 2.5.1.1 diff --git a/src/CabalHelper/Compiletime/Cabal.hs b/src/CabalHelper/Compiletime/Cabal.hs index 6477b85..d1c6c1d 100644 --- a/src/CabalHelper/Compiletime/Cabal.hs +++ b/src/CabalHelper/Compiletime/Cabal.hs @@ -20,23 +20,27 @@ Description : Cabal library source unpacking License : GPL-3 -} -{-# LANGUAGE DeriveFunctor, CPP #-} +{-# LANGUAGE DeriveFunctor, ViewPatterns, CPP #-} module CabalHelper.Compiletime.Cabal where -import Control.Exception (bracket) -import Control.Monad.IO.Class import Data.Char import Data.List import Data.Maybe +import Data.Time.Calendar +import Data.Time.Clock +import Data.Time.Clock.POSIX import Data.Version -import System.Exit import System.Directory +import System.Exit import System.FilePath +import Text.Printf + + import CabalHelper.Compiletime.Types import CabalHelper.Compiletime.Process -import CabalHelper.Shared.Common (trim, replace, parseVer) +import CabalHelper.Shared.Common (replace, parseVer, parseVerMay) type UnpackedCabalVersion = CabalVersion' (CommitId, CabalSourceDir) type ResolvedCabalVersion = CabalVersion' CommitId @@ -182,17 +186,50 @@ unpackCabalHEAD :: Env => FilePath -> IO (CommitId, CabalSourceDir) unpackCabalHEAD tmpdir = do let dir = tmpdir </> "cabal-head.git" url = "https://github.com/haskell/cabal.git" - ExitSuccess <- rawSystem "git" [ "clone", "--depth=1", url, dir] - commit <- - withDirectory_ dir $ trim <$> readProcess' "git" ["rev-parse", "HEAD"] "" - return (CommitId commit, CabalSourceDir $ dir </> "Cabal") - where - withDirectory_ :: FilePath -> IO a -> IO a - withDirectory_ dir action = - bracket - (liftIO getCurrentDirectory) - (liftIO . setCurrentDirectory) - (\_ -> liftIO (setCurrentDirectory dir) >> action) + callProcessStderr (Just "/") "git" [ "clone", "--depth=1", url, dir] + callProcessStderr (Just (dir </> "Cabal")) "cabal" + [ "act-as-setup", "--", "sdist" + , "--output-directory=" ++ tmpdir </> "Cabal" ] + commit <- takeWhile isHexDigit <$> + readCreateProcess (proc "git" ["rev-parse", "HEAD"]){ cwd = Just dir } "" + ts <- + readCreateProcess (proc "git" [ "show", "-s", "--format=%ct", "HEAD" ]) + { cwd = Just dir } "" + let ut = posixSecondsToUTCTime $ fromInteger (read ts) + (y,m,d) = toGregorian $ utctDay ut + sec = round $ utctDayTime ut + datecode = read $ show y ++ show m ++ show d ++ printf "%5d\n" sec + sec :: Int; datecode :: Int + let cabal_file = tmpdir </> "Cabal/Cabal.cabal" + cf0 <- readFile cabal_file + let Just cf1 = replaceVersionDecl (setVersion datecode) cf0 + writeFile (cabal_file<.>"tmp") cf1 + renameFile (cabal_file<.>"tmp") cabal_file + return (CommitId commit, CabalSourceDir $ tmpdir </> "Cabal") + where + -- If the released version of cabal has 4 components but we use only three + -- theirs will always be larger than this one here. That's not really + -- critical though. + setVersion i (versionBranch -> mj:mi:_:_:[]) + | odd mi = Just $ makeVersion $ mj:mi:[i] + setVersion _ _ = error "unpackCabalHEAD.setVersion: Wrong version format" + +-- | Replace the version declaration in a cabal file +replaceVersionDecl :: (Version -> Maybe Version) -> String -> Maybe String +replaceVersionDecl ver_fn cf = let + Just (before_ver,m) = find (\(_i,t) -> "version:" `isPrefixOf` t) $ splits cf + Just (ver_decl,after_ver) + = find (\s -> case s of (_i,'\n':x:_) -> not $ isSpace x; _ -> False) + $ filter (\(_i,t) -> "\n" `isPrefixOf` t) + $ splits m + Just vers0 = dropWhile isSpace <$> stripPrefix "version:" ver_decl + (vers1,rest) = span (\c -> isDigit c || c == '.') vers0 + Just verp | all isSpace rest = parseVerMay $ vers1 in do + new_ver <- ver_fn verp + return $ concat + [ before_ver, "version: ", showVersion new_ver, after_ver ] + where + splits xs = inits xs `zip` tails xs resolveCabalVersion :: Verbose => CabalVersion -> IO ResolvedCabalVersion resolveCabalVersion (CabalVersion ver) = return $ CabalVersion ver diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs index f379081..bff9b7e 100644 --- a/src/CabalHelper/Compiletime/Compile.hs +++ b/src/CabalHelper/Compiletime/Compile.hs @@ -118,8 +118,10 @@ compileHelper' CompHelperEnv {..} = do t0 <- Clock.getTime Clock.Monotonic ghcVer <- ghcVersion Just (prepare, comp) <- case cheCabalVer of - cabalVer@CabalHEAD {} -> do - Just <$> compileWithCabalInPrivatePkgDb' ghcVer cabalVer + cabalVer@CabalHEAD {} -> runMaybeT $ msum $ map (\f -> f ghcVer cabalVer) + [ compileWithCabalV2GhcEnv' + , compileWithCabalInPrivatePkgDb' + ] CabalVersion cabalVerPlain -> do runMaybeT $ msum $ map (\f -> f ghcVer cabalVerPlain) $ case chePkgDb of @@ -208,21 +210,31 @@ compileHelper' CompHelperEnv {..} = do vLog $ logMsg ++ "v2-build package-db " ++ inplace_db_path return $ (return (), compileWithPkg (GPSPackageDBs [inplace_db]) cabalVer CPSProject) + compileWithCabalV2GhcEnv :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile) + compileWithCabalV2GhcEnv ghcVer cabalVer = + compileWithCabalV2GhcEnv' ghcVer (CabalVersion cabalVer) + -- | If this is a v2-build project it makes sense to use @v2-install@ for -- installing Cabal as this will use the @~/.cabal/store@. We use -- @--package-env@ to instruct cabal to not meddle with the user's package -- environment. - compileWithCabalV2GhcEnv :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile) - compileWithCabalV2GhcEnv ghcVer cabalVer = do + compileWithCabalV2GhcEnv' :: Env => GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile) + compileWithCabalV2GhcEnv' ghcVer cabalVer = do _ <- maybe mzero pure cheDistV2 -- bail if this isn't a v2-build project CabalInstallVersion instVer <- liftIO cabalInstallVersion guard $ instVer >= (Version [2,4,1,0] []) -- ^ didn't test with older versions guard $ ghcVer >= (GhcVersion (Version [8,0] [])) - env@(PackageEnvFile env_file) - <- liftIO $ getPrivateCabalPkgEnv ghcVer cabalVer + env@(PackageEnvFile env_file) <- liftIO $ + getPrivateCabalPkgEnv ghcVer $ unpackedToResolvedCabalVersion cabalVer vLog $ logMsg ++ "v2-build package-env " ++ env_file - return $ (prepare env, compileWithPkg (GPSPackageEnv env) cabalVer CPSGlobal) + return $ (,) + (prepare env) + CompileWithCabalPackage + { compPackageSource = GPSPackageEnv env + , compCabalVersion = unpackedToResolvedCabalVersion cabalVer + , compProductTarget = CPSGlobal + } where prepare env = do -- exists_in_env <- liftIO $ cabalVersionExistsInPkgDb cheCabalVer db @@ -237,15 +249,15 @@ compileHelper' CompHelperEnv {..} = do compileWithCabalInPrivatePkgDb :: (Env, MonadIO m) => GhcVersion -> Version -> m (IO (), Compile) compileWithCabalInPrivatePkgDb ghcVer cabalVer = - liftIO $ compileWithCabalInPrivatePkgDb' ghcVer (CabalVersion cabalVer) + compileWithCabalInPrivatePkgDb' ghcVer (CabalVersion cabalVer) -- | Compile the requested Cabal version into an isolated package-db if it's -- not there already compileWithCabalInPrivatePkgDb' - :: Env => GhcVersion -> UnpackedCabalVersion -> IO (IO (), Compile) + :: (Env, MonadIO m) => GhcVersion -> UnpackedCabalVersion -> m (IO (), Compile) compileWithCabalInPrivatePkgDb' ghcVer cabalVer = do - db@(PackageDbDir db_path) - <- getPrivateCabalPkgDb $ unpackedToResolvedCabalVersion cabalVer + db@(PackageDbDir db_path) <- liftIO $ + getPrivateCabalPkgDb $ unpackedToResolvedCabalVersion cabalVer vLog $ logMsg ++ "private package-db in " ++ db_path return $ (,) (prepare db) diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs index f989a02..f6c0018 100644 --- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs +++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs @@ -138,7 +138,7 @@ runSetupHs -> UnpackedCabalVersion -> CabalInstallVersion -> IO () -runSetupHs ghcVer db srcdir iCabalVer CabalInstallVersion {..} +runSetupHs ghcVer db srcdir cabalVer CabalInstallVersion {..} | cabalInstallVer >= parseVer "1.24" = do go $ \args -> callProcessStderr (Just srcdir) (cabalProgram ?progs) $ [ "act-as-setup", "--" ] ++ args @@ -148,9 +148,9 @@ runSetupHs ghcVer db srcdir iCabalVer CabalInstallVersion {..} where parmake_opt :: Maybe Int -> [String] parmake_opt nproc' - | CabalHEAD _ <- iCabalVer = + | CabalHEAD _ <- cabalVer = ["-j"++nproc] - | CabalVersion ver <- iCabalVer, ver >= Version [1,20] [] = + | CabalVersion ver <- cabalVer, ver >= Version [1,20] [] = ["-j"++nproc] | otherwise = [] @@ -195,13 +195,19 @@ cabalWithGHCProgOpts = concat else [] ] +-- TODO: This needs the big message blub from above installCabalLibV2 :: Env => GhcVersion -> UnpackedCabalVersion -> PackageEnvFile -> IO () -installCabalLibV2 _ (CabalHEAD _) _ = error "TODO: `installCabalLibV2 _ CabalHEAD _` is unimplemented" -installCabalLibV2 _ghcVer (CabalVersion cabalVer) (PackageEnvFile env_file) = do +installCabalLibV2 _ghcVer cv (PackageEnvFile env_file) = do exists <- doesFileExist env_file if exists then return () else do + (target, cwd) <- case cv of + CabalVersion cabalVer -> do + tmp <- getTemporaryDirectory + return $ ("Cabal-"++showVersion cabalVer, tmp) + CabalHEAD (_commitid, CabalSourceDir srcdir) -> do + return (".", srcdir) CabalInstallVersion {..} <- cabalInstallVersion cabal_opts <- return $ concat [ if cabalInstallVer >= Version [1,20] [] @@ -214,16 +220,16 @@ installCabalLibV2 _ghcVer (CabalVersion cabalVer) (PackageEnvFile env_file) = do , cabalV2WithGHCProgOpts , [ "--package-env=" ++ env_file , "--lib" - , "Cabal-"++showVersion cabalVer + , target ] , if | ?verbose 3 -> ["-v2"] | ?verbose 4 -> ["-v3"] | otherwise -> [] ] - tmp <- getTemporaryDirectory - callProcessStderr (Just tmp) (cabalProgram ?progs) cabal_opts + callProcessStderr (Just cwd) (cabalProgram ?progs) cabal_opts hPutStrLn stderr "done" + cabalV2WithGHCProgOpts :: Progs => [String] cabalV2WithGHCProgOpts = concat [ [ "--with-compiler=" ++ ghcProgram ?cprogs ] diff --git a/src/CabalHelper/Compiletime/Program/GHC.hs b/src/CabalHelper/Compiletime/Program/GHC.hs index b58eab0..97b04ed 100644 --- a/src/CabalHelper/Compiletime/Program/GHC.hs +++ b/src/CabalHelper/Compiletime/Program/GHC.hs @@ -94,12 +94,12 @@ getPrivateCabalPkgDb cabalVer = do return $ PackageDbDir db_path getPrivateCabalPkgEnv - :: Verbose => GhcVersion -> Version -> IO PackageEnvFile + :: Verbose => GhcVersion -> ResolvedCabalVersion -> IO PackageEnvFile getPrivateCabalPkgEnv ghcVer cabalVer = do appdir <- appCacheDir let env_path = appdir </> "ghc-" ++ showGhcVersion ghcVer ++ ".package-envs" - </> "Cabal-" ++ showVersion cabalVer ++ ".package-env" + </> "Cabal-" ++ showResolvedCabalVersion cabalVer ++ ".package-env" return $ PackageEnvFile env_path listCabalVersions |