versions 3.2.0 → 3.3.0
raw patch · 5 files changed
+393/−252 lines, 5 filesdep +QuickCheckdep +checkersdep +tasty-quickcheck
Dependencies added: QuickCheck, checkers, tasty-quickcheck
Files
- CHANGELOG.md +17/−0
- Data/Versions.hs +270/−148
- README.md +7/−17
- test/Test.hs +85/−76
- versions.cabal +14/−11
CHANGELOG.md view
@@ -1,6 +1,23 @@ Changelog ========= +3.3.0+------+- New `Semantic` typeclass that provides Traversals for SemVer-like data out+ of all the version types. `Text` was also given an instance, so its much+ easier to manipulate directly:++```+λ "1.2.3" & minor %~ (+ 1)+"1.3.3"+```++Some Lenses and Traversals had their names changed or were removed entirely+to accomodate this new typeclass.++- `SemVer` and `Version` should never contain negative values, so their numeric+ components were changed from `Int` to `Word`.+ 3.2.0 ----- - Updated for `megaparsec-6` and GHC 8.2.
Data/Versions.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Rank2Types #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} @@ -40,62 +41,47 @@ , SemVer(..) , Version(..) , Mess(..)- , VUnit(..)+ , VUnit, digits, str , VChunk , VSep(..)- , VParser(..)- , ParsingError -- * Parsers- , semver- , version- , mess+ , VParser(..), ParsingError+ , semver, version, mess -- ** Wrapped Parsers- , parseV- , semverP- , versionP- , messP+ , parseV, semverP, versionP, messP -- ** Megaparsec Parsers- , semver'- , version'- , mess'+ -- | For when you'd like to mix version parsing into some larger parser.+ , semver', version', mess' -- * Pretty Printing- , prettyV- , prettySemVer- , prettyVer- , prettyMess- , parseErrorPretty+ , prettyV, prettySemVer, prettyVer, prettyMess, parseErrorPretty -- * Lenses- -- ** Traversing Text- , _Versioning- , _SemVer- , _Version+ , Lens'+ , Traversal'+ , Semantic(..)+ -- ** Traversing Text+ -- | When traversing `T.Text`, leveraging its `Semantic` instance will+ -- likely benefit you more than using these Traversals directly.+ , _Versioning, _SemVer, _Version, _Mess -- ** Versioning Traversals- , _Ideal- , _General- , _Complex- -- ** (Ideal) SemVer Lenses- , svMajor- , svMinor- , svPatch- , svPreRel- , svMeta+ , _Ideal, _General, _Complex -- ** (General) Version Lenses- , vEpoch- , vChunks- , vRel+ , epoch -- ** Misc. Lenses / Traversals- , _Digits- , _Str ) where+ , _Digits, _Str+ ) where -import Control.DeepSeq-import Data.Hashable-import Data.List (intersperse)-import Data.Monoid-import Data.Text (Text,pack,unpack,snoc)-import Data.Void-import GHC.Generics-import Text.Megaparsec-import Text.Megaparsec.Char+import Control.DeepSeq+import Data.Bool (bool)+import Data.Char (isAlpha)+import Data.Hashable+import Data.List (intersperse)+import Data.Monoid+import qualified Data.Text as T+import Data.Void+import Data.Word (Word)+import GHC.Generics+import Text.Megaparsec+import Text.Megaparsec.Char --- @@ -135,47 +121,131 @@ mFromV (Version e v r) = maybe affix (\a -> VNode [showt a] VColon affix) e where affix = VNode (chunksAsT v) VHyphen $ VLeaf (chunksAsT r) +instance Semantic Versioning where+ major f (Ideal v) = Ideal <$> major f v+ major f (General v) = General <$> major f v+ major f (Complex v) = Complex <$> major f v+ {-# INLINE major #-}++ minor f (Ideal v) = Ideal <$> minor f v+ minor f (General v) = General <$> minor f v+ minor f (Complex v) = Complex <$> minor f v+ {-# INLINE minor #-}++ patch f (Ideal v) = Ideal <$> patch f v+ patch f (General v) = General <$> patch f v+ patch f (Complex v) = Complex <$> patch f v+ {-# INLINE patch #-}++ release f (Ideal v) = Ideal <$> release f v+ release f (General v) = General <$> release f v+ release f (Complex v) = Complex <$> release f v+ {-# INLINE release #-}++ meta f (Ideal v) = Ideal <$> meta f v+ meta f (General v) = General <$> meta f v+ meta f (Complex v) = Complex <$> meta f v+ {-# INLINE meta #-}++ semantic f (Ideal v) = Ideal <$> semantic f v+ semantic f (General v) = General <$> semantic f v+ semantic f (Complex v) = Complex <$> semantic f v+ {-# INLINE semantic #-}+ -- | Traverse some Text for its inner versioning. ----- > _Versioning :: Traversal' Text Versioning------ > ("1.2.3" & _Versioning . _Ideal . svPatch %~ (+ 1)) == "1.2.4"-_Versioning :: Applicative f => (Versioning -> f Versioning) -> Text -> f Text+-- @+-- λ "1.2.3" & _Versioning . _Ideal . patch %~ (+ 1) -- or just: "1.2.3" & patch %~ (+ 1)+-- "1.2.4"+-- @+_Versioning :: Traversal' T.Text Versioning _Versioning f t = either (const (pure t)) (fmap prettyV . f) $ parseV t {-# INLINE _Versioning #-} -- | Traverse some Text for its inner SemVer.------ > _SemVer :: Traversal' Text SemVer-_SemVer :: Applicative f => (SemVer -> f SemVer) -> Text -> f Text+_SemVer :: Traversal' T.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' Text Version-_Version :: Applicative f => (Version -> f Version) -> Text -> f Text+_Version :: Traversal' T.Text Version _Version f t = either (const (pure t)) (fmap prettyVer . f) $ version t {-# INLINE _Version #-} --- | > _Ideal :: Traversal' Versioning SemVer-_Ideal :: Applicative f => (SemVer -> f SemVer) -> Versioning -> f Versioning+-- | Traverse some Text for its inner Mess.+_Mess :: Traversal' T.Text Mess+_Mess f t = either (const (pure t)) (fmap prettyMess . f) $ mess t+{-# INLINE _Mess #-}++_Ideal :: Traversal' Versioning SemVer _Ideal f (Ideal s) = Ideal <$> f s _Ideal _ v = pure v {-# INLINE _Ideal #-} --- | > _General :: Traversal' Versioning Version-_General :: Applicative f => (Version -> f Version) -> Versioning -> f Versioning+_General :: Traversal' Versioning Version _General f (General v) = General <$> f v _General _ v = pure v {-# INLINE _General #-} --- | > _Complex :: Traversal' Versioning Mess-_Complex :: Applicative f => (Mess -> f Mess) -> Versioning -> f Versioning+_Complex :: Traversal' Versioning Mess _Complex f (Complex m) = Complex <$> f m _Complex _ v = pure v {-# INLINE _Complex #-} +-- | Simple Lenses compatible with both lens and microlens.+type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s++-- | Simple Traversals compatible with both lens and microlens.+type Traversal' s a = forall f. Applicative f => (a -> f a) -> s -> f s++-- | Version types which sanely and safely yield `SemVer`-like information+-- about themselves. For instances other than `SemVer` itself however,+-- these optics may /not/ yield anything, depending on the actual value being+-- traversed. Hence, the optics here are all `Traversal'`s.+--+-- Consider the `Version` @1.2.3.4.5@. We can imagine wanting to increment+-- the minor number:+--+-- @+-- λ "1.2.3.4.5" & minor %~ (+ 1)+-- "1.3.3.4.5"+-- @+--+-- But of course something like this would fail:+--+-- @+-- λ "1.e.3.4.5" & minor %~ (+ 1)+-- "1.e.3.4.5"+-- @+--+-- However!+--+-- @+-- λ "1.e.3.4.5" & major %~ (+ 1)+-- "2.e.3.4.5"+-- @+class Semantic v where+ -- | @MAJOR.minor.patch-prerel+meta@+ major :: Traversal' v Word+ -- | @major.MINOR.patch-prerel+meta@+ minor :: Traversal' v Word+ -- | @major.minor.PATCH-prerel+meta@+ patch :: Traversal' v Word+ -- | @major.minor.patch-PREREL+meta@+ release :: Traversal' v [VChunk]+ -- | @major.minor.patch-prerel+META@+ meta :: Traversal' v [VChunk]+ -- | A Natural Transformation into an proper `SemVer`.+ semantic :: Traversal' v SemVer++instance Semantic T.Text where+ major = _Versioning . major+ minor = _Versioning . minor+ patch = _Versioning . patch+ release = _Versioning . release+ meta = _Versioning . meta+ semantic = _SemVer+ -- | An (Ideal) version number that conforms to Semantic Versioning. -- This is a /prescriptive/ parser, meaning it follows the SemVer standard. --@@ -189,10 +259,12 @@ -- -- 2. Build metadata does not affect version precedence. --+-- 3. PREREL and META strings may only contain ASCII alphanumerics.+-- -- For more information, see http://semver.org-data SemVer = SemVer { _svMajor :: Int- , _svMinor :: Int- , _svPatch :: Int+data SemVer = SemVer { _svMajor :: Word+ , _svMinor :: Word+ , _svPatch :: Word , _svPreRel :: [VChunk] , _svMeta :: [VChunk] } deriving (Show,Generic,NFData,Hashable) @@ -218,45 +290,45 @@ 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)-{-# INLINE svMajor #-}+instance Semantic SemVer where+ major f sv = fmap (\ma -> sv { _svMajor = ma }) (f $ _svMajor sv)+ {-# INLINE major #-} --- | > svMinor :: Lens' SemVer Int-svMinor :: Functor f => (Int -> f Int) -> SemVer -> f SemVer-svMinor f sv = fmap (\mi -> sv { _svMinor = mi }) (f $ _svMinor sv)-{-# INLINE svMinor #-}+ minor f sv = fmap (\mi -> sv { _svMinor = mi }) (f $ _svMinor sv)+ {-# INLINE minor #-} --- | > svPatch :: Lens' SemVer Int-svPatch :: Functor f => (Int -> f Int) -> SemVer -> f SemVer-svPatch f sv = fmap (\pa -> sv { _svPatch = pa }) (f $ _svPatch sv)-{-# INLINE svPatch #-}+ patch f sv = fmap (\pa -> sv { _svPatch = pa }) (f $ _svPatch sv)+ {-# INLINE patch #-} --- | > svPreRel :: Lens' SemVer Int-svPreRel :: Functor f => ([VChunk] -> f [VChunk]) -> SemVer -> f SemVer-svPreRel f sv = fmap (\pa -> sv { _svPreRel = pa }) (f $ _svPreRel sv)-{-# INLINE svPreRel #-}+ release f sv = fmap (\pa -> sv { _svPreRel = pa }) (f $ _svPreRel sv)+ {-# INLINE release #-} --- | > svMeta :: Lens' SemVer Int-svMeta :: Functor f => ([VChunk] -> f [VChunk]) -> SemVer -> f SemVer-svMeta f sv = fmap (\pa -> sv { _svMeta = pa }) (f $ _svMeta sv)-{-# INLINE svMeta #-}+ meta f sv = fmap (\pa -> sv { _svMeta = pa }) (f $ _svMeta sv)+ {-# INLINE meta #-} + semantic = ($)+ {-# INLINE semantic #-}+ -- | 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 Int | Str Text deriving (Eq,Show,Read,Ord,Generic,NFData,Hashable)+data VUnit = Digits Word | Str T.Text deriving (Eq,Show,Read,Ord,Generic,NFData,Hashable) --- | > _Digits :: Traversal' VUnit Int-_Digits :: Applicative f => (Int -> f Int) -> VUnit -> f VUnit+-- | Smart constructor for a `VUnit` made of digits.+digits :: Word -> VUnit+digits = Digits++-- | Smart constructor for a `VUnit` made of letters.+str :: T.Text -> Maybe VUnit+str t = bool Nothing (Just $ Str t) $ T.all isAlpha t++_Digits :: Traversal' VUnit Word _Digits f (Digits i) = Digits <$> f i _Digits _ v = pure v {-# INLINE _Digits #-} --- | > _Str :: Traversal' VUnit Text-_Str :: Applicative f => (Text -> f Text) -> VUnit -> f VUnit-_Str f (Str t) = Str <$> f t+_Str :: Traversal' VUnit T.Text+_Str f (Str t) = Str . (\t' -> bool t t' (T.all isAlpha t')) <$> f t _Str _ v = pure v {-# INLINE _Str #-} @@ -271,7 +343,7 @@ -- 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-data Version = Version { _vEpoch :: Maybe Int+data Version = Version { _vEpoch :: Maybe Word , _vChunks :: [VChunk] , _vRel :: [VChunk] } deriving (Eq,Show,Generic,NFData,Hashable) @@ -289,6 +361,8 @@ 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 @@ -333,20 +407,35 @@ f (Digits _ :_) (Str _ :_) = GT f (Str _ :_ ) (Digits _ :_) = LT --- | > vEpoch :: Lens' Version (Maybe Int)-vEpoch :: Functor f => (Maybe Int -> f (Maybe Int)) -> Version -> f Version-vEpoch f v = fmap (\ve -> v { _vEpoch = ve }) (f $ _vEpoch v)+instance Semantic Version where+ major f (Version e ([Digits n] : cs) rs) = (\n' -> Version e ([Digits n'] : cs) rs) <$> f n+ major _ v = pure v+ {-# INLINE major #-} --- | > vChunks :: Lens' Version [VChunk]-vChunks :: Functor f => ([VChunk] -> f [VChunk]) -> Version -> f Version-vChunks f v = fmap (\vc -> v { _vChunks = vc }) (f $ _vChunks v)-{-# INLINE vChunks #-}+ minor f (Version e (c : [Digits n] : cs) rs) = (\n' -> Version e (c : [Digits n'] : cs) rs) <$> f n+ minor _ v = pure v+ {-# INLINE minor #-} --- | > vRel :: Lens' Version [VChunk]-vRel :: Functor f => ([VChunk] -> f [VChunk]) -> Version -> f Version-vRel f v = fmap (\vr -> v { _vRel = vr }) (f $ _vRel v)-{-# INLINE vRel #-}+ patch f (Version e (c : d : [Digits n] : cs) rs) = (\n' -> Version e (c : d : [Digits n'] : cs) rs) <$> f n+ patch _ v = pure v+ {-# INLINE patch #-} + -- | This will always succeed.+ release f v = fmap (\vr -> v { _vRel = vr }) (f $ _vRel v)+ {-# INLINE release #-}++ -- | This will always fail.+ meta _ v = pure v+ {-# INLINE meta #-}++ semantic f (Version _ ([Digits a] : [Digits b] : [Digits c] : _) rs) = vFromS <$> f (SemVer a b c rs [])+ semantic _ v = pure v+ {-# INLINE semantic #-}++epoch :: Lens' Version (Maybe Word)+epoch f v = fmap (\ve -> v { _vEpoch = ve }) (f $ _vEpoch v)+{-# INLINE epoch #-}+ -- | A (Complex) Mess. -- This is a /descriptive/ parser, based on examples of stupidly -- crafted version numbers used in the wild.@@ -359,7 +448,7 @@ -- -- Not guaranteed to have well-defined ordering (@Ord@) behaviour, -- but so far internal tests show consistency.-data Mess = VLeaf [Text] | VNode [Text] VSep Mess deriving (Eq,Show,Generic,NFData,Hashable)+data Mess = VLeaf [T.Text] | VNode [T.Text] VSep Mess deriving (Eq,Show,Generic,NFData,Hashable) instance Ord Mess where compare (VLeaf l1) (VLeaf l2) = compare l1 l2@@ -369,6 +458,39 @@ | t1 > t2 = GT | otherwise = compare v1 v2 +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 _ 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 _ 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 _ v = pure v+ {-# INLINE patch #-}++ -- | This will always fail.+ release _ v = pure v+ {-# INLINE release #-}++ -- | This will always fail.+ meta _ v = pure v+ {-# 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 _ v = pure v+ {-# INLINE semantic #-}+ -- | Developers use a number of symbols to seperate groups of digits/letters -- in their version numbers. These are: --@@ -379,12 +501,12 @@ data VSep = VColon | VHyphen | VPlus | VUnder deriving (Eq,Show,Generic,NFData,Hashable) -- | A synonym for the more verbose `megaparsec` error type.-type ParsingError = ParseError (Token Text) Void+type ParsingError = ParseError (Token T.Text) Void -- | A wrapper for a parser function. Can be composed via their -- Monoid instance, such that a different parser can be tried -- if a previous one fails.-newtype VParser = VParser { runVP :: Text -> Either ParsingError Versioning }+newtype VParser = VParser { runVP :: T.Text -> Either ParsingError Versioning } instance Monoid VParser where -- | A parser which will always fail.@@ -394,9 +516,9 @@ (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)--- Version, or a (Complex) Mess.-parseV :: Text -> Either ParsingError Versioning+-- | Parse a piece of `T.Text` into either an (Ideal) `SemVer`, a (General)+-- `Version`, or a (Complex) `Mess`.+parseV :: T.Text -> Either ParsingError Versioning parseV = runVP $ semverP <> versionP <> messP -- | A wrapped `SemVer` parser. Can be composed with other parsers.@@ -404,89 +526,89 @@ semverP = VParser $ fmap Ideal . semver -- | Parse a (Ideal) Semantic Version.-semver :: Text -> Either ParsingError SemVer+semver :: T.Text -> Either ParsingError SemVer semver = parse (semver' <* eof) "Semantic Version" -- | Internal megaparsec parser of 'semverP'.-semver' :: Parsec Void Text SemVer-semver' = SemVer <$> major <*> minor <*> patch <*> preRel <*> metaData+semver' :: Parsec Void T.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.-digits :: Parsec Void Text Int-digits = read <$> ((unpack <$> string "0") <|> some digitChar)+digitsP :: Parsec Void T.Text Word+digitsP = read <$> ((T.unpack <$> string "0") <|> some digitChar) -major :: Parsec Void Text Int-major = digits <* char '.'+majorP :: Parsec Void T.Text Word+majorP = digitsP <* char '.' -minor :: Parsec Void Text Int-minor = major+minorP :: Parsec Void T.Text Word+minorP = majorP -patch :: Parsec Void Text Int-patch = digits+patchP :: Parsec Void T.Text Word+patchP = digitsP -preRel :: Parsec Void Text [VChunk]+preRel :: Parsec Void T.Text [VChunk] preRel = (char '-' *> chunks) <|> pure [] -metaData :: Parsec Void Text [VChunk]+metaData :: Parsec Void T.Text [VChunk] metaData = (char '+' *> chunks) <|> pure [] -chunks :: Parsec Void Text [VChunk]+chunks :: Parsec Void T.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 Text VChunk+chunk :: Parsec Void T.Text VChunk chunk = try zeroWithLetters <|> oneZero <|> many (iunit <|> sunit)- where oneZero = (:[]) . Digits . read . unpack <$> string "0"+ where oneZero = (:[]) . Digits . read . T.unpack <$> string "0" zeroWithLetters = do- z <- Digits . read . unpack <$> string "0"+ z <- Digits . read . T.unpack <$> string "0" s <- some sunit c <- chunk pure $ (z : s) ++ c -iunit :: Parsec Void Text VUnit+iunit :: Parsec Void T.Text VUnit iunit = Digits . read <$> some digitChar -sunit :: Parsec Void Text VUnit-sunit = Str . pack <$> some letterChar+sunit :: Parsec Void T.Text VUnit+sunit = Str . T.pack <$> some letterChar -- | A wrapped `Version` parser. Can be composed with other parsers. versionP :: VParser versionP = VParser $ fmap General . version -- | Parse a (General) `Version`, as defined above.-version :: Text -> Either ParsingError Version+version :: T.Text -> Either ParsingError Version version = parse (version' <* eof) "Version" -- | Internal megaparsec parser of 'versionP'.-version' :: Parsec Void Text Version-version' = Version <$> optional (try epoch) <*> chunks <*> preRel+version' :: Parsec Void T.Text Version+version' = Version <$> optional (try epochP) <*> chunks <*> preRel -epoch :: Parsec Void Text Int-epoch = read <$> (some digitChar <* char ':')+epochP :: Parsec Void T.Text Word+epochP = read <$> (some digitChar <* char ':') -- | A wrapped `Mess` parser. Can be composed with other parsers. messP :: VParser messP = VParser $ fmap Complex . mess -- | Parse a (Complex) `Mess`, as defined above.-mess :: Text -> Either ParsingError Mess+mess :: T.Text -> Either ParsingError Mess mess = parse (mess' <* eof) "Mess" -- | Internal megaparsec parser of 'messP'.-mess' :: Parsec Void Text Mess+mess' :: Parsec Void T.Text Mess mess' = try node <|> leaf -leaf :: Parsec Void Text Mess+leaf :: Parsec Void T.Text Mess leaf = VLeaf <$> tchunks -node :: Parsec Void Text Mess+node :: Parsec Void T.Text Mess node = VNode <$> tchunks <*> sep <*> mess' -tchunks :: Parsec Void Text [Text]-tchunks = (pack <$> some (letterChar <|> digitChar)) `sepBy` char '.'+tchunks :: Parsec Void T.Text [T.Text]+tchunks = (T.pack <$> some (letterChar <|> digitChar)) `sepBy` char '.' -sep :: Parsec Void Text VSep+sep :: Parsec Void T.Text VSep sep = choice [ VColon <$ char ':' , VHyphen <$ char '-' , VPlus <$ char '+'@@ -499,32 +621,32 @@ sepCh VUnder = '_' -- | Convert any parsed Versioning type to its textual representation.-prettyV :: Versioning -> Text+prettyV :: Versioning -> T.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 -> Text+prettySemVer :: SemVer -> T.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) -- | Convert a `Version` back to its textual representation.-prettyVer :: Version -> Text+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 -- | Convert a `Mess` back to its textual representation.-prettyMess :: Mess -> Text+prettyMess :: Mess -> T.Text prettyMess (VLeaf t) = mconcat $ intersperse "." t-prettyMess (VNode t s v) = snoc t' (sepCh s) <> prettyMess v+prettyMess (VNode t s v) = T.snoc t' (sepCh s) <> prettyMess v where t' = mconcat $ intersperse "." t -chunksAsT :: [VChunk] -> [Text]+chunksAsT :: [VChunk] -> [T.Text] chunksAsT = map (mconcat . map f) where f (Digits i) = showt i f (Str s) = s@@ -542,5 +664,5 @@ opposite GT = LT -- Yes, `text-show` exists, but this reduces external dependencies.-showt :: Show a => a -> Text-showt = pack . show+showt :: Show a => a -> T.Text+showt = T.pack . show
README.md view
@@ -40,15 +40,15 @@ ```haskell incPatch :: SemVer -> SemVer-incPatch s = s & svPatch %~ (+ 1)+incPatch s = s & patch %~ (+ 1) ``` Or, something more involved: ```haskell -- | Get all major versions of legally parsed SemVers.-majors :: [Text] -> [Int]-majors vs = vs ^.. each . to semver . _Right . svMajor+majors :: [Text] -> [Word]+majors vs = vs ^.. each . to semver . _Right . major ``` The `to semver . _Right` is clunky, so we provide some direct `Text`@@ -57,26 +57,16 @@ [lens-aeson](http://hackage.haskell.org/package/lens-aeson): ```haskell--- | Get all major versions of legally parsed SemVers.-majors :: [Text] -> [Int]-majors vs = vs ^.. each . _SemVer . svMajor-```--Note that `_SemVer` only attempts to parse as true Semantic Versioning. If-the package versions you're parsing don't agree to a standard, you can-achieve a similar result via:--```haskell--- | Get all major versions of potentially parsed SemVers.-majors :: [Text] -> [Int]-majors vs = vs ^.. each . _Versioning . _Ideal . svMajor+-- | Get the major version of any `Text` that has one.+majors :: [Text] -> [Word]+majors vs = vs ^.. each . major ``` We can also use these `Text` Traversals to increment versions, as above: ```haskell incPatch :: Text -> Text-incPatch s = s & _SemVer . svPatch %~ (+ 1)+incPatch s = s & patch %~ (+ 1) > incPatch "1.2.3" "1.2.4"
test/Test.hs view
@@ -2,15 +2,38 @@ module Main where +import Data.Char+import Data.Either (isRight, isLeft)+import Data.Maybe (fromJust) import Data.Monoid ((<>))-import Data.Text (Text,unpack)+import Data.Text (Text, unpack, pack) import Data.Versions 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 --- +instance Arbitrary SemVer where+ arbitrary = SemVer <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance EqProp SemVer where+ a =-= b = eq a b++instance Arbitrary VUnit where+ arbitrary = frequency [ (1, digits <$> arbitrary) , (1, s) ]+ where s = fromJust . str . pack . map unletter <$> arbitrary++-- | An ASCII letter.+newtype Letter = Letter { unletter :: Char }++instance Arbitrary Letter where+ arbitrary = Letter . chr <$> choose (97, 122)+ -- | These don't need to parse as a SemVer. goodVers :: [Text] goodVers = [ "1", "1.2", "1.0rc0", "1.0rc1", "1.1rc1", "1.58.0-3", "44.0.2403.157-1"@@ -54,65 +77,72 @@ versionOrd = [ "0.9.9.9", "1.0.0.0", "1.0.0.1", "2" ] suite :: TestTree-suite = testGroup "Unit Tests"- [ testGroup "(Ideal) Semantic Versioning"- [ testGroup "Bad Versions (shouldn't parse)" $- map (\s -> testCase (unpack s) $ assert $ isLeft $ semver s) badSemVs- , testGroup "Good Versions (should parse)" $- map (\s -> testCase (unpack s) $ isomorphSV s) goodSemVs- , testGroup "Comparisons" $- testCase "1.2.3-alpha.2 == 1.2.3-alpha.2+a1b2c3.1"- (assert $ semver "1.2.3-alpha.2" == semver "1.2.3-alpha.2+a1b2c3.1") :- map (\(a,b) -> testCase (unpack $ a <> " < " <> b) $ comp semver a b)- (zip semverOrd $ tail semverOrd)- ]- , testGroup "(General) Versions"- [ testGroup "Good Versions" $- map (\s -> testCase (unpack s) $ isomorphV s) goodVers- , 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") :- testCase "1.0 < 1:1.0" (comp version "1.0" "1:1.0") :- testCase "1.1 < 1:1.0" (comp version "1.1" "1:1.0") :- testCase "1.1 < 1:1.1" (comp version "1.1" "1:1.1") :- map (\(a,b) -> testCase (unpack $ a <> " < " <> b) $ comp version a b)- (zip cabalOrd (tail cabalOrd) <> zip versionOrd (tail versionOrd))- ]- , testGroup "(Complex) Mess"- [ testGroup "Good Versions" $- map (\s -> testCase (unpack s) $ isomorphM s) messes- , testGroup "Comparisons" $- map (\(a,b) -> testCase (unpack $ a <> " < " <> b) $ comp mess a b) $- zip messComps (tail messComps)+suite = testGroup "Tests"+ [ testGroup "Property Tests"+ [ testGroup "SemVer - Monoid" $+ map (\(name, test) -> testProperty name test) . unbatch $ monoid (SemVer 1 2 3 [] [])+ , testProperty "SemVer - Arbitrary" $ \a -> isRight . fmap (== a) $ semver (prettySemVer a) ]- , testGroup "Mixed Versioning"- [ testGroup "Identification"- [ testCase "1.2.3 is SemVer" $ check $ isSemVer <$> parseV "1.2.3"- , testCase "1.2.3-1 is SemVer" $ check $ isSemVer <$> parseV "1.2.3-1"- , testCase "1.2.3-1+1 is SemVer" $ check $ isSemVer <$> parseV "1.2.3-1+1"- , testCase "1.2.3r1 is Version" $ check $ isVersion <$> parseV "1.2.3r1"- , testCase "0.25-2 is Version" $ check $ isVersion <$> parseV "0.25-2"- , testCase "1:1.2.3-1 is Version" $ check $ isVersion <$> parseV "1:1.2.3-1"- , testCase "1.2.3+1-1 is Mess" $ check $ isMess <$> parseV "1.2.3+1-1"- , testCase "000.007-1 is Mess" $ check $ isMess <$> parseV "000.007-1"- , testCase "20.26.1_0-2 is Mess" $ check $ isMess <$> parseV "20.26.1_0-2"+ , testGroup "Unit Tests"+ [ testGroup "(Ideal) Semantic Versioning"+ [ testGroup "Bad Versions (shouldn't parse)" $+ map (\s -> testCase (unpack s) $ assert $ isLeft $ semver s) badSemVs+ , testGroup "Good Versions (should parse)" $+ map (\s -> testCase (unpack s) $ isomorphSV s) goodSemVs+ , testGroup "Comparisons" $+ testCase "1.2.3-alpha.2 == 1.2.3-alpha.2+a1b2c3.1"+ (assert $ semver "1.2.3-alpha.2" == semver "1.2.3-alpha.2+a1b2c3.1") :+ map (\(a,b) -> testCase (unpack $ a <> " < " <> b) $ comp semver a b)+ (zip semverOrd $ tail semverOrd) ]- , testGroup "Isomorphisms" $- map (\s -> testCase (unpack s) $ isomorph s) $ goodSemVs ++ goodVers ++ messes- , testGroup "Comparisons"- [ testCase "1.2.2r1-1 < 1.2.3-1" $ comp parseV "1.2.2r1-1" "1.2.3-1"- , testCase "1.2.3-1 < 1.2.4r1-1" $ comp parseV "1.2.3-1" "1.2.4r1-1"- , testCase "1.2.3-1 < 2+0007-1" $ comp parseV "1.2.3-1" "2+0007-1"- , testCase "1.2.3r1-1 < 2+0007-1" $ comp parseV "1.2.3r1-1" "2+0007-1"- , testCase "1.2-5 < 1.2.3-1" $ comp parseV "1.2-5" "1.2.3-1"+ , testGroup "(General) Versions"+ [ testGroup "Good Versions" $+ map (\s -> testCase (unpack s) $ isomorphV s) goodVers+ , 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") :+ testCase "1.0 < 1:1.0" (comp version "1.0" "1:1.0") :+ testCase "1.1 < 1:1.0" (comp version "1.1" "1:1.0") :+ testCase "1.1 < 1:1.1" (comp version "1.1" "1:1.1") :+ map (\(a,b) -> testCase (unpack $ a <> " < " <> b) $ comp version a b)+ (zip cabalOrd (tail cabalOrd) <> zip versionOrd (tail versionOrd)) ]- ]+ , testGroup "(Complex) Mess"+ [ testGroup "Good Versions" $+ map (\s -> testCase (unpack s) $ isomorphM s) messes+ , testGroup "Comparisons" $+ map (\(a,b) -> testCase (unpack $ a <> " < " <> b) $ comp mess a b) $+ zip messComps (tail messComps)+ ]+ , testGroup "Mixed Versioning"+ [ testGroup "Identification"+ [ testCase "1.2.3 is SemVer" $ check $ isSemVer <$> parseV "1.2.3"+ , testCase "1.2.3-1 is SemVer" $ check $ isSemVer <$> parseV "1.2.3-1"+ , testCase "1.2.3-1+1 is SemVer" $ check $ isSemVer <$> parseV "1.2.3-1+1"+ , testCase "1.2.3r1 is Version" $ check $ isVersion <$> parseV "1.2.3r1"+ , testCase "0.25-2 is Version" $ check $ isVersion <$> parseV "0.25-2"+ , testCase "1:1.2.3-1 is Version" $ check $ isVersion <$> parseV "1:1.2.3-1"+ , testCase "1.2.3+1-1 is Mess" $ check $ isMess <$> parseV "1.2.3+1-1"+ , testCase "000.007-1 is Mess" $ check $ isMess <$> parseV "000.007-1"+ , testCase "20.26.1_0-2 is Mess" $ check $ isMess <$> parseV "20.26.1_0-2"+ ]+ , testGroup "Isomorphisms" $+ map (\s -> testCase (unpack s) $ isomorph s) $ goodSemVs ++ goodVers ++ messes+ , testGroup "Comparisons"+ [ testCase "1.2.2r1-1 < 1.2.3-1" $ comp parseV "1.2.2r1-1" "1.2.3-1"+ , testCase "1.2.3-1 < 1.2.4r1-1" $ comp parseV "1.2.3-1" "1.2.4r1-1"+ , testCase "1.2.3-1 < 2+0007-1" $ comp parseV "1.2.3-1" "2+0007-1"+ , testCase "1.2.3r1-1 < 2+0007-1" $ comp parseV "1.2.3r1-1" "2+0007-1"+ , testCase "1.2-5 < 1.2.3-1" $ comp parseV "1.2-5" "1.2.3-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 ]+ ] ] -- | Does pretty-printing return a Versioning to its original form?@@ -149,42 +179,21 @@ isMess _ = False incPatch :: Assertion-incPatch = (v1 & _Ideal . svPatch %~ (+ 1)) @?= v2+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 & _Ideal . svPatch %~ (+ 1)) @?= v+noInc = (v & patch %~ (+ 1)) @?= v where v = General $ Version Nothing [] [] incFromT :: Assertion-incFromT = ("1.2.3" & _Versioning . _Ideal . svPatch %~ (+ 1)) @?= "1.2.4"+incFromT = (("1.2.3" :: Text) & patch %~ (+ 1)) @?= "1.2.4" 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.-assertRight :: String -> Either a b -> Assertion-assertRight _ (Right _) = return ()-assertRight msg (Left _) = assertFailure msg--instance Assertable (Either a b) where- assert = assertRight ""--assertMaybe :: String -> Maybe a -> Assertion-assertMaybe _ (Just _) = return ()-assertMaybe msg Nothing = assertFailure msg--instance Assertable (Maybe a) where- assert = assertMaybe ""--}+ where ps = (["1.2.3","2.3.4","3.4.5"] :: [Text]) ^.. each . patch main :: IO () main = defaultMain suite
versions.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: versions-version: 3.2.0+version: 3.3.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@@ -42,25 +42,28 @@ exposed-modules: Data.Versions build-depends:- base >=4.8 && <4.11- , text >=1.2 && <1.3- , megaparsec >=6 && <7+ base >= 4.8 && < 4.11+ , text >= 1.2 && < 1.3+ , megaparsec >= 6 && < 7 , deepseq >= 1.4 && < 1.5 , hashable >= 1.2 && < 1.3 default-language: Haskell2010- ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches+ ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -fwarn-incomplete-patterns -Wincomplete-uni-patterns test-suite versions-test type: exitcode-stdio-1.0 build-depends:- base >=4.8 && <4.11- , text >=1.2 && <1.3- , microlens >=0.4 && <0.5- , tasty >=0.10.1.2- , tasty-hunit >=0.9.2+ base >= 4.8 && < 4.11+ , text >= 1.2 && < 1.3+ , checkers >= 0.4 && < 0.5+ , microlens >= 0.4 && < 0.5+ , QuickCheck >= 2.9 && < 2.11+ , tasty >= 0.10.1.2+ , tasty-hunit >= 0.9.2+ , tasty-quickcheck >= 0.8 && < 0.10 , versions hs-source-dirs: test main-is: Test.hs default-language: Haskell2010- ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -threaded+ ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -fwarn-incomplete-patterns -Wincomplete-uni-patterns -threaded