versions 3.5.4 → 4.0.0
raw patch · 5 files changed
+328/−193 lines, 5 filesdep +parser-combinatorssetup-changed
Dependencies added: parser-combinators
Files
- CHANGELOG.md +35/−0
- Data/Versions.hs +249/−170
- Setup.hs +0/−2
- test/Test.hs +42/−20
- versions.cabal +2/−1
CHANGELOG.md view
@@ -1,5 +1,40 @@ # Changelog +## 4.0.0 (2020-10-20)++#### Changed++- **Breaking:** `VChunk` now cannot be empty.+- **Breaking:** A `Version` now guarantees `NonEmpty` chunks.+- **Breaking:** A `Mess` now guarantees `NonEmpty` chunks, and its structure has+ been significantly changed. Particularly, `Mess` values are now aware of the+ `Int` values they hold (when they do), as well as "revision" values of the+ pattern `rXYZ`.+- Comparison of `Version` values is more memory efficient.++#### Added++- `Version` now has an extra field, `_vMeta :: [VChunk]` for capturing+ "metadata" like Semver. This prevents otherwise nice-looking versions from+ being demoted to `Mess`.+- The `MChunk` type to accomodate the changes to `Mess` mentioned above.++#### Removed++- **Breaking:** `Version` no longer has a `Monoid` instance.++#### Fixed++- `""` no longer parses in any way. [#32]+- Version strings with trailing whitespace no longer parse via `versioning`. [#33]+- Particular edge cases involving `Mess` comparisons. [aura#646]+- A particular edge case involving prereleases in `Version` comparisons. [aura#586]++[#32]: https://github.com/fosskers/versions/issues/32+[#33]: https://github.com/fosskers/versions/issues/33+[aura#646]: https://github.com/fosskers/aura/issues/646+[aura#586]: https://github.com/fosskers/aura/issues/586+ ## 3.5.4 (2020-05-12) #### Added
Data/Versions.hs view
@@ -31,7 +31,7 @@ -- -- == Using the Parsers -- In general, `versioning` is the function you want. It attempts to parse a--- given `T.Text` using the three individual parsers, `semver`, `version` and+-- given `Text` using the three individual parsers, `semver`, `version` and -- `mess`. If one fails, it tries the next. If you know you only want to parse -- one specific version type, use that parser directly (e.g. `semver`). @@ -42,6 +42,7 @@ , PVP(..) , Version(..) , Mess(..), messMajor, messMinor, messPatch, messPatchChunk+ , MChunk(..) , VUnit(..), digits, str , VChunk , VSep(..)@@ -58,7 +59,7 @@ , Traversal' , Semantic(..) -- ** Traversing Text- -- | When traversing `T.Text`, leveraging its `Semantic` instance will+ -- | When traversing `Text`, leveraging its `Semantic` instance will -- likely benefit you more than using these Traversals directly. , _Versioning, _SemVer, _Version, _Mess -- ** Versioning Traversals@@ -69,13 +70,17 @@ , _Digits, _Str ) where +import qualified Control.Applicative.Combinators.NonEmpty as PC import Control.DeepSeq+import Control.Monad (void) import Data.Bool (bool) import Data.Char (isAlpha)+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.Text (Text) import qualified Data.Text as T import Data.Void (Void) import GHC.Generics (Generic)@@ -133,15 +138,27 @@ -- | Convert a `SemVer` to a `Version`. vFromS :: SemVer -> Version-vFromS (SemVer m i p r _) = Version Nothing [[Digits m], [Digits i], [Digits p]] r+vFromS (SemVer ma mi pa re me) =+ Version Nothing ((Digits ma :| []) :| [(Digits mi :| []), Digits pa :| []]) re me -- | Convert a `Version` to a `Mess`. mFromV :: Version -> Mess-mFromV (Version e v r) = maybe affix (\a -> VNode [showt a] VColon affix) e+mFromV (Version e v m r) = maybe affix (\a -> Mess (MDigit a (showt a) :| []) $ Just (VColon, affix)) e where affix :: Mess- affix = VNode (chunksAsT v) VHyphen $ VLeaf (chunksAsT r)+ affix = Mess (chunksAsM v) m' + m' :: Maybe (VSep, Mess)+ m' = case NEL.nonEmpty m of+ Nothing -> r'+ Just m'' -> Just (VPlus, Mess (chunksAsM m'') r')++ r' :: Maybe (VSep, Mess)+ r' = case NEL.nonEmpty r of+ Nothing -> Nothing+ Just r'' -> Just (VHyphen, Mess (chunksAsM r'') Nothing)++ -- | 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, -- and in some cases can offer better comparison results.@@ -163,7 +180,7 @@ Just EQ -> fallback Nothing -> case messPatchChunk m of Nothing -> fallback- Just (Digits pa':_) -> case compare pa pa' of+ Just (Digits pa':|_) -> case compare pa pa' of LT -> LT GT -> GT EQ -> GT -- This follows semver's rule!@@ -209,22 +226,22 @@ -- λ "1.2.3" & _Versioning . _Ideal . patch %~ (+ 1) -- or just: "1.2.3" & patch %~ (+ 1) -- "1.2.4" -- @-_Versioning :: Traversal' T.Text Versioning+_Versioning :: Traversal' Text Versioning _Versioning f t = either (const (pure t)) (fmap prettyV . f) $ versioning t {-# INLINE _Versioning #-} -- | Traverse some Text for its inner SemVer.-_SemVer :: Traversal' T.Text SemVer+_SemVer :: Traversal' Text SemVer _SemVer f t = either (const (pure t)) (fmap prettySemVer . f) $ semver t {-# INLINE _SemVer #-} -- | Traverse some Text for its inner Version.-_Version :: Traversal' T.Text Version+_Version :: Traversal' Text Version _Version f t = either (const (pure t)) (fmap prettyVer . f) $ version t {-# INLINE _Version #-} -- | Traverse some Text for its inner Mess.-_Mess :: Traversal' T.Text Mess+_Mess :: Traversal' Text Mess _Mess f t = either (const (pure t)) (fmap prettyMess . f) $ mess t {-# INLINE _Mess #-} @@ -289,7 +306,7 @@ -- | A Natural Transformation into an proper `SemVer`. semantic :: Traversal' v SemVer -instance Semantic T.Text where+instance Semantic Text where major = _Versioning . major minor = _Versioning . minor patch = _Versioning . patch@@ -317,11 +334,11 @@ -- -- For more information, see http://semver.org data SemVer = SemVer- { _svMajor :: Word- , _svMinor :: Word- , _svPatch :: Word- , _svPreRel :: [VChunk]- , _svMeta :: [VChunk] }+ { _svMajor :: !Word+ , _svMinor :: !Word+ , _svPatch :: !Word+ , _svPreRel :: ![VChunk]+ , _svMeta :: ![VChunk] } deriving stock (Show, Generic) deriving anyclass (NFData, Hashable) @@ -375,7 +392,7 @@ -- | 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 T.Text+data VUnit = Digits Word | Str Text deriving stock (Eq, Show, Read, Ord, Generic) deriving anyclass (NFData, Hashable) @@ -397,7 +414,7 @@ digits = Digits -- | Smart constructor for a `VUnit` made of letters.-str :: T.Text -> Maybe VUnit+str :: Text -> Maybe VUnit str t = bool Nothing (Just $ Str t) $ T.all isAlpha t _Digits :: Traversal' VUnit Word@@ -405,14 +422,14 @@ _Digits _ v = pure v {-# INLINE _Digits #-} -_Str :: Traversal' VUnit T.Text+_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 #-} -- | A logical unit of a version number. Can consist of multiple letters -- and numbers.-type VChunk = [VUnit]+type VChunk = NonEmpty VUnit -------------------------------------------------------------------------------- -- (Haskell) PVP@@ -485,26 +502,24 @@ -- | A (General) Version. -- Not quite as ideal as a `SemVer`, but has some internal consistancy -- from version to version.--- Generally conforms to the @x.x.x-x@ pattern, and may optionally have an /epoch/.--- These are prefixes marked by a colon, like in @1:2.3.4@. ----- Examples of @Version@ that are not @SemVer@: 0.25-2, 8.u51-1, 20150826-1, 1:2.3.4+-- 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 unlike SemVer can appear before+-- the "prerelease" (the @-p@).+--+-- Examples of @Version@ that are not @SemVer@: 0.25-2, 8.u51-1, 20150826-1,+-- 1:2.3.4, 1.11.0+20200830-1 data Version = Version- { _vEpoch :: Maybe Word- , _vChunks :: [VChunk]- , _vRel :: [VChunk] }+ { _vEpoch :: !(Maybe Word)+ , _vChunks :: !(NonEmpty VChunk)+ , _vMeta :: ![VChunk]+ , _vRel :: ![VChunk] } deriving stock (Eq, Show, Generic) deriving anyclass (NFData, Hashable) instance Semigroup Version where- Version e c r <> Version e' c' r' = Version ((+) <$> e <*> e') (c ++ c') (r ++ r')--instance Monoid Version where- mempty = Version Nothing [] []--#if !MIN_VERSION_base(4,11,0)- mappend = (<>)-#endif+ Version e c m r <> Version e' c' m' r' = Version ((+) <$> e <*> e') (c <> c') (m <> m') (r <> r') -- | Set a `Version`'s epoch to `Nothing`. wipe :: Version -> Version@@ -512,71 +527,84 @@ -- | Customized. instance Ord Version where- -- | The obvious base case.- compare (Version _ [] []) (Version _ [] []) = EQ- -- | For the purposes of Versions with epochs, `Nothing` is the same as `Just 0`, -- so we need to compare their actual version numbers.- compare v0@(Version (Just 0) _ _) v1@(Version Nothing _ _) = compare (wipe v0) v1- compare v0@(Version Nothing _ _) v1@(Version (Just 0) _ _) = compare v0 (wipe v1)+ compare v0@(Version (Just 0) _ _ _) v1@(Version Nothing _ _ _) = compare (wipe v0) v1+ compare v0@(Version Nothing _ _ _) v1@(Version (Just 0) _ _ _) = compare v0 (wipe v1) -- | If a version has an epoch > 1 and the other has no epoch, the first will -- be considered greater.- compare (Version (Just _) _ _) (Version Nothing _ _) = GT- compare (Version Nothing _ _) (Version (Just _) _ _) = LT+ compare (Version (Just _) _ _ _) (Version Nothing _ _ _) = GT+ compare (Version Nothing _ _ _) (Version (Just _) _ _ _) = LT -- | 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 v0@(Version (Just n) _ _) v1@(Version (Just m) _ _) | n == m = compare (wipe v0) (wipe v1)- | otherwise = compare n m-- -- | If the two Versions were otherwise equal and recursed down this far,- -- we need to compare them by their "release" values.- compare (Version _ [] rs) (Version _ [] rs') = compare (Version Nothing rs []) (Version Nothing rs' [])-- -- | If one side has run out of chunks to compare but the other hasn't,- -- the other must be newer.- compare Version{} (Version _ [] _) = GT- compare (Version _ [] _) Version{} = LT+ compare v0@(Version (Just n) _ _ _) v1@(Version (Just m) _ _ _) | n == m = compare (wipe v0) (wipe v1)+ | otherwise = compare n m -- | The usual case. If first VChunks of each Version is equal, then we keep -- recursing. Otherwise, we don't need to check further. Consider @1.2@ -- compared to @1.1.3.4.5.6@.- compare (Version _ (a:as) rs) (Version _ (b:bs) rs') = case f a b of- EQ -> compare (Version Nothing as rs) (Version Nothing bs rs')- res -> res- where f [] [] = EQ+ compare (Version _ as _ rs) (Version _ bs _ rs') = g (NEL.toList as) (NEL.toList bs)+ where+ g :: [VChunk] -> [VChunk] -> Ordering+ -- | If the two Versions were otherwise equal and recursed down this far,+ -- we need to compare them by their "release" values.+ g [] [] = g rs rs' - -- | 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+ -- | 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 - -- | 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+ -- | If one side has run out of chunks to compare but the other hasn't,+ -- the other must be newer.+ g _ [] = GT+ g [] _ = LT - -- | An arbitrary decision to prioritize digits over letters.- f (Digits _ :_) (Str _ :_) = GT- f (Str _ :_ ) (Digits _ :_) = 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+ instance Semantic Version where- major f (Version e ([Digits n] : cs) rs) = (\n' -> Version e ([Digits n'] : cs) rs) <$> f n+ major f (Version e ((Digits n :| []) :| cs) me rs) =+ (\n' -> Version e ((Digits n' :| []) :| cs) me rs) <$> f n major _ v = pure v {-# INLINE major #-} - minor f (Version e (c : [Digits n] : cs) rs) = (\n' -> Version e (c : [Digits n'] : cs) rs) <$> f n+ minor f (Version e (c :| (Digits n :| []) : cs) me rs) =+ (\n' -> Version e (c :| (Digits n' :| []) : cs) me rs) <$> f n minor _ v = pure v {-# INLINE minor #-} - patch f (Version e (c : d : [Digits n] : cs) rs) = (\n' -> Version e (c : d : [Digits n'] : cs) rs) <$> f n+ patch f (Version e (c :| d : (Digits n :| []) : cs) me rs) =+ (\n' -> Version e (c :| d : (Digits n' :| []) : cs) me rs) <$> f n patch _ v = pure v {-# INLINE patch #-} @@ -588,7 +616,8 @@ meta _ v = pure v {-# INLINE meta #-} - semantic f (Version _ ([Digits a] : [Digits b] : [Digits c] : _) rs) = vFromS <$> f (SemVer a b c rs [])+ semantic f (Version _ ((Digits a:|[]) :| (Digits b:|[]) : (Digits c:|[]) : _) me rs) =+ vFromS <$> f (SemVer a b c me rs) semantic _ v = pure v {-# INLINE semantic #-} @@ -599,15 +628,37 @@ -------------------------------------------------------------------------------- -- (Complex) Mess +-- | Possible values of a section of a `Mess`. A numeric value is extracted if+-- it could be, alongside the original text it came from. This preserves both+-- `Ord` and pretty-print behaviour for versions like @1.003.0@.+data MChunk+ = MDigit Word Text+ -- ^ A nice numeric value.+ | MRev Word Text+ -- ^ A numeric value preceeded by an @r@, indicating a revision.+ | MPlain Text+ -- ^ Anything else.+ deriving stock (Eq, Show, Generic)+ deriving anyclass (NFData, Hashable)++instance Ord MChunk where+ compare (MDigit a _) (MDigit b _) = compare a b+ compare (MRev a _) (MRev b _) = compare a b+ compare (MPlain a) (MPlain b) = compare a b+ compare a b = compare (mchunkText a) (mchunkText b)++-- | A total extraction of the `Text` from an `MChunk`.+mchunkText :: MChunk -> Text+mchunkText (MDigit _ t) = t+mchunkText (MRev _ t) = t+mchunkText (MPlain t) = t+ -- | A (Complex) Mess. This is a /descriptive/ parser, based on examples of -- stupidly crafted version numbers used in the wild. -- -- Groups of letters/numbers, separated by a period, can be further separated by -- the symbols @_-+:@ ----- Unfortunately, @VChunk@s cannot be used here, as some developers have numbers--- like @1.003.04@ which make parsers quite sad.--- -- Some `Mess` values have a shape that is tantalizingly close to a `SemVer`. -- Example: @1.6.0a+2014+m872b87e73dfb-1@. For values like these, we can extract -- the semver-compatible values out with `messMajor`, etc.@@ -615,27 +666,27 @@ -- Not guaranteed to have well-defined ordering (@Ord@) behaviour, but so far -- internal tests show consistency. `messMajor`, etc., are used internally where -- appropriate to enhance accuracy.-data Mess = VLeaf [T.Text] | VNode [T.Text] VSep Mess+data Mess = Mess !(NonEmpty MChunk) !(Maybe (VSep, Mess)) deriving stock (Eq, Show, Generic) deriving anyclass (NFData, Hashable) -- | Try to extract the "major" version number from `Mess`, as if it were a -- `SemVer`. messMajor :: Mess -> Maybe Word-messMajor (VNode (m:_) _ _) = hush $ parse (digitsP <* eof) "Major" m-messMajor _ = Nothing+messMajor (Mess (MDigit i _ :| _) _) = Just i+messMajor _ = Nothing -- | Try to extract the "minor" version number from `Mess`, as if it were a -- `SemVer`. messMinor :: Mess -> Maybe Word-messMinor (VNode (_:m:_) _ _) = hush $ parse (digitsP <* eof) "Minor" m-messMinor _ = Nothing+messMinor (Mess (_ :| MDigit i _ : _) _) = Just i+messMinor _ = Nothing -- | Try to extract the "patch" version number from `Mess`, as if it were a -- `SemVer`. messPatch :: Mess -> Maybe Word-messPatch (VNode (_:_:p:_) _ _) = hush $ parse (digitsP <* eof) "Patch" p-messPatch _ = Nothing+messPatch (Mess (_ :| _ : MDigit i _ : _) _) = Just i+messPatch _ = Nothing -- | 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,@@ -643,30 +694,29 @@ -- -- Example: @1.6.0a+2014+m872b87e73dfb-1@ We should be able to extract @0a@ safely. messPatchChunk :: Mess -> Maybe VChunk-messPatchChunk (VNode (_:_:p:_) _ _) = hush $ parse chunk "Chunk" p-messPatchChunk _ = Nothing+messPatchChunk (Mess (_ :| _ : MPlain p : _) _) = hush $ parse chunk "Chunk" p+messPatchChunk _ = Nothing instance Ord Mess where- compare (VLeaf l1) (VLeaf l2) = compare l1 l2- compare (VNode t1 _ _) (VLeaf t2) = compare t1 t2- compare (VLeaf t1) (VNode t2 _ _) = compare t1 t2- compare (VNode t1 _ v1) (VNode t2 _ v2) | t1 < t2 = LT- | t1 > t2 = GT- | otherwise = compare v1 v2+ compare (Mess t1 Nothing) (Mess t2 Nothing) = compare t1 t2+ compare (Mess t1 m1) (Mess t2 m2) = case compare t1 t2 of+ EQ -> case (m1, m2) of+ (Just (_, v1), Just (_, v2)) -> compare v1 v2+ (Just (_, _), Nothing) -> GT+ (Nothing, Just (_, _)) -> LT+ (Nothing, Nothing) -> EQ+ res -> res instance Semantic Mess where- major f v@(VNode (t : ts) s ms) = either (const $ pure v) g $ parse digitsP "Major" t- where g n = (\n' -> VNode (showt n' : ts) s ms) <$> f n+ major f (Mess (MDigit n _ :| ts) m) = (\n' -> Mess (MDigit n' (showt n') :| ts) m) <$> f n major _ v = pure v {-# INLINE major #-} - minor f v@(VNode (t0 : t : ts) s ms) = either (const $ pure v) g $ parse digitsP "Minor" t- where g n = (\n' -> VNode (t0 : showt n' : ts) s ms) <$> f n+ minor f (Mess (t0 :| MDigit n _ : ts) m) = (\n' -> Mess (t0 :| MDigit n' (showt n') : ts) m) <$> f n minor _ v = pure v {-# INLINE minor #-} - patch f v@(VNode (t0 : t1 : t : ts) s ms) = either (const $ pure v) g $ parse digitsP "Patch" t- where g n = (\n' -> VNode (t0 : t1 : showt n' : ts) s ms) <$> f n+ patch f (Mess (t0 :| t1 : MDigit n _ : ts) m) = (\n' -> Mess (t0 :| t1 : MDigit n' (showt n') : ts) m) <$> f n patch _ v = pure v {-# INLINE patch #-} @@ -679,11 +729,8 @@ {-# INLINE meta #-} -- | Good luck.- semantic f v@(VNode (t0 : t1 : t2 : _) _ _) = either (const $ pure v) (fmap (mFromV . vFromS)) $- (\a b c -> f $ SemVer a b c [] [])- <$> parse digitsP "Major" t0- <*> parse digitsP "Minor" t1- <*> parse digitsP "Patch" t2+ semantic f (Mess (MDigit t0 _ :| MDigit t1 _ : MDigit t2 _ : _) _) =+ mFromV . vFromS <$> (f $ SemVer t0 t1 t2 [] []) semantic _ v = pure v {-# INLINE semantic #-} @@ -702,104 +749,120 @@ -- Parsing -- | A synonym for the more verbose `megaparsec` error type.-type ParsingError = ParseErrorBundle T.Text Void+type ParsingError = ParseErrorBundle Text Void --- | Parse a piece of `T.Text` into either an (Ideal) `SemVer`, a (General)+-- | Parse a piece of `Text` into either an (Ideal) `SemVer`, a (General) -- `Version`, or a (Complex) `Mess`.-versioning :: T.Text -> Either ParsingError Versioning+versioning :: Text -> Either ParsingError Versioning versioning = parse versioning' "versioning" -- | Parse a `Versioning`. Assumes the version number is the last token in -- the string.-versioning' :: Parsec Void T.Text Versioning-versioning' = choice [ try (fmap Ideal semver' <* eof)- , try (fmap General version' <* eof)- , fmap Complex mess' <* eof ]+versioning' :: Parsec Void Text Versioning+versioning' = choice [ try (fmap Ideal semver'' <* eof)+ , try (fmap General version'' <* eof)+ , fmap Complex mess'' <* eof ] -- | Parse a (Ideal) Semantic Version.-semver :: T.Text -> Either ParsingError SemVer-semver = parse (semver' <* eof) "Semantic Version"+semver :: Text -> Either ParsingError SemVer+semver = parse (semver'' <* eof) "Semantic Version" -- | Internal megaparsec parser of `semver`.-semver' :: Parsec Void T.Text SemVer-semver' = L.lexeme space (SemVer <$> majorP <*> minorP <*> patchP <*> preRel <*> metaData)+semver' :: Parsec Void Text SemVer+semver' = L.lexeme space semver'' +semver'' :: Parsec Void Text SemVer+semver'' = SemVer <$> majorP <*> minorP <*> patchP <*> preRel <*> metaData+ -- | Parse a group of digits, which can't be lead by a 0, unless it is 0.-digitsP :: Parsec Void T.Text Word+digitsP :: Parsec Void Text Word digitsP = read <$> ((T.unpack <$> string "0") <|> some digitChar) -majorP :: Parsec Void T.Text Word+majorP :: Parsec Void Text Word majorP = digitsP <* char '.' -minorP :: Parsec Void T.Text Word+minorP :: Parsec Void Text Word minorP = majorP -patchP :: Parsec Void T.Text Word+patchP :: Parsec Void Text Word patchP = digitsP -preRel :: Parsec Void T.Text [VChunk]+preRel :: Parsec Void Text [VChunk] preRel = (char '-' *> chunks) <|> pure [] -metaData :: Parsec Void T.Text [VChunk]+metaData :: Parsec Void Text [VChunk] metaData = (char '+' *> chunks) <|> pure [] -chunks :: Parsec Void T.Text [VChunk]+chunksNE :: Parsec Void Text (NonEmpty VChunk)+chunksNE = chunk `PC.sepBy1` char '.'++chunks :: Parsec Void Text [VChunk] chunks = chunk `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@.-chunk :: Parsec Void T.Text VChunk-chunk = try zeroWithLetters <|> oneZero <|> many (iunit <|> sunit)- where oneZero = (:[]) . Digits . read . T.unpack <$> string "0"+chunk :: Parsec Void Text VChunk+chunk = try zeroWithLetters <|> oneZero <|> PC.some (iunit <|> sunit)+ where oneZero = (:|[]) . Digits . read . T.unpack <$> string "0" zeroWithLetters = do z <- Digits . read . T.unpack <$> string "0"- s <- some sunit- c <- chunk- pure $ (z : s) ++ c+ s <- PC.some sunit+ c <- optional chunk+ case c of+ Nothing -> pure $ NEL.cons z s+ Just c' -> pure $ NEL.cons z s <> c' -iunit :: Parsec Void T.Text VUnit+iunit :: Parsec Void Text VUnit iunit = Digits . read <$> some digitChar -sunit :: Parsec Void T.Text VUnit+sunit :: Parsec Void Text VUnit sunit = Str . T.pack <$> some letterChar -- | Parse a (Haskell) `PVP`, as defined above.-pvp :: T.Text -> Either ParsingError PVP+pvp :: Text -> Either ParsingError PVP pvp = parse (pvp' <* eof) "PVP" -- | Internal megaparsec parser of `pvp`.-pvp' :: Parsec Void T.Text PVP+pvp' :: Parsec Void Text PVP pvp' = L.lexeme space (PVP . NEL.fromList <$> L.decimal `sepBy` char '.') -- | Parse a (General) `Version`, as defined above.-version :: T.Text -> Either ParsingError Version-version = parse (version' <* eof) "Version"+version :: Text -> Either ParsingError Version+version = parse (version'' <* eof) "Version" -- | Internal megaparsec parser of `version`.-version' :: Parsec Void T.Text Version-version' = L.lexeme space (Version <$> optional (try epochP) <*> chunks <*> preRel)+version' :: Parsec Void Text Version+version' = L.lexeme space version'' -epochP :: Parsec Void T.Text Word+version'' :: Parsec Void Text Version+version'' = Version <$> optional (try epochP) <*> chunksNE <*> metaData <*> preRel++epochP :: Parsec Void Text Word epochP = read <$> (some digitChar <* char ':') -- | Parse a (Complex) `Mess`, as defined above.-mess :: T.Text -> Either ParsingError Mess-mess = parse (mess' <* eof) "Mess"+mess :: Text -> Either ParsingError Mess+mess = parse (mess'' <* eof) "Mess" -- | Internal megaparsec parser of `mess`.-mess' :: Parsec Void T.Text Mess-mess' = L.lexeme space (try node <|> leaf)+mess' :: Parsec Void Text Mess+mess' = L.lexeme space mess'' -leaf :: Parsec Void T.Text Mess-leaf = VLeaf <$> tchunks+mess'' :: Parsec Void Text Mess+mess'' = Mess <$> mchunks <*> optional ((,) <$> sep <*> mess') -node :: Parsec Void T.Text Mess-node = VNode <$> tchunks <*> sep <*> mess'+mchunks :: Parsec Void Text (NonEmpty MChunk)+mchunks = mchunk `PC.sepBy1` char '.' -tchunks :: Parsec Void T.Text [T.Text]-tchunks = (T.pack <$> some (letterChar <|> digitChar)) `sepBy` char '.'+mchunk :: Parsec Void Text MChunk+mchunk = choice [ try $ (\(t, i) -> MDigit i t) <$> match (L.decimal <* next)+ , try $ (\(t, i) -> MRev i t) <$> (match (single 'r' *> L.decimal <* next))+ , MPlain . T.pack <$> some (letterChar <|> digitChar) ]+ where+ next :: Parsec Void Text ()+ next = lookAhead (void (single '.') <|> void sep <|> eof) -sep :: Parsec Void T.Text VSep+sep :: Parsec Void Text VSep sep = choice [ VColon <$ char ':' , VHyphen <$ char '-' , VPlus <$ char '+'@@ -812,40 +875,56 @@ sepCh VUnder = '_' -- | Convert any parsed Versioning type to its textual representation.-prettyV :: Versioning -> T.Text+prettyV :: Versioning -> Text prettyV (Ideal sv) = prettySemVer sv prettyV (General v) = prettyVer v prettyV (Complex m) = prettyMess m -- | Convert a `SemVer` back to its textual representation.-prettySemVer :: SemVer -> T.Text+prettySemVer :: SemVer -> Text 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' = foldable [] ("+" :) $ intersperse "." (chunksAsT me)+ where+ ver = intersperse "." [ showt ma, showt mi, showt pa ]+ pr' = foldable [] ("-" :) $ intersperse "." (chunksAsT pr)+ me' = foldable [] ("+" :) $ intersperse "." (chunksAsT me) -- | Convert a `PVP` back to its textual representation.-prettyPVP :: PVP -> T.Text+prettyPVP :: PVP -> Text prettyPVP (PVP (m :| rs)) = T.intercalate "." . map showt $ m : rs -- | Convert a `Version` back to its textual representation.-prettyVer :: Version -> T.Text-prettyVer (Version ep cs pr) = ep' <> mconcat (ver <> pr')- where ver = intersperse "." $ chunksAsT cs- pr' = foldable [] ("-" :) $ intersperse "." (chunksAsT pr)- ep' = maybe "" (\e -> showt e <> ":") ep+prettyVer :: Version -> Text+prettyVer (Version ep cs me pr) = ep' <> mconcat (ver <> me' <> pr')+ where+ ver = intersperse "." . chunksAsT $ NEL.toList cs+ me' = foldable [] ("+" :) $ intersperse "." (chunksAsT me)+ pr' = foldable [] ("-" :) $ intersperse "." (chunksAsT pr)+ ep' = maybe "" (\e -> showt e <> ":") ep -- | Convert a `Mess` back to its textual representation.-prettyMess :: Mess -> T.Text-prettyMess (VLeaf t) = mconcat $ intersperse "." t-prettyMess (VNode t s v) = T.snoc t' (sepCh s) <> prettyMess v- where t' = mconcat $ intersperse "." t+prettyMess :: Mess -> Text+prettyMess (Mess t m) = case m of+ Nothing -> t'+ Just (s, v) -> T.snoc t' (sepCh s) <> prettyMess v+ where+ t' :: Text+ t' = fold . NEL.intersperse "." $ NEL.map mchunkText t -chunksAsT :: [VChunk] -> [T.Text]-chunksAsT = map (mconcat . map f)- where f (Digits i) = showt i- f (Str s) = s+chunksAsT :: Functor t => t VChunk -> t Text+chunksAsT = fmap (foldMap f)+ where+ f :: VUnit -> Text+ f (Digits i) = showt i+ f (Str s) = s +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]+ -- | 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@@ -859,7 +938,7 @@ opposite GT = LT -- Yes, `text-show` exists, but this reduces external dependencies.-showt :: Show a => a -> T.Text+showt :: Show a => a -> Text showt = T.pack . show hush :: Either a b -> Maybe b
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
test/Test.hs view
@@ -1,13 +1,15 @@+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Main where+module Main ( main ) where import Data.Char (chr) import Data.Either (isLeft) import Data.Foldable (fold) import Data.List (groupBy)+import qualified Data.List.NonEmpty as NEL import qualified Data.Text as T import Data.Versions import Data.Void (Void)@@ -25,11 +27,14 @@ arbitrary = SemVer <$> arbitrary <*> arbitrary <*> arbitrary <*> chunks <*> chunks -- | Sane generation of VChunks.-chunks :: Gen [[VUnit]]+chunks :: Gen [VChunk] chunks = resize 10 . listOf1 . fmap simplify . resize 10 $ listOf1 arbitrary -simplify :: [VUnit] -> [VUnit]-simplify = map fold . groupBy f+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@@ -45,16 +50,19 @@ arbitrary = Letter . chr <$> choose (97, 122) instance Arbitrary Version where- arbitrary = Version <$> arbitrary <*> chunks <*> chunks+ arbitrary = Version <$> arbitrary <*> chunksNE <*> chunks <*> chunks -- | 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" , "0.25-2", "8.u51-1", "21-2", "7.1p1-1", "20150826-1", "1:0.10.16-3"- ]+ , "1.11.0.git.20200404-1", "1.11.0+20200830-1" ] +badVers :: [T.Text]+badVers = ["", "1.2 "]+ messes :: [T.Text]-messes = [ "10.2+0.93+1-1", "003.03-3", "002.000-7", "20.26.1_0-2" ]+messes = [ "10.2+0.93+1-1", "003.03-3", "002.000-7", "20.26.1_0-2", "1.6.0a+2014+m872b87e73dfb-1" ] messComps :: [T.Text] messComps = [ "10.2+0.93+1-1", "10.2+0.93+1-2", "10.2+0.93+2-1"@@ -63,7 +71,7 @@ badSemVs :: [T.Text] badSemVs = [ "1", "1.2", "1.2.3+a1b2bc3.1-alpha.2", "a.b.c", "1.01.1"- , "1.2.3+a1b!2c3.1"+ , "1.2.3+a1b!2c3.1", "", "1.2.3 " ] goodSemVs :: [T.Text]@@ -123,6 +131,8 @@ , testGroup "(General) Versions" [ testGroup "Good Versions" $ map (\s -> testCase (T.unpack s) $ isomorphV s) goodVers+ , testGroup "Bad Versions (shouldn't parse)" $+ map (\s -> testCase (T.unpack s) $ assertBool "A bad version parsed" $ isLeft $ version s) badVers , testGroup "Comparisons" $ testCase "1.2-5 < 1.2.3-1" (comp version "1.2-5" "1.2.3-1") : testCase "1.0rc1 < 1.0" (comp version "1.0rc1" "1.0") :@@ -135,6 +145,8 @@ , testGroup "(Complex) Mess" [ testGroup "Good Versions" $ map (\s -> testCase (T.unpack s) $ isomorphM s) messes+ , testGroup "Bad Versions (shouldn't parse)" $+ map (\s -> testCase (T.unpack s) $ assertBool "A bad version parsed" $ isLeft $ mess s) badVers , testGroup "Comparisons" $ map (\(a,b) -> testCase (T.unpack $ a <> " < " <> b) $ comp mess a b) $ zip messComps (tail messComps)@@ -159,10 +171,12 @@ , testCase "1.2.3r1 is Version" $ check $ isVersion <$> versioning "1.2.3r1" , testCase "0.25-2 is Version" $ check $ isVersion <$> versioning "0.25-2" , testCase "1:1.2.3-1 is Version" $ check $ isVersion <$> versioning "1:1.2.3-1"- , testCase "1.2.3+1-1 is Mess" $ check $ isMess <$> versioning "1.2.3+1-1"+ , testCase "1.2.3+1-1 is Version" $ check $ isVersion <$> versioning "1.2.3+1-1" , testCase "000.007-1 is Mess" $ check $ isMess <$> versioning "000.007-1" , testCase "20.26.1_0-2 is Mess" $ check $ isMess <$> versioning "20.26.1_0-2" ]+ , testGroup "Bad Versions" $+ map (\s -> testCase (T.unpack s) $ assertBool "A bad version parsed" $ isLeft $ versioning s) badVers , testGroup "Isomorphisms" $ map (\s -> testCase (T.unpack s) $ isomorph s) $ goodSemVs ++ goodVers ++ messes , testGroup "Comparisons"@@ -173,13 +187,16 @@ , testCase "1.2-5 < 1.2.3-1" $ comp versioning "1.2-5" "1.2.3-1" , testCase "1.6.0a+2014+m872b87e73dfb-1 < 1.6.0-1" $ comp versioning "1.6.0a+2014+m872b87e73dfb-1" "1.6.0-1"+ , testCase "1.11.0.git.20200404-1 < 1.11.0+20200830-1"+ $ comp versioning "1.11.0.git.20200404-1" "1.11.0+20200830-1"+ , testCase "0.17.0+r8+gc41db5f1-1 < 0.17.0+r157+g584760cf-1"+ $ comp versioning "0.17.0+r8+gc41db5f1-1" "0.17.0+r157+g584760cf-1" ] ] , testGroup "Lenses and Traversals" [ testCase "SemVer - Increment Patch" incPatch , testCase "SemVer - Increment Patch from Text" incFromT , testCase "SemVer - Get patches" patches- , testCase "Traverse `General` as `Ideal`" noInc ] , testGroup "Megaparsec Behaviour" [ testCase "manyTill" $ parse nameGrab "manyTill" "linux-firmware-3.2.14-1-x86_64.pkg.tar.xz" @?= Right "linux-firmware"@@ -190,21 +207,31 @@ -- | Does pretty-printing return a Versioning to its original form? isomorph :: T.Text -> Assertion-isomorph t = Right t @=? (prettyV <$> versioning t)+isomorph t = case prettyV <$> versioning t of+ Right t' -> t @?= t'+ Left e -> assertBool (errorBundlePretty e) False -- | Does pretty-printing return a Version to its original form? isomorphV :: T.Text -> Assertion-isomorphV t = Right t @=? (prettyVer <$> version t)+isomorphV t = case prettyVer <$> version t of+ Right t' -> t @?= t'+ Left e -> assertBool (errorBundlePretty e) False -- | Does pretty-printing return a SemVer to its original form? isomorphSV :: T.Text -> Assertion-isomorphSV t = Right t @=? (prettySemVer <$> semver t)+isomorphSV t = case prettySemVer <$> semver t of+ Right t' -> t @?= t'+ Left e -> assertBool (errorBundlePretty e) False isomorphPVP :: T.Text -> Assertion-isomorphPVP t = Right t @=? (prettyPVP <$> pvp t)+isomorphPVP t = case prettyPVP <$> pvp t of+ Right t' -> t @?= t'+ Left e -> assertBool (errorBundlePretty e) False isomorphM :: T.Text -> Assertion-isomorphM t = Right t @=? (prettyMess <$> mess t)+isomorphM t = case prettyMess <$> mess t of+ Right t' -> t @?= t'+ Left e -> assertBool (errorBundlePretty e) False comp :: Ord b => (T.Text -> Either a b) -> T.Text -> T.Text -> Assertion comp f a b = check $ (<) <$> f a <*> f b@@ -228,11 +255,6 @@ incPatch = (v1 & patch %~ (+ 1)) @?= v2 where v1 = Ideal $ SemVer 1 2 3 [] [] v2 = Ideal $ SemVer 1 2 4 [] []---- | Nothing should happen.-noInc :: Assertion-noInc = (v & patch %~ (+ 1)) @?= v- where v = General $ Version 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: 3.5.4+version: 4.0.0 synopsis: Types and parsers for software version numbers. description: A library for parsing and comparing software version numbers. We like to give@@ -48,6 +48,7 @@ build-depends: , deepseq >=1.4 , hashable >=1.2+ , parser-combinators >= 1.0 test-suite versions-test import: commons