From 4b17dc910eabba32e30720dfe25a9734d8a4cbcd Mon Sep 17 00:00:00 2001 From: Colin Woodbury Date: Tue, 13 Apr 2021 21:05:09 -0700 Subject: [PATCH] Enforce the same order of prerel/metadata for Version as SemVer --- Data/Versions.hs | 39 +++++++++++++++++++++++++-------------- test/Test.hs | 5 +++-- 2 files changed, 28 insertions(+), 16 deletions(-) diff --git a/Data/Versions.hs b/Data/Versions.hs index 01ffc75..20cff32 100644 --- a/Data/Versions.hs +++ b/Data/Versions.hs @@ -148,7 +148,7 @@ vFromS (SemVer ma mi pa re me) = -- | Convert a `Version` to a `Mess`. mFromV :: Version -> Mess -mFromV (Version e v m r) = maybe affix (\a -> Mess (MDigit a (showt a) :| []) $ Just (VColon, affix)) e +mFromV (Version e v r m) = maybe affix (\a -> Mess (MDigit a (showt a) :| []) $ Just (VColon, affix)) e where affix :: Mess affix = Mess (chunksAsM v) m' @@ -510,7 +510,7 @@ instance Semantic PVP where -- -- 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 +-- @1:2.3.4@. Metadata is prefixed by @+@, and like SemVer must appear after -- the "prerelease" (the @-p@). -- -- Examples of @Version@ that are not @SemVer@: 0.25-2, 8.u51-1, 20150826-1, @@ -518,8 +518,8 @@ instance Semantic PVP where data Version = Version { _vEpoch :: !(Maybe Word) , _vChunks :: !(NonEmpty VChunk) - , _vMeta :: !(Maybe Text) - , _vRel :: ![VChunk] } + , _vRel :: ![VChunk] + , _vMeta :: !(Maybe Text) } deriving stock (Eq, Show, Generic) deriving anyclass (NFData, Hashable) @@ -531,7 +531,7 @@ instance Semigroup Version where 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 + 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. @@ -606,7 +606,7 @@ instance Semantic Version where meta _ v = pure v {-# INLINE meta #-} - semantic f (Version _ ((Digits a:|[]) :| (Digits b:|[]) : (Digits c:|[]) : _) me rs) = + semantic f (Version _ ((Digits a:|[]) :| (Digits b:|[]) : (Digits c:|[]) : _) rs me) = vFromS <$> f (SemVer a b c rs me) semantic _ v = pure v {-# INLINE semantic #-} @@ -684,7 +684,7 @@ messPatch _ = Nothing -- -- 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 chunk "Chunk" p +messPatchChunk (Mess (_ :| _ : MPlain p : _) _) = hush $ parse (chunkWith unit) "Chunk" p messPatchChunk _ = Nothing instance Ord Mess where @@ -789,15 +789,15 @@ metaData = do section = takeWhile1P (Just "Metadata char") (\c -> isAlphaNum c || c == '-') chunksNE :: Parsec Void Text (NonEmpty VChunk) -chunksNE = chunk `PC.sepBy1` char '.' +chunksNE = chunkWith unit' `PC.sepBy1` char '.' chunks :: Parsec Void Text [VChunk] -chunks = chunk `sepBy` char '.' +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@. -chunk :: Parsec Void Text VChunk -chunk = try zeroWithLetters <|> oneZero <|> PC.some (iunit <|> sunit) +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' @@ -806,17 +806,28 @@ chunk = try zeroWithLetters <|> oneZero <|> PC.some (iunit <|> sunit) zeroWithLetters = do z <- Digits 0 <$ single '0' s <- PC.some sunit - c <- optional chunk + 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" @@ -834,7 +845,7 @@ version' :: Parsec Void Text Version version' = L.lexeme space version'' version'' :: Parsec Void Text Version -version'' = Version <$> optional (try epochP) <*> chunksNE <*> optional metaData <*> preRel +version'' = Version <$> optional (try epochP) <*> chunksNE <*> preRel <*> optional metaData epochP :: Parsec Void Text Word epochP = read <$> (some digitChar <* char ':') @@ -893,7 +904,7 @@ prettyPVP (PVP (m :| rs)) = T.intercalate "." . map showt $ m : rs -- | Convert a `Version` back to its textual representation. prettyVer :: Version -> Text -prettyVer (Version ep cs me pr) = ep' <> mconcat (ver <> me' <> pr') +prettyVer (Version ep cs pr me) = ep' <> mconcat (ver <> me' <> pr') where ver = intersperse "." . chunksAsT $ NEL.toList cs me' = maybe [] (\m -> ["+",m]) me diff --git a/test/Test.hs b/test/Test.hs index 2e897ef..fb0593c 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -51,13 +51,14 @@ instance Arbitrary Letter where arbitrary = Letter . chr <$> choose (97, 122) instance Arbitrary Version where - arbitrary = Version <$> arbitrary <*> chunksNE <*> pure Nothing <*> chunks + 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" , "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", "1:3.20" ] + , "1.11.0.git.20200404-1", "1.11.0+20200830-1", "1:3.20" + ] badVers :: [T.Text] badVers = ["", "1.2 "]