1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
{-# LANGUAGE DeriveGeneric, StandaloneDeriving, BangPatterns, CPP #-}
module GenericsBenchCache (readPackageDescriptionCache) where
import qualified Text.ParserCombinators.ReadP as Read
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as LC8
import Data.Version (parseVersion)
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parse
import Distribution.Version (Version)
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Compression.GZip as GZip
import qualified Data.HashMap.Lazy as Map
import System.Directory
import System.Exit
import GenericsBenchTypes ()
#if ! MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
readTar :: String -> Int -> IO [PackageDescription]
readTar tarPath limit = do
entries <- Tar.read . GZip.decompress <$> L.readFile tarPath
let contents = Tar.foldEntries unpack [] (error "tar error") entries
let !pkgs = Map.fromListWith pick
[ (pkg, (version, content))
| (path, content) <- contents
, Just (pkg, version) <- return (readFilePath path) ]
return $ take limit [ flattenPackageDescription gpd
| (_, (_, content)) <- Map.toList pkgs
, ParseOk _warns gpd <- return (parsePackageDescription (LC8.unpack content)) ]
where
pick (v,a) (w,b) | v >= w = (v,a)
| otherwise = (w,b)
unpack e acc =
case Tar.entryContent e of
Tar.NormalFile content _ -> (Tar.entryPath e, content):acc
_ -> acc
readFilePath :: String -> Maybe (String, Version)
readFilePath str = extract (Read.readP_to_S parse str)
where
extract [(result,_)] = Just result
extract _ = Nothing
parse = do
packageName <- Read.many1 (Read.satisfy (/='/'))
_ <- Read.char '/'
version <- parseVersion
_ <- Read.char '/'
return (packageName, version)
writePackageDescriptionCache :: String -> [PackageDescription] -> IO ()
writePackageDescriptionCache path = writeFile path . show
readPackageDescriptionCache :: Int -> IO [PackageDescription]
readPackageDescriptionCache amount = do
let cacheFilePath' = cacheFilePath ++ "-" ++ (show amount)
createPackageDescriptionCache cacheFilePath' amount
pds <- read <$> readFile cacheFilePath'
-- PackageDescription doesn't implement NFData, let's force with the following line
(length (show pds)) `seq` return pds
cacheFilePath :: String
cacheFilePath = "generics-bench.cache"
createPackageDescriptionCache :: String -> Int -> IO ()
createPackageDescriptionCache path amount = do
cacheExists <- doesFileExist path
if cacheExists
then putStrLn "reusing cache from previous run"
else do
putStr "creating cabal cache file... "
tarFilePath <- (++"/.cabal/packages/hackage.haskell.org/00-index.tar.gz") <$> getHomeDirectory
fileExists <- doesFileExist tarFilePath
if fileExists
then do
pds <- readTar tarFilePath amount
writePackageDescriptionCache path pds
putStrLn "done"
else do
putStrLn (tarFilePath ++ " missing, aborting")
exitFailure
|
