on master help sign in
Loading package database respects custom tarballs
529a846Michael Snoyman
Stackage/LoadDatabase.hs+66−16
@@ -1,6 +1,7 @@
1module Stackage.LoadDatabase where
1module Stackage.LoadDatabase where
2
2
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),
41+ unionVersionRanges,
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 ((<.>), (</>))
43
47
44-- | Load the raw package database.
48-- | Load the raw package database.
45--
49--
@@ -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
83− _ ->
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
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
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
98+ _ -> return pdb
97
99
98 skipTests p = p `Set.member` skippedTests settings
100 skipTests p = p `Set.member` skippedTests settings
99
101
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+
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
Stackage/Select.hs+1
@@ -44,6 +44,7 @@ defaultSelectSettings version = SelectSettings
44 , useGlobalDatabase = False
44 , useGlobalDatabase = False
45 , skippedTests = empty
45 , skippedTests = empty
46 , selectGhcVersion = version
46 , selectGhcVersion = version
47+ , selectTarballDir = "tarballs"
47 }
48 }
48
49
49select :: SelectSettings -> IO BuildPlan
50select :: SelectSettings -> IO BuildPlan
Stackage/Types.hs+2
@@ -120,6 +120,8 @@ data SelectSettings = SelectSettings
120 -- ^ Do not build or run test suites, usually in order to avoid a
120 -- ^ Do not build or run test suites, usually in order to avoid a
121 -- dependency.
121 -- dependency.
122 , selectGhcVersion :: GhcMajorVersion
122 , selectGhcVersion :: GhcMajorVersion
123+ , selectTarballDir :: FilePath
124+ -- ^ Directory containing replacement tarballs.
123 }
125 }
124
126
125data BuildStage = BSTools | BSBuild | BSTest
127data BuildStage = BSTools | BSBuild | BSTest
stackage.cabal+1
@@ -33,6 +33,7 @@ library
33 , containers
33 , containers
34 , Cabal
34 , Cabal
35 , tar >= 0.3
35 , tar >= 0.3
36+ , zlib
36 , bytestring
37 , bytestring
37 , directory
38 , directory
38 , filepath
39 , filepath