diff --git a/Data/Versions.hs b/Data/Versions.hs --- a/Data/Versions.hs +++ b/Data/Versions.hs @@ -1,8 +1,9 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | -- Module : Data.Versions --- Copyright : (c) Colin Woodbury, 2015, 2016 +-- Copyright : (c) Colin Woodbury, 2015 - 2017 -- License : BSD3 -- Maintainer: Colin Woodbury -- @@ -58,7 +59,9 @@ , prettySemVer , prettyVer , prettyMess +#if (__GLASGOW_HASKELL__ > 710) , parseErrorPretty +#endif -- * Lenses -- ** Traversing Text , _Versioning @@ -82,10 +85,10 @@ , _Str ) where import Data.List (intersperse) -import Data.Semigroup -import Data.Text (Text,pack,unpack,snoc) -import Text.Megaparsec.Text +import Data.Monoid +import Data.Text (Text,pack,snoc) import Text.Megaparsec +import Text.Megaparsec.Text --- @@ -93,9 +96,36 @@ -- types. This allows each subtype to have its own parser, and for said -- parsers to be 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) +data Versioning = Ideal SemVer | General Version | Complex Mess deriving (Eq,Show) +-- | Comparison of @Ideal@s is always well defined. +-- +-- If comparison of @General@s is well-defined, then comparison +-- of @Ideal@ and @General@ is well-defined, as there exists a perfect +-- mapping from @Ideal@ to @General@. +-- +-- If comparison of @Complex@es is well-defined, then comparison of @General@ +-- 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) + +-- | Convert a `SemVer` to a `Version`. +vFromS :: SemVer -> Version +vFromS (SemVer m i p r _) = Version [[Digits m], [Digits i], [Digits p]] r + +-- | Convert a `Version` to a `Mess`. +mFromV :: Version -> Mess +mFromV (Version v r) = VNode (chunksAsT v) VHyphen $ VLeaf (chunksAsT r) + -- | Traverse some Text for its inner versioning. -- -- > _Versioning :: Traversal' Text Versioning @@ -137,34 +167,6 @@ _Complex _ v = pure v {-# INLINE _Complex #-} --- | Comparison of @Ideal@s is always well defined. --- --- If comparison of @General@s is well-defined, then comparison --- of @Ideal@ and @General@ is well-defined, as there exists a perfect --- mapping from @Ideal@ to @General@. --- --- If comparison of @Complex@es is well-defined, then comparison of @General@ --- 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) - --- | Convert a `SemVer` to a `Version`. -vFromS :: SemVer -> Version -vFromS (SemVer m i p r _) = Version [[Digits m], [Digits i], [Digits p]] r - --- | Convert a `Version` to a `Mess`. -mFromV :: Version -> Mess -mFromV (Version v r) = VNode (chunksAsT v) VHyphen $ VLeaf (chunksAsT r) - -- | An (Ideal) version number that conforms to Semantic Versioning. -- This is a /prescriptive/ parser, meaning it follows the SemVer standard. -- @@ -185,6 +187,28 @@ , _svPreRel :: [VChunk] , _svMeta :: [VChunk] } deriving (Show) +-- | Two SemVers are equal if all fields except metadata are equal. +instance Eq SemVer where + (SemVer ma mi pa pr _) == (SemVer ma' mi' pa' pr' _) = + (ma,mi,pa,pr) == (ma',mi',pa',pr') + +-- | Build metadata does not affect version precedence. +instance Ord SemVer where + compare (SemVer ma mi pa pr _) (SemVer ma' mi' pa' pr' _) = + 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 Monoid SemVer where + mempty = SemVer 0 0 0 [] [] + SemVer mj mn pa p m `mappend` SemVer mj' mn' pa' p' m' = + SemVer (mj + mj') (mn + mn') (pa + pa') (p ++ p') (m ++ m') + -- | > svMajor :: Lens' SemVer Int svMajor :: Functor f => (Int -> f Int) -> SemVer -> f SemVer svMajor f sv = fmap (\ma -> sv { _svMajor = ma }) (f $ _svMajor sv) @@ -210,23 +234,6 @@ svMeta f sv = fmap (\pa -> sv { _svMeta = pa }) (f $ _svMeta sv) {-# INLINE svMeta #-} --- | Two SemVers are equal if all fields except metadata are equal. -instance Eq SemVer where - (SemVer ma mi pa pr _) == (SemVer ma' mi' pa' pr' _) = - (ma,mi,pa,pr) == (ma',mi',pa',pr') - --- | Build metadata does not affect version precedence. -instance Ord SemVer where - compare (SemVer ma mi pa pr _) (SemVer ma' mi' pa' pr' _) = - case compare (ma,mi,pa) (ma',mi',pa') of - LT -> LT - GT -> GT - EQ -> case (pr,pr') of - ([],[]) -> EQ - ([],_) -> GT - (_,[]) -> LT - _ -> compare pr pr' - -- | 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. @@ -278,7 +285,7 @@ -- numbers like @1.003.04@ which make parsers quite sad. -- -- Not guaranteed to have well-defined ordering (@Ord@) behaviour, --- but so far interal tests show consistency. +-- but so far internal tests show consistency. data Mess = VLeaf [Text] | VNode [Text] VSep Mess deriving (Eq,Show) instance Ord Mess where @@ -299,15 +306,23 @@ data VSep = VColon | VHyphen | VPlus | VUnder deriving (Eq,Show) -- | A synonym for the more verbose `megaparsec` error type. +#if (__GLASGOW_HASKELL__ > 710) type ParsingError = ParseError (Token Text) Dec +#else +type ParsingError = ParseError +#endif -- | A wrapper for a parser function. Can be composed via their --- Semigroup instance, such that a different parser can be tried +-- Monoid instance, such that a different parser can be tried -- if a previous one fails. newtype VParser = VParser { runVP :: Text -> Either ParsingError Versioning } -instance Semigroup VParser where - (VParser f) <> (VParser g) = VParser h +instance Monoid VParser where + -- | A parser which will always fail. + mempty = VParser $ \_ -> Ideal <$> semver "" + + -- | Will attempt the right parser if the left one fails. + (VParser f) `mappend` (VParser g) = VParser h where h t = either (const (g t)) Right $ f t -- | Parse a piece of @Text@ into either an (Ideal) SemVer, a (General) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ versions ======== -[![Build Status](https://travis-ci.org/aurapm/haskell-versions.svg?branch=master)](https://travis-ci.org/aurapm/haskell-versions) +[![Build Status](https://travis-ci.org/fosskers/versions.svg?branch=master)](https://travis-ci.org/fosskers/versions) [![Coverage Status](https://coveralls.io/repos/github/aurapm/haskell-versions/badge.svg?branch=master)](https://coveralls.io/github/aurapm/haskell-versions?branch=master) [![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) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -2,7 +2,6 @@ module Main where -import Data.Either import Data.Monoid ((<>)) import Data.Text (Text,unpack) import Data.Versions @@ -163,6 +162,10 @@ patches :: Assertion patches = ps @?= [3,4,5] where ps = ["1.2.3","2.3.4","3.4.5"] ^.. each . _SemVer . svPatch + +isLeft :: Either t1 t -> Bool +isLeft (Left _) = True +isLeft _ = False {-} -- Need to submit patch for these, as well as Maybe instance. diff --git a/versions.cabal b/versions.cabal --- a/versions.cabal +++ b/versions.cabal @@ -1,65 +1,66 @@ -name: versions -version: 3.0.0 -synopsis: Types and parsers for software version numbers. -description: A library for parsing and comparing software version numbers. - . - We like to give version numbers to our software in a myriad of - ways. Some ways follow strict guidelines for incrementing and comparison. - Some follow conventional wisdom and are generally self-consistent. - Some are just plain asinine. This library provides a means of parsing - and comparing /any/ style of versioning, be it a nice Semantic Version - like this: - . - > 1.2.3-r1+git123 - . - ...or a monstrosity like this: - . - > 2:10.2+0.0093r3+1-1 - . - Please switch to if you - aren't currently using it. It provides consistency in version - incrementing and has the best constraints on comparisons. +-- This file has been generated from package.yaml by hpack version 0.17.0. +-- +-- see: https://github.com/sol/hpack -license: BSD3 -license-file: LICENSE -author: Colin Woodbury -maintainer: colingw@gmail.com -category: Data -build-type: Simple -cabal-version: >=1.10 +name: versions +version: 3.0.1 +synopsis: Types and parsers for software version numbers. +description: A library for parsing and comparing software version numbers. + We like to give version numbers to our software in a myriad of + ways. Some ways follow strict guidelines for incrementing and comparison. + Some follow conventional wisdom and are generally self-consistent. + Some are just plain asinine. This library provides a means of parsing + and comparing /any/ style of versioning, be it a nice Semantic Version + like this: + . + > 1.2.3-r1+git123 + . + ...or a monstrosity like this: + . + > 2:10.2+0.0093r3+1-1 + . + Please switch to if you + aren't currently using it. It provides consistency in version + incrementing and has the best constraints on comparisons. +license: BSD3 +license-file: LICENSE +author: Colin Woodbury +maintainer: colingw@gmail.com +category: Data +build-type: Simple +cabal-version: >= 1.10 -extra-source-files: CHANGELOG.md - , README.md +extra-source-files: + CHANGELOG.md + README.md source-repository head - type: git + type: git location: git://github.com/fosskers/haskell-versions.git library - exposed-modules: Data.Versions - - other-extensions: OverloadedStrings - - build-depends: base >=4.8 && <4.10 - , megaparsec >= 5 && < 6 - , semigroups >= 0.16.2.2 - , text >=1.2 && <1.3 - - default-language: Haskell2010 + exposed-modules: + Data.Versions + other-modules: + Paths_versions + build-depends: + base >=4.8 && <4.10 + , text >=1.2 && <1.3 + , megaparsec >=4 && <6 + default-language: Haskell2010 + ghc-options: -fwarn-unused-imports -fwarn-unused-binds test-suite versions-test - type: exitcode-stdio-1.0 - other-extensions: OverloadedStrings - - build-depends: base >=4.8 && <4.10 - , either >= 4.4.1 - , microlens >= 0.4 && < 0.5 - , tasty >= 0.10.1.2 - , tasty-hunit >= 0.9.2 - , text >=1.2 && <1.3 - , versions - - hs-source-dirs: test - main-is: Test.hs - default-language: Haskell2010 - ghc-options: -Wall -threaded + type: exitcode-stdio-1.0 + build-depends: + base >=4.8 && <4.10 + , text >=1.2 && <1.3 + , microlens >=0.4 && <0.5 + , tasty >=0.10.1.2 + , tasty-hunit >=0.9.2 + , versions + hs-source-dirs: + test + main-is: Test.hs + default-language: Haskell2010 + ghc-options: -fwarn-unused-imports -fwarn-unused-binds -threaded