diff --git a/Stackage/LoadDatabase.hs b/Stackage/LoadDatabase.hs index 57384c76..b69ddf99 100644 --- a/Stackage/LoadDatabase.hs +++ b/Stackage/LoadDatabase.hs @@ -1,6 +1,7 @@ module Stackage.LoadDatabase where import qualified Codec.Archive.Tar as Tar +import qualified Codec.Compression.GZip as GZip import Control.Monad (guard) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8 @@ -36,10 +37,13 @@ import Distribution.PackageDescription (Condition (..), import Distribution.PackageDescription.Parse (ParseResult (ParseOk), parsePackageDescription) import Distribution.System (buildArch, buildOS) -import Distribution.Version (unionVersionRanges, - withinRange, Version (Version)) +import Distribution.Version (Version (Version), + unionVersionRanges, + withinRange) import Stackage.Types import Stackage.Util +import System.Directory (doesFileExist) +import System.FilePath ((<.>), ()) -- | Load the raw package database. -- @@ -80,23 +84,69 @@ loadPackageDB settings coreMap core deps = do case Map.lookup p deps of Just (vrange, _maintainer) | not $ withinRange v vrange -> return pdb - _ -> - case Tar.entryContent e of - Tar.NormalFile bs _ -> do - let (deps', hasTests, buildTools', mgpd, execs, mgithub) = parseDeps p bs - return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo - { piVersion = v - , piDeps = deps' - , piHasTests = hasTests - , piBuildTools = buildTools' - , piGPD = mgpd - , piExecs = execs - , piGithubUser = mgithub - } - _ -> return pdb + _ -> do + let pkgname = packageVersionString (p, v) + tarball = selectTarballDir settings pkgname <.> "tar.gz" + exists <- doesFileExist tarball + if exists + then do + lbs <- L.readFile tarball + findCabalAndAddPackage tarball p v pdb $ Tar.read $ GZip.decompress lbs + else + case Tar.entryContent e of + Tar.NormalFile bs _ -> addPackage p v bs pdb + _ -> return pdb skipTests p = p `Set.member` skippedTests settings + -- Find the relevant cabal file in the given entries and add its contents + -- to the package database + findCabalAndAddPackage tarball p v pdb = + loop + where + expectedPath = let PackageName p' = p in concat + [ packageVersionString (p, v) + , "/" + , p' + , ".cabal" + ] + loop Tar.Done = error $ concat + [ "Missing cabal file " + , show expectedPath + , " in tarball: " + , show tarball + ] + loop (Tar.Fail e) = error $ concat + [ "Unable to read tarball " + , show tarball + , ": " + , show e + ] + loop (Tar.Next entry rest) + | Tar.entryPath entry == expectedPath = + case Tar.entryContent entry of + Tar.NormalFile bs _ -> addPackage p v bs pdb + _ -> error $ concat + [ "In tarball " + , show tarball + , " the cabal file " + , show expectedPath + , " was not a normal file" + ] + | otherwise = loop rest + + addPackage p v lbs pdb = do + let (deps', hasTests, buildTools', mgpd, execs, mgithub) = parseDeps p lbs + return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo + { piVersion = v + , piDeps = deps' + , piHasTests = hasTests + , piBuildTools = buildTools' + , piGPD = mgpd + , piExecs = execs + , piGithubUser = mgithub + } + parseDeps p lbs = case parsePackageDescription $ L8.unpack lbs of ParseOk _ gpd -> (mconcat diff --git a/Stackage/Select.hs b/Stackage/Select.hs index 584f8dfa..d5452b5b 100644 --- a/Stackage/Select.hs +++ b/Stackage/Select.hs @@ -44,6 +44,7 @@ defaultSelectSettings version = SelectSettings , useGlobalDatabase = False , skippedTests = empty , selectGhcVersion = version + , selectTarballDir = "tarballs" } select :: SelectSettings -> IO BuildPlan diff --git a/Stackage/Types.hs b/Stackage/Types.hs index 853f4c88..401b7863 100644 --- a/Stackage/Types.hs +++ b/Stackage/Types.hs @@ -120,6 +120,8 @@ data SelectSettings = SelectSettings -- ^ Do not build or run test suites, usually in order to avoid a -- dependency. , selectGhcVersion :: GhcMajorVersion + , selectTarballDir :: FilePath + -- ^ Directory containing replacement tarballs. } data BuildStage = BSTools | BSBuild | BSTest diff --git a/stackage.cabal b/stackage.cabal index f9e95764..e6d643d8 100644 --- a/stackage.cabal +++ b/stackage.cabal @@ -33,6 +33,7 @@ library , containers , Cabal , tar >= 0.3 + , zlib , bytestring , directory , filepath