@@ -1,6 +1,7 @@
1module Stackage.LoadDatabase where
1module Stackage.LoadDatabase where
3import qualified Codec.Archive.Tar as Tar
3import qualified Codec.Archive.Tar as Tar
4+import qualified Codec.Compression.GZip as GZip
4import Control.Monad (guard)
5import Control.Monad (guard)
5import qualified Data.ByteString.Lazy as L
6import qualified Data.ByteString.Lazy as L
6import qualified Data.ByteString.Lazy.Char8 as L8
7import qualified Data.ByteString.Lazy.Char8 as L8
@@ -36,10 +37,13 @@ import Distribution.PackageDescription (Condition (..),
36import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
37import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
37 parsePackageDescription)
38 parsePackageDescription)
38import Distribution.System (buildArch, buildOS)
39import Distribution.System (buildArch, buildOS)
39−import Distribution.Version (unionVersionRanges,
40+import Distribution.Version (Version (Version),
40− withinRange, Version (Version))
42+ withinRange)
41import Stackage.Types
43import Stackage.Types
42import Stackage.Util
44import Stackage.Util
45+import System.Directory (doesFileExist)
46+import System.FilePath ((<.>), (</>))
44-- | Load the raw package database.
48-- | Load the raw package database.
@@ -80,23 +84,69 @@ loadPackageDB settings coreMap core deps = do
80 case Map.lookup p deps of
84 case Map.lookup p deps of
81 Just (vrange, _maintainer)
85 Just (vrange, _maintainer)
82 | not $ withinRange v vrange -> return pdb
86 | not $ withinRange v vrange -> return pdb
88+ let pkgname = packageVersionString (p, v)
89+ tarball = selectTarballDir settings </> pkgname <.> "tar.gz"
90+ exists <- doesFileExist tarball
93+ lbs <- L.readFile tarball
94+ findCabalAndAddPackage tarball p v pdb $ Tar.read $ GZip.decompress lbs
84− case Tar.entryContent e of
96+ case Tar.entryContent e of
85− Tar.NormalFile bs _ -> do
97+ Tar.NormalFile bs _ -> addPackage p v bs pdb
86− let (deps', hasTests, buildTools', mgpd, execs, mgithub) = parseDeps p bs
87− return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo
90− , piHasTests = hasTests
91− , piBuildTools = buildTools'
94− , piGithubUser = mgithub
96− _ -> return pdb
98+ _ -> return pdb
98 skipTests p = p `Set.member` skippedTests settings
100 skipTests p = p `Set.member` skippedTests settings
102+ -- Find the relevant cabal file in the given entries and add its contents
103+ -- to the package database
104+ findCabalAndAddPackage tarball p v pdb =
107+ expectedPath = let PackageName p' = p in concat
108+ [ packageVersionString (p, v)
113+ loop Tar.Done = error $ concat
114+ [ "Missing cabal file "
119+ loop (Tar.Fail e) = error $ concat
120+ [ "Unable to read tarball "
125+ loop (Tar.Next entry rest)
126+ | Tar.entryPath entry == expectedPath =
127+ case Tar.entryContent entry of
128+ Tar.NormalFile bs _ -> addPackage p v bs pdb
132+ , " the cabal file "
134+ , " was not a normal file"
136+ | otherwise = loop rest
138+ addPackage p v lbs pdb = do
139+ let (deps', hasTests, buildTools', mgpd, execs, mgithub) = parseDeps p lbs
140+ return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo
143+ , piHasTests = hasTests
144+ , piBuildTools = buildTools'
147+ , piGithubUser = mgithub
100 parseDeps p lbs =
150 parseDeps p lbs =
101 case parsePackageDescription $ L8.unpack lbs of
151 case parsePackageDescription $ L8.unpack lbs of
102 ParseOk _ gpd -> (mconcat
152 ParseOk _ gpd -> (mconcat