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