Skip to content
This repository was archived by the owner on Feb 27, 2024. It is now read-only.

List cabal file revisions #9

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 3 additions & 21 deletions .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -44,12 +44,9 @@ matrix:
# env: TEST=--disable-tests BENCH=--disable-benchmarks
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
- compiler: "ghc-8.4.1"
env: GHCHEAD=true
# env: TEST=--disable-tests BENCH=--disable-benchmarks
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}

allow_failures:
- compiler: "ghc-8.4.1"

before_install:
- HC=${CC}
- HCPKG=${HC/ghc/ghc-pkg}
Expand All @@ -71,24 +68,9 @@ install:
- travis_retry cabal update -v
- "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
- rm -fv cabal.project cabal.project.local
# Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage
- |
if $GHCHEAD; then
sed -i.bak 's/-- allow-newer:.*/allow-newer: *:base, *:template-haskell, *:ghc, *:Cabal/' ${HOME}/.cabal/config

echo 'repository head.hackage' >> ${HOME}/.cabal/config
echo ' url: http://head.hackage.haskell.org/' >> ${HOME}/.cabal/config
echo ' secure: True' >> ${HOME}/.cabal/config
echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config
echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config
echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config
echo ' key-threshold: 3' >> ${HOME}/.cabal.config

cabal new-update head.hackage -v
fi
- grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
- if [ $HCNUMVER -ge 80000 ]; then cabal new-install -w ${HC} --symlink-bindir=$HOME/.local/bin doctest --constraint='doctest ==0.13.*'; fi
- if [ $HCNUMVER -eq 80202 ]; then cabal new-install -w ${HC} --symlink-bindir=$HOME/.local/bin hlint --constraint='hlint ==2.0.*'; fi
- if [ $HCNUMVER -ge 80000 ]; then cabal new-install -w ${HC} --symlink-bindir=$HOME/.local/bin doctest --constraint='doctest ==0.14.*'; fi
- if [ $HCNUMVER -eq 80202 ]; then cabal new-install -w ${HC} --symlink-bindir=$HOME/.local/bin hlint --constraint='hlint ==2.1.*'; fi
- "printf 'packages: \".\"\\n' > cabal.project"
- cat cabal.project
- if [ -f "./configure.ac" ]; then
Expand Down
7 changes: 4 additions & 3 deletions src/Distribution/Hackage/DB/Parsed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ import Distribution.Hackage.DB.Utility
import Control.Exception
import Data.ByteString.Lazy as BS
import Data.ByteString.Lazy.UTF8 as BS
import Data.List.NonEmpty
import Data.Map as Map
import Data.Maybe
import Data.Time.Clock
Expand All @@ -30,7 +31,7 @@ type HackageDB = Map PackageName PackageData

type PackageData = Map Version VersionData

data VersionData = VersionData { cabalFile :: !GenericPackageDescription
data VersionData = VersionData { cabalFileRevisions :: NonEmpty GenericPackageDescription
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Storing different revisions in a list means that I cannot easily find a given revision. Before this change, you had essentially a lookup PackageName -> Version -> GenericPackageDescription, which would always give you the latest available revision. If we'd like to make the code aware of revisions, then IMHO it should come in the form of a lookup:

PackageName -> Version -> Revision -> GenericPackageDescription

One possible alternative interface could be to extend our notion of Version with something that is aware of revisions. I suppose that would end up being more space efficient that to create a whole lot of singletons Maps for the majority of package versions, which have never been revised.

, tarballHashes :: !(Map String String)
}
deriving (Show, Eq, Generic)
Expand All @@ -54,12 +55,12 @@ parsePackageData pn (U.PackageData pv vs') =
| otherwise = parseText "preferred version range" (toString pv)

parseVersionData :: PackageName -> Version -> U.VersionData -> VersionData
parseVersionData pn v (U.VersionData cf m) =
parseVersionData pn v (U.VersionData cfs m) =
mapException (\e -> HackageDBPackageVersion v (e :: SomeException)) $
VersionData gpd (parseMetaData pn v m)
where
gpd = fromMaybe (throw (InvalidCabalFile (show (pn,v)))) $
parseGenericPackageDescriptionMaybe (toStrict cf)
nonEmpty =<< traverse (parseGenericPackageDescriptionMaybe . toStrict) cfs

parseMetaData :: PackageName -> Version -> ByteString -> Map String String
parseMetaData pn v buf | BS.null buf = Map.empty
Expand Down
10 changes: 5 additions & 5 deletions src/Distribution/Hackage/DB/Unparsed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -33,8 +33,8 @@ data PackageData = PackageData { preferredVersions :: ByteString
}
deriving (Show, Eq, Generic)

data VersionData = VersionData { cabalFile :: ByteString
, metaFile :: ByteString
data VersionData = VersionData { cabalFileRevisions :: [ByteString]
, metaFile :: ByteString
}
deriving (Show, Eq, Generic)

Expand Down Expand Up @@ -62,8 +62,8 @@ handleEntry db e =
(["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
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 [] buf) db else
throw (UnsupportedTarEntry e)

(_, Directory) -> db -- some tarballs have these superfluous entries
Expand All @@ -84,7 +84,7 @@ insertVersionData setFile pn v vd = insertWith mergeVersionData pn pd
mergeVersionData _ old = old { versions = insertWith setFile v vd (versions old) }

setCabalFile :: VersionData -> VersionData -> VersionData
setCabalFile new old = old { cabalFile = cabalFile new }
setCabalFile new old = old { cabalFileRevisions = cabalFileRevisions old ++ cabalFileRevisions new }

setMetaFile :: VersionData -> VersionData -> VersionData
setMetaFile new old = old { metaFile = metaFile new }