[Lsb-messages] /var/www/bzr/lsb/devel/repogen r201: Add Package functions for comparing packages.

[Jeff Licquia]

------------------------------------------------------------
revno: 201
committer: Jeff Licquia <licquia at linuxfoundation.org>
branch nick: repogen
timestamp: Fri 2013-06-14 14:01:26 -0400
message:
  Add Package functions for comparing packages.
modified:
  Package.hs
-------------- next part --------------
=== modified file 'Package.hs'
--- a/Package.hs	2013-06-13 02:35:11 +0000
+++ b/Package.hs	2013-06-14 18:01:26 +0000
@@ -215,3 +215,87 @@
     release=release p,
     arch=arch p,
     pkgtype=pkgtype p }
+
+-- Package comparison functions.  Besides simple equality, we want
+-- to be able to compare package versions.  The rules below are intended
+-- to mirror the rules as specified by RPM and in the Debian Policy
+-- Manual; any deviation from those rules is a bug.
+
+fragmentCollect :: [Char] -> (String, String) -> (String, String)
+fragmentCollect charset (xs, "") = (xs, "")
+fragmentCollect charset (xs, y:ys)
+    | y `elem` charset
+      = fragmentCollect charset (xs ++ [y], ys)
+    | otherwise
+      = (xs, y:ys)
+
+getSet :: Char -> Maybe [Char]
+getSet c = let sets = filter (elem c) [ ['0'..'9'], (['A'..'Z'] ++ ['a'..'z']),
+                                        ['~'] ]
+           in if null sets then Nothing
+                           else Just $ head sets
+
+splitVersion :: String -> [String]
+splitVersion "" = []
+splitVersion (x:xs)
+    | isJust charset
+      = let (chunk, rest) = fragmentCollect (fromJust charset) ([x], xs)
+        in [chunk] ++ splitVersion rest
+    | otherwise
+      = splitVersion xs
+    where charset = getSet x
+
+compareVersionChunks :: String -> String -> Ordering
+compareVersionChunks "" "" = EQ
+compareVersionChunks "" (y:ys) 
+    | y == '~' = GT
+    | otherwise = LT
+compareVersionChunks (x:xs) ""
+    | x == '~' = LT
+    | otherwise = GT
+compareVersionChunks (x:xs) (y:ys)
+    | x == '~' && y /= '~' = LT
+    | x /= '~' && y == '~' = GT
+    | x `elem` numbers && y `notElem` numbers = GT
+    | x `notElem` numbers && y `elem` numbers = LT
+    | x `elem` numbers && y `elem` numbers
+      = (read (x:xs) :: Int) `compare` (read (y:ys) :: Int)
+    | otherwise
+      = (x:xs) `compare` (y:ys)
+    where numbers = ['0'..'9']
+
+compareVersionChunkLists :: [String] -> [String] -> Ordering
+compareVersionChunkLists [] [] = EQ
+compareVersionChunkLists [] (y:ys)
+    | head y == '~' = GT
+    | otherwise = LT
+compareVersionChunkLists (x:xs) []
+    | head x == '~' = LT
+    | otherwise = GT
+compareVersionChunkLists (x:xs) (y:ys)
+    = case chunkComparison of
+        EQ        -> compareVersionChunkLists xs ys
+        otherwise -> chunkComparison
+    where chunkComparison = compareVersionChunks x y
+
+comparePackageVersions :: Package -> Package -> Ordering
+comparePackageVersions x y
+    = compareVersionChunkLists [epoch x, version x, release x] 
+        [epoch y, version y, release y]
+
+compareVersionStrings :: String -> String -> Ordering
+compareVersionStrings x y
+    = compareVersionChunkLists (splitVersion x) (splitVersion y)
+
+-- Package equivalence: is one package a correct upgrade of another?
+-- This version is fairly naive; it doesn't allow for concepts like
+-- Provides or Replaces.  But it should work for now, and allow for
+-- future enhancement.
+
+equivalent :: Package -> Package -> Bool
+equivalent x y = (pkgtype x == pkgtype y) && (name x == name y)
+
+comparePackages :: Package -> Package -> Maybe Ordering
+comparePackages x y
+    | equivalent x y = Just $ comparePackageVersions x y
+    | otherwise = Nothing