packages feed

hark-0.2: src/Drivers/Version.hs

{-----------------------------------------------------------------

  (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<num> 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