diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,18 @@ # Changelog +## 3.5.4 (2020-05-12) + +#### Added + +- The functions `isIdeal`, `isGeneral`, and `isComplex` for `Bool`-based + inspection of parse results. +- `messMajor`, `messMinor`, `messPatch`, and `messPatchChunk` for improved + introspection into `Mess` values. + +#### Changed + +- Improved `Mess` comparison logic. + ## 3.5.3 - GHC 8.10 support. diff --git a/Data/Versions.hs b/Data/Versions.hs --- a/Data/Versions.hs +++ b/Data/Versions.hs @@ -37,11 +37,11 @@ module Data.Versions ( -- * Types - Versioning(..) + Versioning(..), isIdeal, isGeneral, isComplex , SemVer(..) , PVP(..) , Version(..) - , Mess(..) + , Mess(..), messMajor, messMinor, messPatch, messPatchChunk , VUnit(..), digits, str , VChunk , VSep(..) @@ -96,6 +96,21 @@ data Versioning = Ideal SemVer | General Version | Complex Mess deriving (Eq, Show, Generic, NFData, Hashable) +-- | Short-hand for detecting a `SemVer`. +isIdeal :: Versioning -> Bool +isIdeal (Ideal _) = True +isIdeal _ = False + +-- | Short-hand for detecting a `Version`. +isGeneral :: Versioning -> Bool +isGeneral (General _) = True +isGeneral _ = False + +-- | Short-hand for detecting a `Mess`. +isComplex :: Versioning -> Bool +isComplex (Complex _) = True +isComplex _ = False + -- | Comparison of @Ideal@s is always well defined. -- -- If comparison of @General@s is well-defined, then comparison of @Ideal@ and @@ -106,15 +121,15 @@ -- and @Complex@ is well defined for the same reason. This implies comparison of -- @Ideal@ and @Complex@ is also well-defined. instance Ord Versioning where - 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 (General v) (Complex m) = compare (mFromV v) m - compare (Complex m) (General v) = opposite $ compare (mFromV v) m - compare (Ideal s) m@(Complex _) = compare (General $ vFromS s) m - compare m@(Complex _) (Ideal s) = compare m (General $ vFromS s) + 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 (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 -- | Convert a `SemVer` to a `Version`. vFromS :: SemVer -> Version @@ -123,8 +138,40 @@ -- | Convert a `Version` to a `Mess`. mFromV :: Version -> Mess mFromV (Version e v r) = maybe affix (\a -> VNode [showt a] VColon affix) e - where affix = VNode (chunksAsT v) VHyphen $ VLeaf (chunksAsT r) + where + affix :: Mess + affix = VNode (chunksAsT v) VHyphen $ VLeaf (chunksAsT r) +-- | 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. +semverAndMess :: SemVer -> Mess -> Ordering +semverAndMess s@(SemVer ma mi pa _ _) m = case compare ma <$> messMajor m of + Nothing -> fallback + Just LT -> LT + Just GT -> GT + Just EQ -> case compare mi <$> messMinor m of + Nothing -> fallback + Just LT -> LT + Just GT -> GT + Just EQ -> case compare pa <$> messPatch m of + Just LT -> LT + Just GT -> GT + -- If they've been equal up to this point, the `Mess` + -- 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 + LT -> LT + GT -> GT + EQ -> GT -- This follows semver's rule! + Just _ -> fallback + where + fallback :: Ordering + fallback = compare (General $ vFromS s) (Complex m) + instance Semantic Versioning where major f (Ideal v) = Ideal <$> major f v major f (General v) = General <$> major f v @@ -302,7 +349,7 @@ instance Monoid SemVer where mempty = SemVer 0 0 0 [] [] -#if __GLASGOW_HASKELL__ < 841 +#if !MIN_VERSION_base(4,11,0) mappend = (<>) #endif @@ -341,7 +388,7 @@ instance Monoid VUnit where mempty = Str "" -#if __GLASGOW_HASKELL__ < 841 +#if !MIN_VERSION_base(4,11,0) mappend = (<>) #endif @@ -401,7 +448,7 @@ instance Monoid PVP where mempty = PVP (0 :| []) -#if __GLASGOW_HASKELL__ < 841 +#if !MIN_VERSION_base(4,11,0) mappend = (<>) #endif @@ -455,7 +502,7 @@ instance Monoid Version where mempty = Version Nothing [] [] -#if __GLASGOW_HASKELL__ < 841 +#if !MIN_VERSION_base(4,11,0) mappend = (<>) #endif @@ -561,12 +608,44 @@ -- 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. +-- -- Not guaranteed to have well-defined ordering (@Ord@) behaviour, but so far --- internal tests show consistency. +-- internal tests show consistency. `messMajor`, etc., are used internally where +-- appropriate to enhance accuracy. data Mess = VLeaf [T.Text] | VNode [T.Text] 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 + +-- | 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 + +-- | 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 + +-- | 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`. +-- +-- 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 + instance Ord Mess where compare (VLeaf l1) (VLeaf l2) = compare l1 l2 compare (VNode t1 _ _) (VLeaf t2) = compare t1 t2 @@ -782,3 +861,7 @@ -- Yes, `text-show` exists, but this reduces external dependencies. showt :: Show a => a -> T.Text showt = T.pack . show + +hush :: Either a b -> Maybe b +hush (Left _) = Nothing +hush (Right b) = Just b diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ versions ======== +![](https://github.com/fosskers/versions/workflows/Tests/badge.svg) [![Hackage](https://img.shields.io/hackage/v/versions.svg?style=flat)](https://hackage.haskell.org/package/versions) [![Stackage Nightly](http://stackage.org/package/versions/badge/nightly)](http://stackage.org/nightly/package/versions) [![Stackage LTS](http://stackage.org/package/versions/badge/lts)](http://stackage.org/lts/package/versions) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,17 +1,18 @@ -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where -import BasePrelude hiding (Version, try) +import Data.Char (chr) +import Data.Either (isLeft) +import Data.Foldable (fold) +import Data.List (groupBy) import qualified Data.Text as T import Data.Versions +import Data.Void (Void) import Lens.Micro import Test.QuickCheck -import Test.QuickCheck.Checkers -import Test.QuickCheck.Classes import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck @@ -33,16 +34,10 @@ f (Str _) (Str _) = True f _ _ = False -instance EqProp SemVer where - a =-= b = eq a b - instance Arbitrary VUnit where arbitrary = frequency [ (1, Digits . (+ 1) <$> arbitrary) , (1, s) ] where s = Str . T.pack . map unletter <$> resize 10 (listOf1 arbitrary) -instance EqProp VUnit where - a =-= b = eq a b - -- | An ASCII letter. newtype Letter = Letter { unletter :: Char } @@ -52,9 +47,6 @@ instance Arbitrary Version where arbitrary = Version <$> arbitrary <*> chunks <*> chunks -instance EqProp Version where - a =-= b = eq a b - -- | 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" @@ -100,14 +92,10 @@ suite :: TestTree suite = testGroup "Tests" [ testGroup "Property Tests" - [ testGroup "SemVer - Monoid" $ - map (uncurry testProperty) . unbatch $ monoid (SemVer 1 2 3 [] []) - , testProperty "SemVer - Arbitrary" $ \a -> semver (prettySemVer a) == Right a + [ 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 "VUnit - Monoid" $ - map (uncurry testProperty) . unbatch $ monoid (Digits 0) ] , testGroup "Unit Tests" [ testGroup "(Ideal) Semantic Versioning" @@ -150,6 +138,18 @@ , testGroup "Comparisons" $ map (\(a,b) -> testCase (T.unpack $ a <> " < " <> b) $ comp mess a b) $ zip messComps (tail messComps) + , testGroup "SemVer-like Value Extraction" + [ testCase "messMajor" $ + (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messMajor) @?= Just 1 + , testCase "messMinor" $ + (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messMinor) @?= Just 6 + , testCase "messPatch - Good" $ + (hush (mess "1.6.0+2014+m872b87e73dfb-1") >>= messPatch) @?= Just 0 + , 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"] + ] ] , testGroup "Mixed Versioning" [ testGroup "Identification" @@ -171,6 +171,8 @@ , testCase "1.2.3-1 < 2+0007-1" $ comp versioning "1.2.3-1" "2+0007-1" , testCase "1.2.3r1-1 < 2+0007-1" $ comp versioning "1.2.3r1-1" "2+0007-1" , 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" ] ] , testGroup "Lenses and Traversals" @@ -250,3 +252,7 @@ versionGrab = manyTill anySingle (try finished) *> ver where finished = char '-' *> lookAhead digitChar ver = fmap Ideal semver' <|> fmap General version' <|> fmap Complex mess' + +hush :: Either a b -> Maybe b +hush (Left _) = Nothing +hush (Right b) = Just b diff --git a/versions.cabal b/versions.cabal --- a/versions.cabal +++ b/versions.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: versions -version: 3.5.3 +version: 3.5.4 synopsis: Types and parsers for software version numbers. description: A library for parsing and comparing software version numbers. We like to give @@ -21,7 +21,7 @@ the best constraints on comparisons. category: Data -homepage: https://gitlab.com/fosskers/versions +homepage: https://github.com/fosskers/versions author: Colin Woodbury maintainer: colin@fosskers.ca license: BSD-3-Clause @@ -56,8 +56,6 @@ hs-source-dirs: test ghc-options: -threaded -with-rtsopts=-N build-depends: - , base-prelude - , checkers >=0.4 , microlens >=0.4 , QuickCheck >=2.9 , tasty >=0.10.1.2