diff --git a/CabalHelper/Compile.hs b/CabalHelper/Compile.hs
--- a/CabalHelper/Compile.hs
+++ b/CabalHelper/Compile.hs
@@ -51,7 +51,7 @@
compCabalHelperSourceDir :: FilePath,
compCabalSourceDir :: Maybe FilePath,
compPackageDb :: Maybe FilePath,
- compCabalVersion :: Version,
+ compCabalVersion :: Either String Version,
compPackageDeps :: [String]
}
@@ -86,9 +86,6 @@
-- | Check if this version is globally available
compileGlobal :: FilePath -> MaybeT IO (Either ExitCode FilePath)
compileGlobal chdir = do
- -- TODO: add option to let user specify custom package-db, relevant when
- -- using a Cabal compiled from git!
-
ver <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts
vLog opts $ logMsg ++ "user/global package-db"
liftIO $ compileWithPkg chdir Nothing ver
@@ -111,7 +108,7 @@
case db_exists of
False -> mzero
True -> do
- db <- liftIO $ getPrivateCabalPkgDb opts cabalVer
+ db <- liftIO $ getPrivateCabalPkgDb opts (showVersion cabalVer)
vLog opts $ logMsg ++ "private package-db in " ++ db
liftIO $ compileWithPkg chdir (Just db) cabalVer
@@ -143,10 +140,10 @@
compileWithPkg chdir (Just db) cabalVer
compileWithCabalTree chdir ver srcDir =
- compile distdir opts $ Compile chdir (Just srcDir) Nothing ver []
+ compile distdir opts $ Compile chdir (Just srcDir) Nothing (Right ver) []
compileWithPkg chdir mdb ver =
- compile distdir opts $ Compile chdir Nothing mdb ver [cabalPkgId ver]
+ compile distdir opts $ Compile chdir Nothing mdb (Right ver) [cabalPkgId ver]
cabalPkgId v = "Cabal-" ++ showVersion v
@@ -167,7 +164,9 @@
vLog opts $ "outdir: " ++ outdir
vLog opts $ "exedir: " ++ exedir
- let Version (mj:mi:_) _ = compCabalVersion
+ let (mj:mi:_) = case compCabalVersion of
+ Left _commitid -> [1, 10000]
+ Right (Version vs _) -> vs
let ghc_opts =
concat [
[ "-outputdir", outdir
@@ -204,13 +203,16 @@
ExitSuccess -> Right exe
e@(ExitFailure _) -> Left e
-exePath :: Version -> IO FilePath
+exePath :: Either String Version -> IO FilePath
exePath compCabalVersion = do
exePath' compCabalVersion <$> appDataDir
-exePath' :: Version-> FilePath -> FilePath
-exePath' compCabalVersion outdir =
+exePath' :: Either String Version -> FilePath -> FilePath
+exePath' (Left commitid) outdir =
outdir "cabal-helper-" ++ showVersion version -- our ver
+ ++ "-Cabal-HEAD-" ++ commitid
+exePath' (Right compCabalVersion) outdir =
+ outdir "cabal-helper-" ++ showVersion version -- our ver
++ "-Cabal-" ++ showVersion compCabalVersion
callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode
@@ -255,12 +257,20 @@
mpatch :: Maybe (FilePath -> IO ())
mpatch = snd <$> find ((ver`elem`) . fst) patchyCabalVersions
msrcdir <- sequenceA $ unpackPatchedCabal opts ver tmpdir <$> mpatch
- db <- createPkgDb opts ver
- cabalInstall opts db ver msrcdir
+ db <- createPkgDb opts (showVersion ver)
+ cabalInstall opts db (maybe (Right ver) Left msrcdir)
return db
-cabalInstall :: Options -> FilePath -> Version -> Maybe FilePath -> IO ()
-cabalInstall opts db ver msrcdir = do
+installCabalHEAD :: Options -> IO (FilePath, String)
+installCabalHEAD opts = do
+ withSystemTempDirectory "cabal-helper" $ \tmpdir -> do
+ (srcdir, commit) <- unpackCabalHEAD tmpdir
+ db <- createPkgDb opts commit
+ cabalInstall opts db (Left srcdir)
+ return (db, commit)
+
+cabalInstall :: Options -> FilePath -> Either FilePath Version -> IO ()
+cabalInstall opts db e_ver_msrcdir = do
cabalInstallVer <- cabalInstallVersion opts
cabal_opts <- return $ concat
[
@@ -277,12 +287,12 @@
then [ "--with-ghc-pkg=" ++ ghcPkgProgram opts ]
else []
,
- case msrcdir of
- Nothing ->
+ case e_ver_msrcdir of
+ Right ver ->
[ "install", "Cabal"
, "--constraint", "Cabal == " ++ showVersion ver
]
- Just srcdir ->
+ Left srcdir ->
[ "install", srcdir ]
]
@@ -340,14 +350,26 @@
unpackPatchedCabal ::
Options -> Version -> FilePath -> (FilePath -> IO ()) -> IO FilePath
unpackPatchedCabal opts cabalVer tmpdir patch = do
+ dir <- unpackCabal opts cabalVer tmpdir
+ patch dir
+ return dir
+
+unpackCabal ::
+ Options -> Version -> FilePath -> IO FilePath
+unpackCabal opts cabalVer tmpdir = do
let cabal = "Cabal-" ++ showVersion cabalVer
dir = tmpdir cabal
-
callProcessStderr (Just tmpdir) (cabalProgram opts) [ "get", cabal ]
-
- patch dir
return dir
+unpackCabalHEAD :: FilePath -> IO (FilePath, String)
+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 <- trim <$> readProcess "git" ["-C", dir, "rev-parse", "HEAD"] ""
+ return (dir "Cabal", commit)
+
errorInstallCabal :: Version -> FilePath -> a
errorInstallCabal cabalVer _distdir = panic $ printf "\
\Installing Cabal version %s failed.\n\
@@ -385,7 +407,7 @@
cachedExe :: Version -> IO (Maybe FilePath)
cachedExe compCabalVersion = do
- exe <- exePath compCabalVersion
+ exe <- exePath (Right compCabalVersion)
exists <- doesFileExist exe
return $ if exists then Just exe else Nothing
@@ -403,7 +425,7 @@
cabalPkgDbExists :: Options -> Version -> IO Bool
cabalPkgDbExists opts ver = do
- db <- getPrivateCabalPkgDb opts ver
+ db <- getPrivateCabalPkgDb opts (showVersion ver)
dexists <- doesDirectoryExist db
case dexists of
False -> return False
@@ -427,18 +449,18 @@
trim :: String -> String
trim = dropWhileEnd isSpace
-createPkgDb :: Options -> Version -> IO FilePath
+createPkgDb :: Options -> String -> IO FilePath
createPkgDb opts@Options {..} ver = do
db <- getPrivateCabalPkgDb opts ver
exists <- doesDirectoryExist db
when (not exists) $ callProcessStderr Nothing ghcPkgProgram ["init", db]
return db
-getPrivateCabalPkgDb :: Options -> Version -> IO FilePath
+getPrivateCabalPkgDb :: Options -> String -> IO FilePath
getPrivateCabalPkgDb opts ver = do
appdir <- appDataDir
ghcVer <- ghcVersion opts
- return $ appdir "Cabal-" ++ showVersion ver ++ "-db-" ++ showVersion ghcVer
+ return $ appdir "Cabal-" ++ ver ++ "-db-" ++ showVersion ghcVer
-- | Find @version: XXX@ delcaration in a cabal file
cabalFileVersion :: String -> Version
diff --git a/CabalHelper/Licenses.hs b/CabalHelper/Licenses.hs
--- a/CabalHelper/Licenses.hs
+++ b/CabalHelper/Licenses.hs
@@ -23,9 +23,12 @@
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex
import Distribution.Text
+import Distribution.ModuleName
--------------------------------------------------------------------------------
-#if CABAL_MAJOR == 1 && CABAL_MINOR > 22
+
+
+#if CABAL_MAJOR == 1 && CABAL_MINOR > 22
type CPackageIndex a = PackageIndex (InstalledPackageInfo)
#elif CABAL_MAJOR == 1 && CABAL_MINOR >= 22
type CPackageIndex a = PackageIndex (InstalledPackageInfo_ a)
@@ -33,15 +36,20 @@
type CPackageIndex a = PackageIndex
#endif
-#if CABAL_MAJOR == 1 && CABAL_MINOR > 22
+#if CABAL_MAJOR == 1 && CABAL_MINOR >= 23
+type CInstalledPackageId = UnitId
+lookupInstalledPackageId' :: PackageIndex a -> UnitId -> Maybe a
+lookupInstalledPackageId' = lookupUnitId
+#elif CABAL_MAJOR == 1 && CABAL_MINOR > 22
type CInstalledPackageId = ComponentId
-lookupInstalledPackageId = lookupComponentId
+lookupInstalledPackageId' = lookupComponentId
#else
type CInstalledPackageId = InstalledPackageId
+lookupInstalledPackageId' = lookupInstalledPackageId
#endif
findTransitiveDependencies
- :: CPackageIndex a
+ :: CPackageIndex Distribution.ModuleName.ModuleName
-> Set CInstalledPackageId
-> Set CInstalledPackageId
findTransitiveDependencies pkgIdx set0 = go Set.empty (Set.toList set0)
@@ -50,7 +58,7 @@
go set (q : queue)
| q `Set.member` set = go set queue
| otherwise =
- case lookupInstalledPackageId pkgIdx q of
+ case lookupInstalledPackageId' pkgIdx q of
Nothing ->
-- Not found can mean that the package still needs to be
-- installed (e.g. a component of the target cabal package).
@@ -62,7 +70,7 @@
--------------------------------------------------------------------------------
getDependencyInstalledPackageIds
- :: LocalBuildInfo -> Set InstalledPackageId
+ :: LocalBuildInfo -> Set CInstalledPackageId
getDependencyInstalledPackageIds lbi =
findTransitiveDependencies (installedPkgs lbi) $
Set.fromList $ map fst $ externalPackageDeps lbi
@@ -71,7 +79,7 @@
getDependencyInstalledPackageInfos
:: LocalBuildInfo -> [InstalledPackageInfo]
getDependencyInstalledPackageInfos lbi = catMaybes $
- map (lookupInstalledPackageId pkgIdx) $
+ map (lookupInstalledPackageId' pkgIdx) $
Set.toList (getDependencyInstalledPackageIds lbi)
where
pkgIdx = installedPkgs lbi
@@ -82,16 +90,16 @@
:: [InstalledPackageInfo]
-> [(License, [InstalledPackageInfo])]
groupByLicense = foldl'
- (\assoc ipi -> insert (license ipi) ipi assoc) []
+ (\assoc ipi -> insertAList (license ipi) ipi assoc) []
where
-- 'Cabal.License' doesn't have an 'Ord' instance so we need to use an
-- association list instead of 'Map'. The number of licenses probably won't
-- exceed 100 so I think we're alright.
- insert :: Eq k => k -> v -> [(k, [v])] -> [(k, [v])]
- insert k v [] = [(k, [v])]
- insert k v ((k', vs) : kvs)
+ insertAList :: Eq k => k -> v -> [(k, [v])] -> [(k, [v])]
+ insertAList k v [] = [(k, [v])]
+ insertAList k v ((k', vs) : kvs)
| k == k' = (k, v : vs) : kvs
- | otherwise = (k', vs) : insert k v kvs
+ | otherwise = (k', vs) : insertAList k v kvs
--------------------------------------------------------------------------------
diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs
--- a/CabalHelper/Main.hs
+++ b/CabalHelper/Main.hs
@@ -14,7 +14,7 @@
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see .
-{-# LANGUAGE CPP, BangPatterns, RecordWildCards #-}
+{-# LANGUAGE CPP, BangPatterns, RecordWildCards, RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
import Distribution.Simple.Utils (cabalVersion)
import Distribution.Simple.Configure
@@ -48,10 +48,10 @@
externalPackageDeps,
withComponentsLBI,
withLibLBI)
-#if CABAL_MAJOR == 1 && CABAL_MINOR <= 22
+#if CABAL_MAJOR == 1 && CABAL_MINOR >= 23
+import Distribution.Simple.LocalBuildInfo (localUnitId)
+#elif CABAL_MAJOR == 1 && CABAL_MINOR <= 22
import Distribution.Simple.LocalBuildInfo (inplacePackageId)
-#else
-import Distribution.Simple.LocalBuildInfo (localComponentId)
#endif
import Distribution.Simple.GHC (componentGhcOptions)
@@ -204,8 +204,7 @@
return $ Just $ ChResponseFlags $ sort nonDefaultFlags
"write-autogen-files":[] -> do
- -- calls writeAutogenFiles
- initialBuildSteps distdir pd lbi v
+ initialBuildStepsForAllComponents distdir pd lbi v
return Nothing
"compiler-version":[] -> do
@@ -328,6 +327,8 @@
lr <- newIORef []
+ -- withComponentsLBI is deprecated but also exists in very old versions
+ -- it's equivalent to withAllComponentsInBuildOrder in newer versions
withComponentsLBI pd lbi $ \c clbi -> do
let bi = componentBuildInfo c
name = componentNameFromComponent c
@@ -354,12 +355,20 @@
componentOptions (lbi, v, distdir) inplaceFlag flags f =
componentOptions' (lbi, v, distdir) inplaceFlag flags renderGhcOptions' f
-componentNameToCh CLibName = ChLibName
+#if CABAL_MAJOR == 1 && CABAL_MINOR < 25
+componentNameToCh CLibName = ChLibName ""
+#elif CABAL_MAJOR == 1 && CABAL_MINOR >= 25
+componentNameToCh (CLibName n) = ChLibName n
+#endif
componentNameToCh (CExeName n) = ChExeName n
componentNameToCh (CTestName n) = ChTestName n
componentNameToCh (CBenchName n) = ChBenchName n
+#if CABAL_MAJOR == 1 && CABAL_MINOR < 25
componentNameFromComponent (CLib Library {}) = CLibName
+#elif CABAL_MAJOR == 1 && CABAL_MINOR >= 25
+componentNameFromComponent (CLib Library {..}) = CLibName libName
+#endif
componentNameFromComponent (CExe Executable {..}) = CExeName exeName
componentNameFromComponent (CTest TestSuite {..}) = CTestName testName
componentNameFromComponent (CBench Benchmark {..}) = CBenchName benchmarkName
@@ -413,7 +422,7 @@
liboutdir = componentOutDir lbi (CLib lib)
libopts = (componentGhcOptions normal lbi libbi libclbi liboutdir) {
ghcOptPackageDBs = []
-#if CABAL_MAJOR == 1 && CABAL_MINOR > 22
+#if CABAL_MAJOR == 1 && CABAL_MINOR > 22 && CABAL_MINOR < 23
, ghcOptComponentId = NoFlag
#endif
}
@@ -426,10 +435,11 @@
where
isInplaceDep :: (InstalledPackageId, PackageId) -> Bool
-#if CABAL_MAJOR == 1 && CABAL_MINOR <= 22
+#if CABAL_MAJOR == 1 && CABAL_MINOR >= 23
+ isInplaceDep (ipid, pid) = localUnitId lbi == ipid
+#elif CABAL_MAJOR == 1 && CABAL_MINOR <= 22
isInplaceDep (ipid, pid) = inplacePackageId pid == ipid
-#else
- isInplaceDep (ipid, pid) = localComponentId lbi == ipid
+
#endif
@@ -440,11 +450,29 @@
nubPackageFlags opts = opts { ghcOptPackages = nub $ ghcOptPackages opts }
#endif
+renderGhcOptions' :: LocalBuildInfo
+ -> Verbosity
+ -> GhcOptions
+ -> IO [String]
renderGhcOptions' lbi v opts = do
#if CABAL_MAJOR == 1 && CABAL_MINOR < 20
(ghcProg, _) <- requireProgram v ghcProgram (withPrograms lbi)
let Just ghcVer = programVersion ghcProg
return $ renderGhcOptions ghcVer opts
-#else
+#elif CABAL_MAJOR == 1 && CABAL_MINOR >= 20 && CABAL_MINOR < 24
+-- && CABAL_MINOR < 24
return $ renderGhcOptions (compiler lbi) opts
+#elif CABAL_MAJOR == 1 && CABAL_MINOR >= 24
+-- CABAL_MAJOR == 1 && CABAL_MINOR >= 24
+ return $ renderGhcOptions (compiler lbi) (hostPlatform lbi) opts
+#endif
+
+
+#if CABAL_MAJOR == 1 && CABAL_MINOR < 25
+initialBuildStepsForAllComponents distdir pd lbi v =
+ initialBuildSteps distdir pd lbi v
+#elif CABAL_MAJOR == 1 && CABAL_MINOR >= 25
+initialBuildStepsForAllComponents distdir pd lbi v =
+ withComponentsLBI pd lbi $ \_c clbi ->
+ initialBuildSteps distdir pd lbi clbi v
#endif
diff --git a/CabalHelper/Types.hs b/CabalHelper/Types.hs
--- a/CabalHelper/Types.hs
+++ b/CabalHelper/Types.hs
@@ -24,7 +24,7 @@
deriving (Eq, Ord, Read, Show, Generic)
data ChComponentName = ChSetupHsName
- | ChLibName
+ | ChLibName String
| ChExeName String
| ChTestName String
| ChBenchName String
diff --git a/cabal-helper.cabal b/cabal-helper.cabal
--- a/cabal-helper.cabal
+++ b/cabal-helper.cabal
@@ -1,9 +1,9 @@
name: cabal-helper
-version: 0.6.3.1
+version: 0.7.0.1
synopsis: Simple interface to some of Cabal's configuration state used by ghc-mod
description:
- @cabal-helper@ provides a library which wraps the internal use of
- anexecutable to lift the restrictions imposed by linking against versions of
+ @cabal-helper@ provides a library which wraps the internal use of an
+ executable to lift the restrictions imposed by linking against versions of
GHC before @7.10@. This has the pleasant side effect of isolating the user
from having to deal with Cabal version changes manually as @cabal-helper@
can simply recompile it's helper program automatically as needed.
@@ -49,7 +49,7 @@
default-language: Haskell2010
GHC-Options: -Wall
Build-Depends: base >= 4.5 && < 5
- , Cabal >= 1.14 && < 1.23
+ , Cabal >= 1.14 && < 1.26
, directory
, filepath
, transformers
@@ -73,7 +73,7 @@
X-Install-Target: $libexecdir
Build-Depends: base >= 4.5 && < 5
, bytestring
- , Cabal >= 1.14 && < 1.23
+ , Cabal >= 1.14 && < 1.26
, directory
, filepath
, process
@@ -102,7 +102,7 @@
, cabal-helper
, extra
, unix
- , Cabal >= 1.14 && < 1.23
+ , Cabal >= 1.14 && < 1.26
, directory
, filepath
, transformers
@@ -113,3 +113,33 @@
, utf8-string
, template-haskell
, temporary
+
+-- custom-setup
+-- setup-depends: base,
+-- Cabal,
+-- filepath
+
+-- TODO: Use cabal_macros.h to replace -D flags by including it in
+-- CabalHelper.Data
+--
+-- Executable cabal-helper-main
+-- if flag(dev)
+-- Buildable: True
+-- else
+-- Buildable: False
+-- Default-Language: Haskell2010
+-- Default-Extensions: NondecreasingIndentation
+-- Main-Is: CabalHelper/Main.hs
+-- Other-Modules:
+-- GHC-Options: -Wall -fno-warn-unused-imports -optP-DCABAL_MAJOR=1 -optP-DCABAL_MINOR=25 -optP-DCABAL_HELPER=1 -optP-DCABAL_HELPER_DEV=1
+-- Build-Depends: base
+-- , Cabal
+-- , containers
+-- , bytestring
+-- , filepath
+-- , directory
+--
+-- flag dev
+-- description: Build development components
+-- default: False
+-- manual: True
diff --git a/tests/Spec.hs b/tests/Spec.hs
--- a/tests/Spec.hs
+++ b/tests/Spec.hs
@@ -14,6 +14,7 @@
import CabalHelper.Compile
import CabalHelper.Types
+
main :: IO ()
main = do
flip (setEnv "HOME") True =<< fromMaybe "/tmp" <$> lookupEnv "TMPDIR"
@@ -21,8 +22,11 @@
writeAutogenFiles' $ defaultQueryEnv "." "./dist"
- let vers :: [(Version, [Version])]
- vers = map (parseVer *** map parseVer) [
+ let parseVer' "HEAD" = Left HEAD
+ parseVer' v = Right $ parseVer v
+
+ let vers :: [(Version, [Either HEAD Version])]
+ vers = map (parseVer *** map parseVer') [
("7.4", [ -- "1.14.0" -- not supported at runtime
]),
@@ -57,14 +61,18 @@
, "1.22.4.0"
, "1.22.5.0"
, "1.22.6.0"
+ , "1.22.7.0"
+ , "1.22.8.0"
]),
("8.0", [
+ "1.24.0.0"
+ , "HEAD"
])
]
ghcVer <- majorVer <$> ghcVersion defaultOptions
- let cabalVers = concat $ map snd $ dropWhile (( IO (Either ExitCode FilePath)
-compilePrivatePkgDb cabalVer = do
+data HEAD = HEAD deriving (Show)
+
+compilePrivatePkgDb :: Either HEAD Version -> IO (Either ExitCode FilePath)
+compilePrivatePkgDb (Left HEAD) = do
_ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ]
- db <- installCabal defaultOptions cabalVer `E.catch`
- \(SomeException _) -> errorInstallCabal cabalVer "dist"
- compileWithPkg "." (Just db) cabalVer
+ (db, commit) <- installCabalHEAD defaultOptions { verbose = True } `E.catch`
+ \(SomeException ex) -> error $ "Installing cabal HEAD failed: " ++ show ex
+ compileWithPkg "." (Just db) (Left commit)
+compilePrivatePkgDb (Right cabalVer) = do
+ _ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ]
+ db <- installCabal defaultOptions { verbose = True } cabalVer `E.catch`
+ \(SomeException _) -> errorInstallCabal cabalVer "dist"
+ compileWithPkg "." (Just db) (Right cabalVer)
-compileWithPkg :: FilePath -> Maybe FilePath -> Version -> IO (Either ExitCode FilePath)
+compileWithPkg :: FilePath
+ -> Maybe FilePath
+ -> Either String Version
+ -> IO (Either ExitCode FilePath)
compileWithPkg chdir mdb ver =
- compile "dist" defaultOptions $ Compile chdir Nothing mdb ver [cabalPkgId ver]
+ compile "dist" defaultOptions { verbose = True } $
+ Compile chdir Nothing mdb ver [cabalPkgId ver]
-cabalPkgId :: Version -> String
-cabalPkgId v = "Cabal-" ++ showVersion v
+cabalPkgId :: Either String Version -> String
+cabalPkgId (Left _commitid) = "Cabal"
+cabalPkgId (Right v) = "Cabal-" ++ showVersion v