Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Improved hackport's diff mode

  • Loading branch information...
commit 290e0609b75432153d0411065da4411f782a243f 1 parent 400e6e2
der_eq@freenet.de authored
18 HackPort/Config.hs
View
@@ -21,10 +21,17 @@ data OperationMode
= Query String
| Merge PackageIdentifier
| ListAll
- | DiffTree
+ | DiffTree DiffMode
| Update
| ShowHelp
+data DiffMode
+ = ShowAll
+ | ShowMissing
+ | ShowAdditions
+ | ShowCommon
+ deriving Eq
+
data Config = Config
{ tarCommand ::String
, portageTree ::Maybe String
@@ -86,8 +93,13 @@ parseConfig opts = case getOpt Permute hackageOptions opts of
(popts,"merge":_:rest,[]) -> Left ("'merge' takes 1 argument("++show ((length rest)+1)++" given).\n")
(popts,"list":[],[]) -> Right (ropts popts,ListAll)
(popts,"list":rest,[]) -> Left ("'list' takes zero arguments("++show (length rest)++" given).\n")
- (popts,"diff":[],[]) -> Right (ropts popts,DiffTree)
- (popts,"diff":rest,[]) -> Left ("'diff' takes zero arguments("++show (length rest)++" given).\n")
+ (popts,"diff":[],[]) -> Right (ropts popts,DiffTree ShowAll)
+ (popts,"diff":"all":[],[]) -> Right (ropts popts,DiffTree ShowAll)
+ (popts,"diff":"missing":[],[]) -> Right (ropts popts,DiffTree ShowMissing)
+ (popts,"diff":"additions":[],[]) -> Right (ropts popts,DiffTree ShowAdditions)
+ (popts,"diff":"common":[],[]) -> Right (ropts popts,DiffTree ShowCommon)
+ (popts,"diff":arg:[],[]) -> Left ("Unknown argument to 'diff': Use all,missing,additions or common.\n")
+ (popts,"diff":arg1:args,[]) -> Left ("'diff' takes one argument("++show ((length args)+1)++" given).\n")
(popts,"update":[],[]) -> Right (ropts popts,Update)
(popts,"update":rest,[]) -> Left ("'update' takes zero arguments("++show (length rest)++" given).\n")
(popts,[],[]) -> Right (ropts popts,ShowHelp)
42 HackPort/Diff.hs
View
@@ -1,39 +1,13 @@
module Diff where
-import Prelude hiding(map)
-import qualified Data.List as List
import Data.Set
-data DiffAction
- = Add
- | Remove
- | Stay
- deriving (Eq,Ord,Show)
+diffSet :: (Eq a,Ord a)
+ => Set a -- ^ Set 1
+ -> Set a -- ^ Set 2
+ -> (Set a,Set a,Set a) -- ^ (Things in 1 but not in 2,Things in 2 but not in 1,Things in both sets)
+diffSet set1 set2 = let
+ int = intersection set1 set2
+ in1 = difference set1 int
+ in2 = difference set2 int in (in1,in2,int)
-data DiffResult a
- = DiffResult DiffAction a
- deriving (Eq)
-
-instance Ord x => Ord (DiffResult x) where
- compare (DiffResult _ x1) (DiffResult _ x2) = compare x1 x2
-
-instance Show a => Show (DiffResult a) where
- show (DiffResult action x) = (case action of
- Add -> '+'
- Remove -> '-'
- Stay -> '='):(show x)
-
-{-class Diff a b where
- diff :: a -> a -> DiffResult b
-
-instance Diff [a] a where
- diff lst1 lst2 = -}
-
-diffSet :: (Eq a,Ord a) => Set a -> Set a -> Set (DiffResult a)
-diffSet set1 set2 = unions [map (DiffResult Add) adds,map (DiffResult Remove) removes,map (DiffResult Stay) stays] where
- stays = intersection set1 set2
- removes = difference set1 stays
- adds = difference set2 stays
-
-showDiff :: Show a => Set (DiffResult a) -> String
-showDiff diffs = unlines (List.map show (elems diffs))
1  HackPort/Error.hs
View
@@ -34,6 +34,7 @@ type HackPortResult a = Either
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."
InvalidTarballURL url reason -> "Error while downloading tarball '"++url++"': "++reason
25 HackPort/Main.hs
View
@@ -57,19 +57,28 @@ merge pid = do
ebuild <- hackage2ebuild rpid
mergeEbuild portTree ebuild
-diff :: HPAction ()
-diff = do
+diff :: DiffMode -> HPAction ()
+diff mode = do
cfg <- getCfg
portTree <- getPortageTree
cache <- readCache' portTree
let serverPkgs'=map (\(pkg,_,_)->pkg {pkgName=map toLower (pkgName pkg)}) (packages cache)
portTree <- getPortageTree
portagePkgs <- portageGetPackages portTree
- let pkgDiff=diffSet (Set.fromList portagePkgs) (Set.fromList serverPkgs')
- liftIO $ putStr $ unlines $ map (\(DiffResult action pkg)->(case action of
- Add->'+'
- Remove->'-'
- Stay->'='):(pkgName pkg++"-"++showVersion (pkgVersion pkg))) (Set.elems pkgDiff)
+ let (inport,inhack,inboth)=diffSet (Set.fromList portagePkgs) (Set.fromList serverPkgs')
+ let showPkgSet set = mapM_ (\pkg->echoLn (pkgName pkg++"-"++showVersion (pkgVersion pkg))) (Set.elems set)
+ let vindent = case verbosity cfg of
+ Silent -> id
+ _ -> indent
+ when (mode==ShowAll || mode==ShowMissing) (do
+ info "Packages in hackage, but not in the overlay:"
+ vindent $ showPkgSet inhack)
+ when (mode==ShowAll || mode==ShowAdditions) (do
+ info "Packages in the overlay, but not in hackage:"
+ vindent $ showPkgSet inport)
+ when (mode==ShowAll || mode==ShowCommon) (do
+ info "Packages in the overlay and hackage:"
+ vindent $ showPkgSet inboth)
update :: HPAction ()
update = do
@@ -89,7 +98,7 @@ hpmain = do
ListAll -> listAll
Query pkg -> query pkg
Merge pkg -> merge pkg
- DiffTree -> diff
+ DiffTree mode -> diff mode
Update -> update
main :: IO ()
Please sign in to comment.
Something went wrong with that request. Please try again.