Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

New diff style

  • Loading branch information...
commit 3eb19fc4d00d5828b7a33b459e5c34abbce0a701 1 parent 3754021
der_eq@freenet.de authored

Showing 3 changed files with 62 additions and 9 deletions. Show diff stats Hide diff stats

  1. +20 4 Diff.hs
  2. +18 0 Index.hs
  3. +24 5 Main.hs
24 Diff.hs
... ... @@ -1,13 +1,29 @@
1 1 module Diff where
2 2
3   -import Data.Set
  3 +import Data.Set as Set
  4 +import Data.Map as Map
4 5
5 6 diffSet :: (Eq a,Ord a)
6 7 => Set a -- ^ Set 1
7 8 -> Set a -- ^ Set 2
8 9 -> (Set a,Set a,Set a) -- ^ (Things in 1 but not in 2,Things in 2 but not in 1,Things in both sets)
9 10 diffSet set1 set2 = let
10   - int = intersection set1 set2
11   - in1 = difference set1 int
12   - in2 = difference set2 int in (in1,in2,int)
  11 + int = Set.intersection set1 set2
  12 + in1 = Set.difference set1 int
  13 + in2 = Set.difference set2 int in (in1,in2,int)
13 14
  15 +data DiffState a
  16 + = OnlyLeft a
  17 + | OnlyRight a
  18 + | Both a a
  19 +
  20 +diffBest :: (Ord k,Eq a)
  21 + => Map k a
  22 + -> Map k a
  23 + -> Map k (DiffState a)
  24 +diffBest map1 map2 = Map.unionWith mergeDiffState
  25 + (Map.map OnlyLeft map1)
  26 + (Map.map OnlyRight map2)
  27 + where
  28 + mergeDiffState :: DiffState a -> DiffState a -> DiffState a
  29 + mergeDiffState (OnlyLeft x) (OnlyRight y) = Both x y
18 Index.hs
@@ -2,13 +2,19 @@ module Index where
2 2
3 3 import Data.List(isSuffixOf)
4 4 import Data.Maybe(mapMaybe)
  5 +import qualified Data.Set as Set
  6 +import qualified Data.Map as Map
  7 +import Data.Version (Version,parseVersion)
5 8 import Codec.Compression.GZip(decompress)
6 9 import Data.ByteString.Lazy.Char8(ByteString,unpack)
7 10 import Codec.Archive.Tar
8 11 import Distribution.PackageDescription
  12 +import Distribution.Package
9 13 import System.FilePath.Posix
  14 +import MaybeRead (readPMaybe)
10 15
11 16 type Index = [(String,String,PackageDescription)]
  17 +type IndexMap = Map.Map String (Set.Set Version)
12 18
13 19 readIndex :: ByteString -> Index
14 20 readIndex str = let
@@ -26,3 +32,15 @@ searchIndex f ind = mapMaybe (\(name,vers,pd) -> if f name vers
26 32 then Just pd
27 33 else Nothing
28 34 ) ind
  35 +
  36 +indexMapFromList :: [PackageIdentifier] -> IndexMap
  37 +indexMapFromList = foldl (\mp (PackageIdentifier {pkgName = name,pkgVersion = vers})
  38 + -> Map.alter ((Just).(maybe (Set.singleton vers) (Set.insert vers))) name mp) Map.empty
  39 +
  40 +indexToPackageIdentifier :: Index -> [PackageIdentifier]
  41 +indexToPackageIdentifier = mapMaybe (\(name,vers_str,_) -> do
  42 + vers <- readPMaybe parseVersion vers_str
  43 + return $ PackageIdentifier {pkgName = name,pkgVersion = vers})
  44 +
  45 +bestVersions :: IndexMap -> Map.Map String Version
  46 +bestVersions = Map.map Set.findMax
29 Main.hs
@@ -12,6 +12,7 @@ import System.IO
12 12 import Data.Char
13 13 import Data.List
14 14 import qualified Data.Set as Set
  15 +import qualified Data.Map as Map
15 16
16 17 import Action
17 18 import Error
@@ -54,16 +55,34 @@ merge pid = do
54 55 ebuild <- fixSrc pid (cabal2ebuild pkg)
55 56 mergeEbuild portTree ebuild
56 57
  58 +tabs :: String -> String
  59 +tabs str = let len = length str in str++(if len < 3*8
  60 + then replicate (3*8-len) ' '
  61 + else "")
  62 +
  63 +showDiffState :: String -> DiffState Version -> String
  64 +showDiffState name st = (tabs name) ++ " [" ++ (case st of
  65 + Both x y -> showVersion x ++ (case compare x y of
  66 + EQ -> "="
  67 + GT -> ">"
  68 + LT -> "<") ++ showVersion y
  69 + OnlyLeft x -> showVersion x ++ ">none"
  70 + OnlyRight y -> "none<"++showVersion y)++"]"
  71 +
57 72 diff :: DiffMode -> HPAction ()
58 73 diff mode = do
59 74 cfg <- getCfg
60 75 portTree <- getPortageTree
61 76 cache <- readCache portTree
62   - let serverPkgs'=map (\(_,_,pd)-> (package pd) {pkgName=map toLower (pkgName $ package pd)}) cache
  77 + --let serverPkgs = map (\(_,_,pd)-> (package pd) {pkgName=map toLower (pkgName $ package pd)}) cache
  78 + let serverPkgs = bestVersions $ indexMapFromList $ indexToPackageIdentifier cache
63 79 portTree <- getPortageTree
64   - portagePkgs <- portageGetPackages portTree
65   - let (inport,inhack,inboth)=diffSet (Set.fromList portagePkgs) (Set.fromList serverPkgs')
66   - let showPkgSet set = mapM_ (\pkg->echoLn (pkgName pkg++"-"++showVersion (pkgVersion pkg))) (Set.elems set)
  80 + portagePkgs' <- portageGetPackages portTree
  81 + let portagePkgs = bestVersions $ indexMapFromList portagePkgs'
  82 + let diff = diffBest serverPkgs portagePkgs
  83 + mapM_ (\(name,st) -> info $ showDiffState name st) (Map.assocs diff)
  84 + --let (inport,inhack,inboth)=diffSet (Set.fromList portagePkgs) (Set.fromList serverPkgs)
  85 + {-let showPkgSet set = mapM_ (\pkg->echoLn (pkgName pkg++"-"++showVersion (pkgVersion pkg))) (Set.elems set)
67 86 let vindent = case verbosity cfg of
68 87 Silent -> id
69 88 _ -> indent
@@ -75,7 +94,7 @@ diff mode = do
75 94 vindent $ showPkgSet inport)
76 95 when (mode==ShowAll || mode==ShowCommon) (do
77 96 info "Packages in the overlay and hackage:"
78   - vindent $ showPkgSet inboth)
  97 + vindent $ showPkgSet inboth)-}
79 98
80 99 update :: HPAction ()
81 100 update = do

0 comments on commit 3eb19fc

Please sign in to comment.
Something went wrong with that request. Please try again.