hackage-db 2.0.1 → 2.1.3
raw patch · 11 files changed
Files
- CHANGELOG.md +27/−0
- README.md +7/−0
- example/list-known-versions.hs +1/−1
- example/show-meta-data.hs +1/−1
- hackage-db.cabal +65/−86
- src/Distribution/Hackage/DB/Builder.hs +50/−0
- src/Distribution/Hackage/DB/MetaData.hs +0/−4
- src/Distribution/Hackage/DB/Parsed.hs +18/−12
- src/Distribution/Hackage/DB/Path.hs +34/−5
- src/Distribution/Hackage/DB/Unparsed.hs +32/−53
- src/Distribution/Hackage/DB/Utility.hs +18/−4
+ 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
@@ -4,7 +4,7 @@ import Distribution.Hackage.DB.Unparsed import Control.Monad-import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString as BS import Data.List as List import Data.Map as Map import Distribution.Text
example/show-meta-data.hs view
@@ -5,7 +5,7 @@ import Distribution.Hackage.DB.Utility import Control.Monad-import Data.ByteString.Lazy.UTF8 as BS+import Data.ByteString.UTF8 as BS import Data.Map as Map import Distribution.Package import System.Environment
hackage-db.cabal view
@@ -1,106 +1,85 @@-name: hackage-db-version: 2.0.1-license: BSD3-license-file: LICENSE-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-tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3- , GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1--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.- .- 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.+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+ type: git+ location: git://github.com/NixOS/cabal2nix.git+ subdir: hackage-db flag install-examples- description: Build and install example programs.- default: False+ default: False+ description: Build and install example programs. library- hs-source-dirs:- src- other-extensions: DeriveDataTypeable DeriveGeneric- build-depends:- base >= 3 && < 5- , Cabal >2.2- , 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+ 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+ main-is: list-known-versions.hs+ hs-source-dirs: example+ default-language: Haskell2010+ if flag(install-examples)- buildable: True- build-depends:- base >= 3 && < 5- , Cabal- , containers- , hackage-db- , bytestring+ build-depends: base >= 3 && < 5, Cabal, bytestring, containers, hackage-db else- buildable: False- default-language: Haskell2010+ buildable: False executable show-meta-data- main-is: show-meta-data.hs- hs-source-dirs:- example+ main-is: show-meta-data.hs+ hs-source-dirs: example+ default-language: Haskell2010+ if flag(install-examples)- buildable: True- build-depends:- base >= 3 && < 5- , Cabal- , containers- , hackage-db- , utf8-string+ build-depends: base >= 3 && < 5, Cabal, containers, hackage-db, utf8-string else- buildable: False- default-language: Haskell2010+ buildable: False executable show-package-versions- main-is: show-package-versions.hs- hs-source-dirs:- example+ main-is: show-package-versions.hs+ hs-source-dirs: example+ default-language: Haskell2010 other-extensions: CPP+ if flag(install-examples)- buildable: True- build-depends:- base >= 3 && < 5- , Cabal- , containers- , hackage-db+ build-depends: base >= 3 && < 5, Cabal, containers, hackage-db else- buildable: False- default-language: Haskell2010+ buildable: False
+ 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/MetaData.hs view
@@ -30,10 +30,6 @@ -- >>> :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
src/Distribution/Hackage/DB/Parsed.hs view
@@ -13,9 +13,13 @@ import qualified Distribution.Hackage.DB.Unparsed as U import Distribution.Hackage.DB.Utility +import Codec.Archive.Tar+import Codec.Archive.Tar.Entry import Control.Exception-import Data.ByteString.Lazy as BS-import Data.ByteString.Lazy.UTF8 as BS+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@@ -23,6 +27,7 @@ import Distribution.PackageDescription import Distribution.PackageDescription.Parsec import Distribution.Text+import Distribution.Types.PackageVersionConstraint import Distribution.Version import GHC.Generics ( Generic ) @@ -36,10 +41,10 @@ deriving (Show, Eq, Generic) readTarball :: Maybe UTCTime -> FilePath -> IO HackageDB-readTarball snapshot path = fmap (parseTarball snapshot path) (BS.readFile path)+readTarball snapshot tarball = fmap parseDB (U.readTarball snapshot tarball) -parseTarball :: Maybe UTCTime -> FilePath -> ByteString -> HackageDB-parseTarball snapshot path buf = parseDB (U.parseTarball snapshot path buf)+parseTarball :: MonadThrow m => Maybe UTCTime -> Entries FormatError -> m HackageDB+parseTarball snapshot es = fmap parseDB (U.parseTarball snapshot es mempty) parseDB :: U.HackageDB -> HackageDB parseDB = Map.mapWithKey parsePackageData@@ -50,8 +55,9 @@ Map.mapWithKey (parseVersionData pn) $ Map.filterWithKey (\v _ -> v `withinRange` vr) vs' where- Dependency _ vr | BS.null pv = Dependency pn anyVersion- | otherwise = parseText "preferred version range" (toString pv)+ PackageVersionConstraint _ vr+ | BSS.null pv = PackageVersionConstraint pn anyVersion+ | otherwise = parseText "preferred version range" (toString pv) parseVersionData :: PackageName -> Version -> U.VersionData -> VersionData parseVersionData pn v (U.VersionData cf m) =@@ -59,12 +65,12 @@ VersionData gpd (parseMetaData pn v m) where gpd = fromMaybe (throw (InvalidCabalFile (show (pn,v)))) $- parseGenericPackageDescriptionMaybe (toStrict cf)+ parseGenericPackageDescriptionMaybe cf -parseMetaData :: PackageName -> Version -> ByteString -> Map String String-parseMetaData pn v buf | BS.null buf = Map.empty- | otherwise = maybe Map.empty U.hashes targetData+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- targets = U.targets (U.signed (U.parseMetaData buf))+ 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
@@ -15,10 +15,37 @@ import Control.Exception import System.Directory+import System.Environment (lookupEnv) import System.FilePath +-- |+-- 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 = getAppUserDataDirectory "cabal"+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@@ -29,16 +56,18 @@ 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.-+-- 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. Se we use the ugly+ -- 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
src/Distribution/Hackage/DB/Unparsed.hs view
@@ -9,82 +9,61 @@ module Distribution.Hackage.DB.Unparsed ( HackageDB, PackageData(..), VersionData(..) , readTarball, parseTarball+ , builder ) where -import Distribution.Hackage.DB.Errors+import qualified Distribution.Hackage.DB.Builder as Build+import Distribution.Hackage.DB.Builder ( Builder(..) ) import Distribution.Hackage.DB.Utility 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 Control.Monad.Catch+import Data.ByteString ( ByteString )+import Data.ByteString.Lazy ( toStrict )+import Data.Map.Strict as Map import Data.Time.Clock-import Distribution.Package-import Distribution.Version+import Distribution.Types.PackageName+import Distribution.Types.Version import GHC.Generics ( Generic ) import System.FilePath type HackageDB = Map PackageName PackageData -data PackageData = PackageData { preferredVersions :: ByteString- , versions :: Map Version VersionData+data PackageData = PackageData { preferredVersions :: !ByteString+ , versions :: !(Map Version VersionData) } deriving (Show, Eq, Generic) -data VersionData = VersionData { cabalFile :: ByteString- , metaFile :: ByteString+data VersionData = VersionData { cabalFile :: !ByteString+ , metaFile :: !ByteString } deriving (Show, Eq, Generic) readTarball :: Maybe UTCTime -> FilePath -> IO HackageDB-readTarball snapshot path = fmap (parseTarball snapshot path) (BS.readFile path)--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)--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--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+readTarball snapshot tarball = Build.readTarball tarball >>= \es -> parseTarball snapshot es mempty - _ -> throw (UnsupportedTarEntry e)+parseTarball :: MonadThrow m => Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB+parseTarball = Build.parseTarball builder . fmap toEpochTime -setConstraint :: PackageData -> PackageData -> PackageData-setConstraint new old = old { preferredVersions = preferredVersions new }+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 -insertVersionData :: (VersionData -> VersionData -> VersionData)- -> PackageName -> Version -> VersionData- -> HackageDB -> HackageDB-insertVersionData setFile pn v vd = insertWith mergeVersionData pn pd- where- pd = PackageData BS.empty (Map.singleton v vd)- mergeVersionData _ old = old { versions = insertWith setFile v vd (versions old) }+ , 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 -setCabalFile :: VersionData -> VersionData -> VersionData-setCabalFile new old = old { cabalFile = cabalFile new }+ , 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) } -setMetaFile :: VersionData -> VersionData -> VersionData-setMetaFile new old = old { metaFile = metaFile new }+ 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
@@ -8,15 +8,17 @@ import Distribution.Hackage.DB.Errors -import Control.Exception 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 Distribution.Text+import Data.Time.Format+import Distribution.Parsec -parseText :: Text a => String -> String -> a-parseText t x = fromMaybe (throw (InvalidRepresentationOfType t x)) (simpleParse x)+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.@@ -29,3 +31,15 @@ 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"))