@@ -1,7 +1,10 @@
1+{-# LANGUAGE DeriveGeneric #-}
12{-# LANGUAGE OverloadedStrings #-}
23
34module Cabal2Nix.HackageGit ( Hackage, readHackage, module Data.Map ) where
45
6+import Control.DeepSeq.Generics
7+import GHC.Generics ( Generic )
58import Control.Monad
69import Data.Aeson
710import Data.ByteString.Char8 ( ByteString )
@@ -18,6 +21,9 @@ import Distribution.PackageDescription.Parse ( parsePackageDescription, ParseRes
1821import Distribution.Text ( simpleParse, display )
1922import System.Directory
2023import System.FilePath
24+import Control.Monad.Par.Combinator
25+import Control.Monad.Par.IO
26+import Control.Monad.Trans ( liftIO )
2127
2228-- | A 'Map' representation of the Hackage database. Every package name
2329-- maps to a non-empty set of version, and for every version there is a
@@ -34,28 +40,36 @@ getSubDirs path = do
3440-- 'Hackage' map that provides fast access to its contents.
3541
3642readHackage :: FilePath -> IO Hackage
37−readHackage root = do
38− pkglist <- getSubDirs root
39− x <- mapM (readHackagePackage root) pkglist
40− return (fromList x)
43+readHackage root = runParIO $ do
44+ pkglist <- liftIO $ getSubDirs root
45+ hackage' <- parMapM (readHackagePackage root) $!! pkglist
46+ let hackage = [ (pkg, Data.Map.mapWithKey (mkPkgDescr pkg) version2buf) | (pkg, version2buf) <- hackage' ]
4147
42−readHackagePackage :: FilePath -> FilePath -> IO (FilePath, Map Version GenericPackageDescription)
48+ mkPkgDescr :: String -> Version -> (ByteString, Meta) -> GenericPackageDescription
49+ mkPkgDescr pkg v (buf,meta) = cabal { packageDescription = pd { customFieldsPD = cf } }
50+ where
51+ cabal = parsePackage pkg v buf
52+ pd = packageDescription cabal
53+ cf = customFieldsPD pd ++ ("X-Cabal-File-Hash", mkSHA256 buf)
54+ : [ ("X-Package-" ++ k, v') | (k,v') <- toList (hashes meta) ]
55+
56+ mkSHA256 :: ByteString -> String
57+ mkSHA256 = showDigest . sha256 . fromStrict
58+
59+ return (fromList hackage)
60+
61+readHackagePackage :: FilePath -> FilePath -> ParIO (FilePath, Map Version (ByteString,Meta))
4362readHackagePackage root pkg = do
44− versions <- getSubDirs (root </> pkg)
45− x <- mapM (readHackagePackageVersion root pkg) versions
63+ versions <- liftIO $ getSubDirs (root </> pkg)
64+ x <- parMapM (readHackagePackageVersion root pkg) $!! versions
4665 return (pkg, fromList x)
4766
48−readHackagePackageVersion :: FilePath -> FilePath -> FilePath -> IO (Version, GenericPackageDescription)
67+readHackagePackageVersion :: FilePath -> FilePath -> FilePath -> ParIO (Version, (ByteString,Meta))
4968readHackagePackageVersion root pkg version = do
5069 let v = pVersion version
51− buf <- BS8.readFile (root </> pkg </> version </> pkg <.> "cabal")
52− let cabal = parsePackage pkg v buf
53− meta <- parseMeta pkg v <$> BS8.readFile (root </> pkg </> version </> pkg <.> "json")
54− let pd = packageDescription cabal
55− cf = customFieldsPD pd ++ ("X-Cabal-File-Hash", mkSHA256 buf)
56− : [ ("X-Package-" ++ k, v') | (k,v') <- toList (hashes meta) ]
57− cabal' = cabal { packageDescription = pd { customFieldsPD = cf } }
58− return (v, cabal')
70+ cabal <- liftIO $ BS8.readFile (root </> pkg </> version </> pkg <.> "cabal")
71+ meta <- liftIO (BS8.readFile (root </> pkg </> version </> pkg <.> "json"))
72+ return (v, (cabal,parseMeta pkg v meta))
5973
6074pVersion :: String -> Version
6175pVersion str = fromMaybe (error $ "hackage-db: cannot parse version " ++ show str) (simpleParse str)
@@ -79,7 +93,9 @@ parsePackage' buf = case parsePackageDescription (decodeUTF8 buf) of
7993 decodeUTF8 = toString . fromRep
8094
8195data Meta = Meta { hashes :: Map String String {-, locations :: [String], pkgsize :: Int-} }
82− deriving Show
96+ deriving (Show, Generic)
97+
98+instance NFData Meta where rnf = genericRnf
8399
84100instance FromJSON Meta where
85101 parseJSON (Object v) = Meta <$>
@@ -96,6 +112,3 @@ parseMeta pkg version buf =
96112 Right x -> x
97113 where
98114 pkgid = PackageIdentifier (PackageName pkg) version
99−
100−mkSHA256 :: ByteString -> String
101−mkSHA256 = showDigest . sha256 . fromStrict