versions 6.0.2 → 6.0.3
raw patch · 5 files changed
+105/−53 lines, 5 files
Files
- CHANGELOG.md +8/−0
- Data/Versions.hs +80/−27
- test/TH.hs +0/−19
- test/Test.hs +16/−5
- versions.cabal +1/−2
CHANGELOG.md view
@@ -1,5 +1,13 @@ # Changelog +## 6.0.3 (2023-10-23)++#### Added++- `Data` instances for the various data types.+- Simple conversion types between the main version types.+- Compile-time constructors via Template Haskell, like `versioningQ`.+ ## 6.0.2 (2023-10-12) #### Added
Data/Versions.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE DerivingStrategies #-}@@ -50,6 +51,10 @@ , Chunk(..) , MChunk(..) , VSep(..)+ -- ** Compile-time Constructors+ , versioningQ, semverQ, versionQ, messQ, pvpQ+ -- ** Conversions+ , semverToVersion, versionToMess, versionToPvp -- * Parsing Versions , ParsingError , versioning, semver, pvp, version, mess@@ -76,6 +81,7 @@ import Control.DeepSeq import Control.Monad (unless, void) import Data.Char (isAlpha, isAlphaNum)+import Data.Data (Data) import Data.Foldable (fold) import Data.Hashable (Hashable) import Data.List (intersperse)@@ -86,7 +92,8 @@ import qualified Data.Text as T import Data.Void (Void) import GHC.Generics (Generic)-import Language.Haskell.TH.Syntax (Lift)+import Language.Haskell.TH (Exp, Q)+import Language.Haskell.TH.Syntax (Lift(..)) import Text.Megaparsec hiding (chunk) import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L@@ -99,7 +106,7 @@ -- composed. This is useful for specifying custom behaviour for when a certain -- parser fails. data Versioning = Ideal SemVer | General Version | Complex Mess- deriving (Eq, Show, Generic, NFData, Hashable, Lift)+ deriving (Eq, Show, Generic, NFData, Hashable, Lift, Data) -- | Short-hand for detecting a `SemVer`. isIdeal :: Versioning -> Bool@@ -126,19 +133,19 @@ -- 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) = 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 (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) = semverAndVer s v+ compare (General v) (Ideal s) = opposite $ semverAndVer s v+ compare (General v) (Complex m) = compare (versionToMess v) m+ compare (Complex m) (General v) = opposite $ compare (versionToMess 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-vFromS (SemVer ma mi pa re me) =+semverToVersion :: SemVer -> Version+semverToVersion (SemVer ma mi pa re me) = Version { _vEpoch = Nothing , _vChunks = Chunks $ Numeric ma :| [Numeric mi, Numeric pa]@@ -146,8 +153,8 @@ , _vRel = re } -- | Convert a `Version` to a `Mess`.-mFromV :: Version -> Mess-mFromV (Version me (Chunks v) r _) = case me of+versionToMess :: Version -> Mess+versionToMess (Version me (Chunks v) r _) = case me of Nothing -> f Just e -> let cs = (:| []) . MDigit e $ showt e@@ -163,6 +170,17 @@ where ms = NEL.map toMChunk cs +-- | Convert a `Version` to a `PVP`. Fails if there is an epoch present, but+-- otherwise ignores the `Release` and other metadata. Naturally it also fails+-- if any of the version components contain any non-digits.+versionToPvp :: Version -> Maybe PVP+versionToPvp (Version (Just _) _ _ _) = Nothing+versionToPvp (Version Nothing (Chunks cs) _ _) = PVP <$> traverse f cs+ where+ f :: Chunk -> Maybe Word+ f (Numeric w) = Just w+ f (Alphanum _) = Nothing+ semverAndVer :: SemVer -> Version -> Ordering -- A `Version` with a non-zero epoch value is automatically greater than any -- `SemVer`.@@ -231,7 +249,7 @@ EQ -> GT where fallback :: Ordering- fallback = compare (General $ vFromS s) (Complex m)+ fallback = compare (General $ semverToVersion s) (Complex m) instance Semantic Versioning where major f (Ideal v) = Ideal <$> major f v@@ -386,7 +404,7 @@ , _svPatch :: !Word , _svPreRel :: !(Maybe Release) , _svMeta :: !(Maybe Text) }- deriving stock (Show, Generic, Lift)+ deriving stock (Show, Generic, Lift, Data) deriving anyclass (NFData, Hashable) -- | Two SemVers are equal if all fields except metadata are equal.@@ -427,7 +445,7 @@ -- | `Chunk`s have comparison behaviour according to SemVer's rules for preleases. newtype Release = Release (NonEmpty Chunk)- deriving stock (Eq, Show, Read, Generic, Lift)+ deriving stock (Eq, Show, Read, Generic, Lift, Data) deriving anyclass (NFData, Hashable) instance Ord Release where@@ -459,7 +477,7 @@ -- 0rc1-abc3 -- @ data Chunk = Numeric Word | Alphanum Text- deriving stock (Eq, Show, Read, Generic, Lift)+ deriving stock (Eq, Show, Read, Generic, Lift, Data) deriving anyclass (NFData, Hashable) toMChunk :: Chunk -> MChunk@@ -525,7 +543,7 @@ -- change. The spec otherwise designates no special meaning to components -- past the MINOR position. newtype PVP = PVP { _pComponents :: NonEmpty Word }- deriving stock (Eq, Ord, Show, Generic)+ deriving stock (Eq, Ord, Show, Generic, Lift, Data) deriving anyclass (NFData, Hashable) instance Semantic PVP where@@ -577,7 +595,7 @@ , _vChunks :: !Chunks , _vRel :: !(Maybe Release) , _vMeta :: !(Maybe Text) }- deriving stock (Eq, Show, Generic, Lift)+ deriving stock (Eq, Show, Generic, Lift, Data) deriving anyclass (NFData, Hashable) -- | Customized. As in SemVer, metadata is ignored for the purpose of@@ -620,7 +638,7 @@ {-# INLINE meta #-} semantic f (Version _ (Chunks (Numeric a :| Numeric b : Numeric c : _)) rs me) =- vFromS <$> f (SemVer a b c rs me)+ semverToVersion <$> f (SemVer a b c rs me) semantic _ v = pure v {-# INLINE semantic #-} @@ -631,7 +649,7 @@ -- | `Chunk`s that have a comparison behaviour specific to `Version`. newtype Chunks = Chunks (NonEmpty Chunk)- deriving stock (Eq, Show, Generic, Lift)+ deriving stock (Eq, Show, Generic, Lift, Data) deriving anyclass (NFData, Hashable) instance Ord Chunks where@@ -659,7 +677,7 @@ -- ^ A numeric value preceeded by an @r@, indicating a revision. | MPlain Text -- ^ Anything else.- deriving stock (Eq, Show, Generic, Lift)+ deriving stock (Eq, Show, Generic, Lift, Data) deriving anyclass (NFData, Hashable) instance Ord MChunk where@@ -688,7 +706,7 @@ -- internal tests show consistency. `messMajor`, etc., are used internally where -- appropriate to enhance accuracy. data Mess = Mess !(NonEmpty MChunk) !(Maybe (VSep, Mess))- deriving stock (Eq, Show, Generic, Lift)+ deriving stock (Eq, Show, Generic, Lift, Data) deriving anyclass (NFData, Hashable) -- | Try to extract the "major" version number from `Mess`, as if it were a@@ -750,7 +768,7 @@ -- | Good luck. semantic f (Mess (MDigit t0 _ :| MDigit t1 _ : MDigit t2 _ : _) _) =- mFromV . vFromS <$> f (SemVer t0 t1 t2 Nothing Nothing)+ versionToMess . semverToVersion <$> f (SemVer t0 t1 t2 Nothing Nothing) semantic _ v = pure v {-# INLINE semantic #-} @@ -763,8 +781,43 @@ -- * 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 | VTilde- deriving stock (Eq, Show, Generic, Lift)+ deriving stock (Eq, Show, Generic, Lift, Data) deriving anyclass (NFData, Hashable)++-- | Parse a `Versioning` at compile time.+versioningQ :: Text -> Q Exp+versioningQ nm =+ case versioning nm of+ Left err -> fail (errorBundlePretty err)+ Right v -> lift v++-- | Parse a `SemVer` at compile time.+semverQ :: T.Text -> Q Exp+semverQ nm =+ case semver nm of+ Left err -> fail (errorBundlePretty err)+ Right v -> lift v++-- | Parse a `Version` at compile time.+versionQ :: T.Text -> Q Exp+versionQ nm =+ case version nm of+ Left err -> fail (errorBundlePretty err)+ Right v -> lift v++-- | Parse a `Mess` at compile time.+messQ :: T.Text -> Q Exp+messQ nm =+ case mess nm of+ Left err -> fail (errorBundlePretty err)+ Right v -> lift v++-- | Parse a `PVP` at compile time.+pvpQ :: T.Text -> Q Exp+pvpQ nm =+ case pvp nm of+ Left err -> fail (errorBundlePretty err)+ Right v -> lift v -------------------------------------------------------------------------------- -- Parsing
− test/TH.hs
@@ -1,19 +0,0 @@--- | Template Haskell seems picky about compilation stages. The code here must--- be defined in a module separate from the one it's being used in.--module TH (thVer) where--import qualified Data.Text as T-import Data.Versions-import Language.Haskell.TH (Exp, Q)-import Language.Haskell.TH.Syntax (lift)--------- | Parse a `Versioning` at compile time.-thVer :: T.Text -> Q Exp-thVer nm =- case versioning nm of- Left err -> fail (errorBundlePretty err)- Right v -> lift v-
test/Test.hs view
@@ -18,7 +18,6 @@ import Text.Megaparsec import Text.Megaparsec.Char import Text.Printf (printf)-import TH (thVer) --- @@ -178,6 +177,10 @@ , eqVer "1.0.r15.g3fc772c-5" , eqVer "0.88-2" ]+ , testGroup "Conversions"+ [ testCase "Good Version -> PVP" $ versionToPvp $(versionQ "1.2.3") @?= Just $(pvpQ "1.2.3")+ , testCase "Bad Version -> PVP" $ versionToPvp $(versionQ "1.e.3") @?= Nothing+ ] ] , testGroup "Lenses and Traversals" [ testCase "SemVer - Increment Patch" incPatch@@ -185,14 +188,15 @@ , testCase "SemVer - Get patches" patches ] , testGroup "Template Haskell"- [ testCase "SemVer" $ prettyV $(thVer "1.2.3") @?= "1.2.3"- , testCase "Version" $ prettyV $(thVer "1.2.3.4") @?= "1.2.3.4"- , testCase "Mess" $ prettyV $(thVer "003.03-3") @?= "003.03-3"- , testCase "Failure" $ $(recover [| () |] (thVer "!!!")) @?= ()+ [ testCase "SemVer" $ prettyV $(versioningQ "1.2.3") @?= "1.2.3"+ , testCase "Version" $ prettyV $(versioningQ "1.2.3.4") @?= "1.2.3.4"+ , testCase "Mess" $ prettyV $(versioningQ "003.03-3") @?= "003.03-3"+ , testCase "Failure" $ $(recover [| () |] (versioningQ "!!!")) @?= () ] , 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 (Just . Release $ Alphanum "1-x86" :| []) Nothing)+ , testCase "Parser State" $ parse pvp'' "parser state" "1.2.3arst" @?= Right ($(pvpQ "1.2.3"), "arst") ] ] ]@@ -279,3 +283,10 @@ hush :: Either a b -> Maybe b hush (Left _) = Nothing hush (Right b) = Just b++-- | An attempt to squeeze out the remaining parser state.+pvp'' :: Parsec Void T.Text (PVP, T.Text)+pvp'' = do+ v <- pvp'+ s <- getParserState+ pure (v, stateInput s)
versions.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: versions-version: 6.0.2+version: 6.0.3 synopsis: Types and parsers for software version numbers. description: A library for parsing and comparing software version numbers. We like to give@@ -59,7 +59,6 @@ main-is: Test.hs hs-source-dirs: test ghc-options: -threaded -with-rtsopts=-N- other-modules: TH build-depends: , microlens >=0.4 , tasty >=0.10.1.2