hackage-db 1.22 → 2.0

raw patch · 11 files changed

+445/−182 lines, 11 filesdep +aesondep +hackage-dbdep +timedep ~Cabaldep ~basenew-component:exe:list-known-versionsnew-component:exe:show-meta-datanew-component:exe:show-package-versionsPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, hackage-db, time

Dependency ranges changed: Cabal, base

API changes (from Hackage documentation)

Files

• example/list-known-versions.hs +17/−0
• example/show-meta-data.hs +21/−0
• example/show-package-versions.hs +23/−0
• hackage-db.cabal +86/−55
• src/Distribution/Hackage/DB.hs +5/−17
• src/Distribution/Hackage/DB/Errors.hs +42/−0
• src/Distribution/Hackage/DB/MetaData.hs +62/−0
• src/Distribution/Hackage/DB/Parsed.hs +54/−59
• src/Distribution/Hackage/DB/Path.hs +30/−7
• src/Distribution/Hackage/DB/Unparsed.hs +72/−44
• src/Distribution/Hackage/DB/Utility.hs +33/−0

@@ -0,0 +1,17 @@+module Main ( main ) where++import Distribution.Hackage.DB.Path+import Distribution.Hackage.DB.Unparsed++import Control.Monad+import qualified Data.ByteString.Lazy as BS+import Data.List as List+import Data.Map as Map+import Distribution.Text++main :: IO ()+main = do+  db <- hackageTarball >>= readTarball Nothing+  forM_ (toList db) $ \(pn, PackageData vr vs) -> do+    let pref = if BS.null vr then "" else " (preferred: " ++ show vr ++ ")"+    putStrLn $ display pn ++ ": " ++ intercalate ", " (fmap display (keys vs)) ++ pref

@@ -0,0 +1,21 @@+module Main ( main ) where++import Distribution.Hackage.DB.Path+import Distribution.Hackage.DB.Unparsed+import Distribution.Hackage.DB.Utility++import Control.Monad+import Data.ByteString.Lazy.UTF8 as BS+import Data.Map as Map+import Distribution.Package+import System.Environment++main :: IO ()+main = do+  packageIds <- getArgs+  db <- hackageTarball >>= readTarball Nothing+  forM_ packageIds $ \pid -> do+    let PackageIdentifier pn v = parseText "PackageIdentifier" pid+    putStrLn $ maybe ("*** unknown package identifier on Hackage: " ++ show pid)+                     (toString . metaFile)+                     (Map.lookup pn db >>= Map.lookup v . versions)

@@ -0,0 +1,23 @@+{-# LANGUAGE CPP #-}++#if !MIN_VERSION_Cabal(2,0,0)+#  define mkPackageName PackageName+#endif++module Main ( main ) where++import Distribution.Hackage.DB++import Control.Monad ( forM_ )+import Data.Map as Map+import Distribution.Package+import Distribution.Text ( display )+import System.Environment ( getArgs )++main :: IO ()+main = do+  db <- hackageTarball >>= readTarball Nothing+  pkgs <- getArgs+  forM_ pkgs $ \pkg -> do+    let vs = maybe [] Map.keys (Map.lookup (mkPackageName pkg) db)+    putStrLn $ pkg ++ ": " ++ unwords (fmap display vs)

@@ -1,57 +1,88 @@-Name:                   hackage-db-Version:                1.22-Copyright:              Peter Simons-License:                BSD3-License-File:           LICENSE-Author:                 Peter Simons <simons@cryp.to>-Maintainer:             Peter Simons <simons@cryp.to>-Homepage:               http://github.com/peti/hackage-db-Category:               Distribution-Synopsis:               access Hackage's package database via Data.Map-Cabal-Version:          >= 1.6-Build-Type:             Simple-Tested-With:            GHC >= 6.10.4 && <= 7.8.4-Description:-   This module provides simple access to the Hackage database by means-   of @Data.Map@. Suppose you wanted to implement a utility that queries-   the set of available versions for a given package, the following-   program would do the trick:-   .-   > import qualified Distribution.Hackage.DB as DB-   > import Distribution.Text ( display )-   > import System.Environment ( getArgs )-   >-   > main :: IO ()-   > main = do-   >   pkgs <- getArgs-   >   db <- DB.readHackage-   >   let getVersions name = maybe [] DB.keys (DB.lookup name db)-   >   mapM_ (putStrLn . unwords . map display . getVersions) pkgs-   .-   When run, it would produce the following output:-   .-   > ./a.out containers deepseq cabal-install-   > 0.1.0.0 0.1.0.1 0.2.0.0 0.2.0.1 0.3.0.0 0.4.0.0-   > 1.0.0.0 1.1.0.0 1.1.0.1 1.1.0.2-   > 0.4.0 0.5.0 0.5.1 0.5.2 0.6.0 0.6.2 0.6.4 0.8.0 0.8.2 0.10.0 0.10.2-   .-   Note that once the database has been parsed, it can be accessed-   quickly, but the inital cost of reading @00-index.tar@ is fairly-   high.-   .-   This package is known to work on Linux and Mac OS X, but it's-   probably not going to work on Windows (because no-one tested it, as-   far as I know).+-- This file has been generated from package.yaml by hpack version 0.18.1.+--+-- see: https://github.com/sol/hpack -Source-Repository head-  Type:                 git-  Location:             git://github.com/peti/hackage-db.git+name:                   hackage-db+version:                2.0+license:                BSD3+license-file:           LICENSE+tested-with:            GHC > 7.8 && < 8.3+author:                 Peter Simons, Alexander Altman, Ben James+maintainer:             Peter Simons <simons@cryp.to>+homepage:               https://github.com/peti/hackage-db#readme+bug-reports:            https://github.com/peti/hackage-db/issues+category:               Distribution+synopsis:               Access Hackage's package database via Data.Map+cabal-version:          >= 1.10+build-type:             Simple+description:            This is an early and mostly undocumented release of the 2.x version of hackage-db that's intended mostly for experimenting with and testing of the new API. Porting code from 1.x to 2.x is pretty simple, but if you do that at this point, please expect minor details of this API to change in forthcoming releases. For production code, you are probably better off with the 1.x release for now.+                        .+                        Check out https://github.com/peti/hackage-db/tree/master/example/ for a collection of simple example programs that demonstrate how to use this code. -Library-  Build-Depends:        base >= 3 && < 5, tar >= 0.4, Cabal, containers,-                        directory, filepath, bytestring, utf8-string-  hs-source-dirs:       src-  Exposed-Modules:      Distribution.Hackage.DB.Unparsed-                        Distribution.Hackage.DB.Parsed-                        Distribution.Hackage.DB.Path-                        Distribution.Hackage.DB+source-repository head+  type: git+  location: https://github.com/peti/hackage-db++library+  hs-source-dirs:+      src+  other-extensions: DeriveDataTypeable DeriveGeneric+  build-depends:+      base >= 3 && < 5+    , Cabal+    , containers+    , aeson+    , bytestring+    , directory+    , filepath+    , tar >= 0.4+    , time+    , utf8-string+  exposed-modules:+      Distribution.Hackage.DB+      Distribution.Hackage.DB.Errors+      Distribution.Hackage.DB.MetaData+      Distribution.Hackage.DB.Parsed+      Distribution.Hackage.DB.Path+      Distribution.Hackage.DB.Unparsed+      Distribution.Hackage.DB.Utility+  other-modules:+      Paths_hackage_db+  default-language: Haskell2010++executable list-known-versions+  main-is: list-known-versions.hs+  hs-source-dirs:+      example+  build-depends:+      base >= 3 && < 5+    , Cabal+    , containers+    , hackage-db+    , bytestring+  default-language: Haskell2010++executable show-meta-data+  main-is: show-meta-data.hs+  hs-source-dirs:+      example+  build-depends:+      base >= 3 && < 5+    , Cabal+    , containers+    , hackage-db+    , bytestring+    , utf8-string+  default-language: Haskell2010++executable show-package-versions+  main-is: show-package-versions.hs+  hs-source-dirs:+      example+  other-extensions: CPP+  build-depends:+      base >= 3 && < 5+    , Cabal+    , containers+    , hackage-db+  default-language: Haskell2010

@@ -1,26 +1,14 @@ {- |-   Module      :  Distribution.Hackage.DB-   License     :  BSD3-   Maintainer  :  simons@cryp.to-   Stability   :  provisional-   Portability :  portable--   This module provides simple access to the Hackage database by means-   of 'Map'.+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: portable  -}  module Distribution.Hackage.DB-  ( Hackage, readHackage, readHackage', parseHackage, hackagePath-  , module Data.Map-  , module Data.Version-  , module Distribution.Package-  , module Distribution.PackageDescription+  ( HackageDB, PackageData, VersionData(..)+  , readTarball, parseTarball, hackageTarball   )   where -import Data.Map-import Data.Version import Distribution.Hackage.DB.Parsed import Distribution.Hackage.DB.Path-import Distribution.Package-import Distribution.PackageDescription

@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveDataTypeable #-}++{- |+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: portable+ -}++module Distribution.Hackage.DB.Errors where++import Codec.Archive.Tar+import Control.Exception+import Data.Typeable ( Typeable )+import Distribution.Package+import Distribution.Version++data HackageDBTarball a = HackageDBTarball FilePath a deriving (Show, Typeable)+instance (Show a, Typeable a) => Exception (HackageDBTarball a)++data HackageDBPackageName a = HackageDBPackageName PackageName a deriving (Show, Typeable)+instance (Show a, Typeable a) => Exception (HackageDBPackageName a)++data HackageDBPackageVersion a = HackageDBPackageVersion Version a deriving (Show, Typeable)+instance (Show a, Typeable a) => Exception (HackageDBPackageVersion a)++newtype IncorrectTarfile = IncorrectTarfile FormatError deriving (Show, Typeable)+instance Exception IncorrectTarfile++newtype UnsupportedTarEntry = UnsupportedTarEntry Entry deriving (Show, Typeable)+instance Exception UnsupportedTarEntry++newtype InvalidMetaFile = InvalidMetaFile String deriving (Show, Typeable)+instance Exception InvalidMetaFile++newtype InvalidCabalFile = InvalidCabalFile String deriving (Show, Typeable)+instance Exception InvalidCabalFile++data InvalidRepresentationOfType = InvalidRepresentationOfType String String deriving (Show, Typeable)+instance Exception InvalidRepresentationOfType++data NoHackageTarballFound = NoHackageTarballFound deriving (Show, Typeable)+instance Exception NoHackageTarballFound

@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveGeneric #-}++{- |+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: portable++   Types and class instances for parsing the @package.json@ files found in a+   @01-index.tar@ tarball from Hackage with "Data.Aeson". These parsers mirror+   the exact structure of those files, but only a small part of it is actually+   of interest to anyone other than implementors of @cabal-install@. Everyone+   else will most likely prefer the functions oferred by+   "Distribution.Hackage.DB.Parsed".+ -}++module Distribution.Hackage.DB.MetaData where++import Distribution.Hackage.DB.Errors++import Control.Exception+import Data.Aeson+import Data.ByteString.Lazy.UTF8 as BS+import Data.Map as Map+import GHC.Generics ( Generic )++-- | Parse the @package.json@ file found in a @01-index.tar@ tarball from+-- Hackage with "Data.Aeson". This function is a convenience wrapper around+-- 'eitherDecode' that throws an 'InvalidMetaFile' exception to signal failure.+--+-- >>> :set -XOverloadedStrings+-- >>> parseMetaData "{\"signatures\":[],\"signed\":{\"_type\":\"Targets\",\"expires\":null,\"targets\":{\"<repo>/package/jailbreak-cabal-1.3.2.tar.gz\":{\"hashes\":{\"md5\":\"ba42b3e68323ccbeb3ac900cd68f9e90\",\"sha256\":\"212a8bbc3dfc748c4063282414a2726709d651322f3984c9989179d2352950f4\"},\"length\":2269}},\"version\":0}}"+-- MetaData {signed = SignedMetaData {version = 0, expires = Nothing, _type = "Targets", targets = fromList [("<repo>/package/jailbreak-cabal-1.3.2.tar.gz",TargetData {length = 2269, hashes = fromList [("md5","ba42b3e68323ccbeb3ac900cd68f9e90"),("sha256","212a8bbc3dfc748c4063282414a2726709d651322f3984c9989179d2352950f4")]})]}, signatures = []}+-- >>> parseMetaData "{}"+-- *** Exception: InvalidMetaFile "Error in $: key \"signed\" not present"+-- >>> parseMetaData ""+-- *** Exception: InvalidMetaFile "Error in $: not enough input"++parseMetaData :: ByteString -> MetaData+parseMetaData = either (throw . InvalidMetaFile) id . eitherDecode++data MetaData = MetaData { signed :: SignedMetaData+                         , signatures :: [String]+                         }+  deriving (Show, Generic)++instance FromJSON MetaData++data SignedMetaData = SignedMetaData { version :: Int+                                     , expires :: Maybe String+                                     , _type   :: String+                                     , targets :: Map String TargetData+                                     }+  deriving (Show, Generic)++instance FromJSON SignedMetaData++data TargetData = TargetData { length :: Int+                             , hashes :: Map String String+                             }+  deriving (Show, Generic)++instance FromJSON TargetData

@@ -1,75 +1,70 @@-{- |-   Module      :  Distribution.Hackage.DB.Parsed-   License     :  BSD3-   Maintainer  :  simons@cryp.to-   Stability   :  provisional-   Portability :  portable+{-# LANGUAGE DeriveGeneric #-} -   This module provides simple access to the Hackage database by means-   of 'Map'.+{- |+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: portable  -} -module Distribution.Hackage.DB.Parsed-  ( Hackage, readHackage, readHackage', parseHackage-  , parseUnparsedHackage-  , parsePackage, parsePackage'-  )-  where--import Data.ByteString.Lazy.Char8 ( ByteString )-import Data.Map-import Data.String.UTF8 ( toString, fromRep )-import Data.Version-import qualified Distribution.Hackage.DB.Unparsed as Unparsed-import Distribution.PackageDescription-import Distribution.PackageDescription.Parse ( parsePackageDescription, ParseResult(..) )-import Distribution.Text ( display )---- | A 'Map' representation of the Hackage database. Every package name--- maps to a non-empty set of version, and for every version there is a--- parsed Cabal file.+module Distribution.Hackage.DB.Parsed where -type Hackage = Map String (Map Version GenericPackageDescription)+import Distribution.Hackage.DB.Errors+import qualified Distribution.Hackage.DB.MetaData as U+import qualified Distribution.Hackage.DB.Unparsed as U+import Distribution.Hackage.DB.Utility --- | Read the Hackage database from the location determined by 'hackagePath'--- and return a 'Map' that provides fast access to its contents.+import GHC.Generics ( Generic )+import Control.Exception+import Data.ByteString.Lazy as BS+import Data.ByteString.Lazy.UTF8 as BS+import Data.Map as Map+import Data.Time.Clock+import Distribution.Package+import Distribution.PackageDescription+import Distribution.PackageDescription.Parse+import Distribution.Text+import Distribution.Version -readHackage :: IO Hackage-readHackage = fmap parseUnparsedHackage Unparsed.readHackage+type HackageDB = Map PackageName PackageData --- | Read the Hackage database from the given 'FilePath' and return a--- 'Hackage' map that provides fast access to its contents.+type PackageData = Map Version VersionData -readHackage' :: FilePath -> IO Hackage-readHackage' = fmap parseUnparsedHackage . Unparsed.readHackage'+data VersionData = VersionData { cabalFile :: !GenericPackageDescription+                               , tarballHashes :: !(Map String String)+                               }+  deriving (Show, Eq, Generic) --- | Parse the contents of Hackage's @00-index.tar@ into a 'Hackage' map.+readTarball :: Maybe UTCTime -> FilePath -> IO HackageDB+readTarball snapshot path = fmap (parseTarball snapshot path) (BS.readFile path) -parseHackage :: ByteString -> Hackage-parseHackage = parseUnparsedHackage . Unparsed.parseHackage+parseTarball :: Maybe UTCTime -> FilePath -> ByteString -> HackageDB+parseTarball snapshot path buf = parseDB (U.parseTarball snapshot path buf) --- | Convert an 'Unparsed.Hackage' map into a parsed 'Hackage' map.+parseDB :: U.HackageDB -> HackageDB+parseDB = Map.mapWithKey parsePackageData -parseUnparsedHackage :: Unparsed.Hackage -> Hackage-parseUnparsedHackage = Data.Map.mapWithKey parsePackages+parsePackageData :: PackageName -> U.PackageData -> PackageData+parsePackageData pn (U.PackageData pv vs') =+  mapException (\e -> HackageDBPackageName pn (e :: SomeException)) $+    Map.mapWithKey (parseVersionData pn) $+      Map.filterWithKey (\v _ -> v `withinRange` vr) vs'   where-    parsePackages :: String -> Map Version ByteString -> Map Version GenericPackageDescription-    parsePackages name = Data.Map.mapWithKey (parsePackage name)---- | Convenience wrapper around 'parsePackage'' to parse a single Cabal--- file. Failure is reported with 'error'.--parsePackage :: String -> Version -> ByteString -> GenericPackageDescription-parsePackage name version buf = case parsePackage' buf of-                           Right a  -> a-                           Left err -> error $ "cannot parse cabal package " ++ show name ++ "-" ++ display version ++ ": " ++ err+    Dependency _ vr | BS.null pv = Dependency pn anyVersion+                    | otherwise  = parseText "preferred version range" (toString pv) --- | Parse a single Cabal file.+parseVersionData :: PackageName -> Version -> U.VersionData -> VersionData+parseVersionData pn v (U.VersionData cf m) =+   mapException (\e -> HackageDBPackageVersion v (e :: SomeException)) $+     VersionData gpd (parseMetaData pn v m)+  where+    gpd = case parsePackageDescription (toString cf) of+            ParseOk _ a     -> a+            ParseFailed msg -> throw (InvalidCabalFile (show msg)) -parsePackage' :: ByteString -> Either String GenericPackageDescription-parsePackage' buf = case parsePackageDescription (decodeUTF8 buf) of-                     ParseOk _ a     -> Right a-                     ParseFailed err -> Left (show err)+parseMetaData :: PackageName -> Version -> ByteString -> Map String String+parseMetaData pn v buf | BS.null buf = Map.empty+                       | otherwise   = maybe Map.empty U.hashes targetData   where-    decodeUTF8 :: ByteString -> String-    decodeUTF8 = toString . fromRep+    targets = U.targets (U.signed (U.parseMetaData buf))+    target  = "<repo>/package/" ++ display pn ++ "-" ++ display v ++ ".tar.gz"+    targetData = Map.lookup target targets

@@ -9,16 +9,39 @@    @cabal update@.  -} -module Distribution.Hackage.DB.Path ( hackagePath ) where+module Distribution.Hackage.DB.Path where -import System.Directory ( getAppUserDataDirectory )-import System.FilePath ( joinPath )+import Distribution.Hackage.DB.Errors +import Control.Exception+import System.Directory+import System.FilePath++cabalStateDir :: IO FilePath+cabalStateDir = getAppUserDataDirectory "cabal"++cabalTarballDir :: String -> IO FilePath+cabalTarballDir repo = do+  csd <- cabalStateDir+  return $ joinPath [csd, "packages", repo]++hackageTarballDir :: IO FilePath+hackageTarballDir = cabalTarballDir "hackage.haskell.org"+ -- | Determine the default path of the Hackage database, which typically -- resides at @"$HOME\/.cabal\/packages\/hackage.haskell.org\/00-index.tar"@. -- Running the command @"cabal update"@ will keep that file up-to-date. -hackagePath :: IO FilePath-hackagePath = do-  cabalDir <- getAppUserDataDirectory "cabal"-  return $ joinPath [cabalDir, "packages", "hackage.haskell.org", "00-index.tar"]+hackageTarball :: IO FilePath+hackageTarball = do+  htd <- hackageTarballDir+  let idx00 = htd </> "00-index.tar"+      idx01 = htd </> "01-index.tar"+  -- Using 'msum' here would be nice, but unfortunetaly there was no reliable+  -- MonadPlus instance for IO in pre 8.x versions of GHC. Se we use the ugly+  -- code for sake of portability.+  have01 <- doesFileExist idx01+  if have01 then return idx01 else do+    have00 <- doesFileExist idx00+    if have00 then return idx00 else+      throwIO NoHackageTarballFound

@@ -1,62 +1,90 @@-{- |-   Module      :  Distribution.Hackage.DB.Unparsed-   License     :  BSD3-   Maintainer  :  simons@cryp.to-   Stability   :  provisional-   Portability :  portable+{-# LANGUAGE DeriveGeneric #-} -   This module provides simple access to the Hackage database by means-   of 'Map'.+{- |+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: portable  -}  module Distribution.Hackage.DB.Unparsed-  ( Hackage, readHackage, readHackage', parseHackage, hackagePath+  ( HackageDB, PackageData(..), VersionData(..)+  , readTarball, parseTarball   )   where -import qualified Codec.Archive.Tar as Tar-import Data.ByteString.Lazy.Char8 ( ByteString )-import qualified Data.ByteString.Lazy.Char8 as BS8 ( readFile )-import Data.Map-import Data.Maybe ( fromMaybe )-import Data.Version-import Distribution.Hackage.DB.Path-import Distribution.Text ( simpleParse )-import System.FilePath ( splitDirectories )+import Distribution.Hackage.DB.Errors+import Distribution.Hackage.DB.Utility --- | A 'Map' representation of the Hackage database. Every package name--- maps to a non-empty set of version, and for every version there is a--- Cabal file stored as a (lazy) 'ByteString'.+import Codec.Archive.Tar as Tar+import Codec.Archive.Tar.Entry as Tar+import Control.Exception+import Data.ByteString.Lazy as BS ( ByteString, empty, readFile )+import Data.Map as Map+import Data.Time.Clock+import Distribution.Package+import Distribution.Version+import GHC.Generics ( Generic )+import System.FilePath -type Hackage = Map String (Map Version ByteString)+type HackageDB = Map PackageName PackageData --- | Read the Hackage database from the location determined by 'hackagePath'--- and return a 'Map' that provides fast access to its contents.+data PackageData = PackageData { preferredVersions :: ByteString+                               , versions          :: Map Version VersionData+                               }+  deriving (Show, Eq, Generic) -readHackage :: IO Hackage-readHackage = hackagePath >>= readHackage'+data VersionData = VersionData { cabalFile :: ByteString+                               , metaFile  :: ByteString+                               }+  deriving (Show, Eq, Generic) --- | Read the Hackage database from the given 'FilePath' and return a--- 'Hackage' map that provides fast access to its contents.+readTarball :: Maybe UTCTime -> FilePath -> IO HackageDB+readTarball snapshot path = fmap (parseTarball snapshot path) (BS.readFile path) -readHackage' :: FilePath -> IO Hackage-readHackage' = fmap parseHackage . BS8.readFile+parseTarball :: Maybe UTCTime -> FilePath -> ByteString -> HackageDB+parseTarball snapshot path buf =+  mapException (\e -> HackageDBTarball path (e :: SomeException)) $+    foldEntriesUntil (maybe maxBound toEpochTime snapshot) Map.empty (Tar.read buf) --- | Parse the contents of Hackage's @00-index.tar@ into a 'Hackage' map.+foldEntriesUntil :: EpochTime -> HackageDB -> Entries FormatError -> HackageDB+foldEntriesUntil _        db  Done       = db+foldEntriesUntil _        _  (Fail err)  = throw (IncorrectTarfile err)+foldEntriesUntil snapshot db (Next e es) | entryTime e <= snapshot = foldEntriesUntil snapshot (handleEntry db e) es+                                         | otherwise               = db -parseHackage :: ByteString -> Hackage-parseHackage = Tar.foldEntries addEntry empty (error . show) . Tar.read+handleEntry :: HackageDB -> Entry -> HackageDB+handleEntry db e =+  let (pn':ep) = splitDirectories (entryPath e)+      pn = parseText "PackageName" pn'+  in+  case (ep, entryContent e) of++    (["preferred-versions"], NormalFile buf _) -> insertWith setConstraint pn (PackageData buf Map.empty) db++    ([v',file], NormalFile buf _) -> let v = parseText "Version" v' in+          if file == pn' <.> "cabal" then insertVersionData setCabalFile pn v (VersionData buf BS.empty) db else+          if file == "package.json" then insertVersionData setMetaFile pn v (VersionData BS.empty buf) db else+          throw (UnsupportedTarEntry e)++    (_, Directory) -> db                -- some tarballs have these superfluous entries+    ([], NormalFile {}) -> db+    ([], OtherEntryType {}) -> db++    _ -> throw (UnsupportedTarEntry e)++setConstraint :: PackageData -> PackageData -> PackageData+setConstraint new old = old { preferredVersions = preferredVersions new }++insertVersionData :: (VersionData -> VersionData -> VersionData)+                   -> PackageName -> Version -> VersionData+                   -> HackageDB -> HackageDB+insertVersionData setFile pn v vd = insertWith mergeVersionData pn pd   where-    addEntry :: Tar.Entry -> Hackage -> Hackage-    addEntry e db = case splitDirectories (Tar.entryPath e) of-                        [".",".","@LongLink"] -> db-                        path@[name,vers,_] -> case Tar.entryContent e of-                                                Tar.NormalFile buf _ -> add name vers buf db-                                                _                    -> error ("Hackage.DB.parseHackage: unexpected content type for " ++ show path)-                        _                  -> db+    pd = PackageData BS.empty (Map.singleton v vd)+    mergeVersionData _ old = old { versions = insertWith setFile v vd (versions old) } -    add :: String -> String -> ByteString -> Hackage -> Hackage-    add name version pkg = insertWith union name (singleton (pVersion version) pkg)+setCabalFile :: VersionData -> VersionData -> VersionData+setCabalFile new old = old { cabalFile = cabalFile new } -    pVersion :: String -> Version-    pVersion str = fromMaybe (error $ "Hackage.DB.parseHackage: cannot parse version " ++ show str) (simpleParse str)+setMetaFile :: VersionData -> VersionData -> VersionData+setMetaFile new old = old { metaFile = metaFile new }

@@ -0,0 +1,33 @@+{- |+   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  portable+ -}++module Distribution.Hackage.DB.Utility where++import Distribution.Hackage.DB.Errors++import Control.Exception+import Codec.Archive.Tar.Entry as Tar+import Data.Maybe+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Distribution.Text++parseText :: Text a => String -> String -> a+parseText t x = fromMaybe (throw (InvalidRepresentationOfType t x)) (simpleParse x)++-- | Convert the the 'EpochTime' used by the @tar@ library into a standard+-- 'UTCTime' type.+--+-- prop> \et -> toEpochTime (fromEpochTime et) == et++fromEpochTime :: EpochTime -> UTCTime+fromEpochTime et = posixSecondsToUTCTime (realToFrac et)++-- | Convert the standard 'UTCTime' type into the 'EpochTime' used by the @tar@+-- library.++toEpochTime :: UTCTime -> EpochTime+toEpochTime = floor . utcTimeToPOSIXSeconds