@@ -1,8 +1,10 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
12module Stackage.LoadDatabase where
23
34import qualified Codec.Archive.Tar as Tar
45import qualified Codec.Compression.GZip as GZip
5−import Control.Monad (guard)
6+import Control.Exception (IOException, handle)
7+import Control.Monad (guard, foldM)
68import qualified Data.ByteString.Lazy as L
79import qualified Data.ByteString.Lazy.Char8 as L8
810import Data.List (stripPrefix)
@@ -37,12 +39,13 @@ import Distribution.PackageDescription (Condition (..),
3739import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
3840 parsePackageDescription)
3941import Distribution.System (buildArch, buildOS)
42+import Distribution.Text (simpleParse)
4043import Distribution.Version (Version (Version),
4144 unionVersionRanges,
4245 withinRange)
4346import Stackage.Types
4447import Stackage.Util
45−import System.Directory (doesFileExist)
48+import System.Directory (doesFileExist, getDirectoryContents)
4649import System.FilePath ((<.>), (</>))
4750
4851-- | Load the raw package database.
@@ -64,12 +67,17 @@ loadPackageDB :: SelectSettings
6467loadPackageDB settings coreMap core deps = do
6568 tarName <- getTarballName
6669 lbs <- L.readFile tarName
67− addEntries mempty $ Tar.read lbs
70+ pdb <- addEntries mempty $ Tar.read lbs
71+ contents <- handle (\(_ :: IOException) -> return [])
72+ $ getDirectoryContents $ selectTarballDir settings
73+ foldM addTarball pdb $ mapMaybe stripTarGz contents
6874 where
6975 addEntries _ (Tar.Fail e) = error $ show e
7076 addEntries db Tar.Done = return db
7177 addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es
7278
79+ stripTarGz = fmap reverse . stripPrefix (reverse ".tar.gz") . reverse
80+
7381 ghcVersion' =
7482 let GhcMajorVersion x y = selectGhcVersion settings
7583 in Version [x, y, 2] []
@@ -97,6 +105,17 @@ loadPackageDB settings coreMap core deps = do
97105 Tar.NormalFile bs _ -> addPackage p v bs pdb
98106 _ -> return pdb
99107
108+ addTarball :: PackageDB -> FilePath -> IO PackageDB
109+ addTarball pdb tarball' = do
110+ lbs <- L.readFile tarball
111+ let (v', p') = break (== '-') $ reverse tarball'
112+ p = PackageName $ reverse $ drop 1 p'
113+ v <- maybe (error $ "Invalid tarball name: " ++ tarball) return
114+ $ simpleParse $ reverse v'
115+ findCabalAndAddPackage tarball p v pdb $ Tar.read $ GZip.decompress lbs
116+ where
117+ tarball = selectTarballDir settings </> tarball' <.> "tar.gz"
118+
100119 skipTests p = p `Set.member` skippedTests settings
101120
102121 -- Find the relevant cabal file in the given entries and add its contents