diff --git a/semver.cabal b/semver.cabal --- a/semver.cabal +++ b/semver.cabal @@ -1,8 +1,8 @@ name: semver -version: 0.3.4 +version: 0.4.0.1 synopsis: Representation, manipulation, and de/serialisation of Semantic Versions. homepage: https://github.com/brendanhay/semver -license: OtherLicense +license: MPL-2.0 license-file: LICENSE author: Brendan Hay maintainer: Brendan Hay @@ -10,7 +10,7 @@ category: Data build-type: Simple extra-source-files: README.md -cabal-version: >= 1.10 +cabal-version: >= 1.20 description: Representation, manipulation, and de/serialisation of a Version type @@ -29,6 +29,7 @@ exposed-modules: Data.SemVer + , Data.SemVer.Constraint , Data.SemVer.Delimited other-modules: diff --git a/src/Data/SemVer.hs b/src/Data/SemVer.hs --- a/src/Data/SemVer.hs +++ b/src/Data/SemVer.hs @@ -240,7 +240,7 @@ -- | A greedy attoparsec 'Parser' which requires the entire 'Text' -- input to match. parser :: Parser Version -parser = Delim.parser Delim.semantic +parser = Delim.parser Delim.semantic True {-# INLINE parser #-} -- | Safely construct a numeric identifier. diff --git a/src/Data/SemVer/Constraint.hs b/src/Data/SemVer/Constraint.hs new file mode 100644 --- /dev/null +++ b/src/Data/SemVer/Constraint.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +-- Module : Data.SemVer.Constraint +-- Copyright : (c) 2020 Brendan Hay , Keagan McClelland +-- License : This Source Code Form is subject to the terms of +-- the Mozilla Public License, v. 2.0. +-- A copy of the MPL can be found in the LICENSE file or +-- you can obtain it at http://mozilla.org/MPL/2.0/. +-- Maintainer : Brendan Hay +-- Stability : experimental +-- Portability : non-portable (GHC extensions) + +-- | An implementation of the Semantic Versioning Constraints. +-- In absence of a standard around constraints, the behavior of node-semver is closely followed. +-- The behavior is outlined here: https://github.com/npm/node-semver#ranges +module Data.SemVer.Constraint + ( Constraint(..) + , satisfies + , fromText + ) +where + +import Control.Applicative +import Data.Attoparsec.Text +import Data.Monoid ((<>)) +import Data.SemVer.Internal +import qualified Data.SemVer.Delimited as DL +import Data.Text (Text) + +data Constraint + = CAny + | CLt !Version + | CLtEq !Version + | CGt !Version + | CGtEq !Version + | CEq !Version + | CAnd !Constraint !Constraint + | COr !Constraint !Constraint + deriving (Eq, Show) + +-- | Checks whether the 'Version' satisfies the 'Constraint' +-- +-- Note: Semantics of this are strange in the presence of pre-release identifiers. Without a proper standard for how +-- constraint satisfaction should behave, this implementation attempts to follow the behavior of node-semver +-- which can be found here: https://github.com/npm/node-semver#prerelease-tags. +-- +-- This choice was made because node-semver is the most widely deployed implementation of semantic versioning with +-- the best documentation around how to treat pre-release identifiers. +-- +-- The summary is that you must opt into using pre-release identifiers by specifying them in the constraint +-- and they __must__ match the __exact__ version that attempts to use a pre-release identifier. +satisfies :: Version -> Constraint -> Bool +satisfies version constraint = if containsPrerelease version + then if not . null . filter ((triple version ==) . triple . snd) $ (prereleaseComparators constraint) + then go version constraint + else if constraint == CAny then True else False + else go version constraint + where + triple :: Version -> (Int, Int, Int) + triple = liftA3 (,,) _versionMajor _versionMinor _versionPatch + containsPrerelease :: Version -> Bool + containsPrerelease v = not . null . _versionRelease $ v + -- this helps us gather the comparators that actually consented to prerelease versions + prereleaseComparators :: Constraint -> [(Version -> Constraint, Version)] + prereleaseComparators = \case + CAny -> [] + CLt v -> if containsPrerelease v then [(CLt, v)] else [] + CLtEq v -> if containsPrerelease v then [(CLtEq, v)] else [] + CGt v -> if containsPrerelease v then [(CGt, v)] else [] + CGtEq v -> if containsPrerelease v then [(CGtEq, v)] else [] + CEq v -> if containsPrerelease v then [(CEq, v)] else [] + CAnd a b -> prereleaseComparators a <> prereleaseComparators b + COr a b -> prereleaseComparators a <> prereleaseComparators b + -- naive satisfaction checking + go :: Version -> Constraint -> Bool + go v c = case c of + CAny -> True + CLt vc -> v < vc + CLtEq vc -> v <= vc + CGt vc -> v > vc + CGtEq vc -> v >= vc + CEq vc -> v == vc + CAnd a b -> go v a && go v b + COr a b -> go v a || go v b + +-- | Parsing function to create a 'Constraint' from 'Text' according to the rules specified +-- here: https://github.com/npm/node-semver#ranges +-- +-- Advanced syntax is not yet supported. +fromText :: Text -> Either String Constraint +fromText = parseOnly parser + +parser :: Parser Constraint +parser = parserD DL.semantic + +parserD :: Delimiters -> Parser Constraint +parserD d@Delimiters {..} = choice . fmap (<* endOfInput) $ [primP, andP, orP] + where + primP = choice + [ char '*' *> pure CAny + , char '<' *> (CLt <$> DL.parser d False) + , string "<=" *> (CLtEq <$> DL.parser d False) + , char '>' *> (CGt <$> DL.parser d False) + , string ">=" *> (CGtEq <$> DL.parser d False) + , CEq <$> ((option '=' $ char '=') *> DL.parser d False) + ] + andP = liftA2 CAnd primP (skipSpace *> (andP <|> primP)) + orP = liftA2 COr (andP <|> primP) (skipSpace *> string "||" *> skipSpace *> (orP <|> andP <|> primP)) diff --git a/src/Data/SemVer/Delimited.hs b/src/Data/SemVer/Delimited.hs --- a/src/Data/SemVer/Delimited.hs +++ b/src/Data/SemVer/Delimited.hs @@ -107,14 +107,14 @@ -- | A greedy attoparsec 'Parser' using the specified 'Delimiters' set -- which requires the entire 'Text' input to match. -parser :: Delimiters -> Parser Version -parser Delimiters{..} = Version +parser :: Delimiters -> Bool -> Parser Version +parser Delimiters{..} requireAtEnd = Version <$> (nonNegative <* char _delimMinor) <*> (nonNegative <* char _delimPatch) <*> nonNegative <*> option [] (try (char _delimRelease) *> identifiers) <*> option [] (try (char _delimMeta) *> identifiers) - <* endOfInput + <* when requireAtEnd endOfInput where identifiers :: Parser [Identifier] identifiers = many (identifierParser $ void (char _delimIdent)) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -15,6 +15,7 @@ import Control.Applicative import Data.List (sort) import Data.SemVer +import Data.SemVer.Constraint import Data.Text (Text, unpack) import Test.Tasty import Test.Tasty.HUnit @@ -59,14 +60,39 @@ , testCase "compare 1.2.3 1.2.3+sha.2ac == EQ" $ (sv123 `compare` sv123sha2ac) @=? EQ ] + + , testGroup "constraint satisfaction" + [ testGroup "basic satisfaction" + [ testCase "1.2.3 `satisfies` >=1.2.3" $ true (sv123 `satisfies` sc ">=1.2.3") + , testCase "not $ 1.2.3 `satisfies` >1.2.3" $ false (sv123 `satisfies` sc ">1.2.3") + , testCase "1.2.3 `satisfies` <1.2.4" $ true (sv123 `satisfies` sc "<1.2.4") + , testCase "not $ 1.2.3 `satisfies` =1.2.4" $ false (sv123 `satisfies` sc "=1.2.4") + ] + , testGroup "composite satisfaction" + [ testCase "1.2.3 `satisfies` >1.0.0 <2.0.0" $ true (sv123 `satisfies` sc ">1.0.0 <2.0.0") + , testCase "1.2.3 `satisfies` <2.0.0 || >3.0.0" $ true (sv123 `satisfies` sc "<2.0.0 || >3.0.0") + , testCase "1.2.3 `satisfies` >1.0.0 <2.0.0 || 3.0.0" $ true (sv123 `satisfies` sc ">1.0.0 <2.0.0 || 3.0.0") + , testCase "1.2.3 `satisfies` 3.0.0 || <2.0.0 >1.0.0" $ true (sv123 `satisfies` sc "3.0.0 || <2.0.0 >1.0.0") + ] + , testGroup "prerelease handling" + [ testCase "prerelease versions satisfy if triple is same" $ true (sv100alpha `satisfies` sc ">=1.0.0-alpha") + , testCase "prerelease versions don't satisfy if spec doesn't contain prerelease tag on same triple" $ false (sv100alpha `satisfies` sc ">=1.0.0") + , testCase "prerelease versions don't satisfy if spec doesn't contain prerelease tag on same triple" $ false (sv "3.0.0-alpha" `satisfies` sc ">=1.0.0-alpha") + , testCase "prerelease versions do not require tag to be the same to satisfy" $ true (sv "1.0.0-beta" `satisfies` sc ">=1.0.0-alpha") + , testCase "regular versions can satisfy prerelease constraints" $ true (sv "3.0.0" `satisfies` sc ">=2.0.0-alpha") + ] + ] ] iso :: Text -> TestTree -iso t = testCase (unpack t) (Right t @=? (toText <$> fromText t)) +iso t = testCase (unpack t) (Right t @=? (toText <$> Data.SemVer.fromText t)) true :: Bool -> Assertion true = (True @=?) +false :: Bool -> Assertion +false = (False @=?) + sv000, sv100, sv100alpha, sv100alpha1, sv101 :: Version sv110, sv200, sv123sha2ac, sv123beta1shaexpdc2 :: Version sv000 = initial @@ -81,6 +107,11 @@ sv123beta1shaexpdc2 = sv "1.2.3-beta.1+sha.exp.dc2" sv :: Text -> Version -sv t = case fromText t of +sv t = case Data.SemVer.fromText t of Left e -> error e + Right x -> x + +sc :: Text -> Constraint +sc t = case Data.SemVer.Constraint.fromText t of + Left e -> error e Right x -> x