├── .bumpversion.cfg
├── .ghci
├── .gitignore
├── LICENSE
├── default.nix
├── nix
    ├── 18_09.nix
    └── fetchNixpkgs.nix
├── release.nix
├── semver-range.cabal
├── shell.nix
├── src
    └── Data
    │   ├── SemVer.hs
    │   └── SemVer
    │       ├── Parser.hs
    │       └── Types.hs
└── tests
    └── Unit.hs


/.bumpversion.cfg:
--------------------------------------------------------------------------------
 1 | [bumpversion]
 2 | current_version = 0.2.7
 3 | commit = true
 4 | tag = true
 5 | message = "semver-range: bump version from {current_version} to {new_version}"
 6 | tag_name = {new_version}
 7 | 
 8 | [bumpversion:file:semver-range.cabal]
 9 | 
10 | [bumpversion:file:project.nix]
11 | 
12 | 


--------------------------------------------------------------------------------
/.ghci:
--------------------------------------------------------------------------------
1 | :set -XOverloadedStrings
2 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | dist
2 | dist
3 | dist-newstyle
4 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The MIT License (MIT)
 2 | 
 3 | Copyright (c) 2015 Allen Nelson
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy
 6 | of this software and associated documentation files (the "Software"), to deal
 7 | in the Software without restriction, including without limitation the rights
 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in
13 | all copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
21 | THE SOFTWARE.


--------------------------------------------------------------------------------
/default.nix:
--------------------------------------------------------------------------------
1 | with import <nixpkgs> {};
2 | pkgs.haskell.packages.ghc883.callCabal2nix "semver-range" ./. {}
3 | 


--------------------------------------------------------------------------------
/nix/18_09.nix:
--------------------------------------------------------------------------------
1 | let
2 |   fetchNixpkgs = import ./fetchNixpkgs.nix;
3 | 
4 | in
5 |   fetchNixpkgs {
6 |      rev          = "6a3f5bcb061e1822f50e299f5616a0731636e4e7";
7 |      sha256       = "1ib96has10v5nr6bzf7v8kw7yzww8zanxgw2qi1ll1sbv6kj6zpd";
8 |   }
9 | 


--------------------------------------------------------------------------------
/nix/fetchNixpkgs.nix:
--------------------------------------------------------------------------------
 1 | { rev                             # The Git revision of nixpkgs to fetch
 2 | , sha256                          # The SHA256 of the downloaded data
 3 | , outputSha256 ? null             # The SHA256 output hash
 4 | , system ? builtins.currentSystem # This is overridable if necessary
 5 | }:
 6 | 
 7 | if (0 <= builtins.compareVersions builtins.nixVersion "1.12")
 8 | 
 9 | # In Nix 1.12, we can just give a `sha256` to `builtins.fetchTarball`.
10 | then (
11 |   builtins.fetchTarball {
12 |     url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
13 |     inherit sha256;
14 |   })
15 | 
16 | # This hack should at least work for Nix 1.11
17 | else (
18 |   (rec {
19 |     tarball = import <nix/fetchurl.nix> {
20 |       url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
21 |       inherit sha256;
22 |     };
23 | 
24 |     builtin-paths = import <nix/config.nix>;
25 |       
26 |     script = builtins.toFile "nixpkgs-unpacker" ''
27 |       "$coreutils/mkdir" "$out"
28 |       cd "$out"
29 |       "$gzip" --decompress < "$tarball" | "$tar" -x --strip-components=1
30 |     '';
31 | 
32 |     nixpkgs = builtins.derivation ({
33 |       name = "nixpkgs-${builtins.substring 0 6 rev}";
34 | 
35 |       builder = builtins.storePath builtin-paths.shell;
36 | 
37 |       args = [ script ];
38 | 
39 |       inherit tarball system;
40 | 
41 |       tar       = builtins.storePath builtin-paths.tar;
42 |       gzip      = builtins.storePath builtin-paths.gzip;
43 |       coreutils = builtins.storePath builtin-paths.coreutils;
44 |     } // (if null == outputSha256 then { } else {
45 |       outputHashMode = "recursive";
46 |       outputHashAlgo = "sha256";
47 |       outputHash = outputSha256;
48 |     }));
49 |   }).nixpkgs)
50 | 


--------------------------------------------------------------------------------
/release.nix:
--------------------------------------------------------------------------------
 1 | { nixpkgs ? (import ./nix/18_09.nix) }:
 2 | 
 3 | let
 4 | 
 5 |   config   = { allowUnfree = true; };
 6 | 
 7 |   overlays = [
 8 |     (newPkgs: oldPkgs: {
 9 |       haskellPackages = oldPkgs.haskellPackages.override {
10 |         overrides = haskellPackagesNew: haskellPackagesOld: {
11 |           semver-range = 
12 |             haskellPackagesNew.callPackage ./default.nix { };
13 |         };
14 |       };
15 |     })
16 |   ];
17 | 
18 |   pkgs = import nixpkgs { inherit config overlays; };
19 | 
20 | in
21 | 
22 |   { inherit (pkgs.haskellPackages) semver-range; }
23 | 


--------------------------------------------------------------------------------
/semver-range.cabal:
--------------------------------------------------------------------------------
 1 | name:                semver-range
 2 | version:             0.2.8
 3 | synopsis:            An implementation of semver and semantic version ranges.
 4 | description:         Provides parsing of semvers and range indicators, as well as logic such as version ordering and determining whether a given version falls in a given range.
 5 | license:             MIT
 6 | license-file:        LICENSE
 7 | author:              Allen Nelson
 8 | maintainer:          anelson@narrativescience.com
 9 | build-type:          Simple
10 | cabal-version:       >=1.10
11 | bug-reports:         https://github.com/adnelson/semver-range/issues
12 | 
13 | source-repository head
14 |   type:     git
15 |   location: git://github.com/adnelson/semver-range.git
16 | 
17 | library
18 |   Exposed-modules:     Data.SemVer
19 |   other-modules:       Data.SemVer.Parser
20 |                      , Data.SemVer.Types
21 |   other-extensions:    FlexibleContexts
22 |                      , FlexibleInstances
23 |                      , LambdaCase
24 |                      , NoImplicitPrelude
25 |                      , NoMonomorphismRestriction
26 |                      , OverloadedStrings
27 |                      , QuasiQuotes
28 |                      , RecordWildCards
29 |                      , ScopedTypeVariables
30 |                      , TypeFamilies
31 |                      , TypeSynonymInstances
32 |   build-depends:       base >=4.8 && <5
33 |                      , classy-prelude
34 |                      , text
35 |                      , unordered-containers
36 |                      , parsec
37 |   hs-source-dirs:      src
38 |   default-language:    Haskell2010
39 | 
40 | test-suite unit-tests
41 |   type:                exitcode-stdio-1.0
42 |   hs-source-dirs:      src, tests
43 |   main-is:             Unit.hs
44 |   build-depends:       base
45 |                      , classy-prelude
46 |                      , text
47 |                      , unordered-containers
48 |                      , parsec
49 |                      , hspec
50 |                      , QuickCheck
51 |   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
52 |   default-language:    Haskell2010
53 | 


--------------------------------------------------------------------------------
/shell.nix:
--------------------------------------------------------------------------------
1 | (import ./.).env
2 | 


--------------------------------------------------------------------------------
/src/Data/SemVer.hs:
--------------------------------------------------------------------------------
1 | module Data.SemVer (
2 |   module Data.SemVer.Types,
3 |   module Data.SemVer.Parser
4 |   ) where
5 | 
6 | import Data.SemVer.Types
7 | import Data.SemVer.Parser
8 | 


--------------------------------------------------------------------------------
/src/Data/SemVer/Parser.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE NoImplicitPrelude #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | {-# LANGUAGE LambdaCase #-}
  4 | {-# LANGUAGE OverloadedLists #-}
  5 | 
  6 | module Data.SemVer.Parser (
  7 |     parseSemVer, parseSemVerRange, pSemVerRange, pSemVer,
  8 |     fromHaskellVersion, matchText, splitWS
  9 |   ) where
 10 | 
 11 | import qualified Prelude as P
 12 | import ClassyPrelude hiding (try, many)
 13 | import Text.Parsec hiding ((<|>), spaces, parse, State, uncons, optional)
 14 | import qualified Text.Parsec as Parsec
 15 | import qualified Data.Text as T
 16 | import Text.Read (readMaybe)
 17 | 
 18 | import Data.Version (Version(..))
 19 | import Data.SemVer.Types
 20 | 
 21 | type Parser = ParsecT String () Identity
 22 | 
 23 | -- | Split a text on whitespace. Why isn't this in the stdlib.
 24 | splitWS :: Text -> [Text]
 25 | splitWS = filter (/= "") . T.split (flip elem (" \t\n\r" :: String))
 26 | 
 27 | -------------------------------------------------------------------------------
 28 | -- Wildcards: intermediate representations of semvers
 29 | --
 30 | -- | A partially specified semantic version. Implicitly defines
 31 | -- a range of acceptable versions, as seen in @wildcardToRange@.
 32 | data Wildcard = Any
 33 |               | Maj Int
 34 |               | Min Int Int
 35 |               | Full SemVer
 36 |               deriving (Show, Eq)
 37 | 
 38 | -- | Fills in zeros in a wildcard.
 39 | wildcardToSemver :: Wildcard -> SemVer
 40 | wildcardToSemver Any = semver 0 0 0
 41 | wildcardToSemver (Maj n) = semver n 0 0
 42 | wildcardToSemver (Min n m) = semver n m 0
 43 | wildcardToSemver (Full sv) = sv
 44 | 
 45 | -- | Translates a wildcard (partially specified version) to a range.
 46 | -- Ex: 2 := >=2.0.0 <3.0.0
 47 | -- Ex: 1.2.x := 1.2 := >=1.2.0 <1.3.0
 48 | wildcardToRange :: Wildcard -> SemVerRange
 49 | wildcardToRange = \case
 50 |   Any -> Geq $ semver 0 0 0
 51 |   Maj n -> Geq (semver n 0 0) `And` Lt (semver (n+1) 0 0)
 52 |   Min n m -> Geq (semver n m 0) `And` Lt (semver n (m+1) 0)
 53 |   Full sv -> Eq sv
 54 | 
 55 | -- | Translates a ~wildcard to a range.
 56 | -- Ex: ~1.2.3 := >=1.2.3 <1.(2+1).0 := >=1.2.3 <1.3.0
 57 | tildeToRange :: Wildcard -> SemVerRange
 58 | tildeToRange = \case
 59 |   -- I'm not sure this is officially supported, but just in case...
 60 |   Any -> tildeToRange (Full $ semver 0 0 0)
 61 |   -- ~1 := >=1.0.0 <(1+1).0.0 := >=1.0.0 <2.0.0 (Same as 1.x)
 62 |   Maj n -> Geq (semver n 0 0) `And` Lt (semver (n+1) 0 0)
 63 |   -- ~1.2 := >=1.2.0 <1.(2+1).0 := >=1.2.0 <1.3.0 (Same as 1.2.x)
 64 |   Min n m -> Geq (semver n m 0) `And` Lt (semver n (m+1) 0)
 65 |   -- ~1.2.3 := >=1.2.3 <1.(2+1).0 := >=1.2.3 <1.3.0
 66 |   Full (SemVer n m o [] _) -> Geq (semver n m o) `And` Lt (semver n (m+1) 0)
 67 |   -- ~1.2.3-beta.2 := >=1.2.3-beta.2 <1.3.0
 68 |   Full (SemVer n m o tags _) -> Geq (semver' n m o tags) `And` Lt (semver n (m+1) 0)
 69 | 
 70 | -- | Translates a ^wildcard to a range.
 71 | -- Ex: ^1.2.x := >=1.2.0 <2.0.0
 72 | caratToRange :: Wildcard -> SemVerRange
 73 | caratToRange = \case
 74 |   Maj n -> Geq (semver n 0 0) `And` Lt (semver (n+1) 0 0)
 75 |   Min n m -> Geq (semver n m 0) `And` Lt (semver (n+1) 0 0)
 76 |   Full (SemVer 0 n m tags _) -> Geq (semver' 0 n m tags) `And` Lt (semver' 0 (n+1) 0 tags)
 77 |   Full (SemVer n m o tags _) -> Geq (semver' n m o tags) `And` Lt (semver' (n+1) 0 0 tags)
 78 | 
 79 | -- | Translates two hyphenated wildcards to an actual range.
 80 | -- Ex: 1.2.3 - 2.3.4 := >=1.2.3 <=2.3.4
 81 | -- Ex: 1.2 - 2.3.4 := >=1.2.0 <=2.3.4
 82 | -- Ex: 1.2.3 - 2 := >=1.2.3 <3.0.0
 83 | hyphenatedRange :: Wildcard -> Wildcard -> SemVerRange
 84 | hyphenatedRange wc1 wc2 = And sv1 sv2 where
 85 |   sv1 = case wc1 of Any -> anyVersion
 86 |                     Maj n -> Geq (semver n 0 0)
 87 |                     Min n m -> Geq (semver n m 0)
 88 |                     Full sv -> Geq sv
 89 |   sv2 = case wc2 of Any -> anyVersion
 90 |                     Maj n -> Lt (semver (n+1) 0 0)
 91 |                     Min n m -> Lt (semver n (m+1) 0)
 92 |                     Full sv -> Lt sv
 93 | 
 94 | -- | Given a parser and a string, attempts to parse the string.
 95 | parse :: Parser a -> Text -> Either ParseError a
 96 | parse p = Parsec.parse p "" . unpack
 97 | 
 98 | parseFull :: Parser a -> Text -> Either ParseError a
 99 | parseFull p = Parsec.parse (p <* eof) "" . unpack
100 | 
101 | -- | Consumes any spaces (not other whitespace).
102 | spaces :: Parser String
103 | spaces = many $ oneOf [' ', '\t', '\n', '\r']
104 | 
105 | -- | Consumes at least one space (not other whitespace).
106 | spaces1 :: Parser String
107 | spaces1 = many1 $ oneOf [' ', '\t', '\n', '\r']
108 | 
109 | -- | Parses the given string and any trailing spaces.
110 | sstring :: String -> Parser String
111 | sstring = lexeme . string
112 | 
113 | -- | Parses the given character and any trailing spaces.
114 | schar :: Char -> Parser Char
115 | schar = lexeme . char
116 | 
117 | -- | Parses `p` and any trailing spaces.
118 | lexeme :: Parser a -> Parser a
119 | lexeme p = p <* spaces
120 | 
121 | -- | Parses an integer.
122 | pInt :: Parser Int
123 | pInt = lexeme pInt'
124 | 
125 | -- | Parses an integer without consuming trailing spaces.
126 | pInt' :: Parser Int
127 | pInt' = P.read <$> many1 digit
128 | 
129 | -- | Parse a string as a version range, or return an error.
130 | parseSemVerRange :: Text -> Either ParseError SemVerRange
131 | parseSemVerRange text = case T.strip text of
132 |   -- Handle a few special cases
133 |   "" -> return anyVersion
134 |   "||" -> return anyVersion
135 |   t -> parse (pSemVerRange <* eof) t
136 | 
137 | -- | Parse a string as an explicit version, or return an error.
138 | parseSemVer :: Text -> Either ParseError SemVer
139 | parseSemVer = parse pSemVer . T.strip
140 | 
141 | -- | Parses a semantic version.
142 | pSemVer :: Parser SemVer
143 | pSemVer = do
144 |   optional (char '=')
145 |   wildcardToSemver <$> pWildCard
146 | 
147 | pVersionComp :: Parser SemVerRange
148 | pVersionComp = cmp >>= \case
149 |   "=" -> wildcardToRange <$> pWildCard
150 |   "==" -> wildcardToRange <$> pWildCard
151 |   -- This is a special case to deal with a test case in the npm semver
152 |   -- test suite. The case states that "0.7.2" should satisfy
153 |   -- "<=0.7.x". I'm interpreting this to mean that "<= X", where X is
154 |   -- a range, means "less than or equal to the maximum supported in
155 |   -- this range."
156 |   "<=" -> Leq . topOf <$> pWildCard
157 |   ">=" -> Geq <$> pSemVer
158 |   ">" -> Gt <$> pSemVer
159 |   "<" -> Lt <$> pSemVer
160 |   where
161 |     topOf = \case
162 |       Any -> semver 0 0 0
163 |       Maj n -> semver (n+1) 0 0
164 |       Min n m -> semver n (m+1) 0
165 |       Full sv -> sv
166 | 
167 | -- | Parses a comparison operator.
168 | cmp :: Parser String
169 | cmp = choice (try . sstring <$> [">=", "<=", ">", "<", "==", "="])
170 | 
171 | -- | Parses versions with an explicit range qualifier (gt, lt, etc).
172 | pSemVerRangeSingle :: Parser SemVerRange
173 | pSemVerRangeSingle = choice [
174 |     wildcardToRange <$> pWildCard,
175 |     pTildeRange,
176 |     pCaratRange,
177 |     pVersionComp
178 |   ]
179 | 
180 | -- | Parses semantic version ranges joined with Ands and Ors.
181 | pJoinedSemVerRange :: Parser SemVerRange
182 | pJoinedSemVerRange = do
183 |   first <- pSemVerRangeSingle
184 |   option first $ do
185 |     let next = choice [sstring "||", sstring "&&", map singleton anyChar]
186 |     lookAhead next >>= \case
187 |       "||" -> Or first <$> (sstring "||" *> pJoinedSemVerRange)
188 |       "&&" -> And first <$> (sstring "&&" *> pJoinedSemVerRange)
189 |       _ -> And first <$> pJoinedSemVerRange
190 | 
191 | -- | Parses a hyphenated range.
192 | pHyphen :: Parser SemVerRange
193 | pHyphen = hyphenatedRange <$> pWildCard <*> (sstring "-" *> pWildCard)
194 | 
195 | -- | Parses a "wildcard" (which is a possibly partial semantic version).
196 | pWildCard :: Parser Wildcard
197 | pWildCard = try $ do
198 |   let seps = choice $ map string ["x", "X", "*"]
199 |   let bound = choice [seps *> pure Nothing, Just <$> pInt']
200 |   let getTag t = case readMaybe t of
201 |         Just i -> IntTag i
202 |         _ -> TextTag $ pack t
203 |   let tag = getTag <$> many1 (letter <|> digit <|> char '-')
204 |   -- Versions can optionally start with the character 'v'; ignore this.
205 |   optional (char 'v')
206 |   res <- takeWhile isJust <$> sepBy1 bound (sstring ".") >>= \case
207 |     [] -> return Any
208 |     [Just n] -> return $ Maj n
209 |     [Just n, Just m] -> return $ Min n m
210 |     [Just n, Just m, Just o] -> option (Full $ semver n m o) $ do
211 |       tags <- option [] $ do
212 |         -- Release tags might be separated by a hyphen, or not.
213 |         optional (char '-')
214 |         PrereleaseTags <$> (tag `sepBy1` char '.')
215 |       -- Grab metadata if there is any
216 |       metadata <- option [] $ do
217 |         char '+'
218 |         many1 (letter <|> digit <|> char '-') `sepBy1` char '.'
219 |       return $ Full $ semver'' n m o tags (map pack metadata)
220 |     w -> unexpected ("Invalid version " ++ show w)
221 |   spaces *> return res
222 | 
223 | -- | Parses a tilde range (~1.2.3).
224 | pTildeRange :: Parser SemVerRange
225 | pTildeRange = do
226 |   sstring "~"
227 |   -- For some reason, including the following operators after
228 |   -- a tilde is valid, but seems to have no effect.
229 |   optional $ choice [try $ sstring ">=", sstring ">", sstring "="]
230 |   tildeToRange <$> pWildCard
231 | 
232 | -- | Parses a carat range (^1.2.3).
233 | pCaratRange :: Parser SemVerRange
234 | pCaratRange = sstring "^" *> map caratToRange pWildCard
235 | 
236 | -- | Top-level parser. Parses a semantic version range.
237 | pSemVerRange :: Parser SemVerRange
238 | pSemVerRange = try pHyphen <|> pJoinedSemVerRange
239 | 
240 | -- | Parse a semver from a haskell version. There must be exactly
241 | -- three numbers in the versionBranch field.
242 | fromHaskellVersion :: Version -> Either Text SemVer
243 | fromHaskellVersion v = case versionBranch v of
244 |   [x, y, z] -> return (semver x y z) -- ignoring version tags since deprecated
245 |   bad -> do
246 |     let badVer = intercalate "." (map show bad)
247 |     Left $ pack ("Not a SemVer version: " <> badVer)
248 | 
249 | -- | Parses the first argument as a range and the second argument as a semver,
250 | -- and returns whether they match.
251 | matchText :: Text -> Text -> Either Text Bool
252 | matchText rangeTxt verTxt = case parseSemVerRange rangeTxt of
253 |   Left err -> Left ("Could not parse range: " <> pack (show err))
254 |   Right range -> case parseSemVer verTxt of
255 |     Left err -> Left ("Could not parse version: " <> pack (show err))
256 |     Right version -> Right $ matches range version
257 | 


--------------------------------------------------------------------------------
/src/Data/SemVer/Types.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE NoImplicitPrelude #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | {-# LANGUAGE LambdaCase #-}
  4 | {-# LANGUAGE DeriveGeneric #-}
  5 | {-# LANGUAGE OverloadedLists #-}
  6 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  7 | {-# LANGUAGE TypeFamilies #-}
  8 | 
  9 | module Data.SemVer.Types where
 10 | 
 11 | import ClassyPrelude
 12 | import qualified Prelude as P
 13 | import Data.Text (Text)
 14 | import qualified Data.Text as T
 15 | import GHC.Exts (IsList(..), Item)
 16 | 
 17 | -------------------------------------------------------------------------------
 18 | -- Prerelease tags
 19 | 
 20 | -- | Prerelease tags can either be numbers or text.
 21 | data PrereleaseTag
 22 |   = IntTag Int
 23 |   | TextTag Text
 24 |   deriving (Eq, Ord, Generic)
 25 | 
 26 | instance Show PrereleaseTag where
 27 |   show (IntTag i) = show i
 28 |   show (TextTag t) = T.unpack t
 29 | 
 30 | instance IsString PrereleaseTag where
 31 |   fromString = TextTag . fromString
 32 | 
 33 | instance Hashable PrereleaseTag
 34 | 
 35 | newtype PrereleaseTags = PrereleaseTags [PrereleaseTag]
 36 |   deriving (Show, Eq, Semigroup, Monoid, Generic)
 37 | 
 38 | instance IsList PrereleaseTags where
 39 |   type Item PrereleaseTags = PrereleaseTag
 40 |   fromList = PrereleaseTags
 41 |   toList (PrereleaseTags tags) = tags
 42 | 
 43 | instance Hashable PrereleaseTags
 44 | instance Ord PrereleaseTags where
 45 |   -- | Compare two lists of prerelease tags. See for reference:
 46 |   --
 47 |   -- https://github.com/npm/node-semver/blob/
 48 |   --   d21444a0658224b152ce54965d02dbe0856afb84/semver.js#L356
 49 |   --
 50 |   -- Note that having no prerelease tags is considered "greater" than having
 51 |   -- them, the idea being that prerelease tags indicate a version which
 52 |   -- is not yet complete. Conversely, if neither is empty, then greater length
 53 |   -- is considered to be "greater" overall, if two versions have the same
 54 |   -- prefix.
 55 |   --
 56 |   -- Examples:
 57 |   --   [A, B] < []
 58 |   --   [1, 2, 3] < [2]
 59 |   --   [1, 2] < [1, 2, 3]
 60 |   compare (PrereleaseTags prt1) (PrereleaseTags prt2) = case (prt1, prt2) of
 61 |     ([], _:_) -> GT
 62 |     (_:_, []) -> GT
 63 |     _ -> go $ zipMaybe prt1 prt2 where
 64 |       zipMaybe (x:xs) (y:ys)  =  (Just x, Just y) : zipMaybe xs ys
 65 |       zipMaybe xs     []      =  [(Just x, Nothing) | x <- xs]
 66 |       zipMaybe []     ys      =  [(Nothing, Just y) | y <- ys]
 67 | 
 68 |       go [] = EQ -- They were the same
 69 |       go ((Nothing, Nothing):_) = EQ -- Same as above (shouldn't happen but)
 70 |       go ((Just _, Nothing):_) = GT -- First list was longer than the second.
 71 |       go ((Nothing, Just _):_) = LT -- Second list was longer than the first.
 72 |       go ((Just tag1, Just tag2):rest) = case compare tag1 tag2 of
 73 |         EQ -> go rest
 74 |         result -> result
 75 | 
 76 | -------------------------------------------------------------------------------
 77 | -- Build Metadata
 78 | --
 79 | -- Extra data that can be attached to a version, but which doesn't affect its
 80 | -- version comparison.
 81 | type BuildMetaData = [Text]
 82 | 
 83 | -------------------------------------------------------------------------------
 84 | -- Semantic versions (SemVers)
 85 | --
 86 | -- | A SemVer has major, minor and patch versions, and zero or more
 87 | -- pre-release version tags.
 88 | data SemVer = SemVer {
 89 |   svMajor :: !Int,
 90 |   svMinor :: !Int,
 91 |   svPatch :: !Int,
 92 |   svTags :: !PrereleaseTags,
 93 |   svBuildMetadata :: !BuildMetaData
 94 |   } deriving (Eq, Generic)
 95 | 
 96 | -- | Define an Ord instance which ignores the buildMetaData.
 97 | instance Ord SemVer where
 98 |   compare (SemVer maj1 min1 pat1 tags1 _) (SemVer maj2 min2 pat2 tags2 _) =
 99 |     compare (maj1, min1, pat1, tags1) (maj2, min2, pat2, tags2)
100 | 
101 | instance Show SemVer where
102 |   show (SemVer x y z tags mdata) = base <> tags' <> mdata' where
103 |     base = show x <> "." <> show y <> "." <> show z
104 |     tags' = case tags of
105 |       PrereleaseTags [] -> mempty
106 |       PrereleaseTags tags -> "-" <> intercalate "." (map show tags)
107 |     mdata' = case mdata of
108 |       [] -> mempty
109 |       stuff -> "+" <> intercalate "." (map T.unpack stuff)
110 | 
111 | instance Hashable SemVer
112 | 
113 | -- | A range specifies bounds on a semver.
114 | data SemVerRange
115 |   = Eq SemVer                   -- ^ Exact equality
116 |   | Gt SemVer                   -- ^ Greater than
117 |   | Lt SemVer                   -- ^ Less than
118 |   | Geq SemVer                  -- ^ Greater than or equal to
119 |   | Leq SemVer                  -- ^ Less than or equal to
120 |   | And SemVerRange SemVerRange -- ^ Conjunction
121 |   | Or SemVerRange SemVerRange  -- ^ Disjunction
122 |   deriving (Eq, Ord)
123 | 
124 | infixl 3 `And`
125 | infixl 3 `Or`
126 | infixl 4 `Eq`
127 | infixl 4 `Gt`
128 | infixl 4 `Geq`
129 | infixl 4 `Lt`
130 | infixl 4 `Leq`
131 | 
132 | instance Show SemVerRange where
133 |   show = \case
134 |     Eq sv -> "=" <> show sv
135 |     Gt sv -> ">" <> show sv
136 |     Lt sv -> "<" <> show sv
137 |     Geq sv -> ">=" <> show sv
138 |     Leq sv -> "<=" <> show sv
139 |     And svr1 svr2 -> show svr1 <> " " <> show svr2
140 |     Or svr1 svr2 -> show svr1 <> " || " <> show svr2
141 | 
142 | -- | Pull all of the concrete versions out of a range.
143 | versionsOf :: SemVerRange -> [SemVer]
144 | versionsOf = \case
145 |   Eq sv -> [sv]
146 |   Geq sv -> [sv]
147 |   Leq sv -> [sv]
148 |   Lt sv -> [sv]
149 |   Gt sv -> [sv]
150 |   And svr1 svr2 -> versionsOf svr1 <> versionsOf svr2
151 |   Or svr1 svr2 -> versionsOf svr1 <> versionsOf svr2
152 | 
153 | -- | Strip out all prerelease tags from a given 'SemVerRange'.
154 | stripRangeTags :: SemVerRange -> SemVerRange
155 | stripRangeTags = \case
156 |   Eq  sv -> Eq  (sv { svTags = [] })
157 |   Geq sv -> Geq (sv { svTags = [] })
158 |   Leq sv -> Leq (sv { svTags = [] })
159 |   Lt  sv -> Lt  (sv { svTags = [] })
160 |   Gt  sv -> Gt  (sv { svTags = [] })
161 |   And svr1 svr2 -> And (stripRangeTags svr1) (stripRangeTags svr2)
162 |   Or  svr1 svr2 -> Or  (stripRangeTags svr1) (stripRangeTags svr2)
163 | 
164 | -- | Create a SemVer with no version tags.
165 | semver :: Int -> Int -> Int -> SemVer
166 | semver major minor patch = semver' major minor patch []
167 | 
168 | -- | Create a SemVer with tags
169 | semver' :: Int -> Int -> Int -> PrereleaseTags -> SemVer
170 | semver' major minor patch tags = semver'' major minor patch tags []
171 | 
172 | -- | Create a SemVer with tags and metadata.
173 | semver'' :: Int -> Int -> Int -> PrereleaseTags -> BuildMetaData -> SemVer
174 | semver'' = SemVer
175 | 
176 | -- | Get only the version tuple from a semver.
177 | toTuple :: SemVer -> (Int, Int, Int)
178 | toTuple (SemVer a b c _ _) = (a, b, c)
179 | 
180 | -- | Get a list of tuples from a version range.
181 | tuplesOf :: SemVerRange -> [(Int, Int, Int)]
182 | tuplesOf = map toTuple . versionsOf
183 | 
184 | -- | Get all of the prerelease tags from a version range.
185 | rangePrereleaseTags :: SemVerRange -> PrereleaseTags
186 | rangePrereleaseTags = concatMap svTags . versionsOf
187 | 
188 | -- | Get the range prerelease tags if they're all the same; otherwise
189 | -- Nothing.
190 | sharedTags :: SemVerRange -> Maybe PrereleaseTags
191 | sharedTags range = case map svTags $ versionsOf range of
192 |   [] -> Nothing -- shouldn't happen but in case
193 |   []:_ -> Nothing -- no prerelease tags, so that seals it
194 |   tagList:otherLists
195 |     | all (== tagList) otherLists -> Just tagList
196 |     | otherwise -> Nothing
197 | 
198 | -- | Satisfies any version.
199 | anyVersion :: SemVerRange
200 | anyVersion = Geq $ semver 0 0 0
201 | 
202 | -- | Render a semver as Text.
203 | renderSV :: SemVer -> Text
204 | renderSV = pack . show
205 | 
206 | -- | Returns whether a given semantic version matches a range.
207 | -- Note that there are special cases when there are prerelease tags. For
208 | -- details see https://github.com/npm/node-semver#prerelease-tags.
209 | matches :: SemVerRange -> SemVer -> Bool
210 | matches range version =
211 |   case (sharedTags range, svTags version) of
212 | 
213 |     (Nothing, PrereleaseTags vTags)
214 |       -- Neither the range nor the version have prerelease tags
215 |       | null vTags -> matchesSimple range version
216 | 
217 |       -- If there is no prerelease tag in the range but there is in
218 |       -- the version reject it
219 |       | otherwise  -> False
220 | 
221 |     -- A range with a prerelease tag can match a version without a
222 |     -- prerelease tag provided it *does* meet the semantic version
223 |     -- tuple's constraint criteria
224 |     (Just _, PrereleaseTags []) ->
225 |       matchesSimple range version
226 | 
227 |     -- The most important invariant when considering a comparison
228 |     -- between a range with prerelease tags and a version with
229 |     -- prerelease tags is whether the semantic version in both is the
230 |     -- same; if it is not, then we must reject the version.
231 |     --
232 |     -- Note that we could have a conjunction or a disjunction, so we
233 |     -- want to see if our version tuple is in the list of tuples for
234 |     -- the range. However, it would be possible to then match with,
235 |     -- say, the upper-bound version tuple which may be constrained by
236 |     -- a less-than relation. Therefore, if there is an equivalent
237 |     -- range tuple to the version tuple, we want to check if it
238 |     -- satisfies the constraints with the goal of rejecting early.
239 |     --
240 |     -- For example, if we assume a range constraint of "^1.2.3-alpha"
241 |     -- this translates to ">=1.2.3-alpha <2.0.0-alpha". Also assume we
242 |     -- have the version "1.2.3-alpha". In the trivial case, we check
243 |     -- to see if the version's tuple ("1.2.3") is in the set of
244 |     -- version tuples for the range ([ (1.2.3), (2.0.0) ]). We can
245 |     -- clearly see that it is, therefore we proceed with a match check
246 |     -- on the tags.
247 |     --
248 |     -- However, consider matching "2.0.0-alpha" against the range
249 |     -- constraint we've already given. If we only check for membership
250 |     -- of our version tuple ("2.0.0") in the set of range tuples ([
251 |     -- (1.2.3), (2.0.0) ]) then we would get a match, this is not
252 |     -- correct. Thus, if the version tuple is a member of the set of
253 |     -- range tuples we must also check that it satisfies the range
254 |     -- constraints sans prerelease tags.
255 |     (Just rTags, vTags)
256 | 
257 |       -- Explicit rejection, e.g. "^1.2.3-alpha" must reject
258 |       -- "1.2.4-alpha" and "2.0.0-alpha", anything else is safe to
259 |       -- compare based on tags so we can let it "fall through".
260 |       | versionTuple `notElem` rangeTuple || not (matchesSimple rangeNoTags versionNoTags)
261 |         -> False
262 | 
263 |       | rTags == vTags
264 |         -> True
265 | 
266 |       | rTags /= vTags
267 |         -> matchesTags range rTags vTags
268 | 
269 |   where
270 |     rangeTuple   = tuplesOf range
271 |     versionTuple = toTuple version
272 | 
273 |     rangeNoTags   = stripRangeTags range
274 |     versionNoTags = version { svTags = [] }
275 | 
276 | -- | Simple predicate calculus matching, doing AND and OR combination with
277 | -- numerical comparison.
278 | matchesSimple :: SemVerRange -> SemVer -> Bool
279 | matchesSimple range ver = case range of
280 |   Eq sv -> ver == sv
281 |   Gt sv -> ver > sv
282 |   Lt sv -> ver < sv
283 |   Geq sv -> ver >= sv
284 |   Leq sv -> ver <= sv
285 |   And range1 range2 -> matches range1 ver && matches range2 ver
286 |   Or range1 range2 -> matches range1 ver || matches range2 ver
287 | 
288 | infixl 2 `matches`
289 | 
290 | -- | Given a range and two sets of tags, the first being a bound on the second,
291 | -- uses the range to compare the tags and see if they match.
292 | matchesTags :: SemVerRange -> PrereleaseTags -> PrereleaseTags -> Bool
293 | matchesTags range rangeTags verTags =
294 |   case range of
295 |     Eq _  -> verTags == rangeTags
296 |     Gt _  -> verTags >  rangeTags
297 |     Lt _  -> verTags <  rangeTags
298 |     Geq _ -> verTags >= rangeTags
299 |     Leq _ -> verTags <= rangeTags
300 | 
301 |     And svr1 svr2 ->
302 |       matchesTags svr1 rangeTags verTags
303 |     Or svr1 svr2 ->
304 |       matchesTags svr1 rangeTags verTags || matchesTags svr2 rangeTags verTags
305 | 
306 | -- | Gets the highest-matching semver in a range.
307 | bestMatch :: SemVerRange -> [SemVer] -> Either String SemVer
308 | bestMatch range vs = case filter (matches range) vs of
309 |   [] -> Left "No matching versions"
310 |   vs -> Right $ P.maximum vs
311 | 


--------------------------------------------------------------------------------
/tests/Unit.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE ScopedTypeVariables #-}
  2 | {-# LANGUAGE OverloadedStrings #-}
  3 | {-# LANGUAGE NoMonomorphismRestriction #-}
  4 | {-# LANGUAGE ViewPatterns #-}
  5 | {-# LANGUAGE NoImplicitPrelude #-}
  6 | {-# LANGUAGE OverloadedLists #-}
  7 | {-# LANGUAGE FlexibleContexts #-}
  8 | {-# LANGUAGE TypeFamilies #-}
  9 | {-# LANGUAGE LambdaCase #-}
 10 | 
 11 | 
 12 | module Main (main) where
 13 | 
 14 | import ClassyPrelude
 15 | import Data.Either (isRight, isLeft)
 16 | import Test.Hspec
 17 | import Test.QuickCheck (property, Arbitrary(..), oneof)
 18 | import qualified Data.Text as T
 19 | 
 20 | import Data.SemVer
 21 | 
 22 | -- | Arbitrary semver
 23 | instance Arbitrary SemVer where
 24 |   arbitrary = semver' <$> arb <*> arb <*> arb <*> arbitrary where
 25 |     arb = abs <$> arbitrary
 26 | 
 27 | instance Arbitrary SemVerRange where
 28 |   arbitrary = oneof [Eq <$> arbitrary,
 29 |                      Lt <$> arbitrary,
 30 |                      Gt <$> arbitrary,
 31 |                      Leq <$> arbitrary,
 32 |                      Geq <$> arbitrary
 33 |                      ]
 34 | 
 35 | -- | Unsafe instance!
 36 | instance IsString SemVer where
 37 |   fromString s = case parseSemVer (T.pack s) of
 38 |     Right sv -> sv
 39 |     Left err -> error $ show err
 40 | 
 41 | -- | Unsafe instance!
 42 | instance IsString SemVerRange where
 43 |   fromString s = case parseSemVerRange (T.pack s) of
 44 |     Right svr -> svr
 45 |     Left err -> error $ show err
 46 | 
 47 | instance Arbitrary Text where
 48 |   arbitrary = pack <$> arbitrary
 49 | 
 50 | instance Arbitrary PrereleaseTag where
 51 |   arbitrary = oneof [IntTag . abs <$> arbitrary]
 52 | 
 53 | instance Arbitrary PrereleaseTags where
 54 |   arbitrary = PrereleaseTags <$> arbitrary
 55 | 
 56 | -- | Asserts that the first argument is a `Right` value equal to the second
 57 | -- argument.
 58 | shouldBeR :: (Show a, Show b, Eq b) => Either a b -> b -> IO ()
 59 | shouldBeR x y = do
 60 |   shouldSatisfy x isRight
 61 |   let Right x' = x
 62 |   x' `shouldBe` y
 63 | 
 64 | infixl 1 `shouldBeR`
 65 | 
 66 | shouldBeL :: (Show a, Show b, Eq a) => Either a b -> IO ()
 67 | shouldBeL x = shouldSatisfy x isLeft
 68 | 
 69 | main :: IO ()
 70 | main = hspec $ do
 71 |   describe "semver parsing" $ do
 72 |     it "should parse basic semvers" $ property $
 73 |       -- Pre-apply absolute value so we know they're positive integers
 74 |       \((abs -> maj, abs -> min, abs -> patch) :: (Int, Int, Int)) -> do
 75 |         let s = intercalate "." $ map tshow ([maj, min, patch] :: [Int])
 76 |         parseSemVer s `shouldBeR` semver maj min patch
 77 | 
 78 |     it "should parse a semver with only major version" $ property $
 79 |       \(abs -> maj :: Int) -> do
 80 |         parseSemVer (tshow maj) `shouldBeR` semver maj 0 0
 81 | 
 82 |     it "should parse a semver with only major and minor versions" $ property $
 83 |       \((abs -> maj, abs -> min) :: (Int, Int)) -> do
 84 |         let s = intercalate "." $ map tshow ([maj, min] :: [Int])
 85 |         parseSemVer s `shouldBeR` semver maj min 0
 86 | 
 87 |     it "pretty-printing is an injection" $ property $ \sv -> do
 88 |       parseSemVer (tshow sv) `shouldBeR` sv
 89 | 
 90 |     it "should parse a semver with metadata" $ do
 91 |       parseSemVer "1.2.3-pre+asdf" `shouldBeR` semver'' 1 2 3 ["pre"] ["asdf"]
 92 | 
 93 |     describe "with release tags" $ do
 94 |       it "should parse a semver with release tags" $ do
 95 |         parseSemVer "1.2.3-alpha" `shouldBeR` semver' 1 2 3 ["alpha"]
 96 |         parseSemVer "1.2.3alpha" `shouldBeR` semver' 1 2 3 ["alpha"]
 97 | 
 98 |       it "should parse a semver with multiple release tags" $ do
 99 |         parseSemVer "1.2.3-alpha.3" `shouldBeR` semver' 1 2 3 ["alpha", IntTag 3]
100 |         parseSemVer "1.2.3alpha.3" `shouldBeR` semver' 1 2 3 ["alpha", IntTag 3]
101 | 
102 |   describe "prerelease tag comparison" $ do
103 |     it "should treat empty lists as greater" $ property $
104 |       \(tags::PrereleaseTags) -> case tags of
105 |         PrereleaseTags [] -> return ()
106 |         tags -> [] > tags `shouldBe` True
107 | 
108 |   describe "semver range parsing" $ do
109 |     it "should parse a semver into an exact range" $ property $ \sv -> do
110 |       -- This says that if we pretty-print a semver V and parse it as a
111 |       -- semver range, we get the range "= V" back.
112 |       parseSemVerRange (tshow sv) `shouldBeR` Eq sv
113 | 
114 |     it "pretty printing should be an injection" $ property $ \svr -> do
115 |       -- This says that if we pretty-print a semver V and parse it as a
116 |       -- semver range, we get the range "= V" back.
117 |       parseSemVerRange (tshow svr) `shouldBeR` svr
118 | 
119 |     it "should parse a semver with partial version into a range" $ property $
120 |       \(abs -> maj :: Int, abs -> min :: Int) -> do
121 |         let expected = Geq (semver maj min 0) `And` Lt (semver maj (min + 1) 0)
122 |             parseIt = parseSemVerRange . T.intercalate "."
123 |         -- E.g. 1.2 =====> (>=1.2.0 <1.3)
124 |         parseIt [tshow maj, tshow min] `shouldBeR` expected
125 |         parseIt [tshow maj, tshow min, "X"] `shouldBeR` expected
126 |         parseIt [tshow maj, tshow min, "x"] `shouldBeR` expected
127 |         parseIt [tshow maj, tshow min, "*"] `shouldBeR` expected
128 | 
129 |     it "should parse a multi range" $ do
130 |       parseSemVerRange "1.2.3-pre+asdf - 2.4.3-pre+asdf"
131 |         `shouldBeR` Geq (semver'' 1 2 3 ["pre"] ["asdf"])
132 |                      `And` Lt (semver'' 2 4 3 ["pre"] ["asdf"])
133 | 
134 |     it "should parse semvers with && instead of spaces" $ do
135 |       let expected = Geq (semver 2 0 0) `And` Leq (semver 2 15 0)
136 |       parseSemVerRange ">= 2 && <= 2.14" `shouldBeR` expected
137 | 
138 |     it "should fail when it's wrong" $ do
139 |       shouldBeL (parseSemVerRange "xyz")
140 | 
141 |   rangeTests
142 |   cleanTests
143 | 
144 | -- | These test cases were adapted from
145 | -- https://github.com/npm/node-semver/blob/master/test/clean.js
146 | cleanTests :: Spec
147 | cleanTests = describe "unclean version strings" $ do
148 |   let examples :: [(Text, Maybe Text)] = [
149 |         ("1.2.3", Just "1.2.3"),
150 |         (" 1.2.3 ", Just "1.2.3"),
151 |         (" 1.2.3-4 ", Just "1.2.3-4"),
152 |         (" 1.2.3-pre ", Just "1.2.3-pre"),
153 |         ("  =v1.2.3   ", Just "1.2.3"),
154 |         ("v1.2.3", Just "1.2.3"),
155 |         (" v1.2.3 ", Just "1.2.3"),
156 |         ("\t1.2.3", Just "1.2.3"),
157 |         (">1.2.3", Nothing),
158 |         ("~1.2.3", Nothing),
159 |         ("<=1.2.3", Nothing)
160 |         -- The example below is given in the tests but this doesn't
161 |         -- seem like an error to me, so there.
162 |         -- ("1.2.x", Nothing)
163 |         ]
164 |   forM_ examples $ \(string, result) -> case result of
165 |     Just string' -> do
166 |       it ("should parse " <> show string <> " same as " <> show string') $ do
167 |         parseSemVer string `shouldSatisfy` isRight
168 |         parseSemVer string `shouldBe` parseSemVer string'
169 | 
170 |     Nothing -> do
171 |       it ("should not parse " <> show string) $ do
172 |         parseSemVer string `shouldSatisfy` isLeft
173 | 
174 | -- | These test cases were adapted from
175 | -- https://github.com/npm/node-semver/blob/master/test/index.js#L134
176 | rangeTests :: Spec
177 | rangeTests = describe "range tests" $ do
178 |   -- In each case, the range described in the first element of the
179 |   -- tuple should be satisfied by the concrete version described in
180 |   -- the second element of the tuple.
181 |   let testCases :: [(Bool, Text, Text)] = [
182 | 
183 |         -- Range constraints with pre-release tags require that any
184 |         -- version satisfying the constraint must be equivalent (in
185 |         -- its semantic version tuple) to the minimum of all semantic
186 |         -- versions within the range. In this case the minimum of the
187 |         -- range is "1.2.3" and the version's semantic version tuple
188 |         -- is "1.2.4", therefore it does not satisfy the constraints
189 |         -- of the range given the presence of pre-release tags.
190 |         (False, "1.2.3-pre+asdf - 2.4.3-pre+asdf", "1.2.4-pre+asdf"),
191 |         (False, "1.2.3-pre+asdf - 2.4.3-pre+asdf", "2.4.3-alpha"),
192 |         (False, ">=0.0.1-alpha <0.2.0-alpha", "0.1.1-alpha"),
193 |         (False, "^0.0.1-alpha", "0.0.4-alpha"),
194 | 
195 |         -- Range constraints without prerelease tags are very strict
196 |         -- about not admitting versions *with* prerelease tags
197 |         (False, "^0.1.2", "0.1.2-beta1"),
198 |         (False, "^0.1.2", "0.1.4-beta1"),
199 | 
200 |         -- Despite the numeric quantity, these versions have
201 |         -- prerelease tags and are therefore subjected to the same
202 |         -- invariant checking.
203 |         (False, "^1.2.3-1", "1.8.1-1"),
204 |         (False, "^1.2.3-1", "1.8.1-4"),
205 | 
206 |         -- If we ever have an exact version tuple match at the top of
207 |         -- a given range then it must satisfy the range constraint!
208 |         --
209 |         -- e.g. "^1.2.3-alpha" translates to ">=1.2.3-alpha
210 |         -- <2.0.0-alpha" and the version to check is "2.0.0-alpha". In
211 |         -- this case the version tuples are equivalent, sans
212 |         -- prerelease tags, but it does not satisfy the upper-bound
213 |         -- less-than relation.
214 |         (False, "^1.2.3-alpha", "2.0.0-alpha"),
215 | 
216 |         (True,  "1.2.3-pre+asdf - 2.4.3-pre+asdf", "1.2.3-pre+asdf"),
217 |         (True, "", "1.0.0"),
218 |         (True, "*", "1.2.3"),
219 |         (True, "*", "1.2.3"),
220 |         (True, "*", "v1.2.3"),
221 |         (True, "0.1.20 || 1.2.4", "1.2.4"),
222 |         (True, "1.0.0 - 2.0.0", "1.2.3"),
223 |         (True, "1.0.0", "1.0.0"),
224 |         (True, "1.2.* || 2.*", "1.2.3"),
225 |         (True, "1.2.* || 2.*", "2.1.3"),
226 |         (True, "1.2.*", "1.2.3"),
227 |         (True, "1.2.3 - 2.4.3", "1.2.4"),
228 |         (True, "1.2.3 >=1.2.1", "1.2.3"),
229 |         (True, "1.2.3+asdf - 2.4.3+asdf", "1.2.3"),
230 |         (True, "1.2.3-pre+asdf - 2.4.3-pre+asdf", "1.2.3"),
231 |         (True, "1.2.3-pre+asdf - 2.4.3-pre+asdf", "1.2.3-pre.2"),
232 |         (True, "1.2.3-pre+asdf - 2.4.3-pre+asdf", "1.2.3-pred"),
233 |         (True, "1.2.3-pre+asdf - 2.4.3pre+asdf", "1.2.3"),
234 |         (True, "1.2.3pre+asdf - 2.4.3pre+asdf", "1.2.3"),
235 |         (True, "1.2.x || 2.x", "1.2.3"),
236 |         (True, "1.2.x || 2.x", "2.1.3"),
237 |         (True, "1.2.x", "1.2.3"),
238 |         (True, "2", "2.1.2"),
239 |         (True, "2.*.*", "2.1.3"),
240 |         (True, "2.3", "2.3.1"),
241 |         (True, "2.x.x", "2.1.3"),
242 |         (True, "<    2.0.0", "1.9999.9999"),
243 |         (True, "< 1.2", "1.1.1"),
244 |         (True, "<1.2", "1.1.1"),
245 |         (True, "<2.0.0", "0.2.9"),
246 |         (True, "<2.0.0", "1.9999.9999"),
247 |         (True, "<=   2.0.0", "2.0.0"),
248 |         (True, "<=  2.0.0", "0.2.9"),
249 |         (True, "<= 2.0.0", "1.9999.9999"),
250 |         (True, "<=0.7.x", "0.6.2"),
251 |         (True, "<=0.7.x", "0.7.2"),
252 |         (True, "<=2.0.0", "0.2.9"),
253 |         (True, "<=2.0.0", "1.9999.9999"),
254 |         (True, "<=2.0.0", "2.0.0"),
255 |         (True, "<\t2.0.0", "0.2.9"),
256 |         (True, "=0.7.x", "0.7.2"),
257 |         (True, ">  1.0.0", "1.1.0"),
258 |         (True, "> 1.0.0", "1.0.1"),
259 |         (True, ">1.0.0", "1.0.1"),
260 |         (True, ">1.0.0", "1.1.0"),
261 |         (True, ">=   1.0.0", "1.1.0"),
262 |         (True, ">=  1.0.0", "1.0.1"),
263 |         (True, ">= 1", "1.0.0"),
264 |         (True, ">= 1.0.0", "1.0.0"),
265 |         (True, ">= 4.0.0 <4.1.0-0", "4.0.1"),
266 |         (True, ">=*", "0.2.4"),
267 |         (True, ">=0.1.97", "0.1.97"),
268 |         (True, ">=0.1.97", "v0.1.97"),
269 |         (True, ">=0.2.3 || <0.0.1", "0.0.0"),
270 |         (True, ">=0.2.3 || <0.0.1", "0.2.3"),
271 |         (True, ">=0.2.3 || <0.0.1", "0.2.4"),
272 |         (True, ">=0.7.x", "0.7.2"),
273 |         (True, ">=1", "1.0.0"),
274 |         (True, ">=1.0.0", "1.0.0"),
275 |         (True, ">=1.0.0", "1.0.1"),
276 |         (True, ">=1.0.0", "1.1.0"),
277 |         (True, ">=1.2", "1.2.8"),
278 |         (True, ">=1.2.1 1.2.3", "1.2.3"),
279 |         (True, ">=1.2.1 >=1.2.3", "1.2.3"),
280 |         (True, ">=1.2.3 >=1.2.1", "1.2.3"),
281 |         (True, "^0.0.1-alpha", "0.0.1-beta"),
282 |         (True, "^0.0.1-alpha.1", "0.0.1-alpha.t"),
283 |         (True, "^0.0.1-alpha.1", "0.0.1-alpha.tdff.dddddddddd"),
284 |         (True, "^0.1", "0.1.2"),
285 |         (True, "^0.1.2", "0.1.2"),
286 |         (True, "^1.2 ^1", "1.4.2"),
287 |         (True, "^1.2", "1.4.2"),
288 |         (True, "^1.2.0-alpha", "1.2.0-pre"),
289 |         (True, "^1.2.3", "1.8.1"),
290 |         (True, "^1.2.3+build", "1.2.3"),
291 |         (True, "^1.2.3+build", "1.3.0"),
292 |         (True, "^1.2.3-alpha", "1.2.3-pre"),
293 |         (True, "^1.2.3-alpha.1", "1.2.3-alpha.7"),
294 |         (True, "^1.2.3-boop", "1.2.4"),
295 |         (True, "x", "1.2.3"),
296 |         (True, "||", "1.3.4"),
297 |         (True, "~ 1.0", "1.0.2"),
298 |         (True, "~ 1.0.3", "1.0.12"),
299 |         (True, "~1", "1.2.3"),
300 |         (True, "~1.0", "1.0.2"),
301 |         (True, "~1.2.1 1.2.3 >=1.2.3", "1.2.3"),
302 |         (True, "~1.2.1 1.2.3", "1.2.3"),
303 |         (True, "~1.2.1 1.2.3", "1.2.3"),
304 |         (True, "~1.2.1 =1.2.3", "1.2.3"),
305 |         (True, "~1.2.1 >=1.2.3 1.2.3", "1.2.3"),
306 |         (True, "~1.2.1 >=1.2.3", "1.2.3"),
307 |         (True, "~2.4", "2.4.0"),
308 |         (True, "~2.4", "2.4.5"),
309 |         (True, "~> 1", "1.2.3"),
310 |         (True, "~>1", "1.2.3"),
311 |         (True, "~v0.5.4-pre", "0.5.4"),
312 |         (True, "~v0.5.4-pre", "0.5.5"),
313 |         (True, "~>3.2.1", "3.2.2")
314 |         ]
315 |   forM_ testCases $ \(expectedMatchBool, range, version) -> do
316 |     let fail = expectationFailure
317 |     it (show version <> " satisfies range " <> show range) $ do
318 |       case (parseSemVerRange range, parseSemVer version) of
319 |         (Left err, _) -> fail $ "Semver range parse failed: " <> show err
320 |         (_, Left err) -> fail $ "Semver parse failed: " <> show err
321 |         (Right range, Right version) -> matches range version `shouldBe` expectedMatchBool
322 | 


--------------------------------------------------------------------------------