{----------------------------------------------------------------- (c) 2008-2009 Markus Dittrich This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License Version 3 as published by the Free Software Foundation. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 3 for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --------------------------------------------------------------------} -- | this module contains the top level routines for searching for -- packages with certain dependencies module Drivers.Version ( match_version , is_equal , is_larger , is_larger_equal , is_smaller , is_smaller_equal , is_same_rev_class ) where -- imports import qualified Data.ByteString as B(ByteString, length) import Prelude -- local imports import Helpers.ByteString(equalSign, glob, greater, gr_eq, low_eq, smaller, tilde) import Parsers.Version(test_NumCharTok, test_Revision, remove_trailing_zeros, split_version, VersionTok(..)) -- | check if a version plus qualifier matches a supplied -- version string match_version :: B.ByteString -> B.ByteString -> B.ByteString -> Bool match_version qualifier version target | qualifier == tilde = is_same_rev_class target version | qualifier == equalSign = is_equal target version | qualifier == smaller = is_smaller target version | qualifier == greater = is_larger target version | qualifier == low_eq = is_smaller_equal target version | qualifier == gr_eq = is_larger_equal target version | otherwise = False -- | function checking if two particular versions match -- apart from the revision number is_same_rev_class :: B.ByteString -> B.ByteString -> Bool is_same_rev_class s1 s2 = list_equal (tokenize s1) (tokenize s2) where tokenize :: B.ByteString -> [VersionTok] tokenize = \x -> extract_prefix x ++ extract_suffix x -- | function checking equality of two version strings -- -- NOTE: We do two things to determine equality: -- -- - a raw comparison of the ByteString -- - next, we tokenize both ByteStrings, strip the trailing -- zeros, and then compare to catch cases like -- 1.1.0.0.0 == 1.1 -- -- This means we're currently missing things like -- 1.1.0.0-rc1 and 1.1-rc1 as being equal is_equal :: B.ByteString -> B.ByteString -> Bool is_equal s1 s2 | s1 == s2 = True | list_equal (tokenize s1) (tokenize s2) == True = True | otherwise = False where tokenize :: B.ByteString -> [VersionTok] tokenize = remove_trailing_zeros . split_version -- | compares tokenized version string; this is similar to the -- plain list comparison with the difference that we abort -- when we encounter a glob pattern and declare the versions -- as equal list_equal :: [VersionTok] -> [VersionTok] -> Bool list_equal [] [] = True list_equal (x:xs) (y:ys) | x == y = list_equal xs ys | x == NumTok glob = True | y == NumTok glob = True | otherwise = False list_equal [] (x : _) | x == NumTok glob = True | otherwise = False list_equal (x : _) [] | x == NumTok glob = True | otherwise = False -- | check if version string 1 is smaller equal than version -- string 2. is_smaller_equal :: B.ByteString -> B.ByteString -> Bool is_smaller_equal s1 s2 | (is_equal s1 s2 == True) = True | otherwise = is_smaller s1 s2 -- | check if version string 1 is large equal than version -- string 2 is_larger_equal :: B.ByteString -> B.ByteString -> Bool is_larger_equal s1 s2 | (is_equal s1 s2 == True) = True | otherwise = is_larger s1 s2 -- | check if version string 1 is smaller than version string2 is_smaller :: B.ByteString -> B.ByteString -> Bool is_smaller s1 s2 = is_larger s2 s1 -- | check if version string 1 is larger than version string 2 is_larger :: B.ByteString -> B.ByteString -> Bool is_larger s1 s2 = comp_prefix_larger (extract_prefix s1) (extract_prefix s2) where -- compare the prefix and descent into suffix comparator -- if prefix if identical -- NOTE: Since NumTok is a ByteString we need to compare -- its length first and then its value since e.g. 4 > 12 comp_prefix_larger :: [VersionTok] -> [VersionTok] -> Bool comp_prefix_larger [] (_:_) = False comp_prefix_larger (_:_) [] = True comp_prefix_larger [] [] = comp_suffix_larger (extract_suffix s1) (extract_suffix s2) comp_prefix_larger ((NumTok x):xs) ((NumTok y):ys) | (B.length y) < (B.length x) = True | (B.length x) < (B.length y) = False | y < x = True | x < y = False | otherwise = comp_prefix_larger xs ys -- these next ones should never happen since only NumTok -- and CharTok allowed in the prefix; maybe throw an error -- instead? comp_prefix_larger (Revision : _) (_ : _) = False comp_prefix_larger ((Suffix _) : _) (_ : _) = False comp_prefix_larger ((NumTok _) : _) (Revision : _) = False comp_prefix_larger ((NumTok _) : _) ((Suffix _) : _) = False -- compare the suffic and decent into the revision comparator -- if suffix is identical as well comp_suffix_larger :: [VersionTok] -> [VersionTok] -> Bool comp_suffix_larger [] (_:_) = False comp_suffix_larger (_:_) [] = True comp_suffix_larger [] [] = comp_rev_larger (extract_rev s1) (extract_rev s2) comp_suffix_larger ((Suffix x1):x2:xs) ((Suffix y1):y2:ys) | x1 < y1 = False | x2 < y2 = False | y1 < x1 = True | y2 < x2 = True | otherwise = comp_suffix_larger xs ys -- these next two should never happen since the values -- always come paired; maybe throw an error instead? comp_suffix_larger [_] (_:_) = False comp_suffix_larger (_ : (_ : _)) [_] = False comp_suffix_larger (Revision : (_ : _)) (_ : (_ : _)) = False comp_suffix_larger ((NumTok _) : (_ : _)) (_ : (_ : _)) = False comp_suffix_larger ((Suffix _) : (_ : _)) (Revision : (_ : _)) = False comp_suffix_larger ((Suffix _) : (_ : _)) ((NumTok _) : (_ : _)) = False -- compare revision -- NOTE: the length of both arrays can in principle either -- only be 0 or 2 hence we could add a safety check here -- as well comp_rev_larger :: [VersionTok] -> [VersionTok] -> Bool comp_rev_larger [] [] = False comp_rev_larger [] (_:_) = False comp_rev_larger (_:_) [] = True comp_rev_larger (_:x2:_) (_:y2:_) | y2 < x2 = True | x2 < y2 = False | otherwise = False -- these ones should never happen since we should always -- have r pairs comp_rev_larger [_] (_:_) = False comp_rev_larger (_: (_:_)) [_] = False -- | extract the prefix of a version string extract_prefix :: B.ByteString -> [VersionTok] extract_prefix = remove_trailing_zeros . takeWhile test_NumCharTok . split_version -- | extract the suffix of a version string extract_suffix :: B.ByteString -> [VersionTok] extract_suffix = takeWhile ( not . test_Revision ) . dropWhile test_NumCharTok . split_version -- | extract the revision of a version string extract_rev :: B.ByteString -> [VersionTok] extract_rev = dropWhile ( not . test_Revision ) . dropWhile test_NumCharTok . split_version