git.iko.soy/stackage
on master help sign in
Add tarballs that do not exist on Hackage
d8dec4fMichael Snoyman
Stackage/LoadDatabase.hs+22−3
compare with master
unifiedsplit
@@ -1,8 +1,10 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
1module Stackage.LoadDatabase where
2module Stackage.LoadDatabase where
2
3
3import qualified Codec.Archive.Tar as Tar
4import qualified Codec.Archive.Tar as Tar
4import qualified Codec.Compression.GZip as GZip
5import qualified Codec.Compression.GZip as GZip
5−import Control.Monad (guard)
6+import Control.Exception (IOException, handle)
7+import Control.Monad (guard, foldM)
6import qualified Data.ByteString.Lazy as L
8import qualified Data.ByteString.Lazy as L
7import qualified Data.ByteString.Lazy.Char8 as L8
9import qualified Data.ByteString.Lazy.Char8 as L8
8import Data.List (stripPrefix)
10import Data.List (stripPrefix)
@@ -37,12 +39,13 @@ import Distribution.PackageDescription (Condition (..),
37import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
39import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
38 parsePackageDescription)
40 parsePackageDescription)
39import Distribution.System (buildArch, buildOS)
41import Distribution.System (buildArch, buildOS)
42+import Distribution.Text (simpleParse)
40import Distribution.Version (Version (Version),
43import Distribution.Version (Version (Version),
41 unionVersionRanges,
44 unionVersionRanges,
42 withinRange)
45 withinRange)
43import Stackage.Types
46import Stackage.Types
44import Stackage.Util
47import Stackage.Util
45−import System.Directory (doesFileExist)
48+import System.Directory (doesFileExist, getDirectoryContents)
46import System.FilePath ((<.>), (</>))
49import System.FilePath ((<.>), (</>))
47
50
48-- | Load the raw package database.
51-- | Load the raw package database.
@@ -64,12 +67,17 @@ loadPackageDB :: SelectSettings
64loadPackageDB settings coreMap core deps = do
67loadPackageDB settings coreMap core deps = do
65 tarName <- getTarballName
68 tarName <- getTarballName
66 lbs <- L.readFile tarName
69 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
68 where
74 where
69 addEntries _ (Tar.Fail e) = error $ show e
75 addEntries _ (Tar.Fail e) = error $ show e
70 addEntries db Tar.Done = return db
76 addEntries db Tar.Done = return db
71 addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es
77 addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es
72
78
79+ stripTarGz = fmap reverse . stripPrefix (reverse ".tar.gz") . reverse
80+
73 ghcVersion' =
81 ghcVersion' =
74 let GhcMajorVersion x y = selectGhcVersion settings
82 let GhcMajorVersion x y = selectGhcVersion settings
75 in Version [x, y, 2] []
83 in Version [x, y, 2] []
@@ -97,6 +105,17 @@ loadPackageDB settings coreMap core deps = do
97 Tar.NormalFile bs _ -> addPackage p v bs pdb
105 Tar.NormalFile bs _ -> addPackage p v bs pdb
98 _ -> return pdb
106 _ -> return pdb
99
107
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+
100 skipTests p = p `Set.member` skippedTests settings
119 skipTests p = p `Set.member` skippedTests settings
101
120
102 -- Find the relevant cabal file in the given entries and add its contents
121 -- Find the relevant cabal file in the given entries and add its contents