summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsolpeth <>2019-10-09 03:14:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-10-09 03:14:00 (GMT)
commit7971f44fa29ccd339721fa16e7fdc1ff85d83539 (patch)
tree1d2d8051704a6b468f64ba5d7ae80f8d8bca57fe
parent20e7448ff7f01621d84f457200f8218958e291d3 (diff)
version 0.6.1HEAD0.6.1master
-rw-r--r--Merge.hs70
-rw-r--r--Portage/GHCCore.hs38
-rw-r--r--Portage/PackageId.hs39
-rw-r--r--hackport.cabal2
4 files changed, 135 insertions, 14 deletions
diff --git a/Merge.hs b/Merge.hs
index 487857c..0944c64 100644
--- a/Merge.hs
+++ b/Merge.hs
@@ -6,6 +6,7 @@ module Merge
import Control.Monad
import Control.Exception
import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.ByteString.Builder as BL (stringUtf8, toLazyByteString)
import Data.Function (on)
import Data.Maybe
import qualified Data.List as L
@@ -35,9 +36,10 @@ import System.Directory ( getCurrentDirectory
, setCurrentDirectory
, createDirectoryIfMissing
, doesFileExist
+ , listDirectory
)
import System.Process (system)
-import System.FilePath ((</>))
+import System.FilePath ((</>), isExtensionOf)
import System.Exit
import qualified Cabal2Ebuild as C2E
@@ -64,7 +66,6 @@ a <.> b = a ++ '.':b
{-
Requested features:
* Add files to git?
- * Print diff with the next latest version?
-}
readPackageString :: [String]
@@ -153,9 +154,59 @@ merge verbosity repoContext args overlayPath users_cabal_flags = do
cat <- maybe (Portage.resolveCategory verbosity overlay norm_pkgName) return m_category
mergeGenericPackageDescription verbosity overlayPath cat (CabalInstall.packageDescription selectedPkg) True users_cabal_flags
+ -- Maybe generate a diff
+ let pkgPath = overlayPath </> (Portage.unCategory cat) </> (Cabal.unPackageName norm_pkgName)
+ newPkgId = Portage.fromCabalPackageId cat cabal_pkgId
+ pkgDir <- listDirectory pkgPath
+ case getPreviousPackageId pkgDir newPkgId of
+ Just validPkg -> do info verbosity "Generating a diff..."
+ diffEbuilds overlayPath validPkg newPkgId
+ _ -> info verbosity "Nothing to diff!"
+
+-- | Call diff between two ebuilds.
+diffEbuilds :: FilePath -> Portage.PackageId -> Portage.PackageId -> IO ()
+diffEbuilds fp a b = do _ <- system $ "diff -u --color=auto "
+ ++ fp </> Portage.packageIdToFilePath a ++ " "
+ ++ fp </> Portage.packageIdToFilePath b
+ exitSuccess
+
+-- | Maybe return a PackageId of the next highest version for a given
+-- package, relative to the provided PackageId of the new version.
+-- We achieve this by mapping Portage.filePathToPackageId over the
+-- provided package directory, whose contents are filtered for files
+-- with the '.ebuild' file extension
+getPreviousPackageId :: [FilePath] -- ^ list of ebuilds for given package
+ -> Portage.PackageId -- ^ new PackageId
+ -> Maybe Portage.PackageId -- ^ maybe PackageId of previous version
+getPreviousPackageId pkgDir newPkgId = do
+ let pkgIds = reverse
+ . L.sortOn (Portage.pkgVersion)
+ . filter (<newPkgId)
+ $ Portage.filePathToPackageId newPkgId
+ <$> filter (\fp -> ".ebuild" `isExtensionOf` fp) pkgDir
+ case pkgIds of
+ x:_ -> Just x
+ _ -> Nothing
+
first_just_of :: [Maybe a] -> Maybe a
first_just_of = msum
+-- Gentoo allows underscore ('_') names in IUSE only for
+-- USE_EXPAND values. If it's not a user-specified rename mangle
+-- it into a hyphen ('-').
+mangle_iuse :: String -> String
+mangle_iuse = map f
+ where f '_' = '-'
+ f c = c
+
+-- | Remove "with_" or "with-" from beginning of flag names.
+drop_with :: String -> String
+drop_with = \x ->
+ case splitAt 5 x of
+ ("with_", b) -> b
+ ("with-", b) -> b
+ _ -> x
+
-- used to be FlagAssignment in Cabal but now it's an opaque type
type CabalFlags = [(Cabal.FlagName, Bool)]
@@ -232,11 +283,10 @@ mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch us
, let f = Cabal.unFlagName cabal_f
]
-
cfn_to_iuse :: String -> String
cfn_to_iuse cfn =
case lookup cfn cf_to_iuse_rename of
- Nothing -> cfn
+ Nothing -> mangle_iuse . drop_with $ cfn
Just ein -> ein
-- key idea is to generate all possible list of flags
@@ -383,13 +433,11 @@ mergeGenericPackageDescription verbosity overlayPath cat pkgGenericDesc fetch us
Just ucf -> (\e -> e { E.used_options = E.used_options e ++ [("flags", ucf)] }))
$ C2E.cabal2ebuild cat pkgDesc
- mergeEbuild verbosity existing_meta pkgdir ebuild cabal_flag_descs
+ mergeEbuild verbosity existing_meta pkgdir ebuild active_flag_descs
when fetch $ do
let cabal_pkgId = Cabal.packageId pkgDesc
norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId)
- fetchDigestAndCheck
- verbosity
- (overlayPath </> display cat </> display norm_pkgName)
+ fetchDigestAndCheck verbosity (overlayPath </> display cat </> display norm_pkgName)
fetchDigestAndCheck :: Verbosity
-> FilePath -- ^ directory of ebuild
@@ -423,7 +471,7 @@ to_unstable kw =
-- | Generate a list of tuples containing Cabal flag names and descriptions
metaFlags :: [Cabal.Flag] -> [(String, String)]
-metaFlags flags = zip (Cabal.unFlagName . Cabal.flagName <$> flags) (Cabal.flagDescription <$> flags)
+metaFlags flags = zip (mangle_iuse . drop_with . Cabal.unFlagName . Cabal.flagName <$> flags) (Cabal.flagDescription <$> flags)
mergeEbuild :: Verbosity -> EM.EMeta -> FilePath -> E.EBuild -> [Cabal.Flag] -> IO ()
mergeEbuild verbosity existing_meta pkgdir ebuild flags = do
@@ -432,7 +480,9 @@ mergeEbuild verbosity existing_meta pkgdir ebuild flags = do
epath = edir </> elocal
emeta = "metadata.xml"
mpath = edir </> emeta
- default_meta = BL.pack $ Portage.makeDefaultMetadata (E.long_desc ebuild) (metaFlags flags)
+ default_meta = BL.toLazyByteString . BL.stringUtf8
+ $ Portage.makeDefaultMetadata (E.long_desc ebuild)
+ $ metaFlags flags
createDirectoryIfMissing True edir
now <- TC.getCurrentTime
diff --git a/Portage/GHCCore.hs b/Portage/GHCCore.hs
index 5ebfeec..b922e29 100644
--- a/Portage/GHCCore.hs
+++ b/Portage/GHCCore.hs
@@ -31,7 +31,7 @@ import Debug.Trace
-- It means that first ghc in this list is a minmum default.
ghcs :: [(DC.CompilerInfo, InstalledPackageIndex)]
ghcs = modern_ghcs
- where modern_ghcs = [ghc741, ghc742, ghc761, ghc762, ghc782, ghc7101, ghc7102, ghc801, ghc802, ghc821, ghc843, ghc861, ghc863]
+ where modern_ghcs = [ghc741, ghc742, ghc761, ghc762, ghc782, ghc7101, ghc7102, ghc801, ghc802, ghc821, ghc843, ghc861, ghc863, ghc881]
cabalFromGHC :: [Int] -> Maybe Cabal.Version
cabalFromGHC ver = lookup ver table
@@ -47,6 +47,7 @@ cabalFromGHC ver = lookup ver table
, ([8,2,1], Cabal.mkVersion [2,0,0,2])
, ([8,4,3], Cabal.mkVersion [2,2,0,1])
, ([8,6,1], Cabal.mkVersion [2,4,0,1])
+ , ([8,8,1], Cabal.mkVersion [3,0,0,0])
]
platform :: Platform
@@ -116,6 +117,9 @@ ghc :: [Int] -> DC.CompilerInfo
ghc nrs = DC.unknownCompilerInfo c_id DC.NoAbiTag
where c_id = CompilerId GHC (mkVersion nrs)
+ghc881 :: (DC.CompilerInfo, InstalledPackageIndex)
+ghc881 = (ghc [8,8,1], mkIndex ghc881_pkgs)
+
ghc863 :: (DC.CompilerInfo, InstalledPackageIndex)
ghc863 = (ghc [8,6,3], mkIndex ghc863_pkgs)
@@ -159,6 +163,38 @@ ghc741 = (ghc [7,4,1], mkIndex ghc741_pkgs)
-- Source: http://haskell.org/haskellwiki/Libraries_released_with_GHC
-- and our binary tarballs (package.conf.d.initial subdir)
+ghc881_pkgs :: [Cabal.PackageIdentifier]
+ghc881_pkgs =
+ [ p "array" [0,5,4,0]
+ , p "base" [4,13,0,0]
+ , p "binary" [0,8,7,0] -- used by libghc
+ , p "bytestring" [0,10,9,0]
+-- , p "Cabal" [3,0,0,0] package is upgradeable
+ , p "containers" [0,6,2,1]
+ , p "deepseq" [1,4,4,0] -- used by time
+ , p "directory" [1,3,3,2]
+ , p "filepath" [1,4,2,1]
+ , p "ghc-boot" [8,8,1]
+ , p "ghc-boot-th" [8,8,1]
+ , p "ghc-compact" [0,1,0,0]
+ , p "ghc-prim" [0,5,3,0]
+ , p "ghci" [8,8,1]
+-- , p "haskeline" [0,7,4,3] package is upgradeable
+ , p "hpc" [0,6,0,3] -- used by libghc
+ , p "integer-gmp" [1,0,2,0]
+ -- , p "mtl" [2,2,2] package is upgradeable(?)
+ -- , p "parsec" [3,1,14,0] package is upgradeable(?)
+ , p "pretty" [1,1,3,6]
+ , p "process" [1,6,5,1]
+ -- , p "stm" [2,5,0,0] package is upgradeable(?)
+ , p "template-haskell" [2,15,0,0] -- used by libghc
+ -- , p "terminfo" [0,4,1,4]
+ -- , p "text" [1,2,4,0] dependency of Cabal library
+ , p "time" [1,9,3,0] -- used by unix, directory, hpc, ghc. unsafe to upgrade
+ , p "transformers" [0,5,6,2] -- used by libghc
+ , p "unix" [2,7,2,2]
+-- , p "xhtml" [3000,2,2,1]
+ ]
ghc863_pkgs :: [Cabal.PackageIdentifier]
ghc863_pkgs =
diff --git a/Portage/PackageId.hs b/Portage/PackageId.hs
index 2aa8f0a..ffaa324 100644
--- a/Portage/PackageId.hs
+++ b/Portage/PackageId.hs
@@ -13,6 +13,7 @@ module Portage.PackageId (
parseFriendlyPackage,
normalizeCabalPackageName,
normalizeCabalPackageId,
+ filePathToPackageId,
packageIdToFilePath,
cabal_pn_to_PN
) where
@@ -31,7 +32,7 @@ import Text.PrettyPrint ((<>))
import qualified Data.Char as Char (isAlphaNum, isSpace, toLower)
import Distribution.Text(display)
-import System.FilePath ( (</>) )
+import System.FilePath ((</>), dropExtension)
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
@@ -40,7 +41,7 @@ import Prelude hiding ((<>))
newtype Category = Category { unCategory :: String }
deriving (Eq, Ord, Show, Read)
-data PackageName = PackageName Category Cabal.PackageName
+data PackageName = PackageName { category :: Category, cabalPkgName :: Cabal.PackageName }
deriving (Eq, Ord, Show, Read)
data PackageId = PackageId { packageId :: PackageName, pkgVersion :: Portage.Version }
@@ -67,6 +68,26 @@ packageIdToFilePath (PackageId (PackageName cat pn) version) =
a <-> b = a ++ '-':b
a <.> b = a ++ '.':b
+-- | Attempt to generate a PackageId from a FilePath. If not, return
+-- the provided PackageId as-is.
+filePathToPackageId :: PackageId -> FilePath -> PackageId
+filePathToPackageId pkgId fp = do
+ -- take package name from provided FilePath
+ let pn = take (length
+ $ Cabal.unPackageName . cabalPkgName . packageId
+ $ pkgId) fp
+ -- drop .ebuild file extension
+ p = dropExtension fp
+ -- drop package name and the following dash
+ v = drop ((length pn) +1) p
+ c = unCategory . category . packageId $ pkgId
+ -- parse and extract version
+ parsed_v = case parseVersion v of
+ Just (Just my_v) -> my_v
+ _ -> pkgVersion pkgId
+ -- Construct PackageId
+ PackageId (mkPackageName c pn) parsed_v
+
mkPackageName :: String -> String -> PackageName
mkPackageName cat package = PackageName (Category cat) (Cabal.mkPackageName package)
@@ -133,5 +154,19 @@ parseFriendlyPackage str =
return (Just v)
return (mc, p, mv)
+-- | Parse a String in the form of a Portage version
+parseVersion :: FilePath -> Maybe (Maybe Portage.Version)
+parseVersion str =
+ case [ p | (p,s) <- Parse.readP_to_S parser str
+ , all Char.isSpace s ] of
+ [] -> Nothing
+ (x:_) -> Just x
+ where
+ parser = do
+ mv <- Parse.option Nothing $ do
+ v <- parse
+ return (Just v)
+ return mv
+
cabal_pn_to_PN :: Cabal.PackageName -> String
cabal_pn_to_PN = map toLower . display
diff --git a/hackport.cabal b/hackport.cabal
index 0ab195f..c80c7d2 100644
--- a/hackport.cabal
+++ b/hackport.cabal
@@ -1,5 +1,5 @@
Name: hackport
-Version: 0.6
+Version: 0.6.1
License: GPL
License-file: LICENSE
Author: Henning G√ľnther, Duncan Coutts, Lennart Kolmodin