Version.hs 14.7 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 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
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Version
-- Copyright   :  Isaac Jones 2003-2004
-- 
-- Maintainer  :  Isaac Jones <ijones@syntaxpolice.org>
-- Stability   :  alpha
-- Portability :  GHC
--
-- Explanation: Represents and parses versions like Nov-2003, 1.2-4, etc.

{- 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 45 46 47 48 49 50 51 52 53 54 55 56 57
module Distribution.Version (
  -- * The Version type
  Version(..),

  -- * Package versions
  showVersion,
  parseVersion,

  -- ** Version ranges
  VersionRange(..), 
  orLaterVersion, orEarlierVersion,
  betweenVersionsInclusive,
  withinRange,
  showVersionRange,
  parseVersionRange,
ijones's avatar
ijones committed
58
  hunitTests
simonmar's avatar
simonmar committed
59 60 61
 ) where

import Data.List	( intersperse )
62 63 64 65 66 67 68

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as P

import HUnit

simonmar's avatar
simonmar committed
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
-- -----------------------------------------------------------------------------
-- The Version type

{- |
A 'Version' represents the version of a software entity.

An instance 'Eq' is provided, which implements exact equality modulo
reordering of the tags in the 'versionTags' field.  

The interpretation of ordering is dependent on the entity being
versioned, and perhaps the application.  For example, simple branch
ordering is probably sufficient for many uses (see the 'versionBranch'
field), but some versioning schemes may include pre-releases which
have tags @"pre1"@, @"pre2"@, and so on, and these would need to be
taken into account when determining ordering.  In some cases, date
ordering may be more appropriate, so the application would have to
look for @date@ tags in the 'versionTags' field and compare those.

Similarly, concrete representations of versions may differ, so we leave
parsing and printing up to the application.
-}
data Version = 
  Version { versionBranch :: [Int],
		-- ^ The numeric branch for this version.  This reflects the
		-- fact that most software versions are tree-structured; there
		-- is a main trunk which is tagged with versions at various
		-- points (1,2,3...), and the first branch off the trunk after
		-- version 3 is 3.1, the second branch off the trunk after
		-- version 3 is 3.2, and so on.  The tree can be branched
		-- arbitrarily, just by adding more digits.
		-- 
		-- We represent the branch as a list of 'Int', so
		-- version 3.2.1 becomes [3,2,1].  Lexicographic ordering
		-- (i.e. the default instance of 'Ord' for @[Int]@) gives
		-- the natural ordering of branches.

	   versionTags :: [String]  -- really a bag
		-- ^ A version can be tagged with an arbitrary list of strings.
		-- The interpretation of the list of tags is entirely dependent
108
		-- on the entity that this version applies to.
simonmar's avatar
simonmar committed
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
	}
  deriving (Read,Show)

instance Eq Version where
  v1 == v2  =  versionBranch v1 == versionBranch v2 
		&& all (`elem` (versionTags v2)) (versionTags v1)
		-- tags may be in any order

-- -----------------------------------------------------------------------------
-- Package Versions

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

-- Our conventions:
--
125 126 127 128
--	* Versions are of the form  A.B.C-tag1-tag2
--
--	* Ordering is determined by lexicographic ordering of the
--	  numeric part of the version only.
simonmar's avatar
simonmar committed
129 130 131

showVersion :: Version -> String
showVersion (Version branch tags)
132 133
  = concat (intersperse "." (map show branch)) ++ 
    concat (map ('-':) tags)
simonmar's avatar
simonmar committed
134 135 136 137 138 139

-- -----------------------------------------------------------------------------
-- Version ranges

-- Todo: maybe move this to Distribution.Package.Version?
-- (package-specific versioning scheme).
140 141 142

data VersionRange
  = AnyVersion
simonmar's avatar
simonmar committed
143 144 145 146 147 148 149
  | 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)
150

ijones's avatar
cleanup  
ijones committed
151
orLaterVersion :: Version -> VersionRange
simonmar's avatar
simonmar committed
152
orLaterVersion   v = UnionVersionRanges (ThisVersion v) (LaterVersion v)
ijones's avatar
cleanup  
ijones committed
153 154

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

ijones's avatar
cleanup  
ijones committed
157 158

betweenVersionsInclusive :: Version -> Version -> VersionRange
simonmar's avatar
simonmar committed
159 160
betweenVersionsInclusive v1 v2 =
  IntersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2)
161

ijones's avatar
cleanup  
ijones committed
162
laterVersion :: Version -> Version -> Bool
simonmar's avatar
simonmar committed
163
v1 `laterVersion`   v2 = versionBranch v1 > versionBranch v2
ijones's avatar
cleanup  
ijones committed
164 165

earlierVersion :: Version -> Version -> Bool
simonmar's avatar
simonmar committed
166
v1 `earlierVersion` v2 = versionBranch v1 < versionBranch v2
167 168 169

-- |Does this version fall within the given range?
withinRange :: Version -> VersionRange -> Bool
simonmar's avatar
simonmar committed
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
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"
showVersionRange (ThisVersion v) = '=' : showVersion v
showVersionRange (LaterVersion v) = '>' : showVersion v
showVersionRange (EarlierVersion v) = '<' : showVersion v
showVersionRange (UnionVersionRanges r1 r2) 
  = showVersionRange r1 ++ "||" ++ showVersionRange r2
showVersionRange (IntersectVersionRanges r1 r2) 
  = showVersionRange r1 ++ "&&" ++ showVersionRange r2
188 189 190 191 192 193 194 195 196 197 198

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

word :: Parser String
word = many1 letter <?> "word"

--  -----------------------------------------------------------
parseVersionRange :: Parser VersionRange
parseVersionRange = try (do reservedOp "<"
simonmar's avatar
simonmar committed
199 200
                            v <- parseVersion
                            return $ EarlierVersion v)
201
                    <|> (do reservedOp ">"
simonmar's avatar
simonmar committed
202 203
                            v <- parseVersion
                            return $ LaterVersion v)
204
                    <|> (do reservedOp ">="
simonmar's avatar
simonmar committed
205 206
                            v <- parseVersion
                            return $ orLaterVersion v)
207
                    <|> (do reservedOp "<="
simonmar's avatar
simonmar committed
208 209
                            v <- parseVersion
                            return $ orEarlierVersion v)
210
                    <|> (do reservedOp "=="
simonmar's avatar
simonmar committed
211 212
                            v <- parseVersion
                            return $ ThisVersion v)
213 214 215 216 217 218 219
                    <|> (do reservedOp "-"
                            reserved "any"
                            return $ AnyVersion)


--  -----------------------------------------------------------
-- |Parse any kind of version
simonmar's avatar
simonmar committed
220 221 222 223 224
parseVersion :: Parser Version
parseVersion
    = do branch <- branchParser
	 date <- dateParser
	 return (Version{versionBranch=branch, versionTags=date})
225 226

--  -----------------------------------------------------------
simonmar's avatar
simonmar committed
227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258
-- |Parse a version of the form 1.2.3
branchParser :: Parser [Int]
branchParser
    = do n <- number
	 bs <- branches
	 return (n : bs)

branches :: Parser [Int]
branches
    = option [] $ do
	  char '.'
	  n <- number
          bs <- branches
          return (n:bs)

dateParser :: Parser [String]
dateParser
     = (try $ do char '-'; d <- many anyChar; return ["date="++d])
       <|> (do notFollowedBy anyChar; return [])

number :: (Integral a, Read a) => Parser a
number  = do{ ds <- many1 digit
            ; return (read ds)
            }
        <?> "number"

-- -----------------------------------------------------------------------------
-- Parsing dates

{-
-- Here is some code for parsing dates.  We might need this at some point.

259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286
-- |Seperate the date with typically a '.' or a '-', /sep/
dateSeparatedBy :: Char -> GenParser Char () Version
dateSeparatedBy sep
    = try (do year  <- number -- 2003.01.15, 2003.1.15
              char sep
              month <- number
              char sep
              day   <- number
              return $ DateVersion year (toEnum $ month - 1) day)
      <|>  try (do year  <- number -- 2003-Jan-15
                   char sep
                   month <- shortMonthParser
                   char sep
                   day   <- number
                   return $ DateVersion year month day)

      <|>  try (do month <- shortMonthParser -- Nov-2002
                   char sep
                   year  <- number
                   return $ DateVersion year month 0)

      <|>  try (do year  <- number -- 2003-January-15
                   char sep
                   month <- word
                   char sep
                   day   <- number
                   return $ DateVersion year (read month) day)

simonmar's avatar
simonmar committed
287
dateVersionParser :: Parser String
288 289 290 291 292 293 294 295 296 297 298 299
dateVersionParser 
    = try (dateSeparatedBy '.')
      <|> (dateSeparatedBy '-')

shortMonthParser :: Parser Month
shortMonthParser = foldl1 (<|>) [do reserved a;return b | (a,b)
                                 <- [("Jan", January),   ("Feb", February),
                                     ("Mar", March),     ("Apr", April), 
                                     ("May", May),       ("Jun", June),
                                     ("Jul", July),      ("Aug", August),
                                     ("Sep", September), ("Oct", October),
                                     ("Nov", November),  ("Dec", December)]]
simonmar's avatar
simonmar committed
300
-}
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346

lexer :: P.TokenParser ()
lexer  = P.makeTokenParser 
         (emptyDef

         { P.reservedNames = ["Jan","Feb", "Mar", "Apr", "May", "Jun",
                              "Jul", "Aug", "Sept", "Oct", "Nov", "Dec", "any"
                             ],
           P.identStart    = letter <|> char '_',
           P.identLetter    = alphaNum <|> oneOf "_'",
           P.reservedOpNames = ["<", ">", "<=", ">=", "==", "-"]
         })

whiteSpace :: CharParser () ()
whiteSpace = P.whiteSpace lexer

lexeme :: CharParser () a -> CharParser () a
lexeme = P.lexeme lexer

symbol :: String -> CharParser () String
symbol = P.symbol lexer

natural :: CharParser () Integer
natural = P.natural lexer

parens :: CharParser () a -> CharParser () a
parens  = P.parens lexer

semi :: CharParser () String
semi = P.semi lexer

identifier :: CharParser () String
identifier = P.identifier lexer

reserved :: String -> CharParser () ()
reserved = P.reserved lexer

reservedOp :: String -> CharParser () ()
reservedOp = P.reservedOp lexer

-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------

-- |Simple version parser wrapper
doVersionParse :: String -> Either String Version
simonmar's avatar
simonmar committed
347
doVersionParse input = let x = parse parseVersion "" input
348 349 350 351 352 353 354 355 356 357 358
                        in case x of
                           Left err -> Left (show err)
                           Right y  -> Right y

-- |Version range parsing
doVersionRangeParse :: String -> Either String VersionRange
doVersionRangeParse input
    = let x = parse parseVersionRange "" input
          in case x of
             Left err -> Left (show err)
             Right y  -> Right y
ijones's avatar
cleanup  
ijones committed
359
branch1 :: [Int]
simonmar's avatar
simonmar committed
360
branch1 = [1]
ijones's avatar
cleanup  
ijones committed
361 362

branch2 :: [Int]
simonmar's avatar
simonmar committed
363
branch2 = [1,2]
ijones's avatar
cleanup  
ijones committed
364 365

branch3 :: [Int]
simonmar's avatar
simonmar committed
366
branch3 = [1,2,3]
ijones's avatar
cleanup  
ijones committed
367 368

branch4 :: [Int]
simonmar's avatar
simonmar committed
369 370
branch4 = [1,2,3,4]

ijones's avatar
cleanup  
ijones committed
371
release1 :: Version
372
release1 = Version{versionBranch=branch1, versionTags=[]}
ijones's avatar
cleanup  
ijones committed
373 374

release2 :: Version
375
release2 = Version{versionBranch=branch2, versionTags=[]}
ijones's avatar
cleanup  
ijones committed
376 377

release3 :: Version
378
release3 = Version{versionBranch=branch3, versionTags=[]}
ijones's avatar
cleanup  
ijones committed
379 380

release4 :: Version
381
release4 = Version{versionBranch=branch4, versionTags=[]}
382 383 384 385

hunitTests :: [Test]
hunitTests
    = [
simonmar's avatar
simonmar committed
386 387 388 389
       "released version 1" ~: "failed"
            ~: (Right $ release1) ~=? doVersionParse "1",
       "released version 3" ~: "failed"
            ~: (Right $ release3) ~=? doVersionParse "1.2.3",
390 391 392 393 394 395 396 397

       -- Version ranges
       "Any version" ~: "failed"
            ~: (Right $ AnyVersion)
            ~=? doVersionRangeParse "-any",
       "Any version space" ~: "failed"
            ~: (Right $ AnyVersion)
            ~=? doVersionRangeParse "- any",
simonmar's avatar
simonmar committed
398
       "range comparison LaterVersion 1" ~: "failed"
399
            ~: True
simonmar's avatar
simonmar committed
400 401 402 403 404
            ~=? release3 `withinRange` (LaterVersion release2),
       "range comparison LaterVersion 2" ~: "failed"
            ~: False
            ~=? release2 `withinRange` (LaterVersion release3),
       "range comparison EarlierVersion 1" ~: "failed"
405
            ~: True
simonmar's avatar
simonmar committed
406 407
            ~=? release3 `withinRange` (LaterVersion release2),
       "range comparison EarlierVersion 2" ~: "failed"
408
            ~: False
simonmar's avatar
simonmar committed
409 410
            ~=? release2 `withinRange` (LaterVersion release3),
       "range comparison orLaterVersion 1" ~: "failed"
411
            ~: True
simonmar's avatar
simonmar committed
412 413
            ~=? release3 `withinRange` (orLaterVersion release3),
       "range comparison orLaterVersion 2" ~: "failed"
414
            ~: True
simonmar's avatar
simonmar committed
415 416
            ~=? release3 `withinRange` (orLaterVersion release2),
       "range comparison orLaterVersion 3" ~: "failed"
417
            ~: False
simonmar's avatar
simonmar committed
418 419 420 421 422
            ~=? release2 `withinRange` (orLaterVersion release3),
       "range comparison orEarlierVersion 1" ~: "failed"
            ~: True
            ~=? release2 `withinRange` (orEarlierVersion release2),
       "range comparison orEarlierVersion 2" ~: "failed"
423
            ~: True
simonmar's avatar
simonmar committed
424 425 426 427
            ~=? release2 `withinRange` (orEarlierVersion release3),
       "range comparison orEarlierVersion 3" ~: "failed"
            ~: False
            ~=? release3 `withinRange` (orEarlierVersion release2)
428 429
      ]