git.iko.soy/stackage
on c3a441e help sign in
stackage/Stackage/LoadDatabase.hs
91 lines 4.3 kB history raw
1module Stackage.LoadDatabase where
3import qualified Codec.Archive.Tar as Tar
4import qualified Codec.Archive.Tar.Entry as TarEntry
5import Control.Exception (throwIO)
6import Control.Monad (guard)
7import qualified Data.ByteString.Lazy as L
8import qualified Data.ByteString.Lazy.Char8 as L8
9import Data.List (stripPrefix)
10import qualified Data.Map as Map
11import Data.Monoid (Monoid (..))
12import Data.Set (member)
13import qualified Data.Set as Set
14import Distribution.Package (Dependency (Dependency))
15import Distribution.PackageDescription (condExecutables,
16 condLibrary,
17 condTestSuites,
18 condTreeConstraints)
19import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
20 parsePackageDescription)
21import Distribution.Text (simpleParse)
22import Distribution.Version (withinRange)
23import Stackage.Types
24import System.Directory (getAppUserDataDirectory)
25import System.FilePath ((</>))
27-- | Load the raw package database.
28--
29-- We want to put in some restrictions:
30--
31-- * Drop all core packages. We never want to install a new version of
32-- those, nor include them in the package list.
33--
34-- * For packages with a specific version bound, find the maximum matching
35-- version.
36--
37-- * For other packages, select the maximum version number.
38loadPackageDB :: Set PackageName -- ^ core packages
39 -> Map PackageName VersionRange -- ^ additional deps
40 -> IO PackageDB
41loadPackageDB core deps = do
42 c <- getAppUserDataDirectory "cabal"
43 let tarName = c </> "packages" </> "hackage.haskell.org" </> "00-index.tar"
44 lbs <- L.readFile tarName
45 addEntries mempty $ Tar.read lbs
46 where
47 addEntries :: PackageDB -> Tar.Entries Tar.FormatError -> IO PackageDB
48 addEntries _ (Tar.Fail e) = throwIO e
49 addEntries db Tar.Done = return db
50 addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es
52 addEntry :: PackageDB -> Tar.Entry -> IO PackageDB
53 addEntry pdb e =
54 case getPackageVersion $ TarEntry.fromTarPathToPosixPath (TarEntry.entryTarPath e) of
55 Nothing -> return pdb
56 Just (p, v)
57 | p `member` core -> return pdb
58 | otherwise ->
59 case Map.lookup p deps of
60 Just vrange
61 | not $ withinRange v vrange -> return pdb
62 _ ->
63 case Tar.entryContent e of
64 Tar.NormalFile bs _ -> return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo
65 { piVersion = v
66 , piDeps = parseDeps bs
67 }
68 _ -> return pdb
70 parseDeps lbs =
71 case parsePackageDescription $ L8.unpack lbs of
72 ParseOk _ gpd -> mconcat
73 [ maybe mempty go $ condLibrary gpd
74 , mconcat $ map (go . snd) $ condExecutables gpd
75 , mconcat $ map (go . snd) $ condTestSuites gpd
76 -- , mconcat $ map (go . snd) $ condBenchmarks gpd
77 ]
78 _ -> mempty
79 where
80 go = Set.fromList . map (\(Dependency p _) -> p) . condTreeConstraints
82 getPackageVersion :: FilePath -> Maybe (PackageName, Version)
83 getPackageVersion fp = do
84 let (package', s1) = break (== '/') fp
85 package = PackageName package'
86 s2 <- stripPrefix "/" s1
87 let (version', s3) = break (== '/') s2
88 version <- simpleParse version'
89 s4 <- stripPrefix "/" s3
90 guard $ s4 == package' ++ ".cabal"
91 Just (package, version)