diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## v0.8.5.1 (2023-02-14) + +Release v0.8.5.1 + +- Fix bug where dependencies do not get a `:=` slot operator + +- Improve `remote-id` generation for `metadata.xml` by adding some relevant + repository types and removing irrelevant ones. + ## v0.8.5.0 (2023-02-05) Release v0.8.5.0 diff --git a/hackport.cabal b/hackport.cabal --- a/hackport.cabal +++ b/hackport.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hackport -version: 0.8.5.0 +version: 0.8.5.1 license: GPL-3.0-or-later license-file: LICENSE author: Henning Günther, Duncan Coutts, Lennart Kolmodin @@ -869,6 +869,7 @@ Portage.Overlay Portage.PackageId Portage.Resolve + Portage.Slots Portage.Use Portage.Version Status diff --git a/src/Merge/Dependencies.hs b/src/Merge/Dependencies.hs --- a/src/Merge/Dependencies.hs +++ b/src/Merge/Dependencies.hs @@ -43,6 +43,7 @@ import qualified Portage.Overlay as Portage import qualified Portage.PackageId as Portage import qualified Portage.Use as Portage +import qualified Portage.Slots as Portage import qualified Cabal2Ebuild as C2E import qualified Portage.GHCCore as GHCCore @@ -155,8 +156,8 @@ ], dep_e = S.singleton "${RDEPEND}", rdep = Portage.DependAllOf - [ ghc_dep - , add_profile $ raw_haskell_deps + [ Portage.set_build_slot ghc_dep + , Portage.set_build_slot $ add_profile $ raw_haskell_deps , extra_libs , Portage.DependAllOf pkg_config_libs ] @@ -171,8 +172,8 @@ ], dep_e = S.singleton "${RDEPEND}", rdep = Portage.DependAllOf - [ ghc_dep - , raw_haskell_deps + [ Portage.set_build_slot ghc_dep + , Portage.set_build_slot $ raw_haskell_deps , extra_libs , Portage.DependAllOf pkg_config_libs ] diff --git a/src/Portage/Metadata.hs b/src/Portage/Metadata.hs --- a/src/Portage/Metadata.hs +++ b/src/Portage/Metadata.hs @@ -78,13 +78,9 @@ else S.empty -- Sometimes the .cabal file will explicitly list source repos - sourceRemoteIds = - let r = matchURIs (EBuild.sourceURIs ebuild) - in - if S.null r - -- If the list of source remote-ids is empty, we fall back to using the homepage - then matchURIs [EBuild.homepage ebuild] - else r + sourceRemoteIds = matchURIs (EBuild.sourceURIs ebuild) + -- Try to extract a remote id using the homepage + <> matchURIs [EBuild.homepage ebuild] -- Create the new metadata, adding new USE flags (if any) to those of the -- existing metadata. If an existing flag has a new and old description, diff --git a/src/Portage/Metadata/RemoteId.hs b/src/Portage/Metadata/RemoteId.hs --- a/src/Portage/Metadata/RemoteId.hs +++ b/src/Portage/Metadata/RemoteId.hs @@ -21,18 +21,20 @@ , definedParsers -- ** Individual parsers , hackageParser - , cranParser - , ctanParser + , bitbucketParser + , codebergParser + , freedesktopParser , gentooParser , githubParser , gitlabParser + , gnomeParser + , kdeParser , launchpadParser , osdnParser - , peclParser - , pypiParser - , rubygemsParser + , savannahParser + , savannahNonGnuParser , sourceforgeParser - , vimParser + , sourcehutParser -- ** Utility -- *** URI scheme , httpScheme @@ -53,27 +55,32 @@ import Control.Monad import Data.Foldable (asum) import qualified Data.List as L -import Data.Maybe (catMaybes, mapMaybe) +import Data.Maybe (mapMaybe) import qualified Data.Set as S import Network.URI (URI(..), URIAuth(..), parseURI) import System.FilePath.Posix import Text.Parsec import Text.Parsec.String +-- | Many of these are unlikely to source any Haskell code, but they are added +-- for completeness. The full list can be seen at: +-- data RemoteId = RemoteIdHackage String -- ^ Hackage package - | RemoteIdCRAN String -- ^ CRAN package - | RemoteIdCTAN String -- ^ CTAN package + | RemoteIdBitbucket String String -- ^ Bitbucket project + | RemoteIdCodeberg String String -- ^ Codeberg project + | RemoteIdFreedesktop String String -- ^ Freedesktop GitLab project | RemoteIdGentoo String -- ^ Gentoo project | RemoteIdGithub String String -- ^ Github user and repo | RemoteIdGitlab String String -- ^ Gitlab user and repo + | RemoteIdGnome String String -- ^ Gnome GitLab project + | RemoteIdKDE String String -- ^ KDE Invent project | RemoteIdLaunchpad String -- ^ Launchpad project | RemoteIdOSDN String -- ^ OSDN project - | RemoteIdPECL String -- ^ PECL package - | RemoteIdPyPI String -- ^ PyPI project - | RemoteIdRubygems String -- ^ Rubygems gem + | RemoteIdSavannah String -- ^ GNU Savannah project + | RemoteIdSavannahNonGNU String -- ^ NonGNU Savannah project | RemoteIdSourceforge String -- ^ Sourceforge project - | RemoteIdVim String -- ^ Vim script + | RemoteIdSourcehut String String -- ^ sourcehut project deriving (Show, Eq, Ord) -- | A set of parsers to use on a 'URI'. Each parser can produce an arbitrary @@ -108,18 +115,20 @@ prettyPrintRemoteId :: RemoteId -> String prettyPrintRemoteId = \case RemoteIdHackage p -> pp "hackage" p - RemoteIdCRAN p -> pp "cran" p - RemoteIdCTAN p -> pp "ctan" p + RemoteIdBitbucket u r -> pp "bitbucket" $ u ++ "/" ++ r + RemoteIdCodeberg u r -> pp "codeberg" $ u ++ "/" ++ r + RemoteIdFreedesktop u r -> pp "freedesktop-gitlab" $ u ++ "/" ++ r RemoteIdGentoo p -> pp "gentoo" p RemoteIdGithub u r -> pp "github" $ u ++ "/" ++ r RemoteIdGitlab u r -> pp "gitlab" $ u ++ "/" ++ r + RemoteIdGnome u r -> pp "gnome-gitlab" $ u ++ "/" ++ r RemoteIdLaunchpad p -> pp "launchpad" p + RemoteIdKDE u r -> pp "kde-invent" $ u ++ "/" ++ r RemoteIdOSDN p -> pp "osdn" p - RemoteIdPECL p -> pp "pecl" p - RemoteIdPyPI p -> pp "pypi" p - RemoteIdRubygems g -> pp "rubygems" g + RemoteIdSavannah p -> pp "savannah" p + RemoteIdSavannahNonGNU p -> pp "savannah-nongnu" p RemoteIdSourceforge p -> pp "sourceforge" p - RemoteIdVim s -> pp "vim" s + RemoteIdSourcehut u r -> pp "sourcehut" $ u ++ "/" ++ r where pp t v = "\t\t" ++ v ++ "" @@ -144,18 +153,20 @@ definedParsers :: [URIParser] definedParsers = [ hackageParser - , cranParser - , ctanParser + , bitbucketParser + , codebergParser + , freedesktopParser , gentooParser , githubParser , gitlabParser + , gnomeParser + , kdeParser , launchpadParser , osdnParser - , peclParser - , pypiParser - , rubygemsParser + , savannahParser + , savannahNonGnuParser , sourceforgeParser - , vimParser + , sourcehutParser ] -- | @'hackage': 'https://hackage.haskell.org/package/{project}'@ @@ -173,36 +184,51 @@ ignore (\_ _ _ _ p _ _ -> RemoteIdHackage p) --- | @'cran': 'https://cran.r-project.org/web/packages/{project}/'@ -cranParser :: URIParser -cranParser = URIParser - httpScheme +-- | @"bitbucket": "https://bitbucket.org/{project}"@ +bitbucketParser :: URIParser +bitbucketParser = URIParser + (choice [httpScheme, string "git:"]) ignore - (string "cran.r-project.org") + (domainOrWWW "bitbucket.org") ignore (do - (p:_) <- stripPrefixP "/web/packages" - pure p + (u:r:_) <- stripPrefixP "/" + (u,) <$> gitPath r ) ignore ignore - (\_ _ _ _ p _ _ -> RemoteIdCRAN p) + (\_ _ _ _ (u,r) _ _ -> RemoteIdBitbucket u r) --- | @'ctan': 'https://ctan.org/pkg/{project}'@ -ctanParser :: URIParser -ctanParser = URIParser - httpScheme +-- | @"codeberg": "https://codeberg.org/{project}"@ +codebergParser :: URIParser +codebergParser = URIParser + (choice [httpScheme, string "git:"]) ignore - (domainOrWWW "ctan.org") + (domainOrWWW "codeberg.org") ignore (do - (p:_) <- stripPrefixP "/pkg" - pure p + (u:r:_) <- stripPrefixP "/" + (u,) <$> gitPath r ) ignore ignore - (\_ _ _ _ p _ _ -> RemoteIdCTAN p) + (\_ _ _ _ (u,r) _ _ -> RemoteIdCodeberg u r) +-- | @"freedesktop-gitlab": "https://gitlab.freedesktop.org/{project}.git/"@ +freedesktopParser :: URIParser +freedesktopParser = URIParser + (choice [httpScheme, string "git:"]) + ignore + (domainOrWWW "gitlab.freedesktop.org") + ignore + (do + (u:r:_) <- stripPrefixP "/" + (u,) <$> gitPath r + ) + ignore + ignore + (\_ _ _ _ (u,r) _ _ -> RemoteIdFreedesktop u r) + -- | @'gentoo': 'https://gitweb.gentoo.org/{project}.git/'@ gentooParser :: URIParser gentooParser = URIParser @@ -248,6 +274,36 @@ ignore (\_ _ _ _ (u,r) _ _ -> RemoteIdGitlab u r) +-- | @"gnome-gitlab": "https://gitlab.gnome.org/{project}.git/"@ +gnomeParser :: URIParser +gnomeParser = URIParser + (choice [httpScheme, string "git:"]) + ignore + (domainOrWWW "gitlab.gnome.org") + ignore + (do + (u:r:_) <- stripPrefixP "/" + (u,) <$> gitPath r + ) + ignore + ignore + (\_ _ _ _ (u,r) _ _ -> RemoteIdGnome u r) + +-- | @"kde-invent": "https://invent.kde.org/{project}"@ +kdeParser :: URIParser +kdeParser = URIParser + (choice [httpScheme, string "git:"]) + ignore + (domainOrWWW "invent.kde.org") + ignore + (do + (u:r:_) <- stripPrefixP "/" + (u,) <$> gitPath r + ) + ignore + ignore + (\_ _ _ _ (u,r) _ _ -> RemoteIdKDE u r) + -- | @'launchpad': 'https://launchpad.net/{project}'@ launchpadParser :: URIParser launchpadParser = URIParser @@ -278,50 +334,35 @@ ignore (\_ _ _ _ p _ _ -> RemoteIdOSDN p) --- | @'pecl': 'https://pecl.php.net/package/{project}'@ -peclParser :: URIParser -peclParser = URIParser +-- | @"savannah": "https://savannah.gnu.org/projects/{project}"@ +savannahParser :: URIParser +savannahParser = URIParser httpScheme ignore - (string "pecl.php.net") + (string "savannah.gnu.org") ignore (do - (p:_) <- stripPrefixP "/package" + (p:_) <- stripPrefixP "/projects" pure p ) ignore ignore - (\_ _ _ _ p _ _ -> RemoteIdPECL p) + (\_ _ _ _ p _ _ -> RemoteIdSavannah p) --- | @'pypi': 'https://pypi.org/project/{project}/'@ -pypiParser :: URIParser -pypiParser = URIParser +-- | @"savannah-nongnu": "https://savannah.nongnu.org/projects/{project}"@ +savannahNonGnuParser :: URIParser +savannahNonGnuParser = URIParser httpScheme ignore - (domainOrWWW "pypi.org") + (string "savannah.nongnu.org") ignore (do - (p:_) <- stripPrefixP "/project" + (p:_) <- stripPrefixP "/projects" pure p ) ignore ignore - (\_ _ _ _ p _ _ -> RemoteIdPyPI p) - --- | @'rubygems': 'https://rubygems.org/gems/{project}'@ -rubygemsParser :: URIParser -rubygemsParser = URIParser - httpScheme - ignore - (domainOrWWW "rubygems.org") - ignore - (do - (g:_) <- stripPrefixP "/gems" - pure g - ) - ignore - ignore - (\_ _ _ _ g _ _ -> RemoteIdRubygems g) + (\_ _ _ _ p _ _ -> RemoteIdSavannahNonGNU p) -- | @'sourceforge': 'https://sourceforge.net/projects/{project}/'@ sourceforgeParser :: URIParser @@ -338,25 +379,20 @@ ignore (\_ _ _ _ p _ _ -> RemoteIdSourceforge p) --- | @'vim': 'https://vim.org/scripts/script.php?script_id={project}'@ -vimParser :: URIParser -vimParser = URIParser - httpScheme +-- | @"sourcehut": "https://sr.ht/{project}/"@ +sourcehutParser :: URIParser +sourcehutParser = URIParser + (choice [httpScheme, string "git:"]) ignore - (domainOrWWW "vim.org") + (subdomain "sr.ht") ignore - (string "/scripts/script.php") (do - _ <- char '?' - ss <- sepBy1 (optionMaybe scriptParser) (char '&') - (s:_) <- pure $ catMaybes ss -- The first successful 'scriptParser' - pure s + (u:r:_) <- stripPrefixP "/" + (u,) <$> gitPath r ) ignore - (\_ _ _ _ _ s _ -> RemoteIdVim s) - where - scriptParser :: Parser String - scriptParser = string "script_id=" *> many1 (noneOf ['=','&','#']) + ignore + (\_ _ _ _ (u,r) _ _ -> RemoteIdSourcehut u r) -- | Run a specified 'URIParser' with a string -- diff --git a/src/Portage/Slots.hs b/src/Portage/Slots.hs new file mode 100644 --- /dev/null +++ b/src/Portage/Slots.hs @@ -0,0 +1,19 @@ +{-| +Module : Portage.Tables +License : GPL-3+ +Maintainer : haskell@gentoo.org + +Tables of Portage-specific conversions. +-} +module Portage.Slots + ( set_build_slot + ) where + +import Portage.Dependency.Builder +import Portage.Dependency.Types + +-- | Set the @SLOT@ for a given 'Dependency'. +set_build_slot :: Dependency -> Dependency +set_build_slot = + overAtom $ \(Atom pn dr (DAttr _ u)) -> + Atom pn dr (DAttr AnyBuildTimeSlot u) diff --git a/tests/spec/Portage/Metadata/RemoteIdSpec.hs b/tests/spec/Portage/Metadata/RemoteIdSpec.hs --- a/tests/spec/Portage/Metadata/RemoteIdSpec.hs +++ b/tests/spec/Portage/Metadata/RemoteIdSpec.hs @@ -29,17 +29,13 @@ , exampleRemoteId :: RemoteId } +-- | Since many parsers are nearly identical, and many of the hosts will never +-- source haskell code, these tests don't have to be exhaustive. If you run +-- into a URL that does not parse correctly, be sure to add it and the +-- expected result to 'realWorldExamples'. contrivedExamples :: [Example] contrivedExamples = [ Example - "https://cran.r-project.org/web/packages/foo/" - cranParser - (RemoteIdCRAN "foo") - , Example - "https://ctan.org/pkg/foo" - ctanParser - (RemoteIdCTAN "foo") - , Example "https://gitweb.gentoo.org/foo.git/" gentooParser (RemoteIdGentoo "foo") @@ -60,25 +56,9 @@ osdnParser (RemoteIdOSDN "foo") , Example - "https://pecl.php.net/package/foo" - peclParser - (RemoteIdPECL "foo") - , Example - "https://pypi.org/project/foo/" - pypiParser - (RemoteIdPyPI "foo") - , Example - "https://rubygems.org/gems/foo" - rubygemsParser - (RemoteIdRubygems "foo") - , Example "https://sourceforge.net/projects/foo/" sourceforgeParser (RemoteIdSourceforge "foo") - , Example - "https://vim.org/scripts/script.php?script_id=foo" - vimParser - (RemoteIdVim "foo") ] realWorldExamples :: [Example] @@ -99,4 +79,28 @@ "https://github.com/gentoo-haskell/hackport#readme" githubParser (RemoteIdGithub "gentoo-haskell" "hackport") + , Example + "https://codeberg.org/xmobar/xmobar" + codebergParser + (RemoteIdCodeberg "xmobar" "xmobar") + , Example + "git://codeberg.org/xmobar/xmobar.git" + codebergParser + (RemoteIdCodeberg "xmobar" "xmobar") + , Example + "https://invent.kde.org/plasma/sddm-kcm" + kdeParser + (RemoteIdKDE "plasma" "sddm-kcm") + , Example + "https://bitbucket.org/multicoreware/x265_git/" + bitbucketParser + (RemoteIdBitbucket "multicoreware" "x265_git") + , Example + "https://git.sr.ht/~steef/snixembed" + sourcehutParser + (RemoteIdSourcehut "~steef" "snixembed") + , Example + "https://sr.ht/~emersion/basu/" + sourcehutParser + (RemoteIdSourcehut "~emersion" "basu") ]