├── .github ├── FUNDING.yml ├── dependabot.yml └── workflows │ └── ci.yaml ├── .gitignore ├── CHANGELOG.md ├── Data └── Versions.hs ├── LICENSE ├── README.md ├── stack.yaml ├── test └── Test.hs └── versions.cabal /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: fosskers 2 | custom: https://www.buymeacoffee.com/fosskers 3 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: "github-actions" 4 | directory: "/" 5 | schedule: 6 | interval: "daily" 7 | -------------------------------------------------------------------------------- /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | name: Tests 2 | on: 3 | pull_request: 4 | push: 5 | branches: 6 | - master 7 | 8 | jobs: 9 | build: 10 | name: CI 11 | runs-on: ubuntu-latest 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | resolver: 16 | [ 17 | "lts-23.7", 18 | "lts-22.43", 19 | "lts-21.25", 20 | "lts-20.26", 21 | "lts-19.33", 22 | "lts-18.28", 23 | "lts-16.31", 24 | ] 25 | include: 26 | - resolver: "lts-23.7" 27 | ghc: "9.8.4" 28 | - resolver: "lts-22.43" 29 | ghc: "9.6.6" 30 | - resolver: "lts-21.25" 31 | ghc: "9.4.8" 32 | - resolver: "lts-20.26" 33 | ghc: "9.2.8" 34 | - resolver: "lts-19.33" 35 | ghc: "9.0.2" 36 | - resolver: "lts-18.28" 37 | ghc: "8.10.7" 38 | - resolver: "lts-16.31" 39 | ghc: "8.8.4" 40 | 41 | steps: 42 | - name: Setup GHC 43 | uses: haskell-actions/setup@v2 44 | with: 45 | ghc-version: ${{ matrix.ghc }} 46 | enable-stack: true 47 | stack-version: 'latest' 48 | 49 | - name: Clone project 50 | uses: actions/checkout@v4 51 | 52 | - name: Cache dependencies 53 | uses: actions/cache@v4 54 | with: 55 | path: ~/.stack 56 | key: ${{ runner.os }}-${{ matrix.resolver }}-${{ hashFiles('stack.yaml') }} 57 | restore-keys: | 58 | ${{ runner.os }}-${{ matrix.resolver }}- 59 | 60 | # This entirely avoids the caching of a GHC version. 61 | - name: Build and run tests 62 | run: "stack test --fast --no-terminal --resolver=${{ matrix.resolver }} --system-ghc" 63 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/* 2 | dist-newstyle/* 3 | stack.yaml.lock 4 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## 6.0.8 (2025-02-03) 4 | 5 | #### Changed 6 | 7 | - Bumped upper bound on `base` (support for GHC 9.12). 8 | 9 | ## 6.0.7 (2024-06-03) 10 | 11 | #### Changed 12 | 13 | - Bumped upper bound on `base`. 14 | 15 | ## 6.0.6 (2024-03-08) 16 | 17 | #### Fixed 18 | 19 | - Account for large numbers when parsing on 32-bit (or smaller) systems. 20 | 21 | ## 6.0.5 (2024-01-24) 22 | 23 | #### Fixed 24 | 25 | - Certain illegal versions were parsing as PVP. 26 | 27 | ## 6.0.4 (2023-12-29) 28 | 29 | #### Changed 30 | 31 | - Bump dependencies to support GHC 9.8. 32 | 33 | ## 6.0.3 (2023-10-23) 34 | 35 | #### Added 36 | 37 | - `Data` instances for the various data types. 38 | - Simple conversion functions between the main version types. 39 | - Compile-time constructors via Template Haskell, like `versioningQ`. 40 | 41 | ## 6.0.2 (2023-10-12) 42 | 43 | #### Added 44 | 45 | - `Lift` instances for the various types, which allows parsing version numbers 46 | at compile time within Template Haskell quotes. Currently there is no exported 47 | function that supports this directly, but you could write one like: 48 | 49 | ```haskell 50 | -- | Parse a `Versioning` at compile time. 51 | thVer :: Text -> Q Exp 52 | thVer nm = 53 | case versioning nm of 54 | Left err -> fail (errorBundlePretty err) 55 | Right v -> lift v 56 | ``` 57 | 58 | #### Changed 59 | 60 | - Due to the new dependency on `template-haskell`, GHC 8.8 is now the lowest 61 | supported compiler version. 62 | 63 | ## 6.0.1 (2023-05-08) 64 | 65 | #### Fixed 66 | 67 | - Restored the ability to compile with GHC versions earlier than 9. 68 | 69 | ## 6.0.0 (2023-04-29) 70 | 71 | A number of type changes have been made to improve parsing and comparison logic. 72 | Doing so fixed several bugs and made the code cleaner overall. 73 | 74 | If you're just doing basic parsing and comparisons and not actually inspecting 75 | the types themselves, you shouldn't notice a difference. 76 | 77 | #### Added 78 | 79 | - New types `Release`, `Chunks`, and `Chunk`. 80 | 81 | #### Changed 82 | 83 | - Both `SemVer` and `Version` now contain a better-behaving `Release` type for their prerelease info. 84 | - Similarly, `Version` now also has a better-behaving `Chunks` type for its main 85 | version number sections. 86 | - The `release` traversal now yields a `Maybe Release`. 87 | - Versions with `~` in their metadata will now parse as a `Mess`. Example: `12.0.0-3ubuntu1~20.04.5` 88 | 89 | #### Removed 90 | 91 | - The various `Semigroup` instances. Adding version numbers together is a 92 | nonsensical operation and should never have been added in the first place. 93 | - The `VChunk` and `VUnit` types and their associated functions. 94 | 95 | #### Fixed 96 | 97 | - Leading zeroes are handled a little better in `SemVer` pre-release data. 98 | 99 | ## 5.0.5 (2023-03-23) 100 | 101 | #### Changed 102 | 103 | - Bumped `base` bound to support GHC 9.6. 104 | 105 | ## 5.0.4 (2022-10-18) 106 | 107 | #### Changed 108 | 109 | - Bumped `base` bound to support GHC 9.4. 110 | 111 | ## 5.0.3 (2022-02-25) 112 | 113 | #### Fixed 114 | 115 | - A bug in `prettyVer` that flipped the order of the `preRel` and `meta` fields. 116 | 117 | ## 5.0.2 (2022-01-21) 118 | 119 | #### Added 120 | 121 | - `text-2.0` support. 122 | 123 | ## 5.0.1 (2021-12-08) 124 | 125 | #### Changed 126 | 127 | - Support for GHC 9.2. 128 | 129 | #### Fixed 130 | 131 | - Remove redundant pattern match. 132 | 133 | ## 5.0.0 (2021-04-14) 134 | 135 | This release brings `versions` in line with version `2.0.0` of the SemVer spec. 136 | The main addition to the spec is the allowance of hyphens in both the prerelease 137 | and metadata sections. As such, **certain versions like `1.2.3+1-1` which 138 | previously would not parse as SemVer now do.** 139 | 140 | To accomodate this and other small spec updates, the `SemVer` and `Version` 141 | types have received breaking changes here. 142 | 143 | #### Changed 144 | 145 | - **Breaking:** The `_svMeta` field of `SemVer` is now parsed as a dumber `Maybe Text` instead of `[VChunk]`, due to metadata now being allowed to possess 146 | leading zeroes. 147 | - **Breaking:** Like the above, the `_vMeta` field of `Version` is now `Maybe Text`. 148 | - **Breaking: The `_vRel` and `_vMeta` fields of `Version` have had their order 149 | flipped.** Further, the prelease and meta sections are now expected in the 150 | same order as `SemVer` when parsing (prerel first, meta second). `Version` is 151 | thus now a quite similar to `SemVer`, except allowing letters in more 152 | permissive positions. 153 | - **Breaking:** The `meta` traversal has been altered to accomodate the metadata 154 | field changes. 155 | 156 | #### Fixed 157 | 158 | - Parsing certain legal SemVers specified in the spec. 159 | 160 | ## 4.0.3 (2021-02-23) 161 | 162 | #### Changed 163 | 164 | - Support for GHC 9. 165 | 166 | ## 4.0.2 (2021-01-23) 167 | 168 | #### Fixed 169 | 170 | - A bug in zero parsing within SemVer prereleases. [#42] 171 | 172 | [#42]: https://github.com/fosskers/versions/issues/42 173 | 174 | ## 4.0.1 (2020-10-22) 175 | 176 | #### Fixed 177 | 178 | - An infinite loop in `Version` comparison. [aura#652] 179 | 180 | [aura#652]: https://github.com/fosskers/aura/issues/652 181 | 182 | ## 4.0.0 (2020-10-20) 183 | 184 | #### Changed 185 | 186 | - **Breaking:** `VChunk` now cannot be empty. 187 | - **Breaking:** A `Version` now guarantees `NonEmpty` chunks. 188 | - **Breaking:** A `Mess` now guarantees `NonEmpty` chunks, and its structure has 189 | been significantly changed. Particularly, `Mess` values are now aware of the 190 | `Int` values they hold (when they do), as well as "revision" values of the 191 | pattern `rXYZ`. 192 | - Comparison of `Version` values is more memory efficient. 193 | 194 | #### Added 195 | 196 | - `Version` now has an extra field, `_vMeta :: [VChunk]` for capturing 197 | "metadata" like Semver. This prevents otherwise nice-looking versions from 198 | being demoted to `Mess`. 199 | - The `MChunk` type to accomodate the changes to `Mess` mentioned above. 200 | 201 | #### Removed 202 | 203 | - **Breaking:** `Version` no longer has a `Monoid` instance. 204 | 205 | #### Fixed 206 | 207 | - `""` no longer parses in any way. [#32] 208 | - Version strings with trailing whitespace no longer parse via `versioning`. [#33] 209 | - Particular edge cases involving `Mess` comparisons. [aura#646] 210 | - A particular edge case involving prereleases in `Version` comparisons. [aura#586] 211 | 212 | [#32]: https://github.com/fosskers/versions/issues/32 213 | [#33]: https://github.com/fosskers/versions/issues/33 214 | [aura#646]: https://github.com/fosskers/aura/issues/646 215 | [aura#586]: https://github.com/fosskers/aura/issues/586 216 | 217 | ## 3.5.4 (2020-05-12) 218 | 219 | #### Added 220 | 221 | - The functions `isIdeal`, `isGeneral`, and `isComplex` for `Bool`-based 222 | inspection of parse results. 223 | - `messMajor`, `messMinor`, `messPatch`, and `messPatchChunk` for improved 224 | introspection into `Mess` values. 225 | 226 | #### Changed 227 | 228 | - Improved `Mess` comparison logic. 229 | 230 | ## 3.5.3 231 | 232 | - GHC 8.10 support. 233 | 234 | ## 3.5.2 235 | 236 | - Added a new `PVP` type and parsers. 237 | 238 | ## 3.5.1.1 239 | 240 | - GHC 8.8 compatibility. 241 | 242 | ## 3.5.0 243 | 244 | - Updated to `megaparsec-7`. Our `ParsingError` type alias has changed to match 245 | Megaparsec's new error model, and `errorBundlePretty` is now exposed instead of 246 | the old `parseErrorPretty`. 247 | 248 | ## 3.4.0.1 249 | 250 | - Enhanced the whitespace handling in `semver'`, `version'`, and `mess'`. 251 | 252 | ## 3.4.0 253 | 254 | - Removed `ParseV` and surrounding machinery. 255 | Use `versioning` now instead of the `parseV` function. 256 | 257 | ## 3.3.2 258 | 259 | - GHC 8.4.1 compatibility. 260 | 261 | ## 3.3.0 262 | 263 | - New `Semantic` typeclass that provides Traversals for SemVer-like data out 264 | of all the version types. `Text` was also given an instance, so its much 265 | easier to manipulate directly: 266 | 267 | ``` 268 | λ "1.2.3" & minor %~ (+ 1) 269 | "1.3.3" 270 | ``` 271 | 272 | Some Lenses and Traversals had their names changed or were removed entirely 273 | to accomodate this new typeclass. 274 | 275 | - `SemVer` and `Version` should never contain negative values, so their numeric 276 | components were changed from `Int` to `Word`. 277 | 278 | ## 3.2.0 279 | 280 | - Updated for `megaparsec-6` and GHC 8.2. 281 | 282 | ## 3.1.1 283 | 284 | - Added instances for common typeclasses: `Generic`, `NFData`, and 285 | `Hashable`. This is to avoid having users define these instances themselves 286 | as orphans. If there are more instances you want added, please let me know. 287 | `Data` was left out on purpose. 288 | 289 | ## 3.1.0 290 | 291 | - Added support for _epoch_ numbers in the `Version` type. These are numbers 292 | like the `1:` in `1:2.3.4`. These are used in Arch Linux in rare cases where 293 | packages change their versioning scheme, but need a reliable integer prefix 294 | to establish ordering. The `Version` type has been given a new field, 295 | `_vEpoch :: Maybe Int`, and a corresponding lens, `vEpoch`. 296 | 297 | ## 3.0.2 298 | 299 | - Expose internal parsers so that they could be used in other parser programs 300 | that parse version numbers in larger files. 301 | 302 | ## 3.0.0 303 | 304 | - Updated for `megaparsec-5` and `ghc-8` 305 | 306 | ## 2.0.0 307 | 308 | - Switched to `megaparsec` to perform all parsing as `Text` 309 | - Support for legacy `String` removed 310 | - Added more Traversals and INLINE'd all Lenses/Traversals 311 | 312 | ## 1.1.0 313 | 314 | - Added Lenses and Traversals (no `lens` dependency) 315 | -------------------------------------------------------------------------------- /Data/Versions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveDataTypeable #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE DeriveLift #-} 6 | {-# LANGUAGE DerivingStrategies #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE Rank2Types #-} 9 | 10 | -- | 11 | -- Module : Data.Versions 12 | -- Copyright : (c) Colin Woodbury, 2015 - 2023 13 | -- License : BSD3 14 | -- Maintainer: Colin Woodbury 15 | -- 16 | -- A library for parsing and comparing software version numbers. 17 | -- 18 | -- We like to give version numbers to our software in a myriad of different 19 | -- ways. Some ways follow strict guidelines for incrementing and comparison. 20 | -- Some follow conventional wisdom and are generally self-consistent. Some are 21 | -- just plain asinine. This library provides a means of parsing and comparing 22 | -- /any/ style of versioning, be it a nice Semantic Version like this: 23 | -- 24 | -- > 1.2.3-r1+git123 25 | -- 26 | -- ...or a monstrosity like this: 27 | -- 28 | -- > 2:10.2+0.0093r3+1-1 29 | -- 30 | -- Please switch to if you aren't 31 | -- currently using it. It provides consistency in version incrementing and has 32 | -- the best constraints on comparisons. 33 | -- 34 | -- __This library implements version @2.0.0@ of the SemVer spec.__ 35 | -- 36 | -- == Using the Parsers 37 | -- In general, `versioning` is the function you want. It attempts to parse a 38 | -- given `Text` using the three individual parsers, `semver`, `version` and 39 | -- `mess`. If one fails, it tries the next. If you know you only want to parse 40 | -- one specific version type, use that parser directly (e.g. `semver`). 41 | 42 | module Data.Versions 43 | ( -- * Types 44 | Versioning(..), isIdeal, isGeneral, isComplex 45 | , SemVer(..) 46 | , PVP(..) 47 | , Version(..) 48 | , Mess(..), messMajor, messMinor, messPatch, messPatchChunk 49 | , Release(..) 50 | , Chunks(..) 51 | , Chunk(..) 52 | , MChunk(..) 53 | , VSep(..) 54 | -- ** Compile-time Constructors 55 | , versioningQ, semverQ, versionQ, messQ, pvpQ 56 | -- ** Conversions 57 | , semverToVersion, versionToMess, versionToPvp 58 | -- * Parsing Versions 59 | , ParsingError 60 | , versioning, semver, pvp, version, mess 61 | -- ** Megaparsec Parsers 62 | -- | For when you'd like to mix version parsing into some larger parser. 63 | , versioning', semver', pvp', version', mess' 64 | -- * Pretty Printing 65 | , prettyV, prettySemVer, prettyPVP, prettyVer, prettyMess, errorBundlePretty 66 | -- * Lenses 67 | , Lens' 68 | , Traversal' 69 | , Semantic(..) 70 | -- ** Traversing Text 71 | -- | When traversing `Text`, leveraging its `Semantic` instance will 72 | -- likely benefit you more than using these Traversals directly. 73 | , _Versioning, _SemVer, _Version, _Mess 74 | -- ** Versioning Traversals 75 | , _Ideal, _General, _Complex 76 | -- ** (General) Version Lenses 77 | , epoch 78 | ) where 79 | 80 | import qualified Control.Applicative.Combinators.NonEmpty as PC 81 | import Control.DeepSeq 82 | import Control.Monad (unless, void) 83 | import Data.Char (isAlpha, isAlphaNum) 84 | import Data.Data (Data) 85 | import Data.Foldable (fold) 86 | import Data.Hashable (Hashable) 87 | import Data.List (intersperse) 88 | import Data.List.NonEmpty (NonEmpty(..)) 89 | import qualified Data.List.NonEmpty as NEL 90 | import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) 91 | import Data.Text (Text) 92 | import qualified Data.Text as T 93 | import Data.Void (Void) 94 | import Data.Word (Word64) 95 | import GHC.Generics (Generic) 96 | import Language.Haskell.TH (Exp, Q) 97 | import Language.Haskell.TH.Syntax (Lift(..)) 98 | import Text.Megaparsec hiding (chunk) 99 | import Text.Megaparsec.Char 100 | import qualified Text.Megaparsec.Char.Lexer as L 101 | 102 | --- 103 | 104 | -- | A top-level Versioning type. Acts as a wrapper for the more specific types. 105 | -- This allows each subtype to have its own parser, and for said parsers to be 106 | -- composed. This is useful for specifying custom behaviour for when a certain 107 | -- parser fails. 108 | data Versioning = Ideal !SemVer | General !Version | Complex !Mess 109 | deriving (Eq, Show, Generic, NFData, Hashable, Lift, Data) 110 | 111 | -- | Short-hand for detecting a `SemVer`. 112 | isIdeal :: Versioning -> Bool 113 | isIdeal (Ideal _) = True 114 | isIdeal _ = False 115 | 116 | -- | Short-hand for detecting a `Version`. 117 | isGeneral :: Versioning -> Bool 118 | isGeneral (General _) = True 119 | isGeneral _ = False 120 | 121 | -- | Short-hand for detecting a `Mess`. 122 | isComplex :: Versioning -> Bool 123 | isComplex (Complex _) = True 124 | isComplex _ = False 125 | 126 | -- | Comparison of @Ideal@s is always well defined. 127 | -- 128 | -- If comparison of @General@s is well-defined, then comparison of @Ideal@ and 129 | -- @General@ is well-defined, as there exists a perfect mapping from @Ideal@ to 130 | -- @General@. 131 | -- 132 | -- If comparison of @Complex@es is well-defined, then comparison of @General@ 133 | -- and @Complex@ is well defined for the same reason. This implies comparison of 134 | -- @Ideal@ and @Complex@ is also well-defined. 135 | instance Ord Versioning where 136 | compare (Ideal s) (Ideal s') = compare s s' 137 | compare (General v) (General v') = compare v v' 138 | compare (Complex m) (Complex m') = compare m m' 139 | compare (Ideal s) (General v) = semverAndVer s v 140 | compare (General v) (Ideal s) = opposite $ semverAndVer s v 141 | compare (General v) (Complex m) = compare (versionToMess v) m 142 | compare (Complex m) (General v) = opposite $ compare (versionToMess v) m 143 | compare (Ideal s) (Complex m) = semverAndMess s m 144 | compare (Complex m) (Ideal s) = opposite $ semverAndMess s m 145 | 146 | -- | Convert a `SemVer` to a `Version`. 147 | semverToVersion :: SemVer -> Version 148 | semverToVersion (SemVer ma mi pa re me) = 149 | Version 150 | { _vEpoch = Nothing 151 | , _vChunks = Chunks $ Numeric ma :| [Numeric mi, Numeric pa] 152 | , _vMeta = me 153 | , _vRel = re } 154 | 155 | -- | Convert a `Version` to a `Mess`. 156 | versionToMess :: Version -> Mess 157 | versionToMess (Version me (Chunks v) r _) = case me of 158 | Nothing -> f 159 | Just e -> 160 | let cs = (:| []) . MDigit e $ showt e 161 | in Mess cs $ Just (VColon, f) 162 | where 163 | f :: Mess 164 | f = Mess cs $ fmap g r 165 | where 166 | cs = NEL.map toMChunk v 167 | 168 | g :: Release -> (VSep, Mess) 169 | g (Release cs) = (VHyphen, Mess ms Nothing) 170 | where 171 | ms = NEL.map toMChunk cs 172 | 173 | -- | Convert a `Version` to a `PVP`. Fails if there is an epoch present, but 174 | -- otherwise ignores the `Release` and other metadata. Naturally it also fails 175 | -- if any of the version components contain any non-digits. 176 | versionToPvp :: Version -> Maybe PVP 177 | versionToPvp (Version (Just _) _ _ _) = Nothing 178 | versionToPvp (Version Nothing (Chunks cs) _ _) = PVP <$> traverse f cs 179 | where 180 | f :: Chunk -> Maybe Word 181 | f (Numeric w) = Just w 182 | f (Alphanum _) = Nothing 183 | 184 | semverAndVer :: SemVer -> Version -> Ordering 185 | -- A `Version` with a non-zero epoch value is automatically greater than any 186 | -- `SemVer`. 187 | semverAndVer _ (Version (Just e) _ _ _) | e > 0 = LT 188 | semverAndVer (SemVer ma mi pa sr _) (Version _ (Chunks vc) vr _) = 189 | case compare ma <$> (nth 0 vc' >>= singleDigitLenient) of 190 | Nothing -> GT 191 | Just GT -> GT 192 | Just LT -> LT 193 | Just EQ -> case compare mi <$> (nth 1 vc' >>= singleDigitLenient) of 194 | Nothing -> GT 195 | Just GT -> GT 196 | Just LT -> LT 197 | Just EQ -> case compare pa <$> (nth 2 vc' >>= singleDigitLenient) of 198 | Nothing -> GT 199 | Just GT -> GT 200 | Just LT -> LT 201 | -- By thes point, the major/minor/patch positions have all been equal. 202 | -- If there is a fourth position, its type, not its value, will 203 | -- determine which overall version is greater. 204 | Just EQ -> case nth 3 vc' of 205 | -- 1.2.3 > 1.2.3.git 206 | Just (Alphanum _) -> GT 207 | -- 1.2.3 < 1.2.3.0 208 | Just (Numeric _) -> LT 209 | Nothing -> compare sr vr 210 | where 211 | vc' :: [Chunk] 212 | vc' = NEL.toList vc 213 | 214 | nth :: Int -> [Chunk] -> Maybe Chunk 215 | nth _ [] = Nothing 216 | nth 0 (c:_) = Just c 217 | nth n (_:cs) = nth (n - 1) cs 218 | 219 | -- | Special logic for when semver-like values can be extracted from a `Mess`. 220 | -- This avoids having to "downcast" the `SemVer` into a `Mess` before comparing, 221 | -- and in some cases can offer better comparison results. 222 | semverAndMess :: SemVer -> Mess -> Ordering 223 | semverAndMess s@(SemVer ma mi pa _ _) m = case compare ma <$> messMajor m of 224 | Nothing -> fallback 225 | Just LT -> LT 226 | Just GT -> GT 227 | Just EQ -> case compare mi <$> messMinor m of 228 | Nothing -> fallback 229 | Just LT -> LT 230 | Just GT -> GT 231 | Just EQ -> case compare pa <$> messPatch m of 232 | Just LT -> LT 233 | Just GT -> GT 234 | -- If they've been equal up to this point, the `Mess` 235 | -- will by definition have more to it, meaning that 236 | -- it's more likely to be newer, despite its poor shape. 237 | Just EQ -> fallback 238 | -- Even if we weren't able to extract a standalone patch number, we might 239 | -- still be able to find a number at the head of the `Chunk` in that 240 | -- position. 241 | Nothing -> case messPatchChunk m >>= singleDigitLenient of 242 | -- We were very close, but in the end the `Mess` had a nonsensical value 243 | -- in its patch position. 244 | Nothing -> fallback 245 | Just pa' -> case compare pa pa' of 246 | LT -> LT 247 | GT -> GT 248 | -- This follows semver's rule that pre-releases have lower precedence. 249 | EQ -> GT 250 | where 251 | fallback :: Ordering 252 | fallback = compare (General $ semverToVersion s) (Complex m) 253 | 254 | instance Semantic Versioning where 255 | major f (Ideal v) = Ideal <$> major f v 256 | major f (General v) = General <$> major f v 257 | major f (Complex v) = Complex <$> major f v 258 | {-# INLINE major #-} 259 | 260 | minor f (Ideal v) = Ideal <$> minor f v 261 | minor f (General v) = General <$> minor f v 262 | minor f (Complex v) = Complex <$> minor f v 263 | {-# INLINE minor #-} 264 | 265 | patch f (Ideal v) = Ideal <$> patch f v 266 | patch f (General v) = General <$> patch f v 267 | patch f (Complex v) = Complex <$> patch f v 268 | {-# INLINE patch #-} 269 | 270 | release f (Ideal v) = Ideal <$> release f v 271 | release f (General v) = General <$> release f v 272 | release f (Complex v) = Complex <$> release f v 273 | {-# INLINE release #-} 274 | 275 | meta f (Ideal v) = Ideal <$> meta f v 276 | meta f (General v) = General <$> meta f v 277 | meta f (Complex v) = Complex <$> meta f v 278 | {-# INLINE meta #-} 279 | 280 | semantic f (Ideal v) = Ideal <$> semantic f v 281 | semantic f (General v) = General <$> semantic f v 282 | semantic f (Complex v) = Complex <$> semantic f v 283 | {-# INLINE semantic #-} 284 | 285 | -- | Traverse some Text for its inner versioning. 286 | -- 287 | -- @ 288 | -- λ "1.2.3" & _Versioning . _Ideal . patch %~ (+ 1) -- or just: "1.2.3" & patch %~ (+ 1) 289 | -- "1.2.4" 290 | -- @ 291 | _Versioning :: Traversal' Text Versioning 292 | _Versioning f t = either (const (pure t)) (fmap prettyV . f) $ versioning t 293 | {-# INLINE _Versioning #-} 294 | 295 | -- | Traverse some Text for its inner SemVer. 296 | _SemVer :: Traversal' Text SemVer 297 | _SemVer f t = either (const (pure t)) (fmap prettySemVer . f) $ semver t 298 | {-# INLINE _SemVer #-} 299 | 300 | -- | Traverse some Text for its inner Version. 301 | _Version :: Traversal' Text Version 302 | _Version f t = either (const (pure t)) (fmap prettyVer . f) $ version t 303 | {-# INLINE _Version #-} 304 | 305 | -- | Traverse some Text for its inner Mess. 306 | _Mess :: Traversal' Text Mess 307 | _Mess f t = either (const (pure t)) (fmap prettyMess . f) $ mess t 308 | {-# INLINE _Mess #-} 309 | 310 | -- | Possibly extract a `SemVer` from a `Versioning`. 311 | _Ideal :: Traversal' Versioning SemVer 312 | _Ideal f (Ideal s) = Ideal <$> f s 313 | _Ideal _ v = pure v 314 | {-# INLINE _Ideal #-} 315 | 316 | -- | Possibly extract a `Version` from a `Versioning`. 317 | _General :: Traversal' Versioning Version 318 | _General f (General v) = General <$> f v 319 | _General _ v = pure v 320 | {-# INLINE _General #-} 321 | 322 | -- | Possibly extract a `Mess` from a `Versioning`. 323 | _Complex :: Traversal' Versioning Mess 324 | _Complex f (Complex m) = Complex <$> f m 325 | _Complex _ v = pure v 326 | {-# INLINE _Complex #-} 327 | 328 | -- | Simple Lenses compatible with both lens and microlens. 329 | type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s 330 | 331 | -- | Simple Traversals compatible with both lens and microlens. 332 | type Traversal' s a = forall f. Applicative f => (a -> f a) -> s -> f s 333 | 334 | -- | Version types which sanely and safely yield `SemVer`-like information about 335 | -- themselves. For instances other than `SemVer` itself however, these optics 336 | -- may /not/ yield anything, depending on the actual value being traversed. 337 | -- Hence, the optics here are all `Traversal'`s. 338 | -- 339 | -- Consider the `Version` @1.2.3.4.5@. We can imagine wanting to increment the 340 | -- minor number: 341 | -- 342 | -- @ 343 | -- λ "1.2.3.4.5" & minor %~ (+ 1) 344 | -- "1.3.3.4.5" 345 | -- @ 346 | -- 347 | -- But of course something like this would fail: 348 | -- 349 | -- @ 350 | -- λ "1.e.3.4.5" & minor %~ (+ 1) 351 | -- "1.e.3.4.5" 352 | -- @ 353 | -- 354 | -- However! 355 | -- 356 | -- @ 357 | -- λ "1.e.3.4.5" & major %~ (+ 1) 358 | -- "2.e.3.4.5" 359 | -- @ 360 | class Semantic v where 361 | -- | @MAJOR.minor.patch-prerel+meta@ 362 | major :: Traversal' v Word 363 | -- | @major.MINOR.patch-prerel+meta@ 364 | minor :: Traversal' v Word 365 | -- | @major.minor.PATCH-prerel+meta@ 366 | patch :: Traversal' v Word 367 | -- | @major.minor.patch-PREREL+meta@ 368 | release :: Traversal' v (Maybe Release) 369 | -- | @major.minor.patch-prerel+META@ 370 | meta :: Traversal' v (Maybe Text) 371 | -- | A Natural Transformation into an proper `SemVer`. 372 | semantic :: Traversal' v SemVer 373 | 374 | instance Semantic Text where 375 | major = _Versioning . major 376 | minor = _Versioning . minor 377 | patch = _Versioning . patch 378 | release = _Versioning . release 379 | meta = _Versioning . meta 380 | semantic = _SemVer 381 | 382 | -------------------------------------------------------------------------------- 383 | -- (Ideal) SemVer 384 | 385 | -- | An (Ideal) version number that conforms to Semantic Versioning. 386 | -- This is a /prescriptive/ parser, meaning it follows the SemVer standard. 387 | -- 388 | -- Legal semvers are of the form: MAJOR.MINOR.PATCH-PREREL+META 389 | -- 390 | -- Example: @1.2.3-r1+commithash@ 391 | -- 392 | -- Extra Rules: 393 | -- 394 | -- 1. Pre-release versions have /lower/ precedence than normal versions. 395 | -- 396 | -- 2. Build metadata does not affect version precedence. 397 | -- 398 | -- 3. PREREL and META strings may only contain ASCII alphanumerics and hyphens. 399 | -- 400 | -- For more information, see http://semver.org 401 | data SemVer = SemVer 402 | { _svMajor :: !Word 403 | , _svMinor :: !Word 404 | , _svPatch :: !Word 405 | , _svPreRel :: !(Maybe Release) 406 | , _svMeta :: !(Maybe Text) } 407 | deriving stock (Show, Generic, Lift, Data) 408 | deriving anyclass (NFData, Hashable) 409 | 410 | -- | Two SemVers are equal if all fields except metadata are equal. 411 | instance Eq SemVer where 412 | (SemVer ma mi pa pr _) == (SemVer ma' mi' pa' pr' _) = 413 | (ma,mi,pa,pr) == (ma',mi',pa',pr') 414 | 415 | -- | Build metadata does not affect version precedence. 416 | instance Ord SemVer where 417 | compare (SemVer ma mi pa pr _) (SemVer ma' mi' pa' pr' _) = 418 | case compare (ma,mi,pa) (ma',mi',pa') of 419 | LT -> LT 420 | GT -> GT 421 | EQ -> case (pr, pr') of 422 | (Nothing, Nothing) -> EQ 423 | (Nothing, _) -> GT 424 | (_, Nothing) -> LT 425 | (Just ap, Just bp) -> compare ap bp 426 | 427 | instance Semantic SemVer where 428 | major f sv = fmap (\ma -> sv { _svMajor = ma }) (f $ _svMajor sv) 429 | {-# INLINE major #-} 430 | 431 | minor f sv = fmap (\mi -> sv { _svMinor = mi }) (f $ _svMinor sv) 432 | {-# INLINE minor #-} 433 | 434 | patch f sv = fmap (\pa -> sv { _svPatch = pa }) (f $ _svPatch sv) 435 | {-# INLINE patch #-} 436 | 437 | release f sv = fmap (\pa -> sv { _svPreRel = pa }) (f $ _svPreRel sv) 438 | {-# INLINE release #-} 439 | 440 | meta f sv = fmap (\pa -> sv { _svMeta = pa }) (f $ _svMeta sv) 441 | {-# INLINE meta #-} 442 | 443 | semantic = ($) 444 | {-# INLINE semantic #-} 445 | 446 | -- | `Chunk`s have comparison behaviour according to SemVer's rules for preleases. 447 | newtype Release = Release (NonEmpty Chunk) 448 | deriving stock (Eq, Show, Read, Generic, Lift, Data) 449 | deriving anyclass (NFData, Hashable) 450 | 451 | instance Ord Release where 452 | compare (Release as) (Release bs) = 453 | fromMaybe EQ . listToMaybe . mapMaybe f $ zipLongest (NEL.toList as) (NEL.toList bs) 454 | where 455 | f :: These Chunk Chunk -> Maybe Ordering 456 | f (Both a b) = case cmpSemVer a b of 457 | LT -> Just LT 458 | GT -> Just GT 459 | EQ -> Nothing 460 | f (This _) = Just GT 461 | f (That _) = Just LT 462 | 463 | -- | A logical unit of a version number. 464 | -- 465 | -- Either entirely numerical (with no leading zeroes) or entirely alphanumerical 466 | -- (with a free mixture of numbers, letters, and hyphens.) 467 | -- 468 | -- Groups of these (like `Release`) are separated by periods to form a full 469 | -- section of a version number. 470 | -- 471 | -- Examples: 472 | -- 473 | -- @ 474 | -- 1 475 | -- 20150826 476 | -- r3 477 | -- 0rc1-abc3 478 | -- @ 479 | data Chunk = Numeric !Word | Alphanum !Text 480 | deriving stock (Eq, Show, Read, Generic, Lift, Data) 481 | deriving anyclass (NFData, Hashable) 482 | 483 | toMChunk :: Chunk -> MChunk 484 | toMChunk (Numeric n) = MDigit n $ showt n 485 | toMChunk (Alphanum s) = MPlain s 486 | 487 | -- | `Chunk` is used in multiple places but requires different comparison 488 | -- semantics depending on the wrapping type. This function and `cmpLenient` 489 | -- below provide this. 490 | cmpSemVer :: Chunk -> Chunk -> Ordering 491 | cmpSemVer (Numeric a) (Numeric b) = compare a b 492 | cmpSemVer (Numeric _) (Alphanum _) = LT 493 | cmpSemVer (Alphanum _) (Numeric _) = GT 494 | cmpSemVer (Alphanum a) (Alphanum b) = compare a b 495 | 496 | -- | Like `cmpSemVer`, but for `Version`s. We need to be mindful of comparisons 497 | -- like @1.2.0 > 1.2.0rc1@ which normally wouldn't occur in SemVer. 498 | cmpLenient :: Chunk -> Chunk -> Ordering 499 | cmpLenient (Numeric a) (Numeric b) = compare a b 500 | cmpLenient a@(Alphanum x) b@(Alphanum y) = 501 | case (singleDigitLenient a, singleDigitLenient b) of 502 | (Just i, Just j) -> compare i j 503 | _ -> compare x y 504 | cmpLenient (Numeric n) b@(Alphanum _) = 505 | case singleDigitLenient b of 506 | Nothing -> GT 507 | Just m -> case compare n m of 508 | -- 1.2.0 > 1.2.0rc1 509 | EQ -> GT 510 | c -> c 511 | cmpLenient a@(Alphanum _) (Numeric n) = 512 | case singleDigitLenient a of 513 | Nothing -> LT 514 | Just m -> case compare m n of 515 | -- 1.2.0rc1 < 1.2.0 516 | EQ -> LT 517 | c -> c 518 | 519 | -- | Like `singleDigit` but will grab a leading `Word` even if followed by 520 | -- letters. 521 | singleDigitLenient :: Chunk -> Maybe Word 522 | singleDigitLenient (Numeric n) = Just n 523 | singleDigitLenient (Alphanum s) = hush $ parse unsignedP "Single Digit Lenient" s 524 | 525 | -------------------------------------------------------------------------------- 526 | -- (Haskell) PVP 527 | 528 | -- | A PVP version number specific to the Haskell ecosystem. Like SemVer this is 529 | -- a prescriptive scheme, and follows . 530 | -- 531 | -- Legal PVP values are of the form: MAJOR(.MAJOR.MINOR) 532 | -- 533 | -- Example: @1.2.3@ 534 | -- 535 | -- Extra Rules: 536 | -- 537 | -- 1. Each component must be a number. 538 | -- 539 | -- 2. Only the first MAJOR component is actually necessary. Otherwise, there can 540 | -- be any number of components. @1.2.3.4.5.6.7@ is legal. 541 | -- 542 | -- 3. Unlike SemVer there are two MAJOR components, and both indicate a breaking 543 | -- change. The spec otherwise designates no special meaning to components 544 | -- past the MINOR position. 545 | newtype PVP = PVP { _pComponents :: NonEmpty Word } 546 | deriving stock (Eq, Ord, Show, Generic, Lift, Data) 547 | deriving anyclass (NFData, Hashable) 548 | 549 | instance Semantic PVP where 550 | major f (PVP (m :| rs)) = (\ma -> PVP $ ma :| rs) <$> f m 551 | {-# INLINE major #-} 552 | 553 | minor f (PVP (m :| mi : rs)) = (\mi' -> PVP $ m :| mi' : rs) <$> f mi 554 | minor f (PVP (m :| [])) = (\mi' -> PVP $ m :| [mi']) <$> f 0 555 | {-# INLINE minor #-} 556 | 557 | patch f (PVP (m :| mi : pa : rs)) = (\pa' -> PVP $ m :| mi : pa' : rs) <$> f pa 558 | patch f (PVP (m :| [mi])) = (\pa' -> PVP $ m :| mi : [pa']) <$> f 0 559 | patch f (PVP (m :| [])) = (\pa' -> PVP $ m :| 0 : [pa']) <$> f 0 560 | {-# INLINE patch #-} 561 | 562 | release f p = p <$ f Nothing 563 | {-# INLINE release #-} 564 | 565 | meta f p = p <$ f Nothing 566 | {-# INLINE meta #-} 567 | 568 | semantic f (PVP (m :| rs)) = (\(SemVer ma mi pa _ _) -> PVP $ ma :| [mi, pa]) <$> f s 569 | where 570 | s = case rs of 571 | mi : pa : _ -> SemVer m mi pa Nothing Nothing 572 | mi : _ -> SemVer m mi 0 Nothing Nothing 573 | [] -> SemVer m 0 0 Nothing Nothing 574 | {-# INLINE semantic #-} 575 | 576 | -------------------------------------------------------------------------------- 577 | -- (General) Version 578 | 579 | -- | A version number with decent structure and comparison logic. 580 | -- 581 | -- This is a /descriptive/ scheme, meaning that it encapsulates the most common, 582 | -- unconscious patterns that developers use when assigning version numbers to 583 | -- their software. If not `SemVer`, most version numbers found in the wild will 584 | -- parse as a `Version`. These generally conform to the @x.x.x-x@ pattern, and 585 | -- may optionally have an /epoch/. 586 | -- 587 | -- Epochs are prefixes marked by a colon, like in @1:2.3.4@. When comparing two 588 | -- `Version` values, epochs take precedent. So @2:1.0.0 > 1:9.9.9@. If one of 589 | -- the given `Version`s has no epoch, its epoch is assumed to be 0. 590 | -- 591 | -- Examples of @Version@ that are not @SemVer@: 0.25-2, 8.u51-1, 20150826-1, 592 | -- 1:2.3.4 593 | data Version = Version 594 | { _vEpoch :: !(Maybe Word) 595 | , _vChunks :: !Chunks 596 | , _vRel :: !(Maybe Release) 597 | , _vMeta :: !(Maybe Text) } 598 | deriving stock (Eq, Show, Generic, Lift, Data) 599 | deriving anyclass (NFData, Hashable) 600 | 601 | -- | Customized. As in SemVer, metadata is ignored for the purpose of 602 | -- comparison. 603 | instance Ord Version where 604 | -- If two epochs are equal, we need to compare their actual version numbers. 605 | -- Otherwise, the comparison of the epochs is the only thing that matters. 606 | compare (Version mae ac ar _) (Version mbe bc br _) = 607 | case compare ae be of 608 | EQ -> case compare ac bc of 609 | EQ -> compare ar br 610 | ord -> ord 611 | ord -> ord 612 | where 613 | ae = fromMaybe 0 mae 614 | be = fromMaybe 0 mbe 615 | 616 | instance Semantic Version where 617 | major f (Version e (Chunks (Numeric n :| cs)) me rs) = 618 | (\n' -> Version e (Chunks $ Numeric n' :| cs) me rs) <$> f n 619 | major _ v = pure v 620 | {-# INLINE major #-} 621 | 622 | minor f (Version e (Chunks (c :| Numeric n : cs)) me rs) = 623 | (\n' -> Version e (Chunks $ c :| Numeric n' : cs) me rs) <$> f n 624 | minor _ v = pure v 625 | {-# INLINE minor #-} 626 | 627 | patch f (Version e (Chunks (c :| d : Numeric n : cs)) me rs) = 628 | (\n' -> Version e (Chunks $ c :| d : Numeric n' : cs) me rs) <$> f n 629 | patch _ v = pure v 630 | {-# INLINE patch #-} 631 | 632 | -- | This will always succeed. 633 | release f v = fmap (\vr -> v { _vRel = vr }) (f $ _vRel v) 634 | {-# INLINE release #-} 635 | 636 | -- | This will always fail. 637 | meta _ v = pure v 638 | {-# INLINE meta #-} 639 | 640 | semantic f (Version _ (Chunks (Numeric a :| Numeric b : Numeric c : _)) rs me) = 641 | semverToVersion <$> f (SemVer a b c rs me) 642 | semantic _ v = pure v 643 | {-# INLINE semantic #-} 644 | 645 | -- | A `Version`'s inner epoch `Word`. 646 | epoch :: Lens' Version (Maybe Word) 647 | epoch f v = fmap (\ve -> v { _vEpoch = ve }) (f $ _vEpoch v) 648 | {-# INLINE epoch #-} 649 | 650 | -- | `Chunk`s that have a comparison behaviour specific to `Version`. 651 | newtype Chunks = Chunks (NonEmpty Chunk) 652 | deriving stock (Eq, Show, Generic, Lift, Data) 653 | deriving anyclass (NFData, Hashable) 654 | 655 | instance Ord Chunks where 656 | compare (Chunks as) (Chunks bs) = 657 | fromMaybe EQ . listToMaybe . mapMaybe f $ zipLongest (NEL.toList as) (NEL.toList bs) 658 | where 659 | f :: These Chunk Chunk -> Maybe Ordering 660 | f (Both a b) = case cmpLenient a b of 661 | LT -> Just LT 662 | GT -> Just GT 663 | EQ -> Nothing 664 | f (This _) = Just GT 665 | f (That _) = Just LT 666 | 667 | -------------------------------------------------------------------------------- 668 | -- (Complex) Mess 669 | 670 | -- | Possible values of a section of a `Mess`. A numeric value is extracted if 671 | -- it could be, alongside the original text it came from. This preserves both 672 | -- `Ord` and pretty-print behaviour for versions like @1.003.0@. 673 | data MChunk 674 | = MDigit !Word !Text 675 | -- ^ A nice numeric value. 676 | | MRev !Word !Text 677 | -- ^ A numeric value preceeded by an @r@, indicating a revision. 678 | | MPlain !Text 679 | -- ^ Anything else. 680 | deriving stock (Eq, Show, Generic, Lift, Data) 681 | deriving anyclass (NFData, Hashable) 682 | 683 | instance Ord MChunk where 684 | compare (MDigit a _) (MDigit b _) = compare a b 685 | compare (MRev a _) (MRev b _) = compare a b 686 | compare (MPlain a) (MPlain b) = compare a b 687 | compare a b = compare (mchunkText a) (mchunkText b) 688 | 689 | -- | A total extraction of the `Text` from an `MChunk`. 690 | mchunkText :: MChunk -> Text 691 | mchunkText (MDigit _ t) = t 692 | mchunkText (MRev _ t) = t 693 | mchunkText (MPlain t) = t 694 | 695 | -- | A (Complex) Mess. This is a /descriptive/ parser, based on examples of 696 | -- stupidly crafted version numbers used in the wild. 697 | -- 698 | -- Groups of letters/numbers, separated by a period, can be further separated by 699 | -- the symbols @_-+:@ 700 | -- 701 | -- Some `Mess` values have a shape that is tantalizingly close to a `SemVer`. 702 | -- Example: @1.6.0a+2014+m872b87e73dfb-1@. For values like these, we can extract 703 | -- the semver-compatible values out with `messMajor`, etc. 704 | -- 705 | -- Not guaranteed to have well-defined ordering (@Ord@) behaviour, but so far 706 | -- internal tests show consistency. `messMajor`, etc., are used internally where 707 | -- appropriate to enhance accuracy. 708 | data Mess = Mess !(NonEmpty MChunk) !(Maybe (VSep, Mess)) 709 | deriving stock (Eq, Show, Generic, Lift, Data) 710 | deriving anyclass (NFData, Hashable) 711 | 712 | -- | Try to extract the "major" version number from `Mess`, as if it were a 713 | -- `SemVer`. 714 | messMajor :: Mess -> Maybe Word 715 | messMajor (Mess (MDigit i _ :| _) _) = Just i 716 | messMajor _ = Nothing 717 | 718 | -- | Try to extract the "minor" version number from `Mess`, as if it were a 719 | -- `SemVer`. 720 | messMinor :: Mess -> Maybe Word 721 | messMinor (Mess (_ :| MDigit i _ : _) _) = Just i 722 | messMinor _ = Nothing 723 | 724 | -- | Try to extract the "patch" version number from `Mess`, as if it were a 725 | -- `SemVer`. 726 | messPatch :: Mess -> Maybe Word 727 | messPatch (Mess (_ :| _ : MDigit i _ : _) _) = Just i 728 | messPatch _ = Nothing 729 | 730 | -- | Okay, fine, say `messPatch` couldn't find a nice value. But some `Mess`es 731 | -- have a "proper" patch-plus-release-candidate value in their patch position, 732 | -- which is parsable as a `Chunk`. 733 | -- 734 | -- Example: @1.6.0a+2014+m872b87e73dfb-1@ We should be able to extract @0a@ safely. 735 | messPatchChunk :: Mess -> Maybe Chunk 736 | messPatchChunk (Mess (_ :| _ : MPlain p : _) _) = hush $ parse chunkP "Chunk" p 737 | messPatchChunk _ = Nothing 738 | 739 | instance Ord Mess where 740 | compare (Mess t1 m1) (Mess t2 m2) = case compare t1 t2 of 741 | EQ -> case (m1, m2) of 742 | (Just (_, v1), Just (_, v2)) -> compare v1 v2 743 | (Just (_, _), Nothing) -> GT 744 | (Nothing, Just (_, _)) -> LT 745 | (Nothing, Nothing) -> EQ 746 | res -> res 747 | 748 | instance Semantic Mess where 749 | major f (Mess (MDigit n _ :| ts) m) = (\n' -> Mess (MDigit n' (showt n') :| ts) m) <$> f n 750 | major _ v = pure v 751 | {-# INLINE major #-} 752 | 753 | minor f (Mess (t0 :| MDigit n _ : ts) m) = (\n' -> Mess (t0 :| MDigit n' (showt n') : ts) m) <$> f n 754 | minor _ v = pure v 755 | {-# INLINE minor #-} 756 | 757 | patch f (Mess (t0 :| t1 : MDigit n _ : ts) m) = (\n' -> Mess (t0 :| t1 : MDigit n' (showt n') : ts) m) <$> f n 758 | patch _ v = pure v 759 | {-# INLINE patch #-} 760 | 761 | -- | This will always fail. 762 | release _ v = pure v 763 | {-# INLINE release #-} 764 | 765 | -- | This will always fail. 766 | meta _ v = pure v 767 | {-# INLINE meta #-} 768 | 769 | -- | Good luck. 770 | semantic f (Mess (MDigit t0 _ :| MDigit t1 _ : MDigit t2 _ : _) _) = 771 | versionToMess . semverToVersion <$> f (SemVer t0 t1 t2 Nothing Nothing) 772 | semantic _ v = pure v 773 | {-# INLINE semantic #-} 774 | 775 | -- | Developers use a number of symbols to seperate groups of digits/letters in 776 | -- their version numbers. These are: 777 | -- 778 | -- * A colon (:). Often denotes an "epoch". 779 | -- * A hyphen (-). 780 | -- * A tilde (~). Example: @12.0.0-3ubuntu1~20.04.5@ 781 | -- * A plus (+). Stop using this outside of metadata if you are. Example: @10.2+0.93+1-1@ 782 | -- * An underscore (_). Stop using this if you are. 783 | data VSep = VColon | VHyphen | VPlus | VUnder | VTilde 784 | deriving stock (Eq, Show, Generic, Lift, Data) 785 | deriving anyclass (NFData, Hashable) 786 | 787 | -- | Parse a `Versioning` at compile time. 788 | versioningQ :: Text -> Q Exp 789 | versioningQ nm = 790 | case versioning nm of 791 | Left err -> fail (errorBundlePretty err) 792 | Right v -> lift v 793 | 794 | -- | Parse a `SemVer` at compile time. 795 | semverQ :: T.Text -> Q Exp 796 | semverQ nm = 797 | case semver nm of 798 | Left err -> fail (errorBundlePretty err) 799 | Right v -> lift v 800 | 801 | -- | Parse a `Version` at compile time. 802 | versionQ :: T.Text -> Q Exp 803 | versionQ nm = 804 | case version nm of 805 | Left err -> fail (errorBundlePretty err) 806 | Right v -> lift v 807 | 808 | -- | Parse a `Mess` at compile time. 809 | messQ :: T.Text -> Q Exp 810 | messQ nm = 811 | case mess nm of 812 | Left err -> fail (errorBundlePretty err) 813 | Right v -> lift v 814 | 815 | -- | Parse a `PVP` at compile time. 816 | pvpQ :: T.Text -> Q Exp 817 | pvpQ nm = 818 | case pvp nm of 819 | Left err -> fail (errorBundlePretty err) 820 | Right v -> lift v 821 | 822 | -------------------------------------------------------------------------------- 823 | -- Parsing 824 | 825 | -- | A synonym for the more verbose 'megaparsec' error type. 826 | type ParsingError = ParseErrorBundle Text Void 827 | 828 | -- | Parse a piece of `Text` into either an (Ideal) `SemVer`, a (General) 829 | -- `Version`, or a (Complex) `Mess`. 830 | versioning :: Text -> Either ParsingError Versioning 831 | versioning = parse versioning' "versioning" 832 | 833 | -- | Parse a `Versioning`. Assumes the version number is the last token in 834 | -- the string. 835 | versioning' :: Parsec Void Text Versioning 836 | versioning' = choice [ try (fmap Ideal semver'' <* eof) 837 | , try (fmap General version'' <* eof) 838 | , fmap Complex mess'' <* eof ] 839 | 840 | -- | Parse a (Ideal) Semantic Version. 841 | semver :: Text -> Either ParsingError SemVer 842 | semver = parse (semver'' <* eof) "Semantic Version" 843 | 844 | -- | Internal megaparsec parser of `semver`. 845 | semver' :: Parsec Void Text SemVer 846 | semver' = L.lexeme space semver'' 847 | 848 | semver'' :: Parsec Void Text SemVer 849 | semver'' = SemVer <$> majorP <*> minorP <*> patchP <*> optional releaseP <*> optional metaData 850 | 851 | -- | Parse a group of digits, which can't be lead by a 0, unless it is 0. 852 | unsignedP :: Parsec Void Text Word 853 | unsignedP = asWord64 >>= convertOrFail 854 | where 855 | asWord64 :: Parsec Void Text Word64 856 | asWord64 = (0 <$ char '0') <|> L.decimal 857 | 858 | convertOrFail :: Word64 -> Parsec Void Text Word 859 | convertOrFail w | w > bound = fail $ "Value (" ++ show w ++ ") larger than Word size: " ++ show bound 860 | | otherwise = pure $ fromIntegral w 861 | where 862 | bound :: Word64 863 | bound = fromIntegral (maxBound :: Word) 864 | 865 | majorP :: Parsec Void Text Word 866 | majorP = unsignedP <* char '.' 867 | 868 | minorP :: Parsec Void Text Word 869 | minorP = majorP 870 | 871 | patchP :: Parsec Void Text Word 872 | patchP = unsignedP 873 | 874 | releaseP :: Parsec Void Text Release 875 | releaseP = char '-' *> fmap Release (chunkP `PC.sepBy1` char '.') 876 | 877 | chunkP :: Parsec Void Text Chunk 878 | chunkP = try alphanumP <|> numericP 879 | 880 | alphanumP :: Parsec Void Text Chunk 881 | alphanumP = do 882 | ids <- takeWhile1P (Just "Hyphenated Alphanums") (\c -> isAlphaNum c || c == '-') 883 | -- It's okay for this to `fail` like this, since this fail is caught higher up 884 | -- in `chunkP` and another parser which should be guaranteed to succeed is 885 | -- called. It's guaranteed since by this point we /did/ parse something, but 886 | -- the test below proves it contains only numbers. Therefore the fallback call 887 | -- to `numericP` should succeed. 888 | unless (T.any (\c -> isAlpha c || c == '-') ids) $ fail "Only numeric!" 889 | pure $ Alphanum ids 890 | 891 | alphanumWithoutHyphensP :: Parsec Void Text Chunk 892 | alphanumWithoutHyphensP = do 893 | ids <- takeWhile1P (Just "Unhyphenated Alphanums") isAlphaNum 894 | unless (T.any isAlpha ids) $ fail "Only numeric!" 895 | pure $ Alphanum ids 896 | 897 | numericP :: Parsec Void Text Chunk 898 | numericP = Numeric <$> unsignedP 899 | 900 | chunkWithoutHyphensP :: Parsec Void Text Chunk 901 | chunkWithoutHyphensP = try alphanumWithoutHyphensP <|> numericP 902 | 903 | metaData :: Parsec Void Text Text 904 | metaData = do 905 | void $ char '+' 906 | fold . NEL.intersperse "." <$> section `PC.sepBy1` char '.' 907 | where 908 | section :: Parsec Void Text Text 909 | section = takeWhile1P (Just "Metadata char") (\c -> isAlphaNum c || c == '-') 910 | 911 | -- | Parse a (Haskell) `PVP`, as defined above. 912 | pvp :: Text -> Either ParsingError PVP 913 | pvp = parse (pvp' <* eof) "PVP" 914 | 915 | -- | Internal megaparsec parser of `pvp`. 916 | pvp' :: Parsec Void Text PVP 917 | pvp' = L.lexeme space (PVP <$> unsignedP `PC.sepBy1` char '.') 918 | 919 | -- | Parse a (General) `Version`, as defined above. 920 | version :: Text -> Either ParsingError Version 921 | version = parse (version'' <* eof) "Version" 922 | 923 | -- | Internal megaparsec parser of `version`. 924 | version' :: Parsec Void Text Version 925 | version' = L.lexeme space version'' 926 | 927 | version'' :: Parsec Void Text Version 928 | version'' = Version <$> optional (try epochP) <*> chunksP <*> optional releaseP <*> optional metaData 929 | 930 | epochP :: Parsec Void Text Word 931 | epochP = unsignedP <* char ':' 932 | 933 | chunksP :: Parsec Void Text Chunks 934 | chunksP = Chunks <$> chunkWithoutHyphensP `PC.sepBy1` char '.' 935 | 936 | -- | Parse a (Complex) `Mess`, as defined above. 937 | mess :: Text -> Either ParsingError Mess 938 | mess = parse (mess'' <* eof) "Mess" 939 | 940 | -- | Internal megaparsec parser of `mess`. 941 | mess' :: Parsec Void Text Mess 942 | mess' = L.lexeme space mess'' 943 | 944 | mess'' :: Parsec Void Text Mess 945 | mess'' = Mess <$> mchunks <*> optional ((,) <$> sep <*> mess') 946 | 947 | mchunks :: Parsec Void Text (NonEmpty MChunk) 948 | mchunks = mchunk `PC.sepBy1` char '.' 949 | 950 | mchunk :: Parsec Void Text MChunk 951 | mchunk = choice [ try $ (\(t, i) -> MDigit i t) <$> match (L.decimal <* next) 952 | , try $ (\(t, i) -> MRev i t) <$> match (single 'r' *> L.decimal <* next) 953 | , MPlain . T.pack <$> some (letterChar <|> digitChar) ] 954 | where 955 | next :: Parsec Void Text () 956 | next = lookAhead (void (single '.') <|> void sep <|> eof) 957 | 958 | sep :: Parsec Void Text VSep 959 | sep = choice [ VColon <$ char ':' 960 | , VHyphen <$ char '-' 961 | , VPlus <$ char '+' 962 | , VUnder <$ char '_' 963 | , VTilde <$ char '~' ] 964 | 965 | sepCh :: VSep -> Char 966 | sepCh VColon = ':' 967 | sepCh VHyphen = '-' 968 | sepCh VPlus = '+' 969 | sepCh VUnder = '_' 970 | sepCh VTilde = '~' 971 | 972 | -- | Convert any parsed Versioning type to its textual representation. 973 | prettyV :: Versioning -> Text 974 | prettyV (Ideal sv) = prettySemVer sv 975 | prettyV (General v) = prettyVer v 976 | prettyV (Complex m) = prettyMess m 977 | 978 | -- | Convert a `SemVer` back to its textual representation. 979 | prettySemVer :: SemVer -> Text 980 | prettySemVer (SemVer ma mi pa pr me) = mconcat $ ver <> pr' <> me' 981 | where 982 | ver = intersperse "." [ showt ma, showt mi, showt pa ] 983 | pr' = maybe [] (\m -> ["-", prettyRelease m]) pr 984 | me' = maybe [] (\m -> ["+", m]) me 985 | 986 | -- | Convert a `PVP` back to its textual representation. 987 | prettyPVP :: PVP -> Text 988 | prettyPVP (PVP (m :| rs)) = T.intercalate "." . map showt $ m : rs 989 | 990 | -- | Convert a `Version` back to its textual representation. 991 | prettyVer :: Version -> Text 992 | prettyVer (Version ep cs pr me) = mconcat $ ep' <> [ver] <> pr' <> me' 993 | where 994 | ver = prettyChunks cs 995 | me' = maybe [] (\m -> ["+", m]) me 996 | pr' = maybe [] (\m -> ["-", prettyRelease m]) pr 997 | ep' = maybe [] (\e -> [showt e, ":"]) ep 998 | 999 | -- | Convert a `Mess` back to its textual representation. 1000 | prettyMess :: Mess -> Text 1001 | prettyMess (Mess t m) = case m of 1002 | Nothing -> t' 1003 | Just (s, v) -> T.snoc t' (sepCh s) <> prettyMess v 1004 | where 1005 | t' :: Text 1006 | t' = fold . NEL.intersperse "." $ NEL.map mchunkText t 1007 | 1008 | prettyChunks :: Chunks -> Text 1009 | prettyChunks (Chunks cs) = T.intercalate "." . map prettyChunk $ NEL.toList cs 1010 | 1011 | prettyRelease :: Release -> Text 1012 | prettyRelease (Release cs) = T.intercalate "." . map prettyChunk $ NEL.toList cs 1013 | 1014 | prettyChunk :: Chunk -> Text 1015 | prettyChunk (Numeric n) = showt n 1016 | prettyChunk (Alphanum s) = s 1017 | 1018 | -------------------------------------------------------------------------------- 1019 | -- Utilities 1020 | 1021 | -- | Flip an Ordering. 1022 | opposite :: Ordering -> Ordering 1023 | opposite EQ = EQ 1024 | opposite LT = GT 1025 | opposite GT = LT 1026 | 1027 | -- Yes, `text-show` exists, but this reduces external dependencies. 1028 | showt :: Show a => a -> Text 1029 | showt = T.pack . show 1030 | 1031 | hush :: Either a b -> Maybe b 1032 | hush (Left _) = Nothing 1033 | hush (Right b) = Just b 1034 | 1035 | data These a b = This !a | That !b | Both !a !b 1036 | 1037 | zipLongest :: [a] -> [b] -> [These a b] 1038 | zipLongest [] [] = [] 1039 | zipLongest (a:as) (b:bs) = Both a b : zipLongest as bs 1040 | zipLongest (a:as) [] = This a : zipLongest as [] 1041 | zipLongest [] (b:bs) = That b : zipLongest [] bs 1042 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Colin Woodbury 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Colin Woodbury nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | versions 2 | ======== 3 | 4 | ![](https://github.com/fosskers/versions/workflows/Tests/badge.svg) 5 | [![Hackage](https://img.shields.io/hackage/v/versions.svg?style=flat)](https://hackage.haskell.org/package/versions) 6 | [![Stackage Nightly](http://stackage.org/package/versions/badge/nightly)](http://stackage.org/nightly/package/versions) 7 | [![Stackage LTS](http://stackage.org/package/versions/badge/lts)](http://stackage.org/lts/package/versions) 8 | 9 | A Haskell library for parsing and comparing software version numbers. 10 | 11 | About 12 | ----- 13 | We like to give version numbers to our software in a myriad of ways. Some 14 | ways follow strict guidelines for incrementing and comparison. Some follow 15 | conventional wisdom and are generally self-consistent. Some are just plain 16 | asinine. This library provides a means of parsing and comparing *any* style 17 | of versioning, be it a nice Semantic Version like this: 18 | 19 | > 1.2.3-r1+git123 20 | 21 | ...or a monstrosity like this: 22 | 23 | > 2:10.2+0.0093r3+1-1 24 | 25 | Please switch to [Semantic Versioning](http://semver.org) if you aren't 26 | currently using it. It provides consistency in version incrementing and has 27 | the best constraints on comparisons. 28 | 29 | Usage 30 | ----- 31 | In general, `versioning` is the function you want. It attempts to parse a given 32 | Text using the three individual parsers, `semver`, `version` and `mess`. If 33 | one fails, it tries the next. If you know you only want to parse one 34 | specific version type, use that parser directly (e.g. `semver`). 35 | 36 | #### Lenses and Traversals 37 | The parse result types have Lenses/Traversals for accessing their data 38 | fields. For instance, to increment the patch number of a parsed SemVer, you 39 | could: 40 | 41 | ```haskell 42 | incPatch :: SemVer -> SemVer 43 | incPatch s = s & patch %~ (+ 1) 44 | ``` 45 | 46 | Or, something more involved: 47 | 48 | ```haskell 49 | -- | Get all major versions of legally parsed SemVers. 50 | majors :: [Text] -> [Word] 51 | majors vs = vs ^.. each . to semver . _Right . major 52 | ``` 53 | 54 | The `to semver . _Right` is clunky, so we provide some direct `Text` 55 | Traverals inspired by 56 | ([micro](http://hackage.haskell.org/package/microlens-aeson)) 57 | [lens-aeson](http://hackage.haskell.org/package/lens-aeson): 58 | 59 | ```haskell 60 | -- | Get the major version of any `Text` that has one. 61 | majors :: [Text] -> [Word] 62 | majors vs = vs ^.. each . major 63 | ``` 64 | 65 | We can also use these `Text` Traversals to increment versions, as above: 66 | 67 | ```haskell 68 | incPatch :: Text -> Text 69 | incPatch s = s & patch %~ (+ 1) 70 | 71 | > incPatch "1.2.3" 72 | "1.2.4" 73 | ``` 74 | 75 | #### Caveats 76 | 77 | The largest number that can be parsed as part of a version is: 78 | 79 | ``` haskell 80 | ghci> maxBound :: Word64 81 | 18446744073709551615 82 | ``` 83 | 84 | However, on 32-bit systems (or smaller), the maximum is their `maxBound :: Word`. 85 | A number larger than that, even if smaller than `maxBound :: Word64`, 86 | will yield a parse error. 87 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-23.7 2 | -------------------------------------------------------------------------------- /test/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLists #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | 5 | {-# OPTIONS_GHC -fno-warn-orphans #-} 6 | 7 | module Main ( main ) where 8 | 9 | import Data.Either (fromRight, isLeft) 10 | import Data.List.NonEmpty (NonEmpty(..)) 11 | import qualified Data.List.NonEmpty as NonEmpty 12 | import qualified Data.Text as T 13 | import Data.Versions 14 | import Data.Void (Void) 15 | import Language.Haskell.TH (recover) 16 | import Lens.Micro 17 | import Test.Tasty 18 | import Test.Tasty.HUnit 19 | import Text.Megaparsec 20 | import Text.Megaparsec.Char 21 | import Text.Printf (printf) 22 | 23 | --- 24 | 25 | -- | These don't need to parse as a SemVer. 26 | goodVers :: [T.Text] 27 | goodVers = [ "1", "1.2", "1.0rc0", "1.0rc1", "1.1rc1", "1.58.0-3", "44.0.2403.157-1" 28 | , "0.25-2", "8.u51-1", "21-2", "7.1p1-1", "20150826-1", "1:0.10.16-3" 29 | , "1.11.0.git.20200404-1", "1.11.0+20200830-1", "1:3.20", "9.2.1.b-debug+lol" 30 | , "0:1.2.3" 31 | ] 32 | 33 | badVers :: [T.Text] 34 | badVers = ["", "1.2 "] 35 | 36 | badPVP :: [T.Text] 37 | badPVP = ["", "clc237", "abc"] 38 | 39 | messes :: [T.Text] 40 | messes = [ "10.2+0.93+1-1", "003.03-3", "002.000-7", "20.26.1_0-2", "1.6.0a+2014+m872b87e73dfb-1" 41 | , "1.3.00.16851-1", "5.2.458699.0906-1", "12.0.0-3ubuntu1~20.04.5" ] 42 | 43 | messComps :: NonEmpty T.Text 44 | messComps = [ "10.2+0.93+1-1", "10.2+0.93+1-2", "10.2+0.93+2-1" 45 | , "10.2+0.94+1-1", "10.3+0.93+1-1", "11.2+0.93+1-1", "12" 46 | ] 47 | 48 | badSemVs :: [T.Text] 49 | badSemVs = [ -- Not enough version slots 50 | "1", "1.2", "a.b.c" 51 | -- Illegal characters 52 | , "1.01.1", "1.2.3+a1b!2c3.1", "", "1.2.3 " 53 | -- Really large version 54 | -- , "18446744073709551610000000000000000.0.0" 55 | ] 56 | 57 | goodSemVs :: [T.Text] 58 | goodSemVs = [ "0.1.0", "1.2.3", "1.2.3-1", "1.2.3-alpha", "1.2.3-alpha.2" 59 | , "1.2.3+a1b2c3.1", "1.2.3-alpha.2+a1b2c3.1", "2.2.1-b05" 60 | -- Weird Pre-releases 61 | , "1.0.0-x-y-z.-" 62 | -- Weird metadata 63 | , "1.0.0-alpha+001", "1.0.0+21AF26D3---117B344092BD" 64 | -- Zeroes 65 | , "1.2.2-00a" 66 | -- Really large version 67 | , "18446744073709551610.0.0" 68 | ] 69 | 70 | -- | The exact example from `http://semver.org` 71 | semverOrd :: NonEmpty T.Text 72 | semverOrd = [ "1.0.0-alpha", "1.0.0-alpha.1", "1.0.0-alpha.beta" 73 | , "1.0.0-beta", "1.0.0-beta.2", "1.0.0-beta.11", "1.0.0-rc.1" 74 | , "1.0.0" 75 | ] 76 | 77 | -- | Cabal makes this distinction: 0.2 < 0.2.0 < 0.2.0.0 78 | -- Apparently there are only 5 packages on Hackage that actually 79 | -- make this necessary, meaning `cabal` can't be simplified to ignore it. 80 | -- Logically, these are the same package, but for those 5 packages, they 81 | -- aren't. 82 | cabalOrd :: NonEmpty T.Text 83 | cabalOrd = [ "0", "0.2", "0.2.0", "0.2.0.0" ] 84 | 85 | versionOrd :: NonEmpty T.Text 86 | versionOrd = [ "0.9.9.9", "1.0.0.0", "1.0.0.1", "2" ] 87 | 88 | suite :: TestTree 89 | suite = testGroup "Tests" 90 | [ testGroup "Unit Tests" 91 | [ testGroup "(Ideal) Semantic Versioning" 92 | [ testGroup "Bad Versions (shouldn't parse)" $ map bad badSemVs 93 | , testGroup "Good Versions (should parse)" $ 94 | map (\s -> testCase (T.unpack s) $ isomorphSV s) goodSemVs 95 | , testGroup "Comparisons" $ 96 | testCase "1.2.3-alpha.2 == 1.2.3-alpha.2+a1b2c3.1" 97 | (assertBool "Equality test of two complicated SemVers failed" 98 | $ semver "1.2.3-alpha.2" == semver "1.2.3-alpha.2+a1b2c3.1") : 99 | zipWith (\a b -> testCase (T.unpack $ a <> " < " <> b) $ comp semver a b) (NonEmpty.toList semverOrd) (NonEmpty.tail semverOrd) 100 | , testGroup "Whitespace Handling" 101 | [ testCase "1.2.3-1[ ]" $ parse semver' "semver whitespace" "1.2.3-1 " @?= Right (SemVer 1 2 3 (Just . Release $ Numeric 1 :| []) Nothing) 102 | ] 103 | , testGroup "Zero Handling" 104 | [ testCase "2.2.1-b05" $ semver "2.2.1-b05" @?= Right (SemVer 2 2 1 (Just . Release $ Alphanum "b05" :| []) Nothing) 105 | ] 106 | ] 107 | , testGroup "(Haskell) PVP" 108 | [ testGroup "Good PVPs" $ 109 | map (\s -> testCase (T.unpack s) $ isomorphPVP s) (NonEmpty.toList cabalOrd) 110 | , testGroup "Bad PVP" $ 111 | map (\s -> testCase (T.unpack s) $ assertBool "A bad PVP parsed" $ isLeft $ pvp s) badPVP 112 | , testGroup "Comparisons" $ 113 | zipWith (\a b -> testCase (T.unpack $ a <> " < " <> b) $ comp pvp a b) (NonEmpty.toList cabalOrd) (NonEmpty.tail cabalOrd) 114 | ] 115 | , testGroup "(General) Versions" 116 | [ testGroup "Good Versions" $ 117 | map (\s -> testCase (T.unpack s) $ isomorphV s) goodVers 118 | , testGroup "Bad Versions (shouldn't parse)" $ 119 | map (\s -> testCase (T.unpack s) $ assertBool "A bad version parsed" $ isLeft $ version s) badVers 120 | , testGroup "Comparisons" $ 121 | testCase "1.2-5 < 1.2.3-1" (comp version "1.2-5" "1.2.3-1") : 122 | testCase "1.0rc1 < 1.0" (comp version "1.0rc1" "1.0") : 123 | testCase "1.0 < 1:1.0" (comp version "1.0" "1:1.0") : 124 | testCase "1.1 < 1:1.0" (comp version "1.1" "1:1.0") : 125 | testCase "1.1 < 1:1.1" (comp version "1.1" "1:1.1") : 126 | map (\(a,b) -> testCase (T.unpack $ a <> " < " <> b) $ comp version a b) 127 | (zip (NonEmpty.toList cabalOrd) (NonEmpty.tail cabalOrd) <> zip (NonEmpty.toList versionOrd) (NonEmpty.tail versionOrd)) 128 | ] 129 | , testGroup "(Complex) Mess" 130 | [ testGroup "Good Versions" $ 131 | map (\s -> testCase (T.unpack s) $ isomorphM s) messes 132 | , testGroup "Bad Versions (shouldn't parse)" $ 133 | map (\s -> testCase (T.unpack s) $ assertBool "A bad version parsed" $ isLeft $ mess s) badVers 134 | , testGroup "Comparisons" $ 135 | zipWith (\a b -> testCase (T.unpack $ a <> " < " <> b) $ comp mess a b) (NonEmpty.toList messComps) (NonEmpty.tail messComps) 136 | , testGroup "SemVer-like Value Extraction" 137 | [ testCase "messMajor" $ 138 | (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messMajor) @?= Just 1 139 | , testCase "messMinor" $ 140 | (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messMinor) @?= Just 6 141 | , testCase "messPatch - Good" $ 142 | (hush (mess "1.6.0+2014+m872b87e73dfb-1") >>= messPatch) @?= Just 0 143 | , testCase "messPatch - Bad" $ 144 | (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messPatch) @?= Nothing 145 | , testCase "messPatchChunk" $ 146 | (hush (mess "1.6.0a+2014+m872b87e73dfb-1") >>= messPatchChunk) @?= Just (Alphanum "0a") 147 | ] 148 | ] 149 | , testGroup "Mixed Versioning" 150 | [ testGroup "Identification" 151 | [ testCase "1.2.3 is SemVer" $ check $ isSemVer <$> versioning "1.2.3" 152 | , testCase "1.2.3-1 is SemVer" $ check $ isSemVer <$> versioning "1.2.3-1" 153 | , testCase "1.2.3-1+1 is SemVer" $ check $ isSemVer <$> versioning "1.2.3-1+1" 154 | , testCase "1.2.3+1-1 is SemVer" $ check $ isSemVer <$> versioning "1.2.3+1-1" 155 | , testCase "1.2.3r1 is Version" $ check $ isVersion <$> versioning "1.2.3r1" 156 | , testCase "0.25-2 is Version" $ check $ isVersion <$> versioning "0.25-2" 157 | , testCase "1:1.2.3-1 is Version" $ check $ isVersion <$> versioning "1:1.2.3-1" 158 | , testCase "1:3.20.1-1 is Version" $ check $ isVersion <$> versioning "1:3.20.1-1" 159 | , testCase "000.007-1 is Mess" $ check $ isMess <$> versioning "000.007-1" 160 | , testCase "20.26.1_0-2 is Mess" $ check $ isMess <$> versioning "20.26.1_0-2" 161 | , testCase "1:3.20.1-1 is Version" $ check $ isVersion <$> versioning "1:3.20.1-1" 162 | ] 163 | , testGroup "Bad Versions" $ 164 | map (\s -> testCase (T.unpack s) $ assertBool "A bad version parsed" $ isLeft $ versioning s) badVers 165 | , testGroup "Isomorphisms" $ 166 | map (\s -> testCase (T.unpack s) $ isomorph s) $ goodSemVs ++ goodVers ++ messes 167 | , testGroup "Comparisons" 168 | [ compVer "1.2.2r1-1" "1.2.3-1" 169 | , compVer "1.2.3-1" "1.2.4r1-1" 170 | , compVer "1.2.3-1" "2+0007-1" 171 | , compVer "1.2.3r1-1" "2+0007-1" 172 | , compVer "1.2-5" "1.2.3-1" 173 | , compVer "1.6.0a+2014+m872b87e73dfb-1" "1.6.0-1" 174 | , compVer "1.11.0.git.20200404-1" "1.11.0+20200830-1" 175 | , compVer "0.17.0+r8+gc41db5f1-1" "0.17.0+r157+g584760cf-1" 176 | , compVer "0.4.8-1" "0.4.9-1" 177 | , compVer "7.42.13-4" "7.46.0-2" 178 | , compVer "1.15.2-1" "1.15.3-1" 179 | , compVer "2.1.16102-2" "2.1.17627-1" 180 | , compVer "8.64.0.81-1" "8.65.0.78-1" 181 | , compVer "1.3.00.16851-1" "1.3.00.25560-1" 182 | , compVer "10.0.4-1" "10.1.0-1" 183 | , compVer "1:3.20-1" "1:3.20.1-1" 184 | , compVer "5.2.458699.0906-1" "5.3.472687.1012-1" 185 | ] 186 | , testGroup "Equality" 187 | [ eqVer "1:3.20.1-1" 188 | , eqVer "1.3.00.25560-1" 189 | , eqVer "150_28-3" 190 | , eqVer "1.0.r15.g3fc772c-5" 191 | , eqVer "0.88-2" 192 | ] 193 | , testGroup "Conversions" 194 | [ testCase "Good Version -> PVP" $ versionToPvp $(versionQ "1.2.3") @?= Just $(pvpQ "1.2.3") 195 | , testCase "Bad Version -> PVP" $ versionToPvp $(versionQ "1.e.3") @?= Nothing 196 | ] 197 | ] 198 | , testGroup "Lenses and Traversals" 199 | [ testCase "SemVer - Increment Patch" incPatch 200 | , testCase "SemVer - Increment Patch from Text" incFromT 201 | , testCase "SemVer - Get patches" patches 202 | ] 203 | , testGroup "Template Haskell" 204 | [ testCase "SemVer" $ prettyV $(versioningQ "1.2.3") @?= "1.2.3" 205 | , testCase "Version" $ prettyV $(versioningQ "1.2.3.4") @?= "1.2.3.4" 206 | , testCase "Mess" $ prettyV $(versioningQ "003.03-3") @?= "003.03-3" 207 | , testCase "Failure" $ $(recover [| () |] (versioningQ "!!!")) @?= () 208 | ] 209 | , testGroup "Megaparsec Behaviour" 210 | [ testCase "manyTill" $ parse nameGrab "manyTill" "linux-firmware-3.2.14-1-x86_64.pkg.tar.xz" @?= Right "linux-firmware" 211 | , 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) 212 | , testCase "Parser State" $ parse pvp'' "parser state" "1.2.3arst" @?= Right ($(pvpQ "1.2.3"), "arst") 213 | ] 214 | ] 215 | ] 216 | 217 | bad :: T.Text -> TestTree 218 | bad s = testCase (T.unpack s) $ case semver s of 219 | Left _ -> pure () 220 | Right s' -> assertFailure $ "A bad version parsed: " ++ T.unpack (prettySemVer s') 221 | 222 | compVer :: T.Text -> T.Text -> TestTree 223 | compVer a b = testCase (printf "%s < %s" a b) $ comp versioning a b 224 | 225 | eqVer :: T.Text -> TestTree 226 | eqVer a = testCase (T.unpack a) $ equal versioning a 227 | 228 | -- | Does pretty-printing return a Versioning to its original form? 229 | isomorph :: T.Text -> Assertion 230 | isomorph t = case prettyV <$> versioning t of 231 | Right t' -> t @?= t' 232 | Left e -> assertBool (errorBundlePretty e) False 233 | 234 | -- | Does pretty-printing return a Version to its original form? 235 | isomorphV :: T.Text -> Assertion 236 | isomorphV t = case prettyVer <$> version t of 237 | Right t' -> t @?= t' 238 | Left e -> assertBool (errorBundlePretty e) False 239 | 240 | -- | Does pretty-printing return a SemVer to its original form? 241 | isomorphSV :: T.Text -> Assertion 242 | isomorphSV t = case prettySemVer <$> semver t of 243 | Right t' -> t @?= t' 244 | Left e -> assertBool (errorBundlePretty e) False 245 | 246 | isomorphPVP :: T.Text -> Assertion 247 | isomorphPVP t = case prettyPVP <$> pvp t of 248 | Right t' -> t @?= t' 249 | Left e -> assertBool (errorBundlePretty e) False 250 | 251 | isomorphM :: T.Text -> Assertion 252 | isomorphM t = case prettyMess <$> mess t of 253 | Right t' -> t @?= t' 254 | Left e -> assertBool (errorBundlePretty e) False 255 | 256 | comp :: Ord b => (T.Text -> Either a b) -> T.Text -> T.Text -> Assertion 257 | comp f a b = check $ (<) <$> f a <*> f b 258 | 259 | equal :: Ord r => (T.Text -> Either l r) -> T.Text -> Assertion 260 | equal f a = check $ (\r -> r == r) <$> f a 261 | 262 | check :: Either a Bool -> Assertion 263 | check = assertBool "Some Either-based assertion failed" . fromRight False 264 | 265 | isSemVer :: Versioning -> Bool 266 | isSemVer (Ideal _) = True 267 | isSemVer _ = False 268 | 269 | isVersion :: Versioning -> Bool 270 | isVersion (General _) = True 271 | isVersion _ = False 272 | 273 | isMess :: Versioning -> Bool 274 | isMess (Complex _) = True 275 | isMess _ = False 276 | 277 | incPatch :: Assertion 278 | incPatch = (v1 & patch %~ (+ 1)) @?= v2 279 | where v1 = Ideal $ SemVer 1 2 3 Nothing Nothing 280 | v2 = Ideal $ SemVer 1 2 4 Nothing Nothing 281 | 282 | incFromT :: Assertion 283 | incFromT = (("1.2.3" :: T.Text) & patch %~ (+ 1)) @?= "1.2.4" 284 | 285 | patches :: Assertion 286 | patches = ps @?= [3,4,5] 287 | where ps = (["1.2.3","2.3.4","3.4.5"] :: [T.Text]) ^.. each . patch 288 | 289 | main :: IO () 290 | main = defaultMain suite 291 | 292 | nameGrab :: Parsec Void T.Text T.Text 293 | nameGrab = T.pack <$> manyTill anySingle (try finished) 294 | where finished = char '-' *> lookAhead digitChar 295 | 296 | versionGrab :: Parsec Void T.Text Versioning 297 | versionGrab = manyTill anySingle (try finished) *> ver 298 | where finished = char '-' *> lookAhead digitChar 299 | ver = fmap Ideal semver' <|> fmap General version' <|> fmap Complex mess' 300 | 301 | hush :: Either a b -> Maybe b 302 | hush (Left _) = Nothing 303 | hush (Right b) = Just b 304 | 305 | -- | An attempt to squeeze out the remaining parser state. 306 | pvp'' :: Parsec Void T.Text (PVP, T.Text) 307 | pvp'' = do 308 | v <- pvp' 309 | s <- getParserState 310 | pure (v, stateInput s) 311 | -------------------------------------------------------------------------------- /versions.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: versions 3 | version: 6.0.8 4 | synopsis: Types and parsers for software version numbers. 5 | description: 6 | A library for parsing and comparing software version numbers. We like to give 7 | version numbers to our software in a myriad of ways. Some ways follow strict 8 | guidelines for incrementing and comparison. Some follow conventional wisdom 9 | and are generally self-consistent. Some are just plain asinine. This library 10 | provides a means of parsing and comparing /any/ style of versioning, be it a 11 | nice Semantic Version like this: 12 | . 13 | > 1.2.3-r1+git123 14 | . 15 | ...or a monstrosity like this: 16 | . 17 | > 2:10.2+0.0093r3+1-1 18 | . 19 | Please switch to if you aren't 20 | currently using it. It provides consistency in version incrementing and has 21 | the best constraints on comparisons. 22 | . 23 | This library implements version @2.0.0@ of the SemVer spec. 24 | 25 | category: Data 26 | homepage: https://github.com/fosskers/versions 27 | author: Colin Woodbury 28 | maintainer: colin@fosskers.ca 29 | license: BSD-3-Clause 30 | license-file: LICENSE 31 | build-type: Simple 32 | extra-source-files: 33 | CHANGELOG.md 34 | README.md 35 | 36 | common commons 37 | default-language: Haskell2010 38 | ghc-options: 39 | -Wall -Wcompat -Wincomplete-record-updates 40 | -Wincomplete-uni-patterns 41 | 42 | build-depends: 43 | , base >=4.10 && <4.22 44 | , megaparsec >=7 45 | , text ^>=1.2 || >= 2.0 && < 2.2 46 | , template-haskell >= 2.15 47 | 48 | library 49 | import: commons 50 | exposed-modules: Data.Versions 51 | build-depends: 52 | , deepseq >=1.4 53 | , hashable >=1.2 54 | , parser-combinators >= 1.0 55 | 56 | test-suite versions-test 57 | import: commons 58 | type: exitcode-stdio-1.0 59 | main-is: Test.hs 60 | hs-source-dirs: test 61 | ghc-options: -threaded -with-rtsopts=-N 62 | build-depends: 63 | , microlens >=0.4 64 | , tasty >=0.10.1.2 65 | , tasty-hunit >=0.9.2 66 | , versions 67 | --------------------------------------------------------------------------------