Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Make diffing respect categories

  • Loading branch information...
commit 50782636cebb5c8a5785a14b48bce37649d39a64 1 parent e0f815e
@kolmodin kolmodin authored
Showing with 110 additions and 82 deletions.
  1. +29 −3 Cache.hs
  2. +62 −12 Diff.hs
  3. +4 −60 Main.hs
  4. +0 −1  OverlayPortageDiff.hs
  5. +15 −6 P2.hs
View
32 Cache.hs
@@ -6,17 +6,23 @@ import CacheFile
import Config
import Error
import Index
+import P2
+import Version
+import Data.Char
+import Data.List
import Network.URI
import Network.HTTP
-import Data.ByteString.Lazy as BS
+import qualified Data.ByteString.Lazy as L
import System.Time
import System.FilePath
import Control.Monad.Error(throwError)
-import Control.Monad.Trans(liftIO)
+import Control.Monad.Writer
import Control.Monad (unless)
import System.Directory (doesFileExist,createDirectoryIfMissing)
+import qualified Data.Map as Map
+
-- | A long time. Used in checkCacheDate
alarmingLongTime :: TimeDiff
alarmingLongTime = TimeDiff
@@ -51,5 +57,25 @@ readCache portdir = do
unless exists $ do
info "No cache file present, attempting to update..."
updateCache
- str <- liftIO $ BS.readFile cachePath
+ str <- liftIO $ L.readFile cachePath
return $ readIndex str
+
+indexToPortage :: Index -> Portage -> (Portage, [String])
+indexToPortage index port = 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
+ return $ Ebuild (P pkg_cat pkg_name) (getVersion pkg_h_ver) ""
+ return $ Map.map sort $ Map.fromListWith (++) [ (ePackage e, [e]) | e <- pkgs ]
+ where
+ catMap = Map.fromListWith (++) [ (p, [c]) | P c p <- Map.keys port ]
+ lookupCat :: String -> Writer [String] String
+ lookupCat p = do
+ case Map.lookup p catMap of
+ Nothing -> return "hackage"
+ Just [x] -> return x
+ Just xs -> do
+ let c | elem "dev-haskell" xs = "dev-haskell"
+ | otherwise = head xs
+ tell ["WARNING: Category clash for package " ++ p ++ ", defaulting to " ++ c ++ ". Other categories: " ++ unwords (delete c xs)]
+ return c
View
74 Diff.hs
@@ -1,7 +1,18 @@
module Diff where
-import Data.Set as Set
-import Data.Map as Map
+import Data.Set as Set (Set)
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+
+import Control.Monad.Trans
+import Data.Char
+
+import Action
+import Cache
+import Config
+import P2
+import Portage
+import Version
diffSet :: (Eq a,Ord a)
=> Set a -- ^ Set 1
@@ -17,13 +28,52 @@ data DiffState a
| OnlyRight a
| Both a a
-diffBest :: (Ord k,Eq a)
- => Map k a
- -> Map k a
- -> Map k (DiffState a)
-diffBest map1 map2 = Map.unionWith mergeDiffState
- (Map.map OnlyLeft map1)
- (Map.map OnlyRight map2)
- where
- mergeDiffState :: DiffState a -> DiffState a -> DiffState a
- mergeDiffState (OnlyLeft x) (OnlyRight y) = Both x y
+tabs :: String -> String
+tabs str = let len = length str in str++(if len < 3*8
+ then replicate (3*8-len) ' '
+ else "")
+
+showDiffState :: Package -> DiffState Version -> String
+showDiffState pkg st = (tabs (show pkg)) ++ " [" ++ (case st of
+ Both x y -> showVersion x ++ (case compare x y of
+ EQ -> "="
+ GT -> ">"
+ LT -> "<") ++ showVersion y
+ OnlyLeft x -> showVersion x ++ ">none"
+ OnlyRight y -> "none<"++showVersion y)++"]"
+
+
+diffAction :: DiffMode -> HPAction ()
+diffAction dm = do
+ overlayPath <- getOverlayPath
+ cache <- readCache overlayPath
+ overlayTree <- liftIO $ readPortageTree overlayPath
+ let (hackageTree, clashes) = indexToPortage cache overlayTree
+ liftIO $ mapM_ putStrLn clashes
+ diff hackageTree overlayTree dm
+
+diff :: Portage -> Portage -> DiffMode -> HPAction ()
+diff pt1 pt2 mode = do
+ let pkgs1 = Map.map (OnlyLeft . eVersion . maximum) pt1
+ let pkgs2 = Map.map (OnlyRight . eVersion . maximum) pt2
+ let union = Map.unionWith (\(OnlyLeft x) (OnlyRight y) -> Both x y) pkgs1 pkgs2
+ let showFilter st = case mode of
+ ShowAll -> True
+ ShowMissing -> case st of
+ OnlyLeft _ -> True
+ Both x y -> x > y
+ OnlyRight _ -> False
+ ShowAdditions -> case st of
+ OnlyLeft _ -> False
+ Both x y -> x < y
+ OnlyRight _ -> True
+ ShowNewer -> case st of
+ OnlyLeft _ -> False
+ Both x y -> x > y
+ OnlyRight _ -> False
+ ShowCommon -> case st of
+ OnlyLeft _ -> False
+ Both x y -> x == y
+ OnlyRight _ -> False
+ let packages = filter (showFilter . snd) (Map.assocs union)
+ mapM_ (info . uncurry showDiffState) packages
View
64 Main.hs
@@ -1,35 +1,25 @@
module Main where
-import System.Environment
-import System.Exit
import Distribution.Package
import Distribution.PackageDescription
import Data.Version
-import Control.Monad.Trans
import Control.Monad.Error
-import Data.Typeable
import System.IO
import Data.Char
import Data.List
-import qualified Data.Set as Set
-import qualified Data.Map as Map
import Action
-import Bash
-import Cabal2Ebuild
+import qualified Cabal2Ebuild as E
import Cache
import Config
import Diff
import Error
import GenerateEbuild
import Index
-import MaybeRead
import OverlayPortageDiff
import Portage
-import P2
-
list :: String -> HPAction ()
list name = do
cache <- readCache =<< getOverlayPath
@@ -55,56 +45,10 @@ merge pid = do
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
- ebuild <- fixSrc pid (cabal2ebuild pkg)
+ [pkg] -> do
+ ebuild <- fixSrc pid (E.cabal2ebuild pkg)
mergeEbuild portTree ebuild
-tabs :: String -> String
-tabs str = let len = length str in str++(if len < 3*8
- then replicate (3*8-len) ' '
- else "")
-
-showDiffState :: String -> DiffState Version -> String
-showDiffState name st = (tabs name) ++ " [" ++ (case st of
- Both x y -> showVersion x ++ (case compare x y of
- EQ -> "="
- GT -> ">"
- LT -> "<") ++ showVersion y
- OnlyLeft x -> showVersion x ++ ">none"
- OnlyRight y -> "none<"++showVersion y)++"]"
-
-diff :: DiffMode -> HPAction ()
-diff mode = do
- cfg <- getCfg
- portTree <- getOverlayPath
- cache <- readCache portTree
- --let serverPkgs = map (\(_,_,pd)-> (package pd) {pkgName=map toLower (pkgName $ package pd)}) cache
- let serverPkgs = Map.mapKeys (map toLower) $ bestVersions $ indexMapFromList $ indexToPackageIdentifier cache
- portTree <- getOverlayPath
- portagePkgs' <- portageGetPackages portTree
- let portagePkgs = bestVersions $ indexMapFromList portagePkgs'
- let diff = diffBest serverPkgs portagePkgs
- let showFilter st = case mode of
- ShowAll -> True
- ShowMissing -> case st of
- OnlyLeft _ -> True
- Both x y -> x > y
- OnlyRight _ -> False
- ShowAdditions -> case st of
- OnlyLeft _ -> False
- Both x y -> x < y
- OnlyRight _ -> True
- ShowNewer -> case st of
- OnlyLeft _ -> False
- Both x y -> x > y
- OnlyRight _ -> False
- ShowCommon -> case st of
- OnlyLeft _ -> False
- Both x y -> x == y
- OnlyRight _ -> False
- let packages = filter (showFilter . snd) (Map.assocs diff)
- mapM_ (info . uncurry showDiffState) packages
-
hpmain :: HPAction ()
hpmain = do
mode <- loadConfig
@@ -117,7 +61,7 @@ hpmain = do
ShowHelp -> liftIO hackageUsage
List pkg -> list pkg
Merge pkg -> merge pkg
- DiffTree mode -> diff mode
+ DiffTree mode -> diffAction mode
Update -> updateCache
OverlayOnly -> overlayonly
View
1  OverlayPortageDiff.hs
@@ -52,7 +52,6 @@ overlayonly = do
toColor c t = inColor c False Default t
--- incomplete
portageDiff :: Portage -> Portage -> (Portage, Portage, Portage)
portageDiff p1 p2 = (in1, ins, in2)
where ins = Map.filter (not . null) $
View
21 P2.hs
@@ -16,7 +16,6 @@ import qualified Data.List as List
import System.Directory
import System.IO
-import System.IO.Unsafe
import System.FilePath
import Text.Regex
@@ -30,7 +29,7 @@ data Ebuild = Ebuild {
ePackage :: Package,
eVersion :: Version,
eFilePath :: FilePath }
- deriving (Eq, Show)
+ deriving (Eq, Ord, Show)
data Package = P String String
deriving (Eq, Ord)
@@ -51,12 +50,13 @@ getPackageList portdir = do
return (map (P c) pkg)
return packages
-readPortagePackages :: FilePath -> [Package] -> IO (Map Package [Ebuild])
+readPortagePackages :: FilePath -> [Package] -> IO Portage
readPortagePackages portdir packages0 = do
packages <- filterM (doesDirectoryExist . (portdir </>) . show) packages0
- ebuild_map <- forM packages $ \package -> do
- ebuilds <- unsafeInterleaveIO (getPackageVersions package)
+ ebuild_map0 <- forM packages $ \package -> do
+ ebuilds <- getPackageVersions package
return (package, ebuilds)
+ let ebuild_map = filter (not . null . snd) ebuild_map0
return $ Map.fromList ebuild_map
where
@@ -76,7 +76,7 @@ readPortagePackages portdir packages0 = do
ebuildVersionRegex name = mkRegex ("^"++name++"-(.*)\\.ebuild$")
-readPortageTree :: FilePath -> IO (Map Package [Ebuild])
+readPortageTree :: FilePath -> IO Portage
readPortageTree portdir = do
packages <- getPackageList portdir
readPortagePackages portdir packages
@@ -85,3 +85,12 @@ getDirectories :: FilePath -> IO [String]
getDirectories fp = do
files <- fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents fp
filterM (doesDirectoryExist . (fp </>)) files
+
+printPortage :: Portage -> IO ()
+printPortage port =
+ forM_ (Map.toAscList port) $ \(package, ebuilds) -> do
+ let (P c p) = package
+ putStr $ c ++ '/':p
+ putStr " "
+ forM_ ebuilds (\e -> putStr (show $ eVersion e) >> putChar ' ')
+ putStrLn ""
Please sign in to comment.
Something went wrong with that request. Please try again.