versions 5.0.5 → 6.0.0
raw patch · 4 files changed
+307/−305 lines, 4 filesdep −QuickCheckdep −tasty-quickcheck
Dependencies removed: QuickCheck, tasty-quickcheck
Files
- CHANGELOG.md +30/−0
- Data/Versions.hs +265/−252
- test/Test.hs +11/−50
- versions.cabal +1/−3
CHANGELOG.md view
@@ -1,5 +1,35 @@ # Changelog +## 6.0.0 (2023-04-29)++A number of type changes have been made to improve parsing and comparison logic.+Doing so fixed several bugs and made the code cleaner overall.++If you're just doing basic parsing and comparisons and not actually inspecting+the types themselves, you shouldn't notice a difference.++#### Added++- New types `Release`, `Chunks`, and `Chunk`.++#### Changed++- Both `SemVer` and `Version` now contain a better-behaving `Release` type for their prerelease info.+- Similarly, `Version` now also has a better-behaving `Chunks` type for its main+ version number sections.+- The `release` traversal now yields a `Maybe Release`.+- Versions with `~` in their metadata will now parse as a `Mess`. Example: `12.0.0-3ubuntu1~20.04.5`++#### Removed++- The various `Semigroup` instances. Adding version numbers together is a+ nonsensical operation and should never have been added in the first place.+- The `VChunk` and `VUnit` types and their associated functions.++#### Fixed++- Leading zeroes are handled a little better in `SemVer` pre-release data.+ ## 5.0.5 (2023-03-23) #### Changed
Data/Versions.hs view
@@ -7,7 +7,7 @@ -- | -- Module : Data.Versions--- Copyright : (c) Colin Woodbury, 2015 - 2022+-- Copyright : (c) Colin Woodbury, 2015 - 2023 -- License : BSD3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -44,9 +44,10 @@ , PVP(..) , Version(..) , Mess(..), messMajor, messMinor, messPatch, messPatchChunk+ , Release(..)+ , Chunks(..)+ , Chunk(..) , MChunk(..)- , VUnit(..), digits, str- , VChunk , VSep(..) -- * Parsing Versions , ParsingError@@ -68,21 +69,18 @@ , _Ideal, _General, _Complex -- ** (General) Version Lenses , epoch- -- ** Misc. Lenses / Traversals- , _Digits, _Str ) where import qualified Control.Applicative.Combinators.NonEmpty as PC import Control.DeepSeq-import Control.Monad (void)-import Data.Bool (bool)+import Control.Monad (unless, void) import Data.Char (isAlpha, isAlphaNum) import Data.Foldable (fold) import Data.Hashable (Hashable) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Void (Void)@@ -90,10 +88,7 @@ import Text.Megaparsec hiding (chunk) import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L--#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup-#endif+import Text.Megaparsec.Char.Lexer (decimal) --- @@ -132,39 +127,74 @@ compare (Ideal s) (Ideal s') = compare s s' compare (General v) (General v') = compare v v' compare (Complex m) (Complex m') = compare m m'- compare (Ideal s) (General v) = compare (vFromS s) v- compare (General v) (Ideal s) = opposite $ compare (vFromS s) v+ compare (Ideal s) (General v) = semverAndVer s v+ compare (General v) (Ideal s) = opposite $ semverAndVer s v compare (General v) (Complex m) = compare (mFromV v) m compare (Complex m) (General v) = opposite $ compare (mFromV v) m compare (Ideal s) (Complex m) = semverAndMess s m- compare (Complex m) (Ideal s) = opposite $ semverAndMess s m+ compare (Complex m) (Ideal s) = opposite $ semverAndMess s m -- | Convert a `SemVer` to a `Version`. vFromS :: SemVer -> Version vFromS (SemVer ma mi pa re me) = Version { _vEpoch = Nothing- , _vChunks = (Digits ma :| []) :| [Digits mi :| [], Digits pa :| []]+ , _vChunks = Chunks $ Numeric ma :| [Numeric mi, Numeric pa] , _vMeta = me , _vRel = re } -- | Convert a `Version` to a `Mess`. mFromV :: Version -> Mess-mFromV (Version e v r m) = maybe affix (\a -> Mess (MDigit a (showt a) :| []) $ Just (VColon, affix)) e+mFromV (Version me (Chunks v) r _) = case me of+ Nothing -> f+ Just e ->+ let cs = NEL.singleton . MDigit e $ showt e+ in Mess cs $ Just (VColon, f) where- affix :: Mess- affix = Mess (chunksAsM v) m'+ f :: Mess+ f = Mess cs $ fmap g r+ where+ cs = NEL.map toMChunk v - m' :: Maybe (VSep, Mess)- m' = case m of- Nothing -> r'- Just m'' -> Just (VPlus, Mess (MPlain m'' :| []) r')+ g :: Release -> (VSep, Mess)+ g (Release cs) = (VHyphen, Mess ms Nothing)+ where+ ms = NEL.map toMChunk cs - r' :: Maybe (VSep, Mess)- r' = case NEL.nonEmpty r of- Nothing -> Nothing- Just r'' -> Just (VHyphen, Mess (chunksAsM r'') Nothing)+semverAndVer :: SemVer -> Version -> Ordering+-- A `Version` with a non-zero epoch value is automatically greater than any+-- `SemVer`.+semverAndVer _ (Version (Just e) _ _ _) | e > 0 = LT+semverAndVer (SemVer ma mi pa sr _) (Version _ (Chunks vc) vr _) =+ case compare ma <$> (nth 0 vc' >>= singleDigitLenient) of+ Nothing -> GT+ Just GT -> GT+ Just LT -> LT+ Just EQ -> case compare mi <$> (nth 1 vc' >>= singleDigitLenient) of+ Nothing -> GT+ Just GT -> GT+ Just LT -> LT+ Just EQ -> case compare pa <$> (nth 2 vc' >>= singleDigitLenient) of+ Nothing -> GT+ Just GT -> GT+ Just LT -> LT+ -- By thes point, the major/minor/patch positions have all been equal.+ -- If there is a fourth position, its type, not its value, will+ -- determine which overall version is greater.+ Just EQ -> case nth 3 vc' of+ -- 1.2.3 > 1.2.3.git+ Just (Alphanum _) -> GT+ -- 1.2.3 < 1.2.3.0+ Just (Numeric _) -> LT+ Nothing -> compare sr vr+ where+ vc' :: [Chunk]+ vc' = NEL.toList vc + nth :: Int -> [Chunk] -> Maybe Chunk+ nth _ [] = Nothing+ nth 0 (c:_) = Just c+ nth n (_:cs) = nth (n - 1) cs -- | Special logic for when semver-like values can be extracted from a `Mess`. -- This avoids having to "downcast" the `SemVer` into a `Mess` before comparing,@@ -185,13 +215,18 @@ -- will by definition have more to it, meaning that -- it's more likely to be newer, despite its poor shape. Just EQ -> fallback- Nothing -> case messPatchChunk m of- Nothing -> fallback- Just (Digits pa':|_) -> case compare pa pa' of+ -- Even if we weren't able to extract a standalone patch number, we might+ -- still be able to find a number at the head of the `Chunk` in that+ -- position.+ Nothing -> case messPatchChunk m >>= singleDigitLenient of+ -- We were very close, but in the end the `Mess` had a nonsensical value+ -- in its patch position.+ Nothing -> fallback+ Just pa' -> case compare pa pa' of LT -> LT GT -> GT- EQ -> GT -- This follows semver's rule!- Just _ -> fallback+ -- This follows semver's rule that pre-releases have lower precedence.+ EQ -> GT where fallback :: Ordering fallback = compare (General $ vFromS s) (Complex m)@@ -310,7 +345,7 @@ -- | @major.minor.PATCH-prerel+meta@ patch :: Traversal' v Word -- | @major.minor.patch-PREREL+meta@- release :: Traversal' v [VChunk]+ release :: Traversal' v (Maybe Release) -- | @major.minor.patch-prerel+META@ meta :: Traversal' v (Maybe Text) -- | A Natural Transformation into an proper `SemVer`.@@ -347,7 +382,7 @@ { _svMajor :: !Word , _svMinor :: !Word , _svPatch :: !Word- , _svPreRel :: ![VChunk]+ , _svPreRel :: !(Maybe Release) , _svMeta :: !(Maybe Text) } deriving stock (Show, Generic) deriving anyclass (NFData, Hashable)@@ -363,22 +398,11 @@ case compare (ma,mi,pa) (ma',mi',pa') of LT -> LT GT -> GT- EQ -> case (pr,pr') of- ([],[]) -> EQ- ([],_) -> GT- (_,[]) -> LT- _ -> compare pr pr'--instance Semigroup SemVer where- SemVer mj mn pa p m <> SemVer mj' mn' pa' p' m' =- SemVer (mj + mj') (mn + mn') (pa + pa') (p ++ p') (m <> m')--instance Monoid SemVer where- mempty = SemVer 0 0 0 [] Nothing--#if !MIN_VERSION_base(4,11,0)- mappend = (<>)-#endif+ EQ -> case (pr, pr') of+ (Nothing, Nothing) -> EQ+ (Nothing, _) -> GT+ (_, Nothing) -> LT+ (Just ap, Just bp) -> compare ap bp instance Semantic SemVer where major f sv = fmap (\ma -> sv { _svMajor = ma }) (f $ _svMajor sv)@@ -399,49 +423,84 @@ semantic = ($) {-# INLINE semantic #-} --- | A single unit of a Version. May be digits or a string of characters. Groups--- of these are called `VChunk`s, and are the identifiers separated by periods--- in the source.-data VUnit = Digits Word | Str Text- deriving stock (Eq, Show, Read, Ord, Generic)+-- | `Chunk`s have comparison behaviour according to SemVer's rules for preleases.+newtype Release = Release (NonEmpty Chunk)+ deriving stock (Eq, Show, Read, Generic) deriving anyclass (NFData, Hashable) -instance Semigroup VUnit where- Digits n <> Digits m = Digits $ n + m- Str t <> Str s = Str $ t <> s- Digits n <> _ = Digits n- _ <> Digits n = Digits n--instance Monoid VUnit where- mempty = Str ""--#if !MIN_VERSION_base(4,11,0)- mappend = (<>)-#endif+instance Ord Release where+ compare (Release as) (Release bs) =+ fromMaybe EQ . listToMaybe . mapMaybe f $ zipLongest (NEL.toList as) (NEL.toList bs)+ where+ f :: These Chunk Chunk -> Maybe Ordering+ f (Both a b) = case cmpSemVer a b of+ LT -> Just LT+ GT -> Just GT+ EQ -> Nothing+ f (This _) = Just GT+ f (That _) = Just LT --- | Smart constructor for a `VUnit` made of digits.-digits :: Word -> VUnit-digits = Digits+-- | A logical unit of a version number.+--+-- Either entirely numerical (with no leading zeroes) or entirely alphanumerical+-- (with a free mixture of numbers, letters, and hyphens.)+--+-- Groups of these (like `Release`) are separated by periods to form a full+-- section of a version number.+--+-- Examples:+--+-- @+-- 1+-- 20150826+-- r3+-- 0rc1-abc3+-- @+data Chunk = Numeric Word | Alphanum Text+ deriving stock (Eq, Show, Read, Generic)+ deriving anyclass (NFData, Hashable) --- | Smart constructor for a `VUnit` made of letters.-str :: Text -> Maybe VUnit-str t = bool Nothing (Just $ Str t) $ T.all isAlpha t+toMChunk :: Chunk -> MChunk+toMChunk (Numeric n) = MDigit n $ showt n+toMChunk (Alphanum s) = MPlain s --- | Possibly traverse the inner digit value of a `VUnit`.-_Digits :: Traversal' VUnit Word-_Digits f (Digits i) = Digits <$> f i-_Digits _ v = pure v-{-# INLINE _Digits #-}+-- | `Chunk` is used in multiple places but requires different comparison+-- semantics depending on the wrapping type. This function and `cmpLenient`+-- below provide this.+cmpSemVer :: Chunk -> Chunk -> Ordering+cmpSemVer (Numeric a) (Numeric b) = compare a b+cmpSemVer (Numeric _) (Alphanum _) = LT+cmpSemVer (Alphanum _) (Numeric _) = GT+cmpSemVer (Alphanum a) (Alphanum b) = compare a b --- | Possibly traverse the inner text of a `VUnit`.-_Str :: Traversal' VUnit Text-_Str f (Str t) = Str . (\t' -> bool t t' (T.all isAlpha t')) <$> f t-_Str _ v = pure v-{-# INLINE _Str #-}+-- | Like `cmpSemVer`, but for `Version`s. We need to be mindful of comparisons+-- like @1.2.0 > 1.2.0rc1@ which normally wouldn't occur in SemVer.+cmpLenient :: Chunk -> Chunk -> Ordering+cmpLenient (Numeric a) (Numeric b) = compare a b+cmpLenient a@(Alphanum x) b@(Alphanum y) =+ case (singleDigitLenient a, singleDigitLenient b) of+ (Just i, Just j) -> compare i j+ _ -> compare x y+cmpLenient (Numeric n) b@(Alphanum _) =+ case singleDigitLenient b of+ Nothing -> GT+ Just m -> case compare n m of+ -- 1.2.0 > 1.2.0rc1+ EQ -> GT+ c -> c+cmpLenient a@(Alphanum _) (Numeric n) =+ case singleDigitLenient a of+ Nothing -> LT+ Just m -> case compare m n of+ -- 1.2.0rc1 < 1.2.0+ EQ -> LT+ c -> c --- | A logical unit of a version number. Can consist of multiple letters--- and numbers.-type VChunk = NonEmpty VUnit+-- | Like `singleDigit` but will grab a leading `Word` even if followed by+-- letters.+singleDigitLenient :: Chunk -> Maybe Word+singleDigitLenient (Numeric n) = Just n+singleDigitLenient (Alphanum s) = hush $ parse unsignedP "Single Digit Lenient" s -------------------------------------------------------------------------------- -- (Haskell) PVP@@ -467,20 +526,6 @@ deriving stock (Eq, Ord, Show, Generic) deriving anyclass (NFData, Hashable) -instance Semigroup PVP where- PVP (m :| r) <> PVP (m' :| r') = PVP $ (m + m') :| f r r'- where- f a [] = a- f [] b = b- f (a:as) (b:bs) = (a + b) : f as bs--instance Monoid PVP where- mempty = PVP (0 :| [])--#if !MIN_VERSION_base(4,11,0)- mappend = (<>)-#endif- instance Semantic PVP where major f (PVP (m :| rs)) = (\ma -> PVP $ ma :| rs) <$> f m {-# INLINE major #-}@@ -494,7 +539,7 @@ patch f (PVP (m :| [])) = (\pa' -> PVP $ m :| 0 : [pa']) <$> f 0 {-# INLINE patch #-} - release f p = p <$ f []+ release f p = p <$ f Nothing {-# INLINE release #-} meta f p = p <$ f Nothing@@ -503,105 +548,64 @@ semantic f (PVP (m :| rs)) = (\(SemVer ma mi pa _ _) -> PVP $ ma :| [mi, pa]) <$> f s where s = case rs of- mi : pa : _ -> SemVer m mi pa [] Nothing- mi : _ -> SemVer m mi 0 [] Nothing- [] -> SemVer m 0 0 [] Nothing+ mi : pa : _ -> SemVer m mi pa Nothing Nothing+ mi : _ -> SemVer m mi 0 Nothing Nothing+ [] -> SemVer m 0 0 Nothing Nothing {-# INLINE semantic #-} -------------------------------------------------------------------------------- -- (General) Version --- | A (General) Version.--- Not quite as ideal as a `SemVer`, but has some internal consistancy--- from version to version.+-- | A version number with decent structure and comparison logic. ----- Generally conforms to the @a.b.c-p@ pattern, and may optionally have an--- /epoch/ and /metadata/. Epochs are prefixes marked by a colon, like in--- @1:2.3.4@. Metadata is prefixed by @+@, and like SemVer must appear after--- the "prerelease" (the @-p@).+-- This is a /descriptive/ scheme, meaning that it encapsulates the most common,+-- unconscious patterns that developers use when assigning version numbers to+-- their software. If not `SemVer`, most version numbers found in the wild will+-- parse as a `Version`. These generally conform to the @x.x.x-x@ pattern, and+-- may optionally have an /epoch/. --+-- Epochs are prefixes marked by a colon, like in @1:2.3.4@. When comparing two+-- `Version` values, epochs take precedent. So @2:1.0.0 > 1:9.9.9@. If one of+-- the given `Version`s has no epoch, its epoch is assumed to be 0.+-- -- Examples of @Version@ that are not @SemVer@: 0.25-2, 8.u51-1, 20150826-1, -- 1:2.3.4 data Version = Version { _vEpoch :: !(Maybe Word)- , _vChunks :: !(NonEmpty VChunk)- , _vRel :: ![VChunk]+ , _vChunks :: !Chunks+ , _vRel :: !(Maybe Release) , _vMeta :: !(Maybe Text) } deriving stock (Eq, Show, Generic) deriving anyclass (NFData, Hashable) -instance Semigroup Version where- Version e c m r <> Version e' c' m' r' = Version ((+) <$> e <*> e') (c <> c') (m <> m') (r <> r')- -- | Customized. As in SemVer, metadata is ignored for the purpose of -- comparison. instance Ord Version where- -- | For the purposes of Versions with epochs, `Nothing` is the same as `Just 0`,- -- so we need to compare their actual version numbers.- compare (Version ae as rs _) (Version be bs rs' _) = case compare (fromMaybe 0 ae) (fromMaybe 0 be) of- EQ -> case g (NEL.toList as) (NEL.toList bs) of- -- If the two Versions were otherwise equal and recursed down this far,- -- we need to compare them by their "release" values.- EQ -> g rs rs'+ -- If two epochs are equal, we need to compare their actual version numbers.+ -- Otherwise, the comparison of the epochs is the only thing that matters.+ compare (Version mae ac ar _) (Version mbe bc br _) =+ case compare ae be of+ EQ -> case compare ac bc of+ EQ -> compare ar br+ ord -> ord ord -> ord- ord -> ord where- g :: [VChunk] -> [VChunk] -> Ordering- g [] [] = EQ-- -- | If all chunks up until this point were equal, but one side continues- -- on with "lettered" sections, these are considered to be indicating a- -- beta\/prerelease, and thus are /less/ than the side who already ran out- -- of chunks.- g [] ((Str _ :| _):_) = GT- g ((Str _ :| _):_) [] = LT-- -- | If one side has run out of chunks to compare but the other hasn't,- -- the other must be newer.- g _ [] = GT- g [] _ = LT-- -- | The usual case.- g (x:xs) (y:ys) = case f (NEL.toList x) (NEL.toList y) of- EQ -> g xs ys- res -> res-- f :: [VUnit] -> [VUnit] -> Ordering- f [] [] = EQ-- -- | Opposite of the above. If we've recursed this far and one side- -- has fewer chunks, it must be the "greater" version. A Chunk break- -- only occurs in a switch from digits to letters and vice versa, so- -- anything "extra" must be an @rc@ marking or similar. Consider @1.1@- -- compared to @1.1rc1@.- f [] _ = GT- f _ [] = LT-- -- | The usual case.- f (Digits n:ns) (Digits m:ms) | n > m = GT- | n < m = LT- | otherwise = f ns ms- f (Str n:ns) (Str m:ms) | n > m = GT- | n < m = LT- | otherwise = f ns ms-- -- | An arbitrary decision to prioritize digits over letters.- f (Digits _ :_) (Str _ :_) = GT- f (Str _ :_ ) (Digits _ :_) = LT+ ae = fromMaybe 0 mae+ be = fromMaybe 0 mbe instance Semantic Version where- major f (Version e ((Digits n :| []) :| cs) me rs) =- (\n' -> Version e ((Digits n' :| []) :| cs) me rs) <$> f n+ major f (Version e (Chunks (Numeric n :| cs)) me rs) =+ (\n' -> Version e (Chunks $ Numeric n' :| cs) me rs) <$> f n major _ v = pure v {-# INLINE major #-} - minor f (Version e (c :| (Digits n :| []) : cs) me rs) =- (\n' -> Version e (c :| (Digits n' :| []) : cs) me rs) <$> f n+ minor f (Version e (Chunks (c :| Numeric n : cs)) me rs) =+ (\n' -> Version e (Chunks $ c :| Numeric n' : cs) me rs) <$> f n minor _ v = pure v {-# INLINE minor #-} - patch f (Version e (c :| d : (Digits n :| []) : cs) me rs) =- (\n' -> Version e (c :| d : (Digits n' :| []) : cs) me rs) <$> f n+ patch f (Version e (Chunks (c :| d : Numeric n : cs)) me rs) =+ (\n' -> Version e (Chunks $ c :| d : Numeric n' : cs) me rs) <$> f n patch _ v = pure v {-# INLINE patch #-} @@ -613,7 +617,7 @@ meta _ v = pure v {-# INLINE meta #-} - semantic f (Version _ ((Digits a:|[]) :| (Digits b:|[]) : (Digits c:|[]) : _) rs me) =+ semantic f (Version _ (Chunks (Numeric a :| Numeric b : Numeric c : _)) rs me) = vFromS <$> f (SemVer a b c rs me) semantic _ v = pure v {-# INLINE semantic #-}@@ -623,6 +627,23 @@ epoch f v = fmap (\ve -> v { _vEpoch = ve }) (f $ _vEpoch v) {-# INLINE epoch #-} +-- | `Chunk`s that have a comparison behaviour specific to `Version`.+newtype Chunks = Chunks (NonEmpty Chunk)+ deriving stock (Eq, Show, Generic)+ deriving anyclass (NFData, Hashable)++instance Ord Chunks where+ compare (Chunks as) (Chunks bs) =+ fromMaybe EQ . listToMaybe . mapMaybe f $ zipLongest (NEL.toList as) (NEL.toList bs)+ where+ f :: These Chunk Chunk -> Maybe Ordering+ f (Both a b) = case cmpLenient a b of+ LT -> Just LT+ GT -> Just GT+ EQ -> Nothing+ f (This _) = Just GT+ f (That _) = Just LT+ -------------------------------------------------------------------------------- -- (Complex) Mess @@ -688,11 +709,11 @@ -- | Okay, fine, say `messPatch` couldn't find a nice value. But some `Mess`es -- have a "proper" patch-plus-release-candidate value in their patch position,--- which is parsable as a `VChunk`.+-- which is parsable as a `Chunk`. -- -- Example: @1.6.0a+2014+m872b87e73dfb-1@ We should be able to extract @0a@ safely.-messPatchChunk :: Mess -> Maybe VChunk-messPatchChunk (Mess (_ :| _ : MPlain p : _) _) = hush $ parse (chunkWith unit) "Chunk" p+messPatchChunk :: Mess -> Maybe Chunk+messPatchChunk (Mess (_ :| _ : MPlain p : _) _) = hush $ parse chunkP "Chunk" p messPatchChunk _ = Nothing instance Ord Mess where@@ -727,7 +748,7 @@ -- | Good luck. semantic f (Mess (MDigit t0 _ :| MDigit t1 _ : MDigit t2 _ : _) _) =- mFromV . vFromS <$> f (SemVer t0 t1 t2 [] Nothing)+ mFromV . vFromS <$> f (SemVer t0 t1 t2 Nothing Nothing) semantic _ v = pure v {-# INLINE semantic #-} @@ -736,9 +757,10 @@ -- -- * A colon (:). Often denotes an "epoch". -- * A hyphen (-).+-- * A tilde (~). Example: @12.0.0-3ubuntu1~20.04.5@ -- * A plus (+). Stop using this outside of metadata if you are. Example: @10.2+0.93+1-1@ -- * An underscore (_). Stop using this if you are.-data VSep = VColon | VHyphen | VPlus | VUnder+data VSep = VColon | VHyphen | VPlus | VUnder | VTilde deriving stock (Eq, Show, Generic) deriving anyclass (NFData, Hashable) @@ -769,24 +791,50 @@ semver' = L.lexeme space semver'' semver'' :: Parsec Void Text SemVer-semver'' = SemVer <$> majorP <*> minorP <*> patchP <*> preRel <*> optional metaData+semver'' = SemVer <$> majorP <*> minorP <*> patchP <*> optional releaseP <*> optional metaData -- | Parse a group of digits, which can't be lead by a 0, unless it is 0.-digitsP :: Parsec Void Text Word-digitsP = read <$> ((T.unpack <$> string "0") <|> some digitChar)+unsignedP :: Parsec Void Text Word+unsignedP = (0 <$ char '0') <|> decimal majorP :: Parsec Void Text Word-majorP = digitsP <* char '.'+majorP = unsignedP <* char '.' minorP :: Parsec Void Text Word minorP = majorP patchP :: Parsec Void Text Word-patchP = digitsP+patchP = unsignedP -preRel :: Parsec Void Text [VChunk]-preRel = (char '-' *> chunks) <|> pure []+releaseP :: Parsec Void Text Release+releaseP = char '-' *> fmap Release (chunkP `PC.sepBy1` char '.') +chunkP :: Parsec Void Text Chunk+chunkP = try alphanumP <|> numericP++alphanumP :: Parsec Void Text Chunk+alphanumP = do+ ids <- takeWhile1P (Just "Hyphenated Alphanums") (\c -> isAlphaNum c || c == '-')+ -- It's okay for this to `fail` like this, since this fail is caught higher up+ -- in `chunkP` and another parser which should be guaranteed to succeed is+ -- called. It's guaranteed since by this point we /did/ parse something, but+ -- the test below proves it contains only numbers. Therefore the fallback call+ -- to `numericP` should succeed.+ unless (T.any (\c -> isAlpha c || c == '-') ids) $ fail "Only numeric!"+ pure $ Alphanum ids++alphanumWithoutHyphensP :: Parsec Void Text Chunk+alphanumWithoutHyphensP = do+ ids <- takeWhile1P (Just "Unhyphenated Alphanums") isAlphaNum+ unless (T.any isAlpha ids) $ fail "Only numeric!"+ pure $ Alphanum ids++numericP :: Parsec Void Text Chunk+numericP = Numeric <$> unsignedP++chunkWithoutHyphensP :: Parsec Void Text Chunk+chunkWithoutHyphensP = try alphanumWithoutHyphensP <|> numericP+ metaData :: Parsec Void Text Text metaData = do void $ char '+'@@ -795,46 +843,6 @@ section :: Parsec Void Text Text section = takeWhile1P (Just "Metadata char") (\c -> isAlphaNum c || c == '-') -chunksNE :: Parsec Void Text (NonEmpty VChunk)-chunksNE = chunkWith unit' `PC.sepBy1` char '.'--chunks :: Parsec Void Text [VChunk]-chunks = chunkWith unit `sepBy` char '.'---- | Handling @0@ is a bit tricky. We can't allow runs of zeros in a chunk,--- since a version like @1.000.1@ would parse as @1.0.1@.-chunkWith :: Parsec Void Text VUnit -> Parsec Void Text VChunk-chunkWith u = try zeroWithLetters <|> oneZero <|> PC.some u- where- oneZero :: Parsec Void Text (NonEmpty VUnit)- oneZero = (Digits 0 :| []) <$ single '0'-- zeroWithLetters :: Parsec Void Text (NonEmpty VUnit)- zeroWithLetters = do- z <- Digits 0 <$ single '0'- s <- PC.some sunit- c <- optional (chunkWith u)- case c of- Nothing -> pure $ NEL.cons z s- Just c' -> pure $ NEL.cons z s <> c'--unit :: Parsec Void Text VUnit-unit = iunit <|> sunit--unit' :: Parsec Void Text VUnit-unit' = iunit <|> sunit'--iunit :: Parsec Void Text VUnit-iunit = Digits <$> ((0 <$ single '0') <|> (read <$> some digitChar))--sunit :: Parsec Void Text VUnit-sunit = Str . T.pack <$> some (letterChar <|> single '-')---- | Same as `sunit`, but don't allow hyphens. Intended for the main body of--- `Version`.-sunit' :: Parsec Void Text VUnit-sunit' = Str . T.pack <$> some letterChar- -- | Parse a (Haskell) `PVP`, as defined above. pvp :: Text -> Either ParsingError PVP pvp = parse (pvp' <* eof) "PVP"@@ -852,11 +860,14 @@ version' = L.lexeme space version'' version'' :: Parsec Void Text Version-version'' = Version <$> optional (try epochP) <*> chunksNE <*> preRel <*> optional metaData+version'' = Version <$> optional (try epochP) <*> chunksP <*> optional releaseP <*> optional metaData epochP :: Parsec Void Text Word epochP = read <$> (some digitChar <* char ':') +chunksP :: Parsec Void Text Chunks+chunksP = Chunks <$> chunkWithoutHyphensP `PC.sepBy1` char '.'+ -- | Parse a (Complex) `Mess`, as defined above. mess :: Text -> Either ParsingError Mess mess = parse (mess'' <* eof) "Mess"@@ -883,13 +894,15 @@ sep = choice [ VColon <$ char ':' , VHyphen <$ char '-' , VPlus <$ char '+'- , VUnder <$ char '_' ]+ , VUnder <$ char '_'+ , VTilde <$ char '~' ] sepCh :: VSep -> Char sepCh VColon = ':' sepCh VHyphen = '-' sepCh VPlus = '+' sepCh VUnder = '_'+sepCh VTilde = '~' -- | Convert any parsed Versioning type to its textual representation. prettyV :: Versioning -> Text@@ -902,8 +915,8 @@ prettySemVer (SemVer ma mi pa pr me) = mconcat $ ver <> pr' <> me' where ver = intersperse "." [ showt ma, showt mi, showt pa ]- pr' = foldable [] ("-" :) $ intersperse "." (chunksAsT pr)- me' = maybe [] (\m -> ["+",m]) me+ pr' = maybe [] (\m -> ["-", prettyRelease m]) pr+ me' = maybe [] (\m -> ["+", m]) me -- | Convert a `PVP` back to its textual representation. prettyPVP :: PVP -> Text@@ -911,12 +924,12 @@ -- | Convert a `Version` back to its textual representation. prettyVer :: Version -> Text-prettyVer (Version ep cs pr me) = ep' <> mconcat (ver <> pr' <> me')+prettyVer (Version ep cs pr me) = mconcat $ ep' <> [ver] <> pr' <> me' where- ver = intersperse "." . chunksAsT $ NEL.toList cs- me' = maybe [] (\m -> ["+",m]) me- pr' = foldable [] ("-" :) $ intersperse "." (chunksAsT pr)- ep' = maybe "" (\e -> showt e <> ":") ep+ ver = prettyChunks cs+ me' = maybe [] (\m -> ["+", m]) me+ pr' = maybe [] (\m -> ["-", prettyRelease m]) pr+ ep' = maybe [] (\e -> [showt e, ":"]) ep -- | Convert a `Mess` back to its textual representation. prettyMess :: Mess -> Text@@ -927,27 +940,19 @@ t' :: Text t' = fold . NEL.intersperse "." $ NEL.map mchunkText t -chunksAsT :: Functor t => t VChunk -> t Text-chunksAsT = fmap (foldMap f)- where- f :: VUnit -> Text- f (Digits i) = showt i- f (Str s) = s+prettyChunks :: Chunks -> Text+prettyChunks (Chunks cs) = T.intercalate "." . map prettyChunk $ NEL.toList cs -chunksAsM :: Functor t => t VChunk -> t MChunk-chunksAsM = fmap f- where- f :: VChunk -> MChunk- f (Digits i :| []) = MDigit i $ showt i- f (Str "r" :| [Digits i]) = MRev i . T.cons 'r' $ showt i- f vc = MPlain . T.concat $ chunksAsT [vc]+prettyRelease :: Release -> Text+prettyRelease (Release cs) = T.intercalate "." . map prettyChunk $ NEL.toList cs --- | Analogous to `maybe` and `either`. If a given Foldable is empty,--- a default value is returned. Else, a function is applied to that Foldable.-foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b-foldable d g f | null f = d- | otherwise = g f+prettyChunk :: Chunk -> Text+prettyChunk (Numeric n) = showt n+prettyChunk (Alphanum s) = s +--------------------------------------------------------------------------------+-- Utilities+ -- | Flip an Ordering. opposite :: Ordering -> Ordering opposite EQ = EQ@@ -961,3 +966,11 @@ hush :: Either a b -> Maybe b hush (Left _) = Nothing hush (Right b) = Just b++data These a b = This a | That b | Both a b++zipLongest :: [a] -> [b] -> [These a b]+zipLongest [] [] = []+zipLongest (a:as) (b:bs) = Both a b : zipLongest as bs+zipLongest (a:as) [] = This a : zipLongest as []+zipLongest [] (b:bs) = That b : zipLongest [] bs
test/Test.hs view
@@ -5,54 +5,20 @@ module Main ( main ) where -import Data.Char (chr) import Data.Either (fromRight, isLeft)-import Data.Foldable (fold)-import Data.List (groupBy)-import qualified Data.List.NonEmpty as NEL+import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Text as T import Data.Versions import Data.Void (Void) import Lens.Micro-import Test.QuickCheck import Test.Tasty import Test.Tasty.HUnit-import Test.Tasty.QuickCheck import Text.Megaparsec import Text.Megaparsec.Char import Text.Printf (printf) --- -instance Arbitrary SemVer where- arbitrary = SemVer <$> arbitrary <*> arbitrary <*> arbitrary <*> chunks <*> pure Nothing---- | Sane generation of VChunks.-chunks :: Gen [VChunk]-chunks = resize 10 . listOf1 . fmap simplify . resize 10 $ listOf1 arbitrary--chunksNE :: Gen (NEL.NonEmpty VChunk)-chunksNE = NEL.fromList <$> chunks--simplify :: [VUnit] -> NEL.NonEmpty VUnit-simplify = NEL.fromList . map fold . groupBy f- where f (Digits _) (Digits _) = True- f (Str _) (Str _) = True- f _ _ = False--instance Arbitrary VUnit where- arbitrary = frequency [ (1, Digits . (+ 1) <$> arbitrary) , (1, s) ]- where s = Str . T.pack . map unletter <$> resize 10 (listOf1 arbitrary)---- | An ASCII letter.-newtype Letter = Letter { unletter :: Char }--instance Arbitrary Letter where- arbitrary = Letter . chr <$> choose (97, 122)--instance Arbitrary Version where- arbitrary = Version <$> arbitrary <*> chunksNE <*> chunks <*> pure Nothing- -- | These don't need to parse as a SemVer. goodVers :: [T.Text] goodVers = [ "1", "1.2", "1.0rc0", "1.0rc1", "1.1rc1", "1.58.0-3", "44.0.2403.157-1"@@ -65,7 +31,7 @@ messes :: [T.Text] messes = [ "10.2+0.93+1-1", "003.03-3", "002.000-7", "20.26.1_0-2", "1.6.0a+2014+m872b87e73dfb-1"- , "1.3.00.16851-1", "5.2.458699.0906-1" ]+ , "1.3.00.16851-1", "5.2.458699.0906-1", "12.0.0-3ubuntu1~20.04.5" ] messComps :: [T.Text] messComps = [ "10.2+0.93+1-1", "10.2+0.93+1-2", "10.2+0.93+2-1"@@ -83,6 +49,8 @@ , "1.0.0-x-y-z.-" -- Weird metadata , "1.0.0-alpha+001", "1.0.0+21AF26D3---117B344092BD"+ -- Zeroes+ , "1.2.2-00a" ] -- | The exact example from `http://semver.org`@@ -105,13 +73,7 @@ suite :: TestTree suite = testGroup "Tests"- [ testGroup "Property Tests"- [ testProperty "SemVer - Arbitrary" $ \a -> semver (prettySemVer a) == Right a- , testProperty "Version - Arbitrary" $ \a -> version (prettyVer a) == Right a- -- , testGroup "Version - Monoid" $- -- map (\(name, test) -> testProperty name test) . unbatch $ monoid (Version (Just 1) [[digits 2], [digits 3]])- ]- , testGroup "Unit Tests"+ [ testGroup "Unit Tests" [ testGroup "(Ideal) Semantic Versioning" [ testGroup "Bad Versions (shouldn't parse)" $ map (\s -> testCase (T.unpack s) $ assertBool "A bad version parsed" $ isLeft $ semver s) badSemVs@@ -123,11 +85,10 @@ $ semver "1.2.3-alpha.2" == semver "1.2.3-alpha.2+a1b2c3.1") : zipWith (\a b -> testCase (T.unpack $ a <> " < " <> b) $ comp semver a b) semverOrd (tail semverOrd) , testGroup "Whitespace Handling"- [ testCase "1.2.3-1[ ]" $ parse semver' "semver whitespace" "1.2.3-1 " @?= Right (SemVer 1 2 3 [[Digits 1]] Nothing)+ [ testCase "1.2.3-1[ ]" $ parse semver' "semver whitespace" "1.2.3-1 " @?= Right (SemVer 1 2 3 (Just . Release $ Numeric 1 :| []) Nothing) ] , testGroup "Zero Handling"- [ testCase "2.2.1-b05" $ semver "2.2.1-b05" @?= Right (SemVer 2 2 1 [[Str "b", Digits 0, Digits 5]] Nothing)-+ [ testCase "2.2.1-b05" $ semver "2.2.1-b05" @?= Right (SemVer 2 2 1 (Just . Release $ Alphanum "b05" :| []) Nothing) ] ] , testGroup "(Haskell) PVP"@@ -167,7 +128,7 @@ , testCase "messPatch - Bad" $ (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messPatch) @?= Nothing , testCase "messPatchChunk" $- (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messPatchChunk) @?= Just [Digits 0, Str "a"]+ (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messPatchChunk) @?= Just (Alphanum "0a") ] ] , testGroup "Mixed Versioning"@@ -222,7 +183,7 @@ ] , testGroup "Megaparsec Behaviour" [ testCase "manyTill" $ parse nameGrab "manyTill" "linux-firmware-3.2.14-1-x86_64.pkg.tar.xz" @?= Right "linux-firmware"- , testCase "Extracting version" $ parse versionGrab "extraction" "linux-firmware-3.2.14-1-x86_64.pkg.tar.xz" @?= Right(Ideal $ SemVer 3 2 14 [[Digits 1, Str "-x", Digits 86]] Nothing)+ , testCase "Extracting version" $ parse versionGrab "extraction" "linux-firmware-3.2.14-1-x86_64.pkg.tar.xz" @?= Right (Ideal $ SemVer 3 2 14 (Just . Release $ Alphanum "1-x86" :| []) Nothing) ] ] ]@@ -284,8 +245,8 @@ incPatch :: Assertion incPatch = (v1 & patch %~ (+ 1)) @?= v2- where v1 = Ideal $ SemVer 1 2 3 [] Nothing- v2 = Ideal $ SemVer 1 2 4 [] Nothing+ where v1 = Ideal $ SemVer 1 2 3 Nothing Nothing+ v2 = Ideal $ SemVer 1 2 4 Nothing Nothing incFromT :: Assertion incFromT = (("1.2.3" :: T.Text) & patch %~ (+ 1)) @?= "1.2.4"
versions.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: versions-version: 5.0.5+version: 6.0.0 synopsis: Types and parsers for software version numbers. description: A library for parsing and comparing software version numbers. We like to give@@ -60,8 +60,6 @@ ghc-options: -threaded -with-rtsopts=-N build-depends: , microlens >=0.4- , QuickCheck >=2.9 , tasty >=0.10.1.2 , tasty-hunit >=0.9.2- , tasty-quickcheck >=0.8 , versions