Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Change parameter to merge and remove --portage-category

Not supplying version will make hackport pick the highest version.
Merging selects category in these ways:
1) By command line
     $ hackport merge foo/bar # merges into category foo
   If no category is specified it tries 2).
2) By previous category
     hackport will look into your overlay and see if the package
     already is merged, and then use that category, else 3).
3) Defaults to dev-haskell.
  • Loading branch information...
commit 7d1091ea13b8c9601312f06279e0b9ec72e9ef0b 1 parent 16c6784
@kolmodin kolmodin authored
View
1  Action.hs
@@ -106,7 +106,6 @@ optionToConfig :: Config -> HackPortOptions -> HPAction Config
optionToConfig cfg opt = case opt of
OverlayPath str -> return cfg { overlayPath = Just str }
PortagePath str -> return cfg { portagePath = Just str }
- Category str -> return cfg { defaultPortageCategory = str }
Server str -> case parseURI str of
Nothing -> throwError (InvalidServer str)
Just uri -> return cfg { server = uri }
View
3  Cache.hs
@@ -9,6 +9,7 @@ import Index
import P2
import Version
+import Control.Arrow
import Data.Char
import Data.List
import Network.URI
@@ -61,7 +62,7 @@ readCache portdir = do
return $ readIndex str
indexToPortage :: Index -> Portage -> (Portage, [String])
-indexToPortage index port = runWriter $ do
+indexToPortage index port = second nub . runWriter $ do
pkgs <- forM index $ \(pkg_h_name, pkg_h_ver, pkg_desc) -> do
let pkg_name = map toLower pkg_h_name
pkg_cat <- lookupCat pkg_name
View
9 Config.hs
@@ -21,7 +21,7 @@ data HackPortOptions
data OperationMode
= List String
- | Merge PackageIdentifier
+ | Merge String
| DiffTree DiffMode
| Update
| ShowHelp
@@ -38,7 +38,6 @@ data DiffMode
data Config = Config
{ overlayPath ::Maybe String
, portagePath ::Maybe String
- , defaultPortageCategory::String
, server ::URI
, tmp ::String
, verbosity ::Verbosity
@@ -56,7 +55,6 @@ defaultConfig :: Config
defaultConfig = Config
{ overlayPath = Nothing
, portagePath = Nothing
- , defaultPortageCategory = "dev-haskell"
, server = URI "http:" (Just $ URIAuth "" "hackage.haskell.org" "") "/packages/archive/" "" ""
, tmp = "/tmp"
, verbosity = Normal
@@ -67,7 +65,6 @@ hackageOptions :: [OptDescr HackPortOptions]
hackageOptions =
[Option ['o'] ["overlay-path"] (ReqArg OverlayPath "PATH") "The overlay tree to merge to"
,Option ['p'] ["portdir"] (ReqArg PortagePath "PATH") "The portage directory to use"
- ,Option ['c'] ["portage-category"] (ReqArg Category "CATEGORY") "The cateory the program belongs to"
,Option ['s'] ["server"] (ReqArg Server "URL") "The Hackage server to query"
,Option ['t'] ["temp-dir"] (ReqArg TempDir "PATH") "A temp directory where tarballs can be stored"
,Option ['v'] ["verbosity"] (ReqArg Verbosity "debug|normal|silent") "Set verbosity level (default is 'normal')"
@@ -83,9 +80,7 @@ parseConfig opts = let
| not (null [ () | Help <- popts ]) = Right ShowHelp
| otherwise = case args of
"merge":[] -> Left "Need a package's name and version to merge it.\n"
- "merge":package:[] -> case readPMaybe parsePackageId package of
- Nothing ->Left ("Could not parse '"++package++"' to a valid package. Valid packages use <name>-<version-number>-<version-postfix> where version consists only of numbers and points.\n")
- Just pid -> Right (Merge pid)
+ "merge":package:[] -> Right (Merge package)
"merge":_:rest -> Left ("'merge' takes 1 argument("++show ((length rest)+1)++" given).\n")
"list":[] -> Right (List "")
"list":package:[] -> Right (List package)
View
4 Error.hs
@@ -9,7 +9,7 @@ import Control.Exception
data HackPortError
= ArgumentError String
| ConnectionFailed String String
- | PackageNotFound (Either String PackageIdentifier)
+ | PackageNotFound String
| InvalidTarballURL String String
| InvalidSignatureURL String String
| VerificationFailed String String
@@ -37,7 +37,7 @@ hackPortShowError :: HackPortError -> String
hackPortShowError err = case err of
ArgumentError str -> "Argument error: "++str
ConnectionFailed server reason -> "Connection to hackage server '"++server++"' failed: "++reason
- PackageNotFound pkg -> "Package '"++(either id showPackageId pkg)++"' not found on server."
+ PackageNotFound pkg -> "Package '"++ pkg ++"' not found on server."
InvalidTarballURL url reason -> "Error while downloading tarball '"++url++"': "++reason
InvalidSignatureURL url reason -> "Error while downloading signature '"++url++"': "++reason
VerificationFailed file signature -> "Error while checking signature('"++signature++"') of '"++file++"'"
View
67 Main.hs
@@ -2,12 +2,14 @@ module Main where
import Control.Monad.Error
import Data.Char
+import Data.Maybe
import Data.List
import Data.Version
import Distribution.Package
import Distribution.PackageDescription
import System.IO
import qualified Data.Map as Map
+import Text.ParserCombinators.Parsec
import Action
@@ -19,8 +21,10 @@ import Error
import GenerateEbuild
import Index
import Status
+import Package
import Portage
import P2
+import Utils
list :: String -> HPAction ()
list name = do
@@ -32,35 +36,60 @@ list name = do
lcaseName = lcase name
lcase = map toLower
if null pkgs
- then throwError (PackageNotFound (Left name))
+ then throwError (PackageNotFound name)
else liftIO . putStr . unlines
. map showPackageId
. sort
$ map package pkgs
-merge :: PackageIdentifier -> HPAction ()
-merge pid = do
+merge :: String -> HPAction ()
+merge pstr = do
+ (m_category, pname, m_version) <- case parsePVC of
+ Right v -> return v
+ Left err -> throwError (ArgumentError ("Could not parse [category/]package[-version]: " ++ show err))
portdir <- getOverlayPath
overlay <- liftIO $ readPortageTree portdir
cache <- readCache portdir
let (indexTree,clashes) = indexToPortage cache overlay
mapM_ (liftIO . putStrLn) clashes
- whisper $ "Searching for: "++pkgName pid++"-"++showVersion (pkgVersion pid)
- let pkgs = searchIndex (\name vers -> map toLower name == map toLower (pkgName pid) && vers == showVersion (pkgVersion pid)) cache
- case pkgs of
- [] -> throwError (PackageNotFound (Right pid))
- [pkg] -> do
- let categories = [ c | P c p <- (Map.keys indexTree), p == pkgName pid]
- category <- do
- dpc <- fmap defaultPortageCategory getCfg
- case categories of
- ["hackage"] -> return dpc
- [c] -> return c
- ebuild <- fixSrc (package pkg) (E.cabal2ebuild pkg)
- liftIO $ do
- putStrLn $ "Merging " ++ category ++ '/': pkgName pid ++ '-': showVersion (pkgVersion pid)
- putStrLn $ "Destination: " ++ portdir
- mergeEbuild portdir category ebuild
+ whisper $ "Searching for: "++ pstr
+ let pkgs =
+ Map.elems
+ . Map.filterWithKey (\(P _ pname') _ -> map toLower pname' == map toLower pname)
+ $ indexTree
+ return ()
+ pkg <- case pkgs of
+ [] -> throwError (PackageNotFound pname)
+ [xs] -> case m_version of
+ Nothing -> return (maximum xs) -- highest version
+ Just v -> do
+ let ebuilds = filter (\e -> eVersion e == v) xs
+ case ebuilds of
+ [] -> throwError (PackageNotFound (pname ++ '-':show v))
+ [e] -> return e
+ category <- do
+ case m_category of
+ Just cat -> return cat
+ Nothing -> do
+ case pCategory (ePackage pkg) of
+ "hackage" -> return "dev-haskell"
+ c -> return c
+ let desc = fromJust $ ePkgDesc pkg
+ ebuild <- fixSrc (package desc) (E.cabal2ebuild desc)
+ liftIO $ do
+ putStrLn $ "Merging " ++ category ++ '/': pname ++ showPackageId (package desc)
+ putStrLn $ "Destination: " ++ portdir
+ mergeEbuild portdir category ebuild
+ where
+ parsePVC = parse readPVC "" pstr
+ readPVC = do
+ mc <- option Nothing $ try $ do
+ c <- readCat
+ char '/'
+ return (Just c)
+ (p, mv) <- readPkgAndVer
+ eof
+ return (mc, p, mv)
hpmain :: HPAction ()
hpmain = do
View
2  P2.hs
@@ -36,7 +36,7 @@ data Ebuild = Ebuild {
ePkgDesc :: Maybe Cabal.PackageDescription }
deriving (Eq, Show)
-data Package = P String String
+data Package = P { pCategory :: String, pPackage :: String }
deriving (Eq, Ord)
instance Show Package where
View
72 Package.hs
@@ -0,0 +1,72 @@
+{-|
+ Maintainer : Andres Loeh <kosmikus@gentoo.org>
+ Stability : provisional
+ Portability : haskell98
+
+ Parser for categories and packages.
+
+ Shamelessly borrowed from exi, somewhat modified
+-}
+
+module Package
+ where
+
+import Control.Monad
+import Text.ParserCombinators.Parsec
+
+import Version
+import System.FilePath
+-- import Portage.Utilities
+
+type Category = String
+type Package = String
+type Slot = String
+
+getPV xs = case parsePV xs of
+ Left e ->
+ error $ "getPV: cat/pkg-ver parse error '" ++ xs ++ "'\n" ++ show e
+ Right x -> x
+
+getP xs = case parseP xs of
+ Left e ->
+ error $ "getCatPkg: cat/pkg parse error '" ++ xs ++ "'\n" ++ show e
+ Right x -> x
+
+parsePV = parse (readPV >>= \x -> eof >> return x) "<cat/pkg-ver>"
+
+readPV = do cat <- readCat
+ char '/'
+ (pkg,mver) <- readPkgAndVer
+ case mver of
+ Nothing -> error "readPV: version expected"
+ Just ver -> return (cat, pkg, ver)
+
+parseP = parse (readP >>= \x -> eof >> return x) "<cat/pkg>"
+
+readP = do cat <- readCat
+ char '/'
+ (pkg,mver) <- readPkgAndVer
+ case mver of
+ Nothing -> return (cat, pkg)
+ Just _ -> error "readCatPkg: unexpected version"
+
+readCat :: CharParser st Category
+readPkgAndVer :: CharParser st (Package,Maybe Version)
+
+readCat = many1 (letter <|> digit <|> oneOf "_-")
+readPkgAndVer = do pre <- many1 (letter <|> digit <|> oneOf "_+")
+ (p,v) <- option ("",Nothing)
+ (do char '-'
+ liftM (\v -> ("",Just v)) readVerOrFail
+ <|> liftM (\(p,v) -> ('-':p,v)) readPkgAndVer
+ )
+ return (pre ++ p,v)
+
+readVerOrFail :: CharParser st Version
+readVerOrFail = try $
+ do ver <- many1 (letter <|> digit <|> oneOf "_+.-")
+ case parseVersion ver of
+ Left _ ->
+ fail $ "version parse error"
+ Right x -> return x
+
View
77 Portage.hs
@@ -14,72 +14,25 @@ import Config
ebuildVersionRegex name = mkRegex ("^"++name++"-(.*)\\.ebuild$")
-portageGetPackages ::
- String -> -- ^ the portage dir
- HPAction [PackageIdentifier]
-portageGetPackages portTree = do
- cfg <- getCfg
- let basedir=portTree++"/"++(defaultPortageCategory cfg)++"/"
- content <- liftIO $ getDirectoryContents basedir
- pkgs <- liftIO $ filterPackages basedir content
- identifiers <- mapM (\pkgname->
- (portageGetPackageVersions portTree pkgname
- >>=(\pkgversions->return (map (\pkgv->PackageIdentifier{pkgName=pkgname,pkgVersion=pkgv}) pkgversions)))
- ) pkgs
- return $ concat identifiers
-
-portageGetPackageVersions ::
- String -> -- ^ the portage dir
- String -> -- ^ the package
- HPAction [Version]
-portageGetPackageVersions portTree name
- = do
- cfg <- getCfg
- let basedir=portTree++"/"++(defaultPortageCategory cfg)++"/"++name++"/"
- content <- liftIO $ getDirectoryContents basedir
- let versions=map head (mapMaybe (matchRegex (ebuildVersionRegex name)) content)
- return (mapMaybe (readPMaybe parseVersion . map underscore) versions)
- where
- underscore '_' = '-'
- underscore x = x
-
filterPackages :: String -> [String] -> IO [String]
filterPackages _ [] = return []
filterPackages base (x:xs) = do
- ak <- case x of
- "." -> return Nothing
- ".." -> return Nothing
- dir -> do
- exists <- doesDirectoryExist (base++dir)
- return (if exists then Just dir else Nothing)
- rest <- filterPackages base xs
- return (maybe rest (:rest) ak)
-
-{-filterVersions :: String -> [String] -> IO [String]
-filterVersions _ [] = return []
-filterVersions base (x:xs) = do
- ak <- case x of
- "." -> return Nothing
- ".." -> return Nothing
- dir -> do
- exists <- doesFileExist (base++dir)
- return (if exists then Just dir else Nothing)
- rest <- filterVersions base xs
- return (maybe rest (:rest) ak)
--}
-
---diffPackageLists :: [PackageIdentifier] -> [PackageIdentifier] -> String
---diffPackageLists
-
+ ak <- case x of
+ "." -> return Nothing
+ ".." -> return Nothing
+ dir -> do
+ exists <- doesDirectoryExist (base++dir)
+ return (if exists then Just dir else Nothing)
+ rest <- filterPackages base xs
+ return (maybe rest (:rest) ak)
getOverlayPath :: HPAction String
getOverlayPath = do
- cfg <- getCfg
- case overlayPath cfg of
- Nothing -> do
- tree <- getOverlay `sayDebug` ("Guessing overlay from /etc/make.conf...\n",\tree->"Found '"++tree++"'")
- setOverlayPath $ Just tree
- return tree
- Just tree -> return tree
-
+ cfg <- getCfg
+ case overlayPath cfg of
+ Nothing -> do
+ tree <- getOverlay `sayDebug` ("Guessing overlay from /etc/make.conf...\n",\tree->"Found '"++tree++"'")
+ setOverlayPath $ Just tree
+ return tree
+ Just tree -> return tree
Please sign in to comment.
Something went wrong with that request. Please try again.