Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'from-hackage'

* from-hackage:
  hackport status: now it works with hackage!
  • Loading branch information...
commit ed04a863e7009651f3b75dc487ede1b27a3a495a 2 parents bf26c18 + dd1447b
@trofi trofi authored
Showing with 79 additions and 29 deletions.
  1. +10 −17 Main.hs
  2. +1 −2  Portage/Resolve.hs
  3. +68 −10 Status.hs
View
27 Main.hs
@@ -297,24 +297,13 @@ updateAction flags extraArgs globalFlags = do
data StatusFlags = StatusFlags {
statusVerbosity :: Flag Verbosity,
- statusToPortage :: Flag Bool
+ statusDirection :: Flag StatusDirection
}
-instance Monoid StatusFlags where
- mempty = StatusFlags {
- statusVerbosity = mempty,
- statusToPortage = mempty
- }
- mappend a b = StatusFlags {
- statusVerbosity = combine statusVerbosity,
- statusToPortage = combine statusToPortage
- }
- where combine field = field a `mappend` field b
-
defaultStatusFlags :: StatusFlags
defaultStatusFlags = StatusFlags {
statusVerbosity = Flag normal,
- statusToPortage = Flag False
+ statusDirection = Flag PortagePlusOverlay
}
statusCommand :: CommandUI StatusFlags
@@ -329,18 +318,22 @@ statusCommand = CommandUI {
[ optionVerbosity statusVerbosity (\v flags -> flags { statusVerbosity = v })
, option [] ["to-portage"]
"Print only packages likely to be interesting to move to the portage tree."
- statusToPortage (\v flags -> flags { statusToPortage = v })
- trueArg
+ statusDirection (\v flags -> flags { statusDirection = v })
+ (noArg (Flag OverlayToPortage))
+ , option [] ["from-hackage"]
+ "Print only packages likely to be interesting to move from hackage tree."
+ statusDirection (\v flags -> flags { statusDirection = v })
+ (noArg (Flag HackageToOverlay))
]
}
statusAction :: StatusFlags -> [String] -> GlobalFlags -> IO ()
statusAction flags args globalFlags = do
let verbosity = fromFlag (statusVerbosity flags)
- toPortdir = fromFlag (statusToPortage flags)
+ direction = fromFlag (statusDirection flags)
portagePath <- getPortageDir verbosity globalFlags
overlayPath <- getOverlayPath verbosity (fromFlag $ globalPathToOverlay globalFlags)
- runStatus verbosity portagePath overlayPath toPortdir args
+ runStatus verbosity portagePath overlayPath direction args
-----------------------------------------------------------------------
-- Merge
View
3  Portage/Resolve.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE PatternGuards #-}
-module Portage.Resolve where
+module Portage.Resolve (resolveCategory) where
import qualified Portage.Overlay as Overlay
import qualified Portage.PackageId as Portage
@@ -69,4 +69,3 @@ resolveFullPortageName overlay pn =
, mkC "net-libs"
, mkC "sci-libs"
]
-
View
78 Status.hs
@@ -1,5 +1,6 @@
module Status
( FileStatus(..)
+ , StatusDirection(..)
, fromStatus
, status
, runStatus
@@ -7,6 +8,8 @@ module Status
import AnsiColor
+import qualified Data.Version as V()
+
import Portage.Overlay
import Portage.PackageId
@@ -17,6 +20,7 @@ import qualified Data.List as List
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char
+import Data.Function (on)
import qualified Data.Map as Map
import Data.Map as Map (Map)
@@ -24,16 +28,28 @@ import qualified Data.Traversable as T
import Control.Applicative
-- cabal
+import Distribution.Client.Types ( Repo, SourcePackageDb(..), SourcePackage(..) )
import Distribution.Verbosity
-import Distribution.Simple.Utils (equating, comparing)
+import Distribution.Simple.Utils (comparing, die, equating)
import Distribution.Text ( display, simpleParse )
-import Distribution.Simple.Utils ( die )
+
+import qualified Distribution.Client.PackageIndex as CabalInstall
+import qualified Distribution.Client.IndexUtils as CabalInstall
+
+import Hackage (defaultRepo)
+
+data StatusDirection
+ = PortagePlusOverlay
+ | OverlayToPortage
+ | HackageToOverlay
+ deriving Eq
data FileStatus a
= Same a
| Differs a a
| OverlayOnly a
| PortageOnly a
+ | HackageOnly a
deriving (Show,Eq)
instance Ord a => Ord (FileStatus a) where
@@ -46,6 +62,7 @@ instance Functor FileStatus where
Differs a b -> Differs (f a) (f b)
OverlayOnly a -> OverlayOnly (f a)
PortageOnly a -> PortageOnly (f a)
+ HackageOnly a -> HackageOnly (f a)
fromStatus :: FileStatus a -> a
fromStatus fs =
@@ -54,9 +71,24 @@ fromStatus fs =
Differs a _ -> a -- second status is lost
OverlayOnly a -> a
PortageOnly a -> a
+ HackageOnly a -> a
+
+
+
+loadHackage :: Verbosity -> Distribution.Client.Types.Repo -> IO [[PackageId]]
+loadHackage verbosity repo = do
+ SourcePackageDb { packageIndex = pindex } <- CabalInstall.getSourcePackages verbosity [repo]
+ let pkg_infos = map ( reverse . take 3 . reverse -- hackage usually has a ton of older versions
+ . map (fromCabalPackageId (Category "dev-haskell")
+ . packageInfoId))
+ (CabalInstall.allPackagesByName pindex)
+ return pkg_infos
status :: Verbosity -> FilePath -> FilePath -> IO (Map PackageName [FileStatus ExistingEbuild])
-status _verbosity portdir overlaydir = do
+status verbosity portdir overlaydir = do
+ let repo = defaultRepo overlaydir
+ hackage <- loadHackage verbosity repo
+
overlay <- loadLazy overlaydir
portage <- filterByHerd ("haskell" `elem`) <$> loadLazy portdir
let (over, both, port) = portageDiff (overlayMap overlay) (overlayMap portage)
@@ -71,10 +103,21 @@ status _verbosity portdir overlaydir = do
then Same e1
else Differs e1 e2
- let meld = Map.unionsWith (\a b -> List.sort (a++b))
+ let p_to_ee :: PackageId -> ExistingEbuild
+ p_to_ee p = ExistingEbuild p cabal_p ebuild_path
+ where Just cabal_p = toCabalPackageId p -- lame doubleconv
+ ebuild_path = packageIdToFilePath p
+ mk_fake_ee :: [PackageId] -> (PackageName, [ExistingEbuild])
+ mk_fake_ee ~pkgs@(p:_) = (packageId p, map p_to_ee pkgs)
+
+ map_diff = Map.differenceWith (\le re -> Just $ foldr (List.deleteBy (equating ebuildId)) le re)
+ hack = ((Map.fromList $ map mk_fake_ee hackage) `map_diff` overlayMap overlay) `map_diff` overlayMap portage
+
+ meld = Map.unionsWith (\a b -> List.sort (a++b))
[ Map.map (map PortageOnly) port
, both'
, Map.map (map OverlayOnly) over
+ , Map.map (map HackageOnly) hack
]
return meld
@@ -85,10 +128,12 @@ lookupEbuildWith overlay pkgid = do
ebuilds <- Map.lookup (packageId pkgid) overlay
List.find (\e -> ebuildId e == pkgid) ebuilds
-runStatus :: Verbosity -> FilePath -> FilePath -> Bool -> [String] -> IO ()
-runStatus verbosity portdir overlaydir toPortageFlag pkgs = do
- let pkgFilter | toPortageFlag = toPortageFilter
- | otherwise = id
+runStatus :: Verbosity -> FilePath -> FilePath -> StatusDirection -> [String] -> IO ()
+runStatus verbosity portdir overlaydir direction pkgs = do
+ let pkgFilter = case direction of
+ OverlayToPortage -> toPortageFilter
+ PortagePlusOverlay -> id
+ HackageToOverlay -> fromHackageFilter
pkgs' <- forM pkgs $ \p ->
case simpleParse p of
Nothing -> die ("Could not parse package name: " ++ p ++ ". Format cat/pkg")
@@ -108,6 +153,7 @@ toPortageFilter = Map.mapMaybe $ \ sts ->
let inPortage = flip filter sts $ \st ->
case st of
OverlayOnly _ -> False
+ HackageOnly _ -> False
_ -> True
latestPortageVersion = List.maximum $ map (pkgVersion . ebuildId . fromStatus) inPortage
interestingPackages = flip filter sts $ \st ->
@@ -119,12 +165,25 @@ toPortageFilter = Map.mapMaybe $ \ sts ->
then Just sts
else Nothing
+-- |Only return packages that exist in overlay or portage but look outdated
+fromHackageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]
+fromHackageFilter = Map.mapMaybe $ \ sts ->
+ let inEbuilds = flip filter sts $ \st ->
+ case st of
+ HackageOnly _ -> False
+ _ -> True
+ latestVersion = List.maximumBy (compare `on` pkgVersion . ebuildId . fromStatus) sts
+ in case latestVersion of
+ HackageOnly _ | not (null inEbuilds) -> Just sts
+ _ -> Nothing
+
statusPrinter :: Map PackageName [FileStatus ExistingEbuild] -> IO ()
statusPrinter packages = do
putStrLn $ toColor (Same "Green") ++ ": package in portage and overlay are the same"
putStrLn $ toColor (Differs "Yellow" "") ++ ": package in portage and overlay differs"
putStrLn $ toColor (OverlayOnly "Red") ++ ": package only exist in the overlay"
putStrLn $ toColor (PortageOnly "Magenta") ++ ": package only exist in the portage tree"
+ putStrLn $ toColor (HackageOnly "Cyan") ++ ": package only exist on hackage"
forM_ (Map.toAscList packages) $ \(pkg, ebuilds) -> do
let (PackageName c p) = pkg
putStr $ display c ++ '/' : bold (display p)
@@ -142,7 +201,7 @@ toColor st = inColor c False Default (fromStatus st)
(Differs _ _) -> Yellow
(OverlayOnly _) -> Red
(PortageOnly _) -> Magenta
-
+ (HackageOnly _) -> Cyan
portageDiff :: EMap -> EMap -> (EMap, EMap, EMap)
portageDiff p1 p2 = (in1, ins, in2)
@@ -171,4 +230,3 @@ equal' = equating essence
essence = filter (not . isEmpty) . filter (not . isComment) . L.lines
isComment = L.isPrefixOf (L.pack "#") . L.dropWhile isSpace
isEmpty = L.null . L.dropWhile isSpace
-
Please sign in to comment.
Something went wrong with that request. Please try again.