hackage-db 1.22 → 2.1.3
raw patch · 14 files changed
Files
- CHANGELOG.md +27/−0
- README.md +7/−0
- example/list-known-versions.hs +17/−0
- example/show-meta-data.hs +21/−0
- example/show-package-versions.hs +17/−0
- hackage-db.cabal +83/−55
- src/Distribution/Hackage/DB.hs +5/−17
- src/Distribution/Hackage/DB/Builder.hs +50/−0
- src/Distribution/Hackage/DB/Errors.hs +42/−0
- src/Distribution/Hackage/DB/MetaData.hs +58/−0
- src/Distribution/Hackage/DB/Parsed.hs +60/−59
- src/Distribution/Hackage/DB/Path.hs +62/−10
- src/Distribution/Hackage/DB/Unparsed.hs +52/−45
- src/Distribution/Hackage/DB/Utility.hs +45/−0
+ CHANGELOG.md view
@@ -0,0 +1,27 @@+# Revision history for hackage-db++## 2.1.3++* `hackageTarball` / `cabalStateDir` now support overriding the cabal directory+ location by setting the `CABAL_DIR` environment variable. This is useful if+ `hackage-db` doesn't detect the correct location on its own:++ - A matching cabal state directory may exist, but should not be used for some+ reason.++ - A non-standard cabal state directory may be used, but `hackage-db` can't+ find it (as it doesn't check the `cabal-install` configuration file).++* `hackageTarball` now supports all state dir location(s) (newly) supported by+ `cabal-install`. If `CABAL_DIR` is not set, it will look in the following+ locations in that order:++ 1. `$HOME/.cabal`, the classic location, will be preferred if it exists.+ 2. `$XDG_CACHE_HOME/cabal` (usually `$HOME/.cache/cabal`) is used otherwise.+ `cabal-install` 3.10.1.0 and newer will default to this location for+ fresh installations.++## 2.1.2++Fix a bug which lead to `parsePackageData` always failing if the package had+a `preferred-versions` file in the hackage tarball.
+ README.md view
@@ -0,0 +1,7 @@+hackage-db+==========++[](http://hackage.haskell.org/package/hackage-db)+[](http://stackage.org/lts/package/hackage-db)+[](http://stackage.org/nightly/package/hackage-db)+
+ example/list-known-versions.hs view
@@ -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 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
+ example/show-meta-data.hs view
@@ -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.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)
+ example/show-package-versions.hs view
@@ -0,0 +1,17 @@+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)
hackage-db.cabal view
@@ -1,57 +1,85 @@-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).+name: hackage-db+version: 2.1.3+synopsis: Access cabal-install's Hackage database via Data.Map+description: This library provides convenient access to the local copy of the Hackage+ database that \"cabal update\" creates. Check out+ <https://github.com/NixOS/hackage-db/tree/master/example/> for a collection+ of simple example programs that demonstrate how to use this code.+license: BSD3+license-file: LICENSE+author: Peter Simons, Alexander Altman, Ben James, Kevin Quick+maintainer: sternenseemann <sternenseemann@systemli.org>+tested-with: GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.7 || == 9.4.4+category: Distribution+homepage: https://github.com/NixOS/cabal2nix/tree/master/hackage-db#readme+bug-reports: https://github.com/NixOS/cabal2nix/issues+build-type: Simple+cabal-version: >= 1.10+extra-source-files: README.md+ CHANGELOG.md -Source-Repository head- Type: git- Location: git://github.com/peti/hackage-db.git+source-repository head+ type: git+ location: git://github.com/NixOS/cabal2nix.git+ subdir: hackage-db -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+flag install-examples+ default: False+ description: Build and install example programs.++library+ exposed-modules: Distribution.Hackage.DB+ Distribution.Hackage.DB.Builder+ 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+ hs-source-dirs: src+ build-depends: base >= 4.9 && < 5+ , Cabal > 3+ , aeson+ , bytestring+ , containers+ , directory+ , exceptions+ , filepath+ , tar >= 0.4+ , time+ , utf8-string+ default-language: Haskell2010+ other-extensions: DeriveDataTypeable+ DeriveGeneric++executable list-known-versions+ main-is: list-known-versions.hs+ hs-source-dirs: example+ default-language: Haskell2010++ if flag(install-examples)+ build-depends: base >= 3 && < 5, Cabal, bytestring, containers, hackage-db+ else+ buildable: False++executable show-meta-data+ main-is: show-meta-data.hs+ hs-source-dirs: example+ default-language: Haskell2010++ if flag(install-examples)+ build-depends: base >= 3 && < 5, Cabal, containers, hackage-db, utf8-string+ else+ buildable: False++executable show-package-versions+ main-is: show-package-versions.hs+ hs-source-dirs: example+ default-language: Haskell2010+ other-extensions: CPP++ if flag(install-examples)+ build-depends: base >= 3 && < 5, Cabal, containers, hackage-db+ else+ buildable: False
src/Distribution/Hackage/DB.hs view
@@ -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
+ src/Distribution/Hackage/DB/Builder.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}++{- |+ Maintainer: simons@cryp.to+ Stability: provisional+ Portability: portable+ -}++module Distribution.Hackage.DB.Builder+ ( readTarball, parseTarball+ , Builder(..)+ )+ where++import Distribution.Hackage.DB.Errors+import Distribution.Hackage.DB.Utility++import Codec.Archive.Tar as Tar+import Codec.Archive.Tar.Entry as Tar+import Control.Monad.Catch+import qualified Data.ByteString.Lazy as BSL+import Distribution.Types.PackageName+import Distribution.Types.Version+import System.FilePath++readTarball :: FilePath -> IO (Entries FormatError)+readTarball = fmap Tar.read . BSL.readFile++data Builder m a = Builder+ { insertPreferredVersions :: PackageName -> EpochTime -> BSL.ByteString -> a -> m a+ , insertCabalFile :: PackageName -> Version -> EpochTime -> BSL.ByteString -> a -> m a+ , insertMetaFile :: PackageName -> Version -> EpochTime -> BSL.ByteString -> a -> m a+ }++{-# INLINABLE parseTarball #-}+parseTarball :: MonadThrow m => Builder m a -> Maybe EpochTime -> Entries FormatError -> a -> m a+parseTarball b (Just et) (Next e es) !db = if entryTime e > et then return db else insertEntry b e db >>= parseTarball b (Just et) es+parseTarball b Nothing (Next e es) !db = insertEntry b e db >>= parseTarball b Nothing es+parseTarball _ _ (Fail err) _ = throwM err+parseTarball _ _ Done !db = return db++{-# INLINABLE insertEntry #-}+insertEntry :: MonadThrow m => Builder m a -> Entry -> a -> m a+insertEntry b e db =+ case (splitDirectories (entryPath e), entryContent e) of+ ([pn,"preferred-versions"], NormalFile buf _) -> insertPreferredVersions b (mkPackageName pn) (entryTime e) buf db+ ([pn,v,file], NormalFile buf _)+ | takeExtension file == ".cabal" -> insertCabalFile b (mkPackageName pn) (parseText "Version" v) (entryTime e) buf db+ | takeExtension file == ".json" -> insertMetaFile b (mkPackageName pn) (parseText "Version" v) (entryTime e) buf db+ _ -> throwM (UnsupportedTarEntry e)
+ src/Distribution/Hackage/DB/Errors.hs view
@@ -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
+ src/Distribution/Hackage/DB/MetaData.hs view
@@ -0,0 +1,58 @@+{-# 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 :: 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
src/Distribution/Hackage/DB/Parsed.hs view
@@ -1,75 +1,76 @@-{- |- 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 Codec.Archive.Tar+import Codec.Archive.Tar.Entry+import Control.Exception+import Control.Monad.Catch+import Data.ByteString as BSS+import Data.ByteString.Lazy as BSL+import Data.ByteString.UTF8 as BSS+import Data.Map as Map+import Data.Maybe+import Data.Time.Clock+import Distribution.Package+import Distribution.PackageDescription+import Distribution.PackageDescription.Parsec+import Distribution.Text+import Distribution.Types.PackageVersionConstraint+import Distribution.Version+import GHC.Generics ( Generic ) -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 tarball = fmap parseDB (U.readTarball snapshot tarball) -parseHackage :: ByteString -> Hackage-parseHackage = parseUnparsedHackage . Unparsed.parseHackage+parseTarball :: MonadThrow m => Maybe UTCTime -> Entries FormatError -> m HackageDB+parseTarball snapshot es = fmap parseDB (U.parseTarball snapshot es mempty) --- | 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+ PackageVersionConstraint _ vr+ | BSS.null pv = PackageVersionConstraint 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 = fromMaybe (throw (InvalidCabalFile (show (pn,v)))) $+ parseGenericPackageDescriptionMaybe cf -parsePackage' :: ByteString -> Either String GenericPackageDescription-parsePackage' buf = case parsePackageDescription (decodeUTF8 buf) of- ParseOk _ a -> Right a- ParseFailed err -> Left (show err)+parseMetaData :: PackageName -> Version -> BSS.ByteString -> Map String String+parseMetaData pn v buf | BSS.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 (BSL.fromStrict buf)))+ target = "<repo>/package/" ++ display pn ++ "-" ++ display v ++ ".tar.gz"+ targetData = Map.lookup target targets
src/Distribution/Hackage/DB/Path.hs view
@@ -9,16 +9,68 @@ @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 --- | 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.+import Control.Exception+import System.Directory+import System.Environment (lookupEnv)+import System.FilePath -hackagePath :: IO FilePath-hackagePath = do- cabalDir <- getAppUserDataDirectory "cabal"- return $ joinPath [cabalDir, "packages", "hackage.haskell.org", "00-index.tar"]+-- |+-- Determines the /state/ directory (which e.g. holds the hackage tarball)+-- cabal-install uses via the following logic:+--+-- 1. If the @CABAL_DIR@ environment variable is set, its content is used as the+-- cabal state directory+-- 2. If @~/.cabal@ (see 'getAppUserDataDirectory') exists, use that.+-- 3. Otherwise, use @${XDG_CACHE_HOME}/cabal@ (see @'getXdgDirectory' 'XdgCache'@)+-- which is the new directory cabal-install can use starting with+-- version @3.10.*@.+--+-- This logic is mostly equivalent to what upstream cabal-install is+-- [doing](https://github.com/haskell/cabal/blob/0ed12188525335ac9759dc957d49979ab09382a1/cabal-install/src/Distribution/Client/Config.hs#L594-L610)+-- with the following exception:+-- The state directory can freely be configured to use a different location+-- in the cabal-install configuration file. hackage-db doesn't parse this+-- configuration file, so differing state directories are ignored.+cabalStateDir :: IO FilePath+cabalStateDir = do+ envCabal <- lookupEnv "CABAL_DIR"+ dotCabal <- getAppUserDataDirectory "cabal"+ dotCabalExists <- doesDirectoryExist dotCabal+ case envCabal of+ Just dir -> pure dir+ Nothing ->+ if dotCabalExists+ then pure dotCabal+ else getXdgDirectory XdgCache "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 in @$HOME\/.cabal\/packages\/hackage.haskell.org\/@.+-- Running the command @cabal update@ or @cabal v2-update@ will keep the index+-- up-to-date.+--+-- See 'cabalStateDir' on how @hackage-db@ searches for the cabal state directory.+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. So 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
src/Distribution/Hackage/DB/Unparsed.hs view
@@ -1,62 +1,69 @@-{- |- 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+ , builder ) 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 qualified Distribution.Hackage.DB.Builder as Build+import Distribution.Hackage.DB.Builder ( Builder(..) )+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 Control.Monad.Catch+import Data.ByteString ( ByteString )+import Data.ByteString.Lazy ( toStrict )+import Data.Map.Strict as Map+import Data.Time.Clock+import Distribution.Types.PackageName+import Distribution.Types.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 tarball = Build.readTarball tarball >>= \es -> parseTarball snapshot es mempty -readHackage' :: FilePath -> IO Hackage-readHackage' = fmap parseHackage . BS8.readFile+parseTarball :: MonadThrow m => Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB+parseTarball = Build.parseTarball builder . fmap toEpochTime --- | Parse the contents of Hackage's @00-index.tar@ into a 'Hackage' map.+builder :: Applicative m => Builder m HackageDB+builder = Builder+ { insertPreferredVersions = \pn _ buf -> let new = PackageData (toStrict buf) mempty+ f _ old = old { preferredVersions = preferredVersions new }+ in pure . Map.insertWith f pn new -parseHackage :: ByteString -> Hackage-parseHackage = Tar.foldEntries addEntry empty (error . show) . Tar.read- 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+ , insertCabalFile = \pn v _ buf -> let f Nothing = PackageData mempty (Map.singleton v new)+ f (Just pd) = pd { versions = Map.insertWith g v new (versions pd) }+ new = VersionData (toStrict buf) mempty+ g _ old = old { cabalFile = cabalFile new }+ in pure . Map.alter (Just . f) pn - add :: String -> String -> ByteString -> Hackage -> Hackage- add name version pkg = insertWith union name (singleton (pVersion version) pkg)+ , insertMetaFile = \pn v _ buf -> let f Nothing = PackageData mempty (Map.singleton v new)+ f (Just pd) = pd { versions = Map.insertWith g v new (versions pd) } - pVersion :: String -> Version- pVersion str = fromMaybe (error $ "Hackage.DB.parseHackage: cannot parse version " ++ show str) (simpleParse str)+ new = VersionData mempty (toStrict buf)+ g _ old = old { metaFile = metaFile new }+ in pure . Map.alter (Just . f) pn+ }
+ src/Distribution/Hackage/DB/Utility.hs view
@@ -0,0 +1,45 @@+{- |+ Maintainer : simons@cryp.to+ Stability : provisional+ Portability : portable+ -}++module Distribution.Hackage.DB.Utility where++import Distribution.Hackage.DB.Errors++import Codec.Archive.Tar.Entry as Tar+import Control.Exception+import Control.Monad.Fail+import Data.Maybe+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Data.Time.Format+import Distribution.Parsec++parseText :: Parsec a => String -> String -> a+parseText t x = fromMaybe (throw (InvalidRepresentationOfType t x)) (simpleParsec x)++-- | Convert the the 'EpochTime' used by the @tar@ library into a standard+-- 'UTCTime' type.++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++-- | Parse an UTC timestamp in extended ISO8601 format a standard 'UTCTime'+-- type. This function is useful to parse the "snapshot" identifier printed by+-- @cabal-install@ after a database update into a useable type. Combine with+-- 'toEpochTime' to obtain an 'EpochTime' that can be passed to the Hackage DB+-- reading code from this library.+--+-- >>> parseIso8601 "2018-12-21T13:17:40Z"+-- 2018-12-21 13:17:40 UTC++parseIso8601 :: MonadFail m => String -> m UTCTime+parseIso8601 = parseTimeM False defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%SZ"))