aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/CabalHelper/Compiletime/Cabal.hs69
-rw-r--r--src/CabalHelper/Compiletime/Compile.hs34
-rw-r--r--src/CabalHelper/Compiletime/Program/CabalInstall.hs22
-rw-r--r--src/CabalHelper/Compiletime/Program/GHC.hs4
4 files changed, 92 insertions, 37 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-21 10:47:33 +0000