@@ -1,6 +1,7 @@
11module Stackage.LoadDatabase where
22
33import qualified Codec.Archive.Tar as Tar
4+import qualified Codec.Compression.GZip as GZip
45import Control.Monad (guard)
56import qualified Data.ByteString.Lazy as L
67import qualified Data.ByteString.Lazy.Char8 as L8
@@ -36,10 +37,13 @@ import Distribution.PackageDescription (Condition (..),
3637import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
3738 parsePackageDescription)
3839import Distribution.System (buildArch, buildOS)
39−import Distribution.Version (unionVersionRanges,
40− withinRange, Version (Version))
40+import Distribution.Version (Version (Version),
41+ unionVersionRanges,
42+ withinRange)
4143import Stackage.Types
4244import Stackage.Util
45+import System.Directory (doesFileExist)
46+import System.FilePath ((<.>), (</>))
4347
4448-- | Load the raw package database.
4549--
@@ -80,23 +84,69 @@ loadPackageDB settings coreMap core deps = do
8084 case Map.lookup p deps of
8185 Just (vrange, _maintainer)
8286 | not $ withinRange v vrange -> return pdb
83− _ ->
84− case Tar.entryContent e of
85− Tar.NormalFile bs _ -> do
86− let (deps', hasTests, buildTools', mgpd, execs, mgithub) = parseDeps p bs
87− return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo
88− { piVersion = v
89− , piDeps = deps'
90− , piHasTests = hasTests
91− , piBuildTools = buildTools'
92− , piGPD = mgpd
93− , piExecs = execs
94− , piGithubUser = mgithub
95− }
96− _ -> return pdb
87+ _ -> do
88+ let pkgname = packageVersionString (p, v)
89+ tarball = selectTarballDir settings </> pkgname <.> "tar.gz"
90+ exists <- doesFileExist tarball
91+ if exists
92+ then do
93+ lbs <- L.readFile tarball
94+ findCabalAndAddPackage tarball p v pdb $ Tar.read $ GZip.decompress lbs
95+ else
96+ case Tar.entryContent e of
97+ Tar.NormalFile bs _ -> addPackage p v bs pdb
98+ _ -> return pdb
9799
98100 skipTests p = p `Set.member` skippedTests settings
99101
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 =
105+ loop
106+ where
107+ expectedPath = let PackageName p' = p in concat
108+ [ packageVersionString (p, v)
109+ , "/"
110+ , p'
111+ , ".cabal"
112+ ]
113+ loop Tar.Done = error $ concat
114+ [ "Missing cabal file "
115+ , show expectedPath
116+ , " in tarball: "
117+ , show tarball
118+ ]
119+ loop (Tar.Fail e) = error $ concat
120+ [ "Unable to read tarball "
121+ , show tarball
122+ , ": "
123+ , show e
124+ ]
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
129+ _ -> error $ concat
130+ [ "In tarball "
131+ , show tarball
132+ , " the cabal file "
133+ , show expectedPath
134+ , " was not a normal file"
135+ ]
136+ | otherwise = loop rest
137+
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
141+ { piVersion = v
142+ , piDeps = deps'
143+ , piHasTests = hasTests
144+ , piBuildTools = buildTools'
145+ , piGPD = mgpd
146+ , piExecs = execs
147+ , piGithubUser = mgithub
148+ }
149+
100150 parseDeps p lbs =
101151 case parsePackageDescription $ L8.unpack lbs of
102152 ParseOk _ gpd -> (mconcat