Version.hs 6.55 KB
Newer Older
1 2 3
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Version
simonmar's avatar
simonmar committed
4
-- Copyright   :  Isaac Jones, Simon Marlow 2003-2004
5 6 7
-- 
-- Maintainer  :  Isaac Jones <ijones@syntaxpolice.org>
-- Stability   :  alpha
ijones's avatar
ijones committed
8
-- Portability :  portable
9
--
simonmar's avatar
simonmar committed
10
-- Versions for packages, based on the 'Version' datatype.
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42

{- Copyright (c) 2003-2004, Isaac Jones
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

simonmar's avatar
simonmar committed
43 44
module Distribution.Version (
  -- * Package versions
simonmar's avatar
simonmar committed
45
  Version(..),
simonmar's avatar
simonmar committed
46
  showVersion,
47
  readVersion,
simonmar's avatar
simonmar committed
48 49
  parseVersion,

simonmar's avatar
simonmar committed
50
  -- * Version ranges
simonmar's avatar
simonmar committed
51 52 53 54 55 56
  VersionRange(..), 
  orLaterVersion, orEarlierVersion,
  betweenVersionsInclusive,
  withinRange,
  showVersionRange,
  parseVersionRange,
57
  isAnyVersion,
simonmar's avatar
simonmar committed
58

simonmar's avatar
simonmar committed
59 60
 ) where

61
import Data.Version	( Version(..), showVersion )
simonmar's avatar
simonmar committed
62

63
import Control.Monad    ( liftM )
64
import Data.Char	( isSpace, isDigit, isAlphaNum )
65
import Data.Maybe	( listToMaybe )
66

simonmar's avatar
simonmar committed
67
import Distribution.Compat.ReadP
68

simonmar's avatar
simonmar committed
69
-- -----------------------------------------------------------------------------
70
-- Version utils
simonmar's avatar
simonmar committed
71 72

parseVersion :: ReadP r Version
73
parseVersion = do branch <- sepBy1 digits (char '.')
simonmar's avatar
simonmar committed
74 75
                  tags   <- many (char '-' >> munch1 isAlphaNum)
                  return Version{versionBranch=branch, versionTags=tags}
76 77 78 79 80 81 82
  where
    digits  :: ReadP r Int
    digits   = do first <- satisfy isDigit
                  if first == '0'
		    then return 0
		    else do rest <- munch isDigit
                            return (read (first : rest))
simonmar's avatar
simonmar committed
83

84 85 86 87
readVersion :: String -> Maybe Version
readVersion str =
  listToMaybe [ r | (r,s) <- readP_to_S parseVersion str, all isSpace s ]

simonmar's avatar
simonmar committed
88 89 90 91 92
-- -----------------------------------------------------------------------------
-- Version ranges

-- Todo: maybe move this to Distribution.Package.Version?
-- (package-specific versioning scheme).
93 94 95

data VersionRange
  = AnyVersion
simonmar's avatar
simonmar committed
96 97 98 99 100 101 102
  | ThisVersion		   Version -- = version
  | LaterVersion	   Version -- > version  (NB. not >=)
  | EarlierVersion	   Version -- < version
	-- ToDo: are these too general?
  | UnionVersionRanges      VersionRange VersionRange
  | IntersectVersionRanges  VersionRange VersionRange
  deriving (Show,Read,Eq)
103

104 105 106 107
isAnyVersion :: VersionRange -> Bool
isAnyVersion AnyVersion = True
isAnyVersion _ = False

ijones's avatar
cleanup  
ijones committed
108
orLaterVersion :: Version -> VersionRange
simonmar's avatar
simonmar committed
109
orLaterVersion   v = UnionVersionRanges (ThisVersion v) (LaterVersion v)
ijones's avatar
cleanup  
ijones committed
110 111

orEarlierVersion :: Version -> VersionRange
simonmar's avatar
simonmar committed
112 113
orEarlierVersion v = UnionVersionRanges (ThisVersion v) (EarlierVersion v)

ijones's avatar
cleanup  
ijones committed
114 115

betweenVersionsInclusive :: Version -> Version -> VersionRange
simonmar's avatar
simonmar committed
116 117
betweenVersionsInclusive v1 v2 =
  IntersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2)
118

ijones's avatar
cleanup  
ijones committed
119
laterVersion :: Version -> Version -> Bool
simonmar's avatar
simonmar committed
120
v1 `laterVersion`   v2 = versionBranch v1 > versionBranch v2
ijones's avatar
cleanup  
ijones committed
121 122

earlierVersion :: Version -> Version -> Bool
simonmar's avatar
simonmar committed
123
v1 `earlierVersion` v2 = versionBranch v1 < versionBranch v2
124 125 126

-- |Does this version fall within the given range?
withinRange :: Version -> VersionRange -> Bool
simonmar's avatar
simonmar committed
127 128 129 130 131 132 133 134 135 136 137
withinRange _  AnyVersion                = True
withinRange v1 (ThisVersion v2) 	 = v1 == v2
withinRange v1 (LaterVersion v2)         = v1 `laterVersion` v2
withinRange v1 (EarlierVersion v2)       = v1 `earlierVersion` v2
withinRange v1 (UnionVersionRanges v2 v3) 
   = v1 `withinRange` v2 || v1 `withinRange` v3
withinRange v1 (IntersectVersionRanges v2 v3) 
   = v1 `withinRange` v2 && v1 `withinRange` v3

showVersionRange :: VersionRange -> String
showVersionRange AnyVersion = "-any"
ka2_mail's avatar
ka2_mail committed
138
showVersionRange (ThisVersion v) = '=' : '=' : showVersion v
simonmar's avatar
simonmar committed
139 140
showVersionRange (LaterVersion v) = '>' : showVersion v
showVersionRange (EarlierVersion v) = '<' : showVersion v
ka2_mail's avatar
ka2_mail committed
141 142 143 144 145 146 147 148
showVersionRange (UnionVersionRanges (ThisVersion v1) (LaterVersion v2))
  | v1 == v2 = '>' : '=' : showVersion v1
showVersionRange (UnionVersionRanges (LaterVersion v2) (ThisVersion v1))
  | v1 == v2 = '>' : '=' : showVersion v1
showVersionRange (UnionVersionRanges (ThisVersion v1) (EarlierVersion v2))
  | v1 == v2 = '<' : '=' : showVersion v1
showVersionRange (UnionVersionRanges (EarlierVersion v2) (ThisVersion v1))
  | v1 == v2 = '<' : '=' : showVersion v1
simonmar's avatar
simonmar committed
149 150 151 152
showVersionRange (UnionVersionRanges r1 r2) 
  = showVersionRange r1 ++ "||" ++ showVersionRange r2
showVersionRange (IntersectVersionRanges r1 r2) 
  = showVersionRange r1 ++ "&&" ++ showVersionRange r2
153 154 155 156 157 158

-- ------------------------------------------------------------
-- * Parsing
-- ------------------------------------------------------------

--  -----------------------------------------------------------
159
parseVersionRange :: ReadP r VersionRange
ka2_mail's avatar
ka2_mail committed
160 161
parseVersionRange = do
  f1 <- factor
ijones's avatar
ijones committed
162
  skipSpaces
ka2_mail's avatar
ka2_mail committed
163 164
  (do
     string "||"
ijones's avatar
ijones committed
165
     skipSpaces
ka2_mail's avatar
ka2_mail committed
166 167 168 169 170
     f2 <- factor
     return (UnionVersionRanges f1 f2)
   +++
   do    
     string "&&"
ijones's avatar
ijones committed
171
     skipSpaces
ka2_mail's avatar
ka2_mail committed
172 173 174 175 176 177
     f2 <- factor
     return (IntersectVersionRanges f1 f2)
   +++
   return f1)
  where 
        factor   = choice ((string "-any" >> return AnyVersion) :
ijones's avatar
ijones committed
178 179
                                    map parseRangeOp rangeOps)
        parseRangeOp (s,f) = string s >> skipSpaces >> liftM f parseVersion
ka2_mail's avatar
ka2_mail committed
180
        rangeOps = [ ("<",  EarlierVersion),
181 182 183 184
                     ("<=", orEarlierVersion),
                     (">",  LaterVersion),
                     (">=", orLaterVersion),
                     ("==", ThisVersion) ]