haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-28 07:00:25 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Add tarballs that do not exist on Hackage

Browse Source
This commit is contained in:
Michael Snoyman 2013-10-15 09:03:20 +03:00
parent 5f9a87b653
commit d8dec4f827
1 changed files with 22 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Stackage/LoadDatabase.hs
View File

@ -1,8 +1,10 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Stackage.LoadDatabase where module Stackage.LoadDatabase where
import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar as Tar
import qualified Codec.Compression.GZip as GZip import qualified Codec.Compression.GZip as GZip
import Control.Monad (guard) import Control.Exception (IOException, handle)
import Control.Monad (guard, foldM)
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy.Char8 as L8
import Data.List (stripPrefix) import Data.List (stripPrefix)
@ -37,12 +39,13 @@ import Distribution.PackageDescription (Condition (..),
import Distribution.PackageDescription.Parse (ParseResult (ParseOk), import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
parsePackageDescription) parsePackageDescription)
import Distribution.System (buildArch, buildOS) import Distribution.System (buildArch, buildOS)
import Distribution.Text (simpleParse)
import Distribution.Version (Version (Version), import Distribution.Version (Version (Version),
unionVersionRanges, unionVersionRanges,
withinRange) withinRange)
import Stackage.Types import Stackage.Types
import Stackage.Util import Stackage.Util
import System.Directory (doesFileExist) import System.Directory (doesFileExist, getDirectoryContents)
import System.FilePath ((<.>), (</>)) import System.FilePath ((<.>), (</>))
-- | Load the raw package database. -- | Load the raw package database.
@ -64,12 +67,17 @@ loadPackageDB :: SelectSettings
loadPackageDB settings coreMap core deps = do loadPackageDB settings coreMap core deps = do
tarName <- getTarballName tarName <- getTarballName
lbs <- L.readFile tarName lbs <- L.readFile tarName
addEntries mempty $ Tar.read lbs pdb <- addEntries mempty $ Tar.read lbs
contents <- handle (\(_ :: IOException) -> return [])
$ getDirectoryContents $ selectTarballDir settings
foldM addTarball pdb $ mapMaybe stripTarGz contents
where where
addEntries _ (Tar.Fail e) = error $ show e addEntries _ (Tar.Fail e) = error $ show e
addEntries db Tar.Done = return db addEntries db Tar.Done = return db
addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es
stripTarGz = fmap reverse . stripPrefix (reverse ".tar.gz") . reverse
ghcVersion' = ghcVersion' =
let GhcMajorVersion x y = selectGhcVersion settings let GhcMajorVersion x y = selectGhcVersion settings
in Version [x, y, 2] [] in Version [x, y, 2] []
@ -97,6 +105,17 @@ loadPackageDB settings coreMap core deps = do
Tar.NormalFile bs _ -> addPackage p v bs pdb Tar.NormalFile bs _ -> addPackage p v bs pdb
_ -> return pdb _ -> return pdb
addTarball :: PackageDB -> FilePath -> IO PackageDB
addTarball pdb tarball' = do
lbs <- L.readFile tarball
let (v', p') = break (== '-') $ reverse tarball'
p = PackageName $ reverse $ drop 1 p'
v <- maybe (error $ "Invalid tarball name: " ++ tarball) return
$ simpleParse $ reverse v'
findCabalAndAddPackage tarball p v pdb $ Tar.read $ GZip.decompress lbs
where
tarball = selectTarballDir settings </> tarball' <.> "tar.gz"
skipTests p = p `Set.member` skippedTests settings skipTests p = p `Set.member` skippedTests settings
-- Find the relevant cabal file in the given entries and add its contents -- Find the relevant cabal file in the given entries and add its contents