1{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE DeriveFoldable #-} 3{-# LANGUAGE DeriveFunctor #-} 4{-# LANGUAGE DeriveGeneric #-} 5{-# LANGUAGE DeriveTraversable #-} 6{-# LANGUAGE FlexibleContexts #-} 7{-# LANGUAGE OverloadedStrings #-} 8{-# LANGUAGE ScopedTypeVariables #-} 9 10-- | The only purpose of this module is to prevent the export of 11-- 'VersionRange' constructors from 12-- 'Distribution.Types.VersionRange'. To avoid creating orphan 13-- instances, a lot of related code had to be moved here too. 14 15module Distribution.Types.VersionRange.Internal 16 ( VersionRange(..) 17 , anyVersion, noVersion 18 , thisVersion, notThisVersion 19 , laterVersion, earlierVersion 20 , orLaterVersion, orEarlierVersion 21 , unionVersionRanges, intersectVersionRanges 22 , withinVersion 23 , majorBoundVersion 24 25 , VersionRangeF(..) 26 , projectVersionRange 27 , embedVersionRange 28 , cataVersionRange 29 , anaVersionRange 30 , hyloVersionRange 31 , versionRangeParser 32 33 , majorUpperBound 34 , wildcardUpperBound 35 ) where 36 37import Distribution.Compat.Prelude 38import Distribution.Types.Version 39import Prelude () 40 41import Distribution.CabalSpecVersion 42import Distribution.Parsec 43import Distribution.Pretty 44import Distribution.Utils.Generic (unsnoc) 45 46import qualified Distribution.Compat.CharParsing as P 47import qualified Distribution.Compat.DList as DList 48import qualified Text.PrettyPrint as Disp 49 50data VersionRange 51 = ThisVersion Version -- = version 52 | LaterVersion Version -- > version (NB. not >=) 53 | OrLaterVersion Version -- >= version 54 | EarlierVersion Version -- < version 55 | OrEarlierVersion Version -- <= version 56 | MajorBoundVersion Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1) 57 | UnionVersionRanges VersionRange VersionRange 58 | IntersectVersionRanges VersionRange VersionRange 59 deriving ( Data, Eq, Generic, Read, Show, Typeable ) 60 61instance Binary VersionRange 62instance Structured VersionRange 63instance NFData VersionRange where rnf = genericRnf 64 65-- | The version range @-any@. That is, a version range containing all 66-- versions. 67-- 68-- > withinRange v anyVersion = True 69-- 70anyVersion :: VersionRange 71anyVersion = OrLaterVersion (mkVersion [0]) 72 73-- | The empty version range, that is a version range containing no versions. 74-- 75-- This can be constructed using any unsatisfiable version range expression, 76-- for example @< 0@. 77-- 78-- > withinRange v noVersion = False 79-- 80noVersion :: VersionRange 81noVersion = EarlierVersion (mkVersion [0]) 82 83-- | The version range @== v@ 84-- 85-- > withinRange v' (thisVersion v) = v' == v 86-- 87thisVersion :: Version -> VersionRange 88thisVersion = ThisVersion 89 90-- | The version range @< v || > v@ 91-- 92-- > withinRange v' (notThisVersion v) = v' /= v 93-- 94notThisVersion :: Version -> VersionRange 95notThisVersion v = UnionVersionRanges (EarlierVersion v) (LaterVersion v) 96 97-- | The version range @> v@ 98-- 99-- > withinRange v' (laterVersion v) = v' > v 100-- 101laterVersion :: Version -> VersionRange 102laterVersion = LaterVersion 103 104-- | The version range @>= v@ 105-- 106-- > withinRange v' (orLaterVersion v) = v' >= v 107-- 108orLaterVersion :: Version -> VersionRange 109orLaterVersion = OrLaterVersion 110 111-- | The version range @< v@ 112-- 113-- > withinRange v' (earlierVersion v) = v' < v 114-- 115earlierVersion :: Version -> VersionRange 116earlierVersion = EarlierVersion 117 118-- | The version range @<= v@ 119-- 120-- > withinRange v' (orEarlierVersion v) = v' <= v 121-- 122orEarlierVersion :: Version -> VersionRange 123orEarlierVersion = OrEarlierVersion 124 125-- | The version range @vr1 || vr2@ 126-- 127-- > withinRange v' (unionVersionRanges vr1 vr2) 128-- > = withinRange v' vr1 || withinRange v' vr2 129-- 130unionVersionRanges :: VersionRange -> VersionRange -> VersionRange 131unionVersionRanges = UnionVersionRanges 132 133-- | The version range @vr1 && vr2@ 134-- 135-- > withinRange v' (intersectVersionRanges vr1 vr2) 136-- > = withinRange v' vr1 && withinRange v' vr2 137-- 138intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange 139intersectVersionRanges = IntersectVersionRanges 140 141-- | The version range @== v.*@. 142-- 143-- For example, for version @1.2@, the version range @== 1.2.*@ is the same as 144-- @>= 1.2 && < 1.3@ 145-- 146-- > withinRange v' (laterVersion v) = v' >= v && v' < upper v 147-- > where 148-- > upper (Version lower t) = Version (init lower ++ [last lower + 1]) t 149-- 150withinVersion :: Version -> VersionRange 151withinVersion v = intersectVersionRanges 152 (orLaterVersion v) 153 (earlierVersion (wildcardUpperBound v)) 154 155-- | The version range @^>= v@. 156-- 157-- For example, for version @1.2.3.4@, the version range @^>= 1.2.3.4@ 158-- is the same as @>= 1.2.3.4 && < 1.3@. 159-- 160-- Note that @^>= 1@ is equivalent to @>= 1 && < 1.1@. 161-- 162-- @since 2.0.0.2 163majorBoundVersion :: Version -> VersionRange 164majorBoundVersion = MajorBoundVersion 165 166 167-- | F-Algebra of 'VersionRange'. See 'cataVersionRange'. 168-- 169-- @since 2.2 170data VersionRangeF a 171 = ThisVersionF Version -- = version 172 | LaterVersionF Version -- > version (NB. not >=) 173 | OrLaterVersionF Version -- >= version 174 | EarlierVersionF Version -- < version 175 | OrEarlierVersionF Version -- <= version 176 | MajorBoundVersionF Version -- @^>= ver@ (same as >= ver && < MAJ(ver)+1) 177 | UnionVersionRangesF a a 178 | IntersectVersionRangesF a a 179 deriving ( Data, Eq, Generic, Read, Show, Typeable 180 , Functor, Foldable, Traversable ) 181 182-- | @since 2.2 183projectVersionRange :: VersionRange -> VersionRangeF VersionRange 184projectVersionRange (ThisVersion v) = ThisVersionF v 185projectVersionRange (LaterVersion v) = LaterVersionF v 186projectVersionRange (OrLaterVersion v) = OrLaterVersionF v 187projectVersionRange (EarlierVersion v) = EarlierVersionF v 188projectVersionRange (OrEarlierVersion v) = OrEarlierVersionF v 189projectVersionRange (MajorBoundVersion v) = MajorBoundVersionF v 190projectVersionRange (UnionVersionRanges a b) = UnionVersionRangesF a b 191projectVersionRange (IntersectVersionRanges a b) = IntersectVersionRangesF a b 192 193-- | Fold 'VersionRange'. 194-- 195-- @since 2.2 196cataVersionRange :: (VersionRangeF a -> a) -> VersionRange -> a 197cataVersionRange f = c where c = f . fmap c . projectVersionRange 198 199-- | @since 2.2 200embedVersionRange :: VersionRangeF VersionRange -> VersionRange 201embedVersionRange (ThisVersionF v) = ThisVersion v 202embedVersionRange (LaterVersionF v) = LaterVersion v 203embedVersionRange (OrLaterVersionF v) = OrLaterVersion v 204embedVersionRange (EarlierVersionF v) = EarlierVersion v 205embedVersionRange (OrEarlierVersionF v) = OrEarlierVersion v 206embedVersionRange (MajorBoundVersionF v) = MajorBoundVersion v 207embedVersionRange (UnionVersionRangesF a b) = UnionVersionRanges a b 208embedVersionRange (IntersectVersionRangesF a b) = IntersectVersionRanges a b 209 210-- | Unfold 'VersionRange'. 211-- 212-- @since 2.2 213anaVersionRange :: (a -> VersionRangeF a) -> a -> VersionRange 214anaVersionRange g = a where a = embedVersionRange . fmap a . g 215 216-- | Refold 'VersionRange' 217-- 218-- @since 2.2 219hyloVersionRange :: (VersionRangeF VersionRange -> VersionRange) 220 -> (VersionRange -> VersionRangeF VersionRange) 221 -> VersionRange -> VersionRange 222hyloVersionRange f g = h where h = f . fmap h . g 223 224------------------------------------------------------------------------------- 225-- Parsec & Pretty 226------------------------------------------------------------------------------- 227 228-- | 229-- 230-- >>> fmap pretty (simpleParsec' CabalSpecV1_6 "== 3.2.*" :: Maybe VersionRange) 231-- Just >=3.2 && <3.3 232-- 233-- >>> fmap (prettyVersioned CabalSpecV1_6) (simpleParsec' CabalSpecV1_6 "== 3.2.*" :: Maybe VersionRange) 234-- Just ==3.2.* 235-- 236-- >>> fmap pretty (simpleParsec' CabalSpecV1_6 "-any" :: Maybe VersionRange) 237-- Just >=0 238-- 239-- >>> fmap (prettyVersioned CabalSpecV1_6) (simpleParsec' CabalSpecV1_6 "-any" :: Maybe VersionRange) 240-- Just >=0 241-- 242instance Pretty VersionRange where 243 pretty = prettyVersioned cabalSpecLatest 244 245 prettyVersioned csv 246 | csv > CabalSpecV1_6 = prettyVersionRange 247 | otherwise = prettyVersionRange16 248 249prettyVersionRange :: VersionRange -> Disp.Doc 250prettyVersionRange vr = cataVersionRange alg vr 0 251 where 252 alg :: VersionRangeF (Int -> Disp.Doc) -> Int -> Disp.Doc 253 alg (ThisVersionF v) _ = Disp.text "==" <<>> pretty v 254 alg (LaterVersionF v) _ = Disp.text ">" <<>> pretty v 255 alg (OrLaterVersionF v) _ = Disp.text ">=" <<>> pretty v 256 alg (EarlierVersionF v) _ = Disp.text "<" <<>> pretty v 257 alg (OrEarlierVersionF v) _ = Disp.text "<=" <<>> pretty v 258 alg (MajorBoundVersionF v) _ = Disp.text "^>=" <<>> pretty v 259 alg (UnionVersionRangesF r1 r2) d = parens (d > 0) 260 $ r1 1 <+> Disp.text "||" <+> r2 0 261 alg (IntersectVersionRangesF r1 r2) d = parens (d > 1) 262 $ r1 2 <+> Disp.text "&&" <+> r2 1 263 264 parens True = Disp.parens 265 parens False = id 266 267-- | Don't use && and || operators. If possible. 268prettyVersionRange16 :: VersionRange -> Disp.Doc 269prettyVersionRange16 (IntersectVersionRanges (OrLaterVersion v) (EarlierVersion u)) 270 | u == wildcardUpperBound v 271 = Disp.text "==" <<>> dispWild v 272 where 273 dispWild ver = 274 Disp.hcat (Disp.punctuate (Disp.char '.') 275 (map Disp.int $ versionNumbers ver)) 276 <<>> Disp.text ".*" 277 278prettyVersionRange16 vr = prettyVersionRange vr 279 280-- | 281-- 282-- >>> simpleParsec "^>= 3.4" :: Maybe VersionRange 283-- Just (MajorBoundVersion (mkVersion [3,4])) 284-- 285-- Small history: 286-- 287-- @-any@ and @-none@ removed in 3.4 288-- Use @>=0@ and @<0@ instead. 289-- 290-- >>> map (`simpleParsec'` "-none") [CabalSpecV3_0, CabalSpecV3_4] :: [Maybe VersionRange] 291-- [Just (EarlierVersion (mkVersion [0])),Nothing] 292-- 293-- Set operations are introduced in 3.0 294-- 295-- >>> map (`simpleParsec'` "^>= { 1.2 , 1.3 }") [CabalSpecV2_4, CabalSpecV3_0] :: [Maybe VersionRange] 296-- [Nothing,Just (UnionVersionRanges (MajorBoundVersion (mkVersion [1,2])) (MajorBoundVersion (mkVersion [1,3])))] 297-- 298-- @^>=@ is introduced in 2.0 299-- 300-- >>> map (`simpleParsec'` "^>=1.2") [CabalSpecV1_24, CabalSpecV2_0] :: [Maybe VersionRange] 301-- [Nothing,Just (MajorBoundVersion (mkVersion [1,2]))] 302-- 303-- @-none@ is introduced in 1.22 304-- 305-- >>> map (`simpleParsec'` "-none") [CabalSpecV1_20, CabalSpecV1_22] :: [Maybe VersionRange] 306-- [Nothing,Just (EarlierVersion (mkVersion [0]))] 307-- 308-- Operators are introduced in 1.8. Issues only a warning. 309-- 310-- >>> map (`simpleParsecW'` "== 1 || ==2") [CabalSpecV1_6, CabalSpecV1_8] :: [Maybe VersionRange] 311-- [Nothing,Just (UnionVersionRanges (ThisVersion (mkVersion [1])) (ThisVersion (mkVersion [2])))] 312-- 313-- Wild-version ranges are introduced in 1.6. Issues only a warning. 314-- 315-- >>> map (`simpleParsecW'` "== 1.2.*") [CabalSpecV1_4, CabalSpecV1_6] :: [Maybe VersionRange] 316-- [Nothing,Just (IntersectVersionRanges (OrLaterVersion (mkVersion [1,2])) (EarlierVersion (mkVersion [1,3])))] 317-- 318instance Parsec VersionRange where 319 parsec = askCabalSpecVersion >>= versionRangeParser versionDigitParser 320 321-- | 'VersionRange' parser parametrised by version digit parser 322-- 323-- - 'versionDigitParser' is used for all 'VersionRange'. 324-- - 'P.integral' is used for backward-compat @pkgconfig-depends@ 325-- versions, 'PkgConfigVersionRange'. 326-- 327-- @since 3.0 328versionRangeParser :: forall m. CabalParsing m => m Int -> CabalSpecVersion -> m VersionRange 329versionRangeParser digitParser csv = expr 330 where 331 expr = do P.spaces 332 t <- term 333 P.spaces 334 (do _ <- P.string "||" 335 checkOp 336 P.spaces 337 e <- expr 338 return (unionVersionRanges t e) 339 <|> 340 return t) 341 term = do f <- factor 342 P.spaces 343 (do _ <- P.string "&&" 344 checkOp 345 P.spaces 346 t <- term 347 return (intersectVersionRanges f t) 348 <|> 349 return f) 350 factor = parens expr <|> prim 351 352 prim = do 353 op <- P.munch1 isOpChar P.<?> "operator" 354 case op of 355 "-" -> anyVersion <$ P.string "any" <|> P.string "none" *> noVersion' 356 357 "==" -> do 358 P.spaces 359 (do (wild, v) <- verOrWild 360 checkWild wild 361 pure $ (if wild then withinVersion else thisVersion) v 362 <|> 363 (verSet' thisVersion =<< verSet)) 364 365 "^>=" -> do 366 P.spaces 367 (do (wild, v) <- verOrWild 368 when wild $ P.unexpected $ 369 "wild-card version after ^>= operator" 370 majorBoundVersion' v 371 <|> 372 (verSet' majorBoundVersion =<< verSet)) 373 374 _ -> do 375 P.spaces 376 (wild, v) <- verOrWild 377 when wild $ P.unexpected $ 378 "wild-card version after non-== operator: " ++ show op 379 case op of 380 ">=" -> pure $ orLaterVersion v 381 "<" -> pure $ earlierVersion v 382 "<=" -> pure $ orEarlierVersion v 383 ">" -> pure $ laterVersion v 384 _ -> fail $ "Unknown version operator " ++ show op 385 386 -- Cannot be warning 387 -- On 2020-03-16 there was around 27400 files on Hackage failing to parse due this 388 -- For example https://hackage.haskell.org/package/haxr-3000.0.0/haxr.cabal 389 -- 390 checkOp = when (csv < CabalSpecV1_8) $ 391 parsecWarning PWTVersionOperator $ unwords 392 [ "version operators used." 393 , "To use version operators the package needs to specify at least 'cabal-version: >= 1.8'." 394 ] 395 396 -- Cannot be warning 397 -- On 2020-03-16 there was 46 files on Hackage failing to parse due this 398 -- For example https://hackage.haskell.org/package/derive-0.1.2/derive.cabal 399 -- 400 checkWild False = pure () 401 checkWild True = when (csv < CabalSpecV1_6) $ 402 parsecWarning PWTVersionWildcard $ unwords 403 [ "Wildcard syntax used." 404 , "To use version wildcards the package needs to specify at least 'cabal-version: >= 1.6'." 405 ] 406 407 -- https://gitlab.haskell.org/ghc/ghc/issues/17752 408 isOpChar '<' = True 409 isOpChar '=' = True 410 isOpChar '>' = True 411 isOpChar '^' = True 412 isOpChar '-' = csv < CabalSpecV3_4 413 -- https://github.com/haskell/cabal/issues/6589 414 -- Unfortunately we have must not consume the dash, 415 -- as otherwise following parts may not be parsed. 416 -- 417 -- i.e. we cannot fail here with good error. 418 isOpChar _ = False 419 420 -- -none version range is available since 1.22 421 noVersion' = 422 if csv >= CabalSpecV1_22 423 then pure noVersion 424 else fail $ unwords 425 [ "-none version range used." 426 , "To use this syntax the package needs to specify at least 'cabal-version: 1.22'." 427 , "Alternatively, if broader compatibility is important then use" 428 , "<0 or other empty range." 429 ] 430 431 -- ^>= is available since 2.0 432 majorBoundVersion' v = 433 if csv >= CabalSpecV2_0 434 then pure $ majorBoundVersion v 435 else fail $ unwords 436 [ "major bounded version syntax (caret, ^>=) used." 437 , "To use this syntax the package need to specify at least 'cabal-version: 2.0'." 438 , "Alternatively, if broader compatibility is important then use:" 439 , prettyShow $ eliminateMajorBoundSyntax $ majorBoundVersion v 440 ] 441 where 442 eliminateMajorBoundSyntax = hyloVersionRange embed projectVersionRange 443 embed (MajorBoundVersionF u) = intersectVersionRanges 444 (orLaterVersion u) (earlierVersion (majorUpperBound u)) 445 embed vr = embedVersionRange vr 446 447 -- version set notation (e.g. "== { 0.0.1.0, 0.0.2.0, 0.1.0.0 }") 448 verSet' op vs = 449 if csv >= CabalSpecV3_0 450 then pure $ foldr1 unionVersionRanges (fmap op vs) 451 else fail $ unwords 452 [ "version set syntax used." 453 , "To use this syntax the package needs to specify at least 'cabal-version: 3.0'." 454 , "Alternatively, if broader compatibility is important then use" 455 , "a series of single version constraints joined with the || operator:" 456 , prettyShow (foldr1 unionVersionRanges (fmap op vs)) 457 ] 458 459 verSet :: CabalParsing m => m (NonEmpty Version) 460 verSet = do 461 _ <- P.char '{' 462 P.spaces 463 vs <- P.sepByNonEmpty (verPlain <* P.spaces) (P.char ',' *> P.spaces) 464 _ <- P.char '}' 465 pure vs 466 467 -- a plain version without tags or wildcards 468 verPlain :: CabalParsing m => m Version 469 verPlain = mkVersion <$> toList <$> P.sepByNonEmpty digitParser (P.char '.') 470 471 -- either wildcard or normal version 472 verOrWild :: CabalParsing m => m (Bool, Version) 473 verOrWild = do 474 x <- digitParser 475 verLoop (DList.singleton x) 476 477 -- trailing: wildcard (.y.*) or normal version (optional tags) (.y.z-tag) 478 verLoop :: CabalParsing m => DList.DList Int -> m (Bool, Version) 479 verLoop acc = verLoop' acc 480 <|> (tags *> pure (False, mkVersion (DList.toList acc))) 481 482 verLoop' :: CabalParsing m => DList.DList Int -> m (Bool, Version) 483 verLoop' acc = do 484 _ <- P.char '.' 485 let digit = digitParser >>= verLoop . DList.snoc acc 486 let wild = (True, mkVersion (DList.toList acc)) <$ P.char '*' 487 digit <|> wild 488 489 parens p = P.between 490 ((P.char '(' P.<?> "opening paren") >> P.spaces) 491 (P.char ')' >> P.spaces) 492 $ do 493 a <- p 494 P.spaces 495 return a 496 497 tags :: CabalParsing m => m () 498 tags = do 499 ts <- many $ P.char '-' *> some (P.satisfy isAlphaNum) 500 case ts of 501 [] -> pure () 502 (_ : _) -> parsecWarning PWTVersionTag "version with tags" 503 504 505---------------------------- 506-- Wildcard range utilities 507-- 508 509-- | Compute next greater major version to be used as upper bound 510-- 511-- Example: @0.4.1@ produces the version @0.5@ which then can be used 512-- to construct a range @>= 0.4.1 && < 0.5@ 513-- 514-- @since 2.2 515majorUpperBound :: Version -> Version 516majorUpperBound = alterVersion $ \numbers -> case numbers of 517 [] -> [0,1] -- should not happen 518 [m1] -> [m1,1] -- e.g. version '1' 519 (m1:m2:_) -> [m1,m2+1] 520 521-- | @since 2.2 522wildcardUpperBound :: Version -> Version 523wildcardUpperBound = alterVersion $ 524 \lowerBound -> case unsnoc lowerBound of 525 Nothing -> [] 526 Just (xs, x) -> xs ++ [x + 1] 527