{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE Rank2Types         #-}

-- |
-- Module    : Data.Versions
-- Copyright : (c) Colin Woodbury, 2015 - 2020
-- License   : BSD3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- A library for parsing and comparing software version numbers.
--
-- We like to give version numbers to our software in a myriad of different
-- ways. Some ways follow strict guidelines for incrementing and comparison.
-- Some follow conventional wisdom and are generally self-consistent. Some are
-- just plain asinine. This library provides a means of parsing and comparing
-- /any/ style of versioning, be it a nice Semantic Version like this:
--
-- > 1.2.3-r1+git123
--
-- ...or a monstrosity like this:
--
-- > 2:10.2+0.0093r3+1-1
--
-- Please switch to <http://semver.org Semantic Versioning> if you aren't
-- currently using it. It provides consistency in version incrementing and has
-- the best constraints on comparisons.
--
-- == Using the Parsers
-- In general, `versioning` is the function you want. It attempts to parse a
-- given `Text` using the three individual parsers, `semver`, `version` and
-- `mess`. If one fails, it tries the next. If you know you only want to parse
-- one specific version type, use that parser directly (e.g. `semver`).

module Data.Versions
  ( -- * Types
    Versioning(..), isIdeal, isGeneral, isComplex
  , SemVer(..)
  , PVP(..)
  , Version(..)
  , Mess(..), messMajor, messMinor, messPatch, messPatchChunk
  , MChunk(..)
  , VUnit(..), digits, str
  , VChunk
  , VSep(..)
    -- * Parsing Versions
  , ParsingError
  , versioning, semver, pvp, version, mess
    -- ** Megaparsec Parsers
    -- | For when you'd like to mix version parsing into some larger parser.
  , versioning', semver', pvp', version', mess'
    -- * Pretty Printing
  , prettyV, prettySemVer, prettyPVP, prettyVer, prettyMess, errorBundlePretty
    -- * Lenses
  , Lens'
  , Traversal'
  , Semantic(..)
    -- ** Traversing Text
    -- | When traversing `Text`, leveraging its `Semantic` instance will
    -- likely benefit you more than using these Traversals directly.
  , _Versioning, _SemVer, _Version, _Mess
    -- ** Versioning Traversals
  , _Ideal, _General, _Complex
    -- ** (General) Version Lenses
  , epoch
    -- ** Misc. Lenses / Traversals
  , _Digits, _Str
  ) where

import qualified Control.Applicative.Combinators.NonEmpty as PC
import           Control.DeepSeq
import           Control.Monad (void)
import           Data.Bool (bool)
import           Data.Char (isAlpha)
import           Data.Foldable (fold)
import           Data.Hashable (Hashable)
import           Data.List (intersperse)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
import           Data.Maybe (fromMaybe)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Void (Void)
import           GHC.Generics (Generic)
import           Text.Megaparsec hiding (chunk)
import           Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L

#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup
#endif

---

-- | A top-level Versioning type. Acts as a wrapper for the more specific types.
-- This allows each subtype to have its own parser, and for said parsers to be
-- composed. This is useful for specifying custom behaviour for when a certain
-- parser fails.
data Versioning = Ideal SemVer | General Version | Complex Mess
  deriving (Versioning -> Versioning -> Bool
(Versioning -> Versioning -> Bool)
-> (Versioning -> Versioning -> Bool) -> Eq Versioning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Versioning -> Versioning -> Bool
$c/= :: Versioning -> Versioning -> Bool
== :: Versioning -> Versioning -> Bool
$c== :: Versioning -> Versioning -> Bool
Eq, Int -> Versioning -> ShowS
[Versioning] -> ShowS
Versioning -> String
(Int -> Versioning -> ShowS)
-> (Versioning -> String)
-> ([Versioning] -> ShowS)
-> Show Versioning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Versioning] -> ShowS
$cshowList :: [Versioning] -> ShowS
show :: Versioning -> String
$cshow :: Versioning -> String
showsPrec :: Int -> Versioning -> ShowS
$cshowsPrec :: Int -> Versioning -> ShowS
Show, (forall x. Versioning -> Rep Versioning x)
-> (forall x. Rep Versioning x -> Versioning) -> Generic Versioning
forall x. Rep Versioning x -> Versioning
forall x. Versioning -> Rep Versioning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Versioning x -> Versioning
$cfrom :: forall x. Versioning -> Rep Versioning x
Generic, Versioning -> ()
(Versioning -> ()) -> NFData Versioning
forall a. (a -> ()) -> NFData a
rnf :: Versioning -> ()
$crnf :: Versioning -> ()
NFData, Int -> Versioning -> Int
Versioning -> Int
(Int -> Versioning -> Int)
-> (Versioning -> Int) -> Hashable Versioning
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Versioning -> Int
$chash :: Versioning -> Int
hashWithSalt :: Int -> Versioning -> Int
$chashWithSalt :: Int -> Versioning -> Int
Hashable)

-- | Short-hand for detecting a `SemVer`.
isIdeal :: Versioning -> Bool
isIdeal :: Versioning -> Bool
isIdeal (Ideal SemVer
_) = Bool
True
isIdeal Versioning
_         = Bool
False

-- | Short-hand for detecting a `Version`.
isGeneral :: Versioning -> Bool
isGeneral :: Versioning -> Bool
isGeneral (General Version
_) = Bool
True
isGeneral Versioning
_           = Bool
False

-- | Short-hand for detecting a `Mess`.
isComplex :: Versioning -> Bool
isComplex :: Versioning -> Bool
isComplex (Complex Mess
_) = Bool
True
isComplex Versioning
_           = Bool
False

-- | Comparison of @Ideal@s is always well defined.
--
-- If comparison of @General@s is well-defined, then comparison of @Ideal@ and
-- @General@ is well-defined, as there exists a perfect mapping from @Ideal@ to
-- @General@.
--
-- If comparison of @Complex@es is well-defined, then comparison of @General@
-- and @Complex@ is well defined for the same reason. This implies comparison of
-- @Ideal@ and @Complex@ is also well-defined.
instance Ord Versioning where
  compare :: Versioning -> Versioning -> Ordering
compare (Ideal SemVer
s)     (Ideal SemVer
s')   = SemVer -> SemVer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SemVer
s SemVer
s'
  compare (General Version
v)   (General Version
v') = Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Version
v Version
v'
  compare (Complex Mess
m)   (Complex Mess
m') = Mess -> Mess -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Mess
m Mess
m'
  compare (Ideal SemVer
s)     (General Version
v)  = Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SemVer -> Version
vFromS SemVer
s) Version
v
  compare (General Version
v)   (Ideal SemVer
s)    = Ordering -> Ordering
opposite (Ordering -> Ordering) -> Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SemVer -> Version
vFromS SemVer
s) Version
v
  compare (General Version
v)   (Complex Mess
m)  = Mess -> Mess -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Version -> Mess
mFromV Version
v) Mess
m
  compare (Complex Mess
m)   (General Version
v)  = Ordering -> Ordering
opposite (Ordering -> Ordering) -> Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ Mess -> Mess -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Version -> Mess
mFromV Version
v) Mess
m
  compare (Ideal SemVer
s)     (Complex Mess
m)  = SemVer -> Mess -> Ordering
semverAndMess SemVer
s Mess
m
  compare (Complex Mess
m) (Ideal SemVer
s)      = Ordering -> Ordering
opposite (Ordering -> Ordering) -> Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ SemVer -> Mess -> Ordering
semverAndMess SemVer
s Mess
m

-- | Convert a `SemVer` to a `Version`.
vFromS :: SemVer -> Version
vFromS :: SemVer -> Version
vFromS (SemVer Word
ma Word
mi Word
pa [VChunk]
re [VChunk]
me) =
  Maybe Word -> NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version
Version Maybe Word
forall a. Maybe a
Nothing ((Word -> VUnit
Digits Word
ma VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
:| []) VChunk -> [VChunk] -> NonEmpty VChunk
forall a. a -> [a] -> NonEmpty a
:| [(Word -> VUnit
Digits Word
mi VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
:| []), Word -> VUnit
Digits Word
pa VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
:| []]) [VChunk]
re [VChunk]
me

-- | Convert a `Version` to a `Mess`.
mFromV :: Version -> Mess
mFromV :: Version -> Mess
mFromV (Version Maybe Word
e NonEmpty VChunk
v [VChunk]
m [VChunk]
r) = Mess -> (Word -> Mess) -> Maybe Word -> Mess
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mess
affix (\Word
a -> NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess
Mess (Word -> Text -> MChunk
MDigit Word
a (Word -> Text
forall a. Show a => a -> Text
showt Word
a) MChunk -> [MChunk] -> NonEmpty MChunk
forall a. a -> [a] -> NonEmpty a
:| []) (Maybe (VSep, Mess) -> Mess) -> Maybe (VSep, Mess) -> Mess
forall a b. (a -> b) -> a -> b
$ (VSep, Mess) -> Maybe (VSep, Mess)
forall a. a -> Maybe a
Just (VSep
VColon, Mess
affix)) Maybe Word
e
  where
    affix :: Mess
    affix :: Mess
affix = NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess
Mess (NonEmpty VChunk -> NonEmpty MChunk
forall (t :: * -> *). Functor t => t VChunk -> t MChunk
chunksAsM NonEmpty VChunk
v) Maybe (VSep, Mess)
m'

    m' :: Maybe (VSep, Mess)
    m' :: Maybe (VSep, Mess)
m' = case [VChunk] -> Maybe (NonEmpty VChunk)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [VChunk]
m of
      Maybe (NonEmpty VChunk)
Nothing  -> Maybe (VSep, Mess)
r'
      Just NonEmpty VChunk
m'' -> (VSep, Mess) -> Maybe (VSep, Mess)
forall a. a -> Maybe a
Just (VSep
VPlus, NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess
Mess (NonEmpty VChunk -> NonEmpty MChunk
forall (t :: * -> *). Functor t => t VChunk -> t MChunk
chunksAsM NonEmpty VChunk
m'') Maybe (VSep, Mess)
r')

    r' :: Maybe (VSep, Mess)
    r' :: Maybe (VSep, Mess)
r' = case [VChunk] -> Maybe (NonEmpty VChunk)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [VChunk]
r of
      Maybe (NonEmpty VChunk)
Nothing  -> Maybe (VSep, Mess)
forall a. Maybe a
Nothing
      Just NonEmpty VChunk
r'' -> (VSep, Mess) -> Maybe (VSep, Mess)
forall a. a -> Maybe a
Just (VSep
VHyphen, NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess
Mess (NonEmpty VChunk -> NonEmpty MChunk
forall (t :: * -> *). Functor t => t VChunk -> t MChunk
chunksAsM NonEmpty VChunk
r'') Maybe (VSep, Mess)
forall a. Maybe a
Nothing)


-- | Special logic for when semver-like values can be extracted from a `Mess`.
-- This avoids having to "downcast" the `SemVer` into a `Mess` before comparing,
-- and in some cases can offer better comparison results.
semverAndMess :: SemVer -> Mess -> Ordering
semverAndMess :: SemVer -> Mess -> Ordering
semverAndMess s :: SemVer
s@(SemVer Word
ma Word
mi Word
pa [VChunk]
_ [VChunk]
_) Mess
m = case Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
ma (Word -> Ordering) -> Maybe Word -> Maybe Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mess -> Maybe Word
messMajor Mess
m of
  Maybe Ordering
Nothing -> Ordering
fallback
  Just Ordering
LT -> Ordering
LT
  Just Ordering
GT -> Ordering
GT
  Just Ordering
EQ -> case Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
mi (Word -> Ordering) -> Maybe Word -> Maybe Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mess -> Maybe Word
messMinor Mess
m of
    Maybe Ordering
Nothing -> Ordering
fallback
    Just Ordering
LT -> Ordering
LT
    Just Ordering
GT -> Ordering
GT
    Just Ordering
EQ -> case Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
pa (Word -> Ordering) -> Maybe Word -> Maybe Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mess -> Maybe Word
messPatch Mess
m of
      Just Ordering
LT -> Ordering
LT
      Just Ordering
GT -> Ordering
GT
      -- If they've been equal up to this point, the `Mess`
      -- will by definition have more to it, meaning that
      -- it's more likely to be newer, despite its poor shape.
      Just Ordering
EQ -> Ordering
fallback
      Maybe Ordering
Nothing -> case Mess -> Maybe VChunk
messPatchChunk Mess
m of
        Maybe VChunk
Nothing             -> Ordering
fallback
        Just (Digits Word
pa':|[VUnit]
_) -> case Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
pa Word
pa' of
          Ordering
LT -> Ordering
LT
          Ordering
GT -> Ordering
GT
          Ordering
EQ -> Ordering
GT  -- This follows semver's rule!
        Just VChunk
_ -> Ordering
fallback
  where
    fallback :: Ordering
    fallback :: Ordering
fallback = Versioning -> Versioning -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Version -> Versioning
General (Version -> Versioning) -> Version -> Versioning
forall a b. (a -> b) -> a -> b
$ SemVer -> Version
vFromS SemVer
s) (Mess -> Versioning
Complex Mess
m)

instance Semantic Versioning where
  major :: (Word -> f Word) -> Versioning -> f Versioning
major Word -> f Word
f (Ideal SemVer
v)   = SemVer -> Versioning
Ideal   (SemVer -> Versioning) -> f SemVer -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> SemVer -> f SemVer
forall v. Semantic v => Traversal' v Word
major Word -> f Word
f SemVer
v
  major Word -> f Word
f (General Version
v) = Version -> Versioning
General (Version -> Versioning) -> f Version -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> Version -> f Version
forall v. Semantic v => Traversal' v Word
major Word -> f Word
f Version
v
  major Word -> f Word
f (Complex Mess
v) = Mess -> Versioning
Complex (Mess -> Versioning) -> f Mess -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> Mess -> f Mess
forall v. Semantic v => Traversal' v Word
major Word -> f Word
f Mess
v
  {-# INLINE major #-}

  minor :: (Word -> f Word) -> Versioning -> f Versioning
minor Word -> f Word
f (Ideal SemVer
v)   = SemVer -> Versioning
Ideal   (SemVer -> Versioning) -> f SemVer -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> SemVer -> f SemVer
forall v. Semantic v => Traversal' v Word
minor Word -> f Word
f SemVer
v
  minor Word -> f Word
f (General Version
v) = Version -> Versioning
General (Version -> Versioning) -> f Version -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> Version -> f Version
forall v. Semantic v => Traversal' v Word
minor Word -> f Word
f Version
v
  minor Word -> f Word
f (Complex Mess
v) = Mess -> Versioning
Complex (Mess -> Versioning) -> f Mess -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> Mess -> f Mess
forall v. Semantic v => Traversal' v Word
minor Word -> f Word
f Mess
v
  {-# INLINE minor #-}

  patch :: (Word -> f Word) -> Versioning -> f Versioning
patch Word -> f Word
f (Ideal SemVer
v)   = SemVer -> Versioning
Ideal   (SemVer -> Versioning) -> f SemVer -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> SemVer -> f SemVer
forall v. Semantic v => Traversal' v Word
patch Word -> f Word
f SemVer
v
  patch Word -> f Word
f (General Version
v) = Version -> Versioning
General (Version -> Versioning) -> f Version -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> Version -> f Version
forall v. Semantic v => Traversal' v Word
patch Word -> f Word
f Version
v
  patch Word -> f Word
f (Complex Mess
v) = Mess -> Versioning
Complex (Mess -> Versioning) -> f Mess -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> f Word) -> Mess -> f Mess
forall v. Semantic v => Traversal' v Word
patch Word -> f Word
f Mess
v
  {-# INLINE patch #-}

  release :: ([VChunk] -> f [VChunk]) -> Versioning -> f Versioning
release [VChunk] -> f [VChunk]
f (Ideal SemVer
v)   = SemVer -> Versioning
Ideal   (SemVer -> Versioning) -> f SemVer -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([VChunk] -> f [VChunk]) -> SemVer -> f SemVer
forall v. Semantic v => Traversal' v [VChunk]
release [VChunk] -> f [VChunk]
f SemVer
v
  release [VChunk] -> f [VChunk]
f (General Version
v) = Version -> Versioning
General (Version -> Versioning) -> f Version -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([VChunk] -> f [VChunk]) -> Version -> f Version
forall v. Semantic v => Traversal' v [VChunk]
release [VChunk] -> f [VChunk]
f Version
v
  release [VChunk] -> f [VChunk]
f (Complex Mess
v) = Mess -> Versioning
Complex (Mess -> Versioning) -> f Mess -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([VChunk] -> f [VChunk]) -> Mess -> f Mess
forall v. Semantic v => Traversal' v [VChunk]
release [VChunk] -> f [VChunk]
f Mess
v
  {-# INLINE release #-}

  meta :: ([VChunk] -> f [VChunk]) -> Versioning -> f Versioning
meta [VChunk] -> f [VChunk]
f (Ideal SemVer
v)   = SemVer -> Versioning
Ideal   (SemVer -> Versioning) -> f SemVer -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([VChunk] -> f [VChunk]) -> SemVer -> f SemVer
forall v. Semantic v => Traversal' v [VChunk]
meta [VChunk] -> f [VChunk]
f SemVer
v
  meta [VChunk] -> f [VChunk]
f (General Version
v) = Version -> Versioning
General (Version -> Versioning) -> f Version -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([VChunk] -> f [VChunk]) -> Version -> f Version
forall v. Semantic v => Traversal' v [VChunk]
meta [VChunk] -> f [VChunk]
f Version
v
  meta [VChunk] -> f [VChunk]
f (Complex Mess
v) = Mess -> Versioning
Complex (Mess -> Versioning) -> f Mess -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([VChunk] -> f [VChunk]) -> Mess -> f Mess
forall v. Semantic v => Traversal' v [VChunk]
meta [VChunk] -> f [VChunk]
f Mess
v
  {-# INLINE meta #-}

  semantic :: (SemVer -> f SemVer) -> Versioning -> f Versioning
semantic SemVer -> f SemVer
f (Ideal SemVer
v)   = SemVer -> Versioning
Ideal   (SemVer -> Versioning) -> f SemVer -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SemVer -> f SemVer) -> SemVer -> f SemVer
forall v. Semantic v => Traversal' v SemVer
semantic SemVer -> f SemVer
f SemVer
v
  semantic SemVer -> f SemVer
f (General Version
v) = Version -> Versioning
General (Version -> Versioning) -> f Version -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SemVer -> f SemVer) -> Version -> f Version
forall v. Semantic v => Traversal' v SemVer
semantic SemVer -> f SemVer
f Version
v
  semantic SemVer -> f SemVer
f (Complex Mess
v) = Mess -> Versioning
Complex (Mess -> Versioning) -> f Mess -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SemVer -> f SemVer) -> Mess -> f Mess
forall v. Semantic v => Traversal' v SemVer
semantic SemVer -> f SemVer
f Mess
v
  {-# INLINE semantic #-}

-- | Traverse some Text for its inner versioning.
--
-- @
-- λ "1.2.3" & _Versioning . _Ideal . patch %~ (+ 1)  -- or just: "1.2.3" & patch %~ (+ 1)
-- "1.2.4"
-- @
_Versioning :: Traversal' Text Versioning
_Versioning :: (Versioning -> f Versioning) -> Text -> f Text
_Versioning Versioning -> f Versioning
f Text
t = (ParsingError -> f Text)
-> (Versioning -> f Text)
-> Either ParsingError Versioning
-> f Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f Text -> ParsingError -> f Text
forall a b. a -> b -> a
const (Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t)) ((Versioning -> Text) -> f Versioning -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioning -> Text
prettyV (f Versioning -> f Text)
-> (Versioning -> f Versioning) -> Versioning -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioning -> f Versioning
f) (Either ParsingError Versioning -> f Text)
-> Either ParsingError Versioning -> f Text
forall a b. (a -> b) -> a -> b
$ Text -> Either ParsingError Versioning
versioning Text
t
{-# INLINE _Versioning #-}

-- | Traverse some Text for its inner SemVer.
_SemVer :: Traversal' Text SemVer
_SemVer :: (SemVer -> f SemVer) -> Text -> f Text
_SemVer SemVer -> f SemVer
f Text
t = (ParsingError -> f Text)
-> (SemVer -> f Text) -> Either ParsingError SemVer -> f Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f Text -> ParsingError -> f Text
forall a b. a -> b -> a
const (Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t)) ((SemVer -> Text) -> f SemVer -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SemVer -> Text
prettySemVer (f SemVer -> f Text) -> (SemVer -> f SemVer) -> SemVer -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SemVer -> f SemVer
f) (Either ParsingError SemVer -> f Text)
-> Either ParsingError SemVer -> f Text
forall a b. (a -> b) -> a -> b
$ Text -> Either ParsingError SemVer
semver Text
t
{-# INLINE _SemVer #-}

-- | Traverse some Text for its inner Version.
_Version :: Traversal' Text Version
_Version :: (Version -> f Version) -> Text -> f Text
_Version Version -> f Version
f Text
t = (ParsingError -> f Text)
-> (Version -> f Text) -> Either ParsingError Version -> f Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f Text -> ParsingError -> f Text
forall a b. a -> b -> a
const (Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t)) ((Version -> Text) -> f Version -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Text
prettyVer (f Version -> f Text)
-> (Version -> f Version) -> Version -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> f Version
f) (Either ParsingError Version -> f Text)
-> Either ParsingError Version -> f Text
forall a b. (a -> b) -> a -> b
$ Text -> Either ParsingError Version
version Text
t
{-# INLINE _Version #-}

-- | Traverse some Text for its inner Mess.
_Mess :: Traversal' Text Mess
_Mess :: (Mess -> f Mess) -> Text -> f Text
_Mess Mess -> f Mess
f Text
t = (ParsingError -> f Text)
-> (Mess -> f Text) -> Either ParsingError Mess -> f Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f Text -> ParsingError -> f Text
forall a b. a -> b -> a
const (Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t)) ((Mess -> Text) -> f Mess -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mess -> Text
prettyMess (f Mess -> f Text) -> (Mess -> f Mess) -> Mess -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mess -> f Mess
f) (Either ParsingError Mess -> f Text)
-> Either ParsingError Mess -> f Text
forall a b. (a -> b) -> a -> b
$ Text -> Either ParsingError Mess
mess Text
t
{-# INLINE _Mess #-}

_Ideal :: Traversal' Versioning SemVer
_Ideal :: (SemVer -> f SemVer) -> Versioning -> f Versioning
_Ideal SemVer -> f SemVer
f (Ideal SemVer
s) = SemVer -> Versioning
Ideal (SemVer -> Versioning) -> f SemVer -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SemVer -> f SemVer
f SemVer
s
_Ideal SemVer -> f SemVer
_ Versioning
v         = Versioning -> f Versioning
forall (f :: * -> *) a. Applicative f => a -> f a
pure Versioning
v
{-# INLINE _Ideal #-}

_General :: Traversal' Versioning Version
_General :: (Version -> f Version) -> Versioning -> f Versioning
_General Version -> f Version
f (General Version
v) = Version -> Versioning
General (Version -> Versioning) -> f Version -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> f Version
f Version
v
_General Version -> f Version
_ Versioning
v           = Versioning -> f Versioning
forall (f :: * -> *) a. Applicative f => a -> f a
pure Versioning
v
{-# INLINE _General #-}

_Complex :: Traversal' Versioning Mess
_Complex :: (Mess -> f Mess) -> Versioning -> f Versioning
_Complex Mess -> f Mess
f (Complex Mess
m) = Mess -> Versioning
Complex (Mess -> Versioning) -> f Mess -> f Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mess -> f Mess
f Mess
m
_Complex Mess -> f Mess
_ Versioning
v           = Versioning -> f Versioning
forall (f :: * -> *) a. Applicative f => a -> f a
pure Versioning
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 Text where
  major :: (Word -> f Word) -> Text -> f Text
major    = (Versioning -> f Versioning) -> Text -> f Text
Traversal' Text Versioning
_Versioning ((Versioning -> f Versioning) -> Text -> f Text)
-> ((Word -> f Word) -> Versioning -> f Versioning)
-> (Word -> f Word)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> f Word) -> Versioning -> f Versioning
forall v. Semantic v => Traversal' v Word
major
  minor :: (Word -> f Word) -> Text -> f Text
minor    = (Versioning -> f Versioning) -> Text -> f Text
Traversal' Text Versioning
_Versioning ((Versioning -> f Versioning) -> Text -> f Text)
-> ((Word -> f Word) -> Versioning -> f Versioning)
-> (Word -> f Word)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> f Word) -> Versioning -> f Versioning
forall v. Semantic v => Traversal' v Word
minor
  patch :: (Word -> f Word) -> Text -> f Text
patch    = (Versioning -> f Versioning) -> Text -> f Text
Traversal' Text Versioning
_Versioning ((Versioning -> f Versioning) -> Text -> f Text)
-> ((Word -> f Word) -> Versioning -> f Versioning)
-> (Word -> f Word)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> f Word) -> Versioning -> f Versioning
forall v. Semantic v => Traversal' v Word
patch
  release :: ([VChunk] -> f [VChunk]) -> Text -> f Text
release  = (Versioning -> f Versioning) -> Text -> f Text
Traversal' Text Versioning
_Versioning ((Versioning -> f Versioning) -> Text -> f Text)
-> (([VChunk] -> f [VChunk]) -> Versioning -> f Versioning)
-> ([VChunk] -> f [VChunk])
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VChunk] -> f [VChunk]) -> Versioning -> f Versioning
forall v. Semantic v => Traversal' v [VChunk]
release
  meta :: ([VChunk] -> f [VChunk]) -> Text -> f Text
meta     = (Versioning -> f Versioning) -> Text -> f Text
Traversal' Text Versioning
_Versioning ((Versioning -> f Versioning) -> Text -> f Text)
-> (([VChunk] -> f [VChunk]) -> Versioning -> f Versioning)
-> ([VChunk] -> f [VChunk])
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VChunk] -> f [VChunk]) -> Versioning -> f Versioning
forall v. Semantic v => Traversal' v [VChunk]
meta
  semantic :: (SemVer -> f SemVer) -> Text -> f Text
semantic = (SemVer -> f SemVer) -> Text -> f Text
Traversal' Text SemVer
_SemVer

--------------------------------------------------------------------------------
-- (Ideal) SemVer

-- | An (Ideal) version number that conforms to Semantic Versioning.
-- This is a /prescriptive/ parser, meaning it follows the SemVer standard.
--
-- Legal semvers are of the form: MAJOR.MINOR.PATCH-PREREL+META
--
-- Example: @1.2.3-r1+commithash@
--
-- Extra Rules:
--
-- 1. Pre-release versions have /lower/ precedence than normal versions.
--
-- 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
  { SemVer -> Word
_svMajor  :: !Word
  , SemVer -> Word
_svMinor  :: !Word
  , SemVer -> Word
_svPatch  :: !Word
  , SemVer -> [VChunk]
_svPreRel :: ![VChunk]
  , SemVer -> [VChunk]
_svMeta   :: ![VChunk] }
  deriving stock (Int -> SemVer -> ShowS
[SemVer] -> ShowS
SemVer -> String
(Int -> SemVer -> ShowS)
-> (SemVer -> String) -> ([SemVer] -> ShowS) -> Show SemVer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemVer] -> ShowS
$cshowList :: [SemVer] -> ShowS
show :: SemVer -> String
$cshow :: SemVer -> String
showsPrec :: Int -> SemVer -> ShowS
$cshowsPrec :: Int -> SemVer -> ShowS
Show, (forall x. SemVer -> Rep SemVer x)
-> (forall x. Rep SemVer x -> SemVer) -> Generic SemVer
forall x. Rep SemVer x -> SemVer
forall x. SemVer -> Rep SemVer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SemVer x -> SemVer
$cfrom :: forall x. SemVer -> Rep SemVer x
Generic)
  deriving anyclass (SemVer -> ()
(SemVer -> ()) -> NFData SemVer
forall a. (a -> ()) -> NFData a
rnf :: SemVer -> ()
$crnf :: SemVer -> ()
NFData, Int -> SemVer -> Int
SemVer -> Int
(Int -> SemVer -> Int) -> (SemVer -> Int) -> Hashable SemVer
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SemVer -> Int
$chash :: SemVer -> Int
hashWithSalt :: Int -> SemVer -> Int
$chashWithSalt :: Int -> SemVer -> Int
Hashable)

-- | Two SemVers are equal if all fields except metadata are equal.
instance Eq SemVer where
  (SemVer Word
ma Word
mi Word
pa [VChunk]
pr [VChunk]
_) == :: SemVer -> SemVer -> Bool
== (SemVer Word
ma' Word
mi' Word
pa' [VChunk]
pr' [VChunk]
_) =
    (Word
ma,Word
mi,Word
pa,[VChunk]
pr) (Word, Word, Word, [VChunk])
-> (Word, Word, Word, [VChunk]) -> Bool
forall a. Eq a => a -> a -> Bool
== (Word
ma',Word
mi',Word
pa',[VChunk]
pr')

-- | Build metadata does not affect version precedence.
instance Ord SemVer where
  compare :: SemVer -> SemVer -> Ordering
compare (SemVer Word
ma Word
mi Word
pa [VChunk]
pr [VChunk]
_) (SemVer Word
ma' Word
mi' Word
pa' [VChunk]
pr' [VChunk]
_) =
    case (Word, Word, Word) -> (Word, Word, Word) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word
ma,Word
mi,Word
pa) (Word
ma',Word
mi',Word
pa') of
     Ordering
LT -> Ordering
LT
     Ordering
GT -> Ordering
GT
     Ordering
EQ -> case ([VChunk]
pr,[VChunk]
pr') of
            ([],[]) -> Ordering
EQ
            ([],[VChunk]
_)  -> Ordering
GT
            ([VChunk]
_,[])  -> Ordering
LT
            ([VChunk], [VChunk])
_       -> [VChunk] -> [VChunk] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [VChunk]
pr [VChunk]
pr'

instance Semigroup SemVer where
  SemVer Word
mj Word
mn Word
pa [VChunk]
p [VChunk]
m <> :: SemVer -> SemVer -> SemVer
<> SemVer Word
mj' Word
mn' Word
pa' [VChunk]
p' [VChunk]
m' =
    Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer (Word
mj Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
mj') (Word
mn Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
mn') (Word
pa Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
pa') ([VChunk]
p [VChunk] -> [VChunk] -> [VChunk]
forall a. [a] -> [a] -> [a]
++ [VChunk]
p') ([VChunk]
m [VChunk] -> [VChunk] -> [VChunk]
forall a. [a] -> [a] -> [a]
++ [VChunk]
m')

instance Monoid SemVer where
  mempty :: SemVer
mempty = Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer Word
0 Word
0 Word
0 [] []

#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

instance Semantic SemVer where
  major :: (Word -> f Word) -> SemVer -> f SemVer
major Word -> f Word
f SemVer
sv = (Word -> SemVer) -> f Word -> f SemVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word
ma -> SemVer
sv { _svMajor :: Word
_svMajor = Word
ma }) (Word -> f Word
f (Word -> f Word) -> Word -> f Word
forall a b. (a -> b) -> a -> b
$ SemVer -> Word
_svMajor SemVer
sv)
  {-# INLINE major #-}

  minor :: (Word -> f Word) -> SemVer -> f SemVer
minor Word -> f Word
f SemVer
sv = (Word -> SemVer) -> f Word -> f SemVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word
mi -> SemVer
sv { _svMinor :: Word
_svMinor = Word
mi }) (Word -> f Word
f (Word -> f Word) -> Word -> f Word
forall a b. (a -> b) -> a -> b
$ SemVer -> Word
_svMinor SemVer
sv)
  {-# INLINE minor #-}

  patch :: (Word -> f Word) -> SemVer -> f SemVer
patch Word -> f Word
f SemVer
sv = (Word -> SemVer) -> f Word -> f SemVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word
pa -> SemVer
sv { _svPatch :: Word
_svPatch = Word
pa }) (Word -> f Word
f (Word -> f Word) -> Word -> f Word
forall a b. (a -> b) -> a -> b
$ SemVer -> Word
_svPatch SemVer
sv)
  {-# INLINE patch #-}

  release :: ([VChunk] -> f [VChunk]) -> SemVer -> f SemVer
release [VChunk] -> f [VChunk]
f SemVer
sv = ([VChunk] -> SemVer) -> f [VChunk] -> f SemVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[VChunk]
pa -> SemVer
sv { _svPreRel :: [VChunk]
_svPreRel = [VChunk]
pa }) ([VChunk] -> f [VChunk]
f ([VChunk] -> f [VChunk]) -> [VChunk] -> f [VChunk]
forall a b. (a -> b) -> a -> b
$ SemVer -> [VChunk]
_svPreRel SemVer
sv)
  {-# INLINE release #-}

  meta :: ([VChunk] -> f [VChunk]) -> SemVer -> f SemVer
meta [VChunk] -> f [VChunk]
f SemVer
sv = ([VChunk] -> SemVer) -> f [VChunk] -> f SemVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[VChunk]
pa -> SemVer
sv { _svMeta :: [VChunk]
_svMeta = [VChunk]
pa }) ([VChunk] -> f [VChunk]
f ([VChunk] -> f [VChunk]) -> [VChunk] -> f [VChunk]
forall a b. (a -> b) -> a -> b
$ SemVer -> [VChunk]
_svMeta SemVer
sv)
  {-# INLINE meta #-}

  semantic :: (SemVer -> f SemVer) -> SemVer -> f SemVer
semantic = (SemVer -> f SemVer) -> SemVer -> f SemVer
forall a b. (a -> b) -> a -> b
($)
  {-# 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 Word | Str Text
  deriving stock (VUnit -> VUnit -> Bool
(VUnit -> VUnit -> Bool) -> (VUnit -> VUnit -> Bool) -> Eq VUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VUnit -> VUnit -> Bool
$c/= :: VUnit -> VUnit -> Bool
== :: VUnit -> VUnit -> Bool
$c== :: VUnit -> VUnit -> Bool
Eq, Int -> VUnit -> ShowS
[VUnit] -> ShowS
VUnit -> String
(Int -> VUnit -> ShowS)
-> (VUnit -> String) -> ([VUnit] -> ShowS) -> Show VUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VUnit] -> ShowS
$cshowList :: [VUnit] -> ShowS
show :: VUnit -> String
$cshow :: VUnit -> String
showsPrec :: Int -> VUnit -> ShowS
$cshowsPrec :: Int -> VUnit -> ShowS
Show, ReadPrec [VUnit]
ReadPrec VUnit
Int -> ReadS VUnit
ReadS [VUnit]
(Int -> ReadS VUnit)
-> ReadS [VUnit]
-> ReadPrec VUnit
-> ReadPrec [VUnit]
-> Read VUnit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VUnit]
$creadListPrec :: ReadPrec [VUnit]
readPrec :: ReadPrec VUnit
$creadPrec :: ReadPrec VUnit
readList :: ReadS [VUnit]
$creadList :: ReadS [VUnit]
readsPrec :: Int -> ReadS VUnit
$creadsPrec :: Int -> ReadS VUnit
Read, Eq VUnit
Eq VUnit
-> (VUnit -> VUnit -> Ordering)
-> (VUnit -> VUnit -> Bool)
-> (VUnit -> VUnit -> Bool)
-> (VUnit -> VUnit -> Bool)
-> (VUnit -> VUnit -> Bool)
-> (VUnit -> VUnit -> VUnit)
-> (VUnit -> VUnit -> VUnit)
-> Ord VUnit
VUnit -> VUnit -> Bool
VUnit -> VUnit -> Ordering
VUnit -> VUnit -> VUnit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VUnit -> VUnit -> VUnit
$cmin :: VUnit -> VUnit -> VUnit
max :: VUnit -> VUnit -> VUnit
$cmax :: VUnit -> VUnit -> VUnit
>= :: VUnit -> VUnit -> Bool
$c>= :: VUnit -> VUnit -> Bool
> :: VUnit -> VUnit -> Bool
$c> :: VUnit -> VUnit -> Bool
<= :: VUnit -> VUnit -> Bool
$c<= :: VUnit -> VUnit -> Bool
< :: VUnit -> VUnit -> Bool
$c< :: VUnit -> VUnit -> Bool
compare :: VUnit -> VUnit -> Ordering
$ccompare :: VUnit -> VUnit -> Ordering
$cp1Ord :: Eq VUnit
Ord, (forall x. VUnit -> Rep VUnit x)
-> (forall x. Rep VUnit x -> VUnit) -> Generic VUnit
forall x. Rep VUnit x -> VUnit
forall x. VUnit -> Rep VUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VUnit x -> VUnit
$cfrom :: forall x. VUnit -> Rep VUnit x
Generic)
  deriving anyclass (VUnit -> ()
(VUnit -> ()) -> NFData VUnit
forall a. (a -> ()) -> NFData a
rnf :: VUnit -> ()
$crnf :: VUnit -> ()
NFData, Int -> VUnit -> Int
VUnit -> Int
(Int -> VUnit -> Int) -> (VUnit -> Int) -> Hashable VUnit
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: VUnit -> Int
$chash :: VUnit -> Int
hashWithSalt :: Int -> VUnit -> Int
$chashWithSalt :: Int -> VUnit -> Int
Hashable)

instance Semigroup VUnit where
  Digits Word
n <> :: VUnit -> VUnit -> VUnit
<> Digits Word
m = Word -> VUnit
Digits (Word -> VUnit) -> Word -> VUnit
forall a b. (a -> b) -> a -> b
$ Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
m
  Str Text
t    <> Str Text
s    = Text -> VUnit
Str (Text -> VUnit) -> Text -> VUnit
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
  Digits Word
n <> VUnit
_        = Word -> VUnit
Digits Word
n
  VUnit
_        <> Digits Word
n = Word -> VUnit
Digits Word
n

instance Monoid VUnit where
  mempty :: VUnit
mempty = Text -> VUnit
Str Text
""

#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

-- | Smart constructor for a `VUnit` made of digits.
digits :: Word -> VUnit
digits :: Word -> VUnit
digits = Word -> VUnit
Digits

-- | Smart constructor for a `VUnit` made of letters.
str :: Text -> Maybe VUnit
str :: Text -> Maybe VUnit
str Text
t = Maybe VUnit -> Maybe VUnit -> Bool -> Maybe VUnit
forall a. a -> a -> Bool -> a
bool Maybe VUnit
forall a. Maybe a
Nothing (VUnit -> Maybe VUnit
forall a. a -> Maybe a
Just (VUnit -> Maybe VUnit) -> VUnit -> Maybe VUnit
forall a b. (a -> b) -> a -> b
$ Text -> VUnit
Str Text
t) (Bool -> Maybe VUnit) -> Bool -> Maybe VUnit
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlpha Text
t

_Digits :: Traversal' VUnit Word
_Digits :: (Word -> f Word) -> VUnit -> f VUnit
_Digits Word -> f Word
f (Digits Word
i) = Word -> VUnit
Digits (Word -> VUnit) -> f Word -> f VUnit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
i
_Digits Word -> f Word
_ VUnit
v          = VUnit -> f VUnit
forall (f :: * -> *) a. Applicative f => a -> f a
pure VUnit
v
{-# INLINE _Digits #-}

_Str :: Traversal' VUnit Text
_Str :: (Text -> f Text) -> VUnit -> f VUnit
_Str Text -> f Text
f (Str Text
t) = Text -> VUnit
Str (Text -> VUnit) -> (Text -> Text) -> Text -> VUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
t' -> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
t Text
t' ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlpha Text
t')) (Text -> VUnit) -> f Text -> f VUnit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
t
_Str Text -> f Text
_ VUnit
v       = VUnit -> f VUnit
forall (f :: * -> *) a. Applicative f => a -> f a
pure VUnit
v
{-# INLINE _Str #-}

-- | A logical unit of a version number. Can consist of multiple letters
-- and numbers.
type VChunk = NonEmpty VUnit

--------------------------------------------------------------------------------
-- (Haskell) PVP

-- | A PVP version number specific to the Haskell ecosystem. Like SemVer this is
-- a prescriptive scheme, and follows <https://pvp.haskell.org/ the PVP spec>.
--
-- Legal PVP values are of the form: MAJOR(.MAJOR.MINOR)
--
-- Example: @1.2.3@
--
-- Extra Rules:
--
-- 1. Each component must be a number.
--
-- 2. Only the first MAJOR component is actually necessary. Otherwise, there can
--    be any number of components. @1.2.3.4.5.6.7@ is legal.
--
-- 3. Unlike SemVer there are two MAJOR components, and both indicate a breaking
--    change. The spec otherwise designates no special meaning to components
--    past the MINOR position.
newtype PVP = PVP { PVP -> NonEmpty Word
_pComponents :: NonEmpty Word }
  deriving stock (PVP -> PVP -> Bool
(PVP -> PVP -> Bool) -> (PVP -> PVP -> Bool) -> Eq PVP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PVP -> PVP -> Bool
$c/= :: PVP -> PVP -> Bool
== :: PVP -> PVP -> Bool
$c== :: PVP -> PVP -> Bool
Eq, Eq PVP
Eq PVP
-> (PVP -> PVP -> Ordering)
-> (PVP -> PVP -> Bool)
-> (PVP -> PVP -> Bool)
-> (PVP -> PVP -> Bool)
-> (PVP -> PVP -> Bool)
-> (PVP -> PVP -> PVP)
-> (PVP -> PVP -> PVP)
-> Ord PVP
PVP -> PVP -> Bool
PVP -> PVP -> Ordering
PVP -> PVP -> PVP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PVP -> PVP -> PVP
$cmin :: PVP -> PVP -> PVP
max :: PVP -> PVP -> PVP
$cmax :: PVP -> PVP -> PVP
>= :: PVP -> PVP -> Bool
$c>= :: PVP -> PVP -> Bool
> :: PVP -> PVP -> Bool
$c> :: PVP -> PVP -> Bool
<= :: PVP -> PVP -> Bool
$c<= :: PVP -> PVP -> Bool
< :: PVP -> PVP -> Bool
$c< :: PVP -> PVP -> Bool
compare :: PVP -> PVP -> Ordering
$ccompare :: PVP -> PVP -> Ordering
$cp1Ord :: Eq PVP
Ord, Int -> PVP -> ShowS
[PVP] -> ShowS
PVP -> String
(Int -> PVP -> ShowS)
-> (PVP -> String) -> ([PVP] -> ShowS) -> Show PVP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PVP] -> ShowS
$cshowList :: [PVP] -> ShowS
show :: PVP -> String
$cshow :: PVP -> String
showsPrec :: Int -> PVP -> ShowS
$cshowsPrec :: Int -> PVP -> ShowS
Show, (forall x. PVP -> Rep PVP x)
-> (forall x. Rep PVP x -> PVP) -> Generic PVP
forall x. Rep PVP x -> PVP
forall x. PVP -> Rep PVP x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PVP x -> PVP
$cfrom :: forall x. PVP -> Rep PVP x
Generic)
  deriving anyclass (PVP -> ()
(PVP -> ()) -> NFData PVP
forall a. (a -> ()) -> NFData a
rnf :: PVP -> ()
$crnf :: PVP -> ()
NFData, Int -> PVP -> Int
PVP -> Int
(Int -> PVP -> Int) -> (PVP -> Int) -> Hashable PVP
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PVP -> Int
$chash :: PVP -> Int
hashWithSalt :: Int -> PVP -> Int
$chashWithSalt :: Int -> PVP -> Int
Hashable)

instance Semigroup PVP where
  PVP (Word
m :| [Word]
r) <> :: PVP -> PVP -> PVP
<> PVP (Word
m' :| [Word]
r') = NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> NonEmpty Word -> PVP
forall a b. (a -> b) -> a -> b
$ (Word
m Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
m') Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word] -> [Word] -> [Word]
forall a. Num a => [a] -> [a] -> [a]
f [Word]
r [Word]
r'
    where
      f :: [a] -> [a] -> [a]
f [a]
a []          = [a]
a
      f [] [a]
b          = [a]
b
      f (a
a:[a]
as) (a
b:[a]
bs) = (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
f [a]
as [a]
bs

instance Monoid PVP where
  mempty :: PVP
mempty = NonEmpty Word -> PVP
PVP (Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [])

#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

instance Semantic PVP where
  major :: (Word -> f Word) -> PVP -> f PVP
major Word -> f Word
f (PVP (Word
m :| [Word]
rs)) = (\Word
ma -> NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> NonEmpty Word -> PVP
forall a b. (a -> b) -> a -> b
$ Word
ma Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word]
rs) (Word -> PVP) -> f Word -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
m
  {-# INLINE major #-}

  minor :: (Word -> f Word) -> PVP -> f PVP
minor Word -> f Word
f (PVP (Word
m :| Word
mi : [Word]
rs)) = (\Word
mi' -> NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> NonEmpty Word -> PVP
forall a b. (a -> b) -> a -> b
$ Word
m Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| Word
mi' Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
rs) (Word -> PVP) -> f Word -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
mi
  minor Word -> f Word
f (PVP (Word
m :| []))      = (\Word
mi' -> NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> NonEmpty Word -> PVP
forall a b. (a -> b) -> a -> b
$ Word
m Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
mi']) (Word -> PVP) -> f Word -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
0
  {-# INLINE minor #-}

  patch :: (Word -> f Word) -> PVP -> f PVP
patch Word -> f Word
f (PVP (Word
m :| Word
mi : Word
pa : [Word]
rs)) = (\Word
pa' -> NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> NonEmpty Word -> PVP
forall a b. (a -> b) -> a -> b
$ Word
m Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| Word
mi Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Word
pa' Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
rs) (Word -> PVP) -> f Word -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
pa
  patch Word -> f Word
f (PVP (Word
m :| Word
mi : []))      = (\Word
pa' -> NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> NonEmpty Word -> PVP
forall a b. (a -> b) -> a -> b
$ Word
m Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| Word
mi Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word
pa']) (Word -> PVP) -> f Word -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
0
  patch Word -> f Word
f (PVP (Word
m :| []))           = (\Word
pa' -> NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> NonEmpty Word -> PVP
forall a b. (a -> b) -> a -> b
$ Word
m Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| Word
0 Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word
pa']) (Word -> PVP) -> f Word -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
0
  {-# INLINE patch #-}

  release :: ([VChunk] -> f [VChunk]) -> PVP -> f PVP
release [VChunk] -> f [VChunk]
f PVP
p = PVP -> [VChunk] -> PVP
forall a b. a -> b -> a
const PVP
p ([VChunk] -> PVP) -> f [VChunk] -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VChunk] -> f [VChunk]
f []
  {-# INLINE release #-}

  meta :: ([VChunk] -> f [VChunk]) -> PVP -> f PVP
meta [VChunk] -> f [VChunk]
f PVP
p = PVP -> [VChunk] -> PVP
forall a b. a -> b -> a
const PVP
p ([VChunk] -> PVP) -> f [VChunk] -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VChunk] -> f [VChunk]
f []
  {-# INLINE meta #-}

  semantic :: (SemVer -> f SemVer) -> PVP -> f PVP
semantic SemVer -> f SemVer
f (PVP (Word
m :| [Word]
rs)) = (\(SemVer Word
ma Word
mi Word
pa [VChunk]
_ [VChunk]
_) -> NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> NonEmpty Word -> PVP
forall a b. (a -> b) -> a -> b
$ Word
ma Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
mi, Word
pa]) (SemVer -> PVP) -> f SemVer -> f PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SemVer -> f SemVer
f SemVer
s
    where
      s :: SemVer
s = case [Word]
rs of
        Word
mi : Word
pa : [Word]
_ -> Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer Word
m Word
mi Word
pa [] []
        Word
mi : [Word]
_      -> Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer Word
m Word
mi Word
0  [] []
        []          -> Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer Word
m Word
0 Word
0   [] []
  {-# INLINE semantic #-}

--------------------------------------------------------------------------------
-- (General) Version

-- | A (General) Version.
-- Not quite as ideal as a `SemVer`, but has some internal consistancy
-- from version to version.
--
-- Generally conforms to the @a.b.c-p@ pattern, and may optionally have an
-- /epoch/ and /metadata/. Epochs are prefixes marked by a colon, like in
-- @1:2.3.4@. Metadata is prefixed by @+@, and unlike SemVer can appear before
-- the "prerelease" (the @-p@).
--
-- Examples of @Version@ that are not @SemVer@: 0.25-2, 8.u51-1, 20150826-1,
-- 1:2.3.4, 1.11.0+20200830-1
data Version = Version
  { Version -> Maybe Word
_vEpoch  :: !(Maybe Word)
  , Version -> NonEmpty VChunk
_vChunks :: !(NonEmpty VChunk)
  , Version -> [VChunk]
_vMeta   :: ![VChunk]
  , Version -> [VChunk]
_vRel    :: ![VChunk] }
  deriving stock (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic)
  deriving anyclass (Version -> ()
(Version -> ()) -> NFData Version
forall a. (a -> ()) -> NFData a
rnf :: Version -> ()
$crnf :: Version -> ()
NFData, Int -> Version -> Int
Version -> Int
(Int -> Version -> Int) -> (Version -> Int) -> Hashable Version
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Version -> Int
$chash :: Version -> Int
hashWithSalt :: Int -> Version -> Int
$chashWithSalt :: Int -> Version -> Int
Hashable)

instance Semigroup Version where
  Version Maybe Word
e NonEmpty VChunk
c [VChunk]
m [VChunk]
r <> :: Version -> Version -> Version
<> Version Maybe Word
e' NonEmpty VChunk
c' [VChunk]
m' [VChunk]
r' = Maybe Word -> NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version
Version (Word -> Word -> Word
forall a. Num a => a -> a -> a
(+) (Word -> Word -> Word) -> Maybe Word -> Maybe (Word -> Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word
e Maybe (Word -> Word) -> Maybe Word -> Maybe Word
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Word
e') (NonEmpty VChunk
c NonEmpty VChunk -> NonEmpty VChunk -> NonEmpty VChunk
forall a. Semigroup a => a -> a -> a
<> NonEmpty VChunk
c') ([VChunk]
m [VChunk] -> [VChunk] -> [VChunk]
forall a. Semigroup a => a -> a -> a
<> [VChunk]
m') ([VChunk]
r [VChunk] -> [VChunk] -> [VChunk]
forall a. Semigroup a => a -> a -> a
<> [VChunk]
r')

-- | Customized.
instance Ord Version where
  -- | For the purposes of Versions with epochs, `Nothing` is the same as `Just 0`,
  -- so we need to compare their actual version numbers.
  compare :: Version -> Version -> Ordering
compare (Version Maybe Word
ae NonEmpty VChunk
as [VChunk]
_ [VChunk]
rs) (Version Maybe Word
be NonEmpty VChunk
bs [VChunk]
_ [VChunk]
rs') = case Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
0 Maybe Word
ae) (Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
0 Maybe Word
be) of
    Ordering
EQ  -> case [VChunk] -> [VChunk] -> Ordering
g (NonEmpty VChunk -> [VChunk]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty VChunk
as) (NonEmpty VChunk -> [VChunk]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty VChunk
bs) of
      -- If the two Versions were otherwise equal and recursed down this far,
      -- we need to compare them by their "release" values.
      Ordering
EQ  -> [VChunk] -> [VChunk] -> Ordering
g [VChunk]
rs [VChunk]
rs'
      Ordering
ord -> Ordering
ord
    Ordering
ord -> Ordering
ord
    where
      g :: [VChunk] -> [VChunk] -> Ordering
      g :: [VChunk] -> [VChunk] -> Ordering
g [] [] = Ordering
EQ

      -- | If all chunks up until this point were equal, but one side continues
      -- on with "lettered" sections, these are considered to be indicating a
      -- beta\/prerelease, and thus are /less/ than the side who already ran out
      -- of chunks.
      g [] ((Str Text
_ :| [VUnit]
_):[VChunk]
_) = Ordering
GT
      g ((Str Text
_ :| [VUnit]
_):[VChunk]
_) [] = Ordering
LT

      -- | If one side has run out of chunks to compare but the other hasn't,
      -- the other must be newer.
      g [VChunk]
_ []  = Ordering
GT
      g [] [VChunk]
_  = Ordering
LT

      -- | The usual case.
      g (VChunk
x:[VChunk]
xs) (VChunk
y:[VChunk]
ys) = case [VUnit] -> [VUnit] -> Ordering
f (VChunk -> [VUnit]
forall a. NonEmpty a -> [a]
NEL.toList VChunk
x) (VChunk -> [VUnit]
forall a. NonEmpty a -> [a]
NEL.toList VChunk
y) of
        Ordering
EQ  -> [VChunk] -> [VChunk] -> Ordering
g [VChunk]
xs [VChunk]
ys
        Ordering
res -> Ordering
res

      f :: [VUnit] -> [VUnit] -> Ordering
      f :: [VUnit] -> [VUnit] -> Ordering
f [] [] = Ordering
EQ

      -- | Opposite of the above. If we've recursed this far and one side
      -- has fewer chunks, it must be the "greater" version. A Chunk break
      -- only occurs in a switch from digits to letters and vice versa, so
      -- anything "extra" must be an @rc@ marking or similar. Consider @1.1@
      -- compared to @1.1rc1@.
      f [] [VUnit]
_  = Ordering
GT
      f [VUnit]
_ []  = Ordering
LT

      -- | The usual case.
      f (Digits Word
n:[VUnit]
ns) (Digits Word
m:[VUnit]
ms) | Word
n Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
m = Ordering
GT
                                    | Word
n Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
m = Ordering
LT
                                    | Bool
otherwise = [VUnit] -> [VUnit] -> Ordering
f [VUnit]
ns [VUnit]
ms
      f (Str Text
n:[VUnit]
ns) (Str Text
m:[VUnit]
ms) | Text
n Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
> Text
m = Ordering
GT
                              | Text
n Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
< Text
m = Ordering
LT
                              | Bool
otherwise = [VUnit] -> [VUnit] -> Ordering
f [VUnit]
ns [VUnit]
ms

      -- | An arbitrary decision to prioritize digits over letters.
      f (Digits Word
_ :[VUnit]
_) (Str Text
_ :[VUnit]
_) = Ordering
GT
      f (Str Text
_ :[VUnit]
_ ) (Digits Word
_ :[VUnit]
_) = Ordering
LT

instance Semantic Version where
  major :: (Word -> f Word) -> Version -> f Version
major Word -> f Word
f (Version Maybe Word
e ((Digits Word
n :| []) :| [VChunk]
cs) [VChunk]
me [VChunk]
rs) =
    (\Word
n' -> Maybe Word -> NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version
Version Maybe Word
e ((Word -> VUnit
Digits Word
n' VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
:| []) VChunk -> [VChunk] -> NonEmpty VChunk
forall a. a -> [a] -> NonEmpty a
:| [VChunk]
cs) [VChunk]
me [VChunk]
rs) (Word -> Version) -> f Word -> f Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
n
  major Word -> f Word
_ Version
v = Version -> f Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
  {-# INLINE major #-}

  minor :: (Word -> f Word) -> Version -> f Version
minor Word -> f Word
f (Version Maybe Word
e (VChunk
c :| (Digits Word
n :| []) : [VChunk]
cs) [VChunk]
me [VChunk]
rs) =
    (\Word
n' -> Maybe Word -> NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version
Version Maybe Word
e (VChunk
c VChunk -> [VChunk] -> NonEmpty VChunk
forall a. a -> [a] -> NonEmpty a
:| (Word -> VUnit
Digits Word
n' VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
:| []) VChunk -> [VChunk] -> [VChunk]
forall a. a -> [a] -> [a]
: [VChunk]
cs) [VChunk]
me [VChunk]
rs) (Word -> Version) -> f Word -> f Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
n
  minor Word -> f Word
_ Version
v = Version -> f Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
  {-# INLINE minor #-}

  patch :: (Word -> f Word) -> Version -> f Version
patch Word -> f Word
f (Version Maybe Word
e (VChunk
c :| VChunk
d : (Digits Word
n :| []) : [VChunk]
cs) [VChunk]
me [VChunk]
rs) =
    (\Word
n' -> Maybe Word -> NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version
Version Maybe Word
e (VChunk
c VChunk -> [VChunk] -> NonEmpty VChunk
forall a. a -> [a] -> NonEmpty a
:| VChunk
d VChunk -> [VChunk] -> [VChunk]
forall a. a -> [a] -> [a]
: (Word -> VUnit
Digits Word
n' VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
:| []) VChunk -> [VChunk] -> [VChunk]
forall a. a -> [a] -> [a]
: [VChunk]
cs) [VChunk]
me [VChunk]
rs) (Word -> Version) -> f Word -> f Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
n
  patch Word -> f Word
_ Version
v = Version -> f Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
  {-# INLINE patch #-}

  -- | This will always succeed.
  release :: ([VChunk] -> f [VChunk]) -> Version -> f Version
release [VChunk] -> f [VChunk]
f Version
v = ([VChunk] -> Version) -> f [VChunk] -> f Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[VChunk]
vr -> Version
v { _vRel :: [VChunk]
_vRel = [VChunk]
vr }) ([VChunk] -> f [VChunk]
f ([VChunk] -> f [VChunk]) -> [VChunk] -> f [VChunk]
forall a b. (a -> b) -> a -> b
$ Version -> [VChunk]
_vRel Version
v)
  {-# INLINE release #-}

  -- | This will always fail.
  meta :: ([VChunk] -> f [VChunk]) -> Version -> f Version
meta [VChunk] -> f [VChunk]
_ Version
v = Version -> f Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
  {-# INLINE meta #-}

  semantic :: (SemVer -> f SemVer) -> Version -> f Version
semantic SemVer -> f SemVer
f (Version Maybe Word
_ ((Digits Word
a:|[]) :| (Digits Word
b:|[]) : (Digits Word
c:|[]) : [VChunk]
_) [VChunk]
me [VChunk]
rs) =
    SemVer -> Version
vFromS (SemVer -> Version) -> f SemVer -> f Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SemVer -> f SemVer
f (Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer Word
a Word
b Word
c [VChunk]
me [VChunk]
rs)
  semantic SemVer -> f SemVer
_ Version
v = Version -> f Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
  {-# INLINE semantic #-}

epoch :: Lens' Version (Maybe Word)
epoch :: (Maybe Word -> f (Maybe Word)) -> Version -> f Version
epoch Maybe Word -> f (Maybe Word)
f Version
v = (Maybe Word -> Version) -> f (Maybe Word) -> f Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Word
ve -> Version
v { _vEpoch :: Maybe Word
_vEpoch = Maybe Word
ve }) (Maybe Word -> f (Maybe Word)
f (Maybe Word -> f (Maybe Word)) -> Maybe Word -> f (Maybe Word)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Word
_vEpoch Version
v)
{-# INLINE epoch #-}

--------------------------------------------------------------------------------
-- (Complex) Mess

-- | Possible values of a section of a `Mess`. A numeric value is extracted if
-- it could be, alongside the original text it came from. This preserves both
-- `Ord` and pretty-print behaviour for versions like @1.003.0@.
data MChunk
  = MDigit Word Text
  -- ^ A nice numeric value.
  | MRev Word Text
  -- ^ A numeric value preceeded by an @r@, indicating a revision.
  | MPlain Text
  -- ^ Anything else.
  deriving stock (MChunk -> MChunk -> Bool
(MChunk -> MChunk -> Bool)
-> (MChunk -> MChunk -> Bool) -> Eq MChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MChunk -> MChunk -> Bool
$c/= :: MChunk -> MChunk -> Bool
== :: MChunk -> MChunk -> Bool
$c== :: MChunk -> MChunk -> Bool
Eq, Int -> MChunk -> ShowS
[MChunk] -> ShowS
MChunk -> String
(Int -> MChunk -> ShowS)
-> (MChunk -> String) -> ([MChunk] -> ShowS) -> Show MChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MChunk] -> ShowS
$cshowList :: [MChunk] -> ShowS
show :: MChunk -> String
$cshow :: MChunk -> String
showsPrec :: Int -> MChunk -> ShowS
$cshowsPrec :: Int -> MChunk -> ShowS
Show, (forall x. MChunk -> Rep MChunk x)
-> (forall x. Rep MChunk x -> MChunk) -> Generic MChunk
forall x. Rep MChunk x -> MChunk
forall x. MChunk -> Rep MChunk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MChunk x -> MChunk
$cfrom :: forall x. MChunk -> Rep MChunk x
Generic)
  deriving anyclass (MChunk -> ()
(MChunk -> ()) -> NFData MChunk
forall a. (a -> ()) -> NFData a
rnf :: MChunk -> ()
$crnf :: MChunk -> ()
NFData, Int -> MChunk -> Int
MChunk -> Int
(Int -> MChunk -> Int) -> (MChunk -> Int) -> Hashable MChunk
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MChunk -> Int
$chash :: MChunk -> Int
hashWithSalt :: Int -> MChunk -> Int
$chashWithSalt :: Int -> MChunk -> Int
Hashable)

instance Ord MChunk where
  compare :: MChunk -> MChunk -> Ordering
compare (MDigit Word
a Text
_) (MDigit Word
b Text
_) = Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
a Word
b
  compare (MRev Word
a Text
_) (MRev Word
b Text
_)     = Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
a Word
b
  compare (MPlain Text
a) (MPlain Text
b)     = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
b
  compare MChunk
a MChunk
b                       = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (MChunk -> Text
mchunkText MChunk
a) (MChunk -> Text
mchunkText MChunk
b)

-- | A total extraction of the `Text` from an `MChunk`.
mchunkText :: MChunk -> Text
mchunkText :: MChunk -> Text
mchunkText (MDigit Word
_ Text
t) = Text
t
mchunkText (MRev Word
_ Text
t)   = Text
t
mchunkText (MPlain Text
t)   = Text
t

-- | A (Complex) Mess. This is a /descriptive/ parser, based on examples of
-- stupidly crafted version numbers used in the wild.
--
-- Groups of letters/numbers, separated by a period, can be further separated by
-- the symbols @_-+:@
--
-- Some `Mess` values have a shape that is tantalizingly close to a `SemVer`.
-- Example: @1.6.0a+2014+m872b87e73dfb-1@. For values like these, we can extract
-- the semver-compatible values out with `messMajor`, etc.
--
-- Not guaranteed to have well-defined ordering (@Ord@) behaviour, but so far
-- internal tests show consistency. `messMajor`, etc., are used internally where
-- appropriate to enhance accuracy.
data Mess = Mess !(NonEmpty MChunk) !(Maybe (VSep, Mess))
  deriving stock (Mess -> Mess -> Bool
(Mess -> Mess -> Bool) -> (Mess -> Mess -> Bool) -> Eq Mess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mess -> Mess -> Bool
$c/= :: Mess -> Mess -> Bool
== :: Mess -> Mess -> Bool
$c== :: Mess -> Mess -> Bool
Eq, Int -> Mess -> ShowS
[Mess] -> ShowS
Mess -> String
(Int -> Mess -> ShowS)
-> (Mess -> String) -> ([Mess] -> ShowS) -> Show Mess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mess] -> ShowS
$cshowList :: [Mess] -> ShowS
show :: Mess -> String
$cshow :: Mess -> String
showsPrec :: Int -> Mess -> ShowS
$cshowsPrec :: Int -> Mess -> ShowS
Show, (forall x. Mess -> Rep Mess x)
-> (forall x. Rep Mess x -> Mess) -> Generic Mess
forall x. Rep Mess x -> Mess
forall x. Mess -> Rep Mess x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mess x -> Mess
$cfrom :: forall x. Mess -> Rep Mess x
Generic)
  deriving anyclass (Mess -> ()
(Mess -> ()) -> NFData Mess
forall a. (a -> ()) -> NFData a
rnf :: Mess -> ()
$crnf :: Mess -> ()
NFData, Int -> Mess -> Int
Mess -> Int
(Int -> Mess -> Int) -> (Mess -> Int) -> Hashable Mess
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Mess -> Int
$chash :: Mess -> Int
hashWithSalt :: Int -> Mess -> Int
$chashWithSalt :: Int -> Mess -> Int
Hashable)

-- | Try to extract the "major" version number from `Mess`, as if it were a
-- `SemVer`.
messMajor :: Mess -> Maybe Word
messMajor :: Mess -> Maybe Word
messMajor (Mess (MDigit Word
i Text
_ :| [MChunk]
_) Maybe (VSep, Mess)
_) = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
i
messMajor Mess
_                          = Maybe Word
forall a. Maybe a
Nothing

-- | Try to extract the "minor" version number from `Mess`, as if it were a
-- `SemVer`.
messMinor :: Mess -> Maybe Word
messMinor :: Mess -> Maybe Word
messMinor (Mess (MChunk
_ :| MDigit Word
i Text
_ : [MChunk]
_) Maybe (VSep, Mess)
_) = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
i
messMinor Mess
_                              = Maybe Word
forall a. Maybe a
Nothing

-- | Try to extract the "patch" version number from `Mess`, as if it were a
-- `SemVer`.
messPatch :: Mess -> Maybe Word
messPatch :: Mess -> Maybe Word
messPatch (Mess (MChunk
_ :| MChunk
_ : MDigit Word
i Text
_ : [MChunk]
_) Maybe (VSep, Mess)
_) = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
i
messPatch Mess
_                                  = Maybe Word
forall a. Maybe a
Nothing

-- | Okay, fine, say `messPatch` couldn't find a nice value. But some `Mess`es
-- have a "proper" patch-plus-release-candidate value in their patch position,
-- which is parsable as a `VChunk`.
--
-- Example: @1.6.0a+2014+m872b87e73dfb-1@ We should be able to extract @0a@ safely.
messPatchChunk :: Mess -> Maybe VChunk
messPatchChunk :: Mess -> Maybe VChunk
messPatchChunk (Mess (MChunk
_ :| MChunk
_ : MPlain Text
p : [MChunk]
_) Maybe (VSep, Mess)
_) = Either ParsingError VChunk -> Maybe VChunk
forall a b. Either a b -> Maybe b
hush (Either ParsingError VChunk -> Maybe VChunk)
-> Either ParsingError VChunk -> Maybe VChunk
forall a b. (a -> b) -> a -> b
$ Parsec Void Text VChunk
-> String -> Text -> Either ParsingError VChunk
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text VChunk
chunk String
"Chunk" Text
p
messPatchChunk Mess
_                                = Maybe VChunk
forall a. Maybe a
Nothing

instance Ord Mess where
  compare :: Mess -> Mess -> Ordering
compare (Mess NonEmpty MChunk
t1 Maybe (VSep, Mess)
Nothing) (Mess NonEmpty MChunk
t2 Maybe (VSep, Mess)
Nothing) = NonEmpty MChunk -> NonEmpty MChunk -> Ordering
forall a. Ord a => a -> a -> Ordering
compare NonEmpty MChunk
t1 NonEmpty MChunk
t2
  compare (Mess NonEmpty MChunk
t1 Maybe (VSep, Mess)
m1) (Mess NonEmpty MChunk
t2 Maybe (VSep, Mess)
m2) = case NonEmpty MChunk -> NonEmpty MChunk -> Ordering
forall a. Ord a => a -> a -> Ordering
compare NonEmpty MChunk
t1 NonEmpty MChunk
t2 of
    Ordering
EQ  -> case (Maybe (VSep, Mess)
m1, Maybe (VSep, Mess)
m2) of
      (Just (VSep
_, Mess
v1), Just (VSep
_, Mess
v2)) -> Mess -> Mess -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Mess
v1 Mess
v2
      (Just (VSep
_, Mess
_), Maybe (VSep, Mess)
Nothing)       -> Ordering
GT
      (Maybe (VSep, Mess)
Nothing, Just (VSep
_, Mess
_))       -> Ordering
LT
      (Maybe (VSep, Mess)
Nothing, Maybe (VSep, Mess)
Nothing)           -> Ordering
EQ
    Ordering
res -> Ordering
res

instance Semantic Mess where
  major :: (Word -> f Word) -> Mess -> f Mess
major Word -> f Word
f (Mess (MDigit Word
n Text
_ :| [MChunk]
ts) Maybe (VSep, Mess)
m) = (\Word
n' -> NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess
Mess (Word -> Text -> MChunk
MDigit Word
n' (Word -> Text
forall a. Show a => a -> Text
showt Word
n') MChunk -> [MChunk] -> NonEmpty MChunk
forall a. a -> [a] -> NonEmpty a
:| [MChunk]
ts) Maybe (VSep, Mess)
m) (Word -> Mess) -> f Word -> f Mess
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
n
  major Word -> f Word
_ Mess
v = Mess -> f Mess
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mess
v
  {-# INLINE major #-}

  minor :: (Word -> f Word) -> Mess -> f Mess
minor Word -> f Word
f (Mess (MChunk
t0 :| MDigit Word
n Text
_ : [MChunk]
ts) Maybe (VSep, Mess)
m) = (\Word
n' -> NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess
Mess (MChunk
t0 MChunk -> [MChunk] -> NonEmpty MChunk
forall a. a -> [a] -> NonEmpty a
:| Word -> Text -> MChunk
MDigit Word
n' (Word -> Text
forall a. Show a => a -> Text
showt Word
n') MChunk -> [MChunk] -> [MChunk]
forall a. a -> [a] -> [a]
: [MChunk]
ts) Maybe (VSep, Mess)
m) (Word -> Mess) -> f Word -> f Mess
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
n
  minor Word -> f Word
_ Mess
v = Mess -> f Mess
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mess
v
  {-# INLINE minor #-}

  patch :: (Word -> f Word) -> Mess -> f Mess
patch Word -> f Word
f (Mess (MChunk
t0 :| MChunk
t1 : MDigit Word
n Text
_ : [MChunk]
ts) Maybe (VSep, Mess)
m) = (\Word
n' -> NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess
Mess (MChunk
t0 MChunk -> [MChunk] -> NonEmpty MChunk
forall a. a -> [a] -> NonEmpty a
:| MChunk
t1 MChunk -> [MChunk] -> [MChunk]
forall a. a -> [a] -> [a]
: Word -> Text -> MChunk
MDigit Word
n' (Word -> Text
forall a. Show a => a -> Text
showt Word
n') MChunk -> [MChunk] -> [MChunk]
forall a. a -> [a] -> [a]
: [MChunk]
ts) Maybe (VSep, Mess)
m) (Word -> Mess) -> f Word -> f Mess
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> f Word
f Word
n
  patch Word -> f Word
_ Mess
v = Mess -> f Mess
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mess
v
  {-# INLINE patch #-}

  -- | This will always fail.
  release :: ([VChunk] -> f [VChunk]) -> Mess -> f Mess
release [VChunk] -> f [VChunk]
_ Mess
v = Mess -> f Mess
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mess
v
  {-# INLINE release #-}

  -- | This will always fail.
  meta :: ([VChunk] -> f [VChunk]) -> Mess -> f Mess
meta [VChunk] -> f [VChunk]
_ Mess
v = Mess -> f Mess
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mess
v
  {-# INLINE meta #-}

  -- | Good luck.
  semantic :: (SemVer -> f SemVer) -> Mess -> f Mess
semantic SemVer -> f SemVer
f (Mess (MDigit Word
t0 Text
_ :| MDigit Word
t1 Text
_ : MDigit Word
t2 Text
_ : [MChunk]
_) Maybe (VSep, Mess)
_) =
    Version -> Mess
mFromV (Version -> Mess) -> (SemVer -> Version) -> SemVer -> Mess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SemVer -> Version
vFromS (SemVer -> Mess) -> f SemVer -> f Mess
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SemVer -> f SemVer
f (SemVer -> f SemVer) -> SemVer -> f SemVer
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer Word
t0 Word
t1 Word
t2 [] [])
  semantic SemVer -> f SemVer
_ Mess
v = Mess -> f Mess
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mess
v
  {-# INLINE semantic #-}

-- | Developers use a number of symbols to seperate groups of digits/letters in
-- their version numbers. These are:
--
-- * A colon (:). Often denotes an "epoch".
-- * A hyphen (-).
-- * A plus (+). Stop using this outside of metadata if you are. Example: @10.2+0.93+1-1@
-- * An underscore (_). Stop using this if you are.
data VSep = VColon | VHyphen | VPlus | VUnder
  deriving stock (VSep -> VSep -> Bool
(VSep -> VSep -> Bool) -> (VSep -> VSep -> Bool) -> Eq VSep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VSep -> VSep -> Bool
$c/= :: VSep -> VSep -> Bool
== :: VSep -> VSep -> Bool
$c== :: VSep -> VSep -> Bool
Eq, Int -> VSep -> ShowS
[VSep] -> ShowS
VSep -> String
(Int -> VSep -> ShowS)
-> (VSep -> String) -> ([VSep] -> ShowS) -> Show VSep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VSep] -> ShowS
$cshowList :: [VSep] -> ShowS
show :: VSep -> String
$cshow :: VSep -> String
showsPrec :: Int -> VSep -> ShowS
$cshowsPrec :: Int -> VSep -> ShowS
Show, (forall x. VSep -> Rep VSep x)
-> (forall x. Rep VSep x -> VSep) -> Generic VSep
forall x. Rep VSep x -> VSep
forall x. VSep -> Rep VSep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VSep x -> VSep
$cfrom :: forall x. VSep -> Rep VSep x
Generic)
  deriving anyclass (VSep -> ()
(VSep -> ()) -> NFData VSep
forall a. (a -> ()) -> NFData a
rnf :: VSep -> ()
$crnf :: VSep -> ()
NFData, Int -> VSep -> Int
VSep -> Int
(Int -> VSep -> Int) -> (VSep -> Int) -> Hashable VSep
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: VSep -> Int
$chash :: VSep -> Int
hashWithSalt :: Int -> VSep -> Int
$chashWithSalt :: Int -> VSep -> Int
Hashable)

--------------------------------------------------------------------------------
-- Parsing

-- | A synonym for the more verbose `megaparsec` error type.
type ParsingError = ParseErrorBundle Text Void

-- | Parse a piece of `Text` into either an (Ideal) `SemVer`, a (General)
-- `Version`, or a (Complex) `Mess`.
versioning :: Text -> Either ParsingError Versioning
versioning :: Text -> Either ParsingError Versioning
versioning = Parsec Void Text Versioning
-> String -> Text -> Either ParsingError Versioning
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text Versioning
versioning' String
"versioning"

-- | Parse a `Versioning`. Assumes the version number is the last token in
-- the string.
versioning' :: Parsec Void Text Versioning
versioning' :: Parsec Void Text Versioning
versioning' = [Parsec Void Text Versioning] -> Parsec Void Text Versioning
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Parsec Void Text Versioning -> Parsec Void Text Versioning
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((SemVer -> Versioning)
-> ParsecT Void Text Identity SemVer -> Parsec Void Text Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SemVer -> Versioning
Ideal ParsecT Void Text Identity SemVer
semver''    Parsec Void Text Versioning
-> ParsecT Void Text Identity () -> Parsec Void Text Versioning
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
                     , Parsec Void Text Versioning -> Parsec Void Text Versioning
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((Version -> Versioning)
-> ParsecT Void Text Identity Version
-> Parsec Void Text Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Versioning
General ParsecT Void Text Identity Version
version'' Parsec Void Text Versioning
-> ParsecT Void Text Identity () -> Parsec Void Text Versioning
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
                     , (Mess -> Versioning)
-> ParsecT Void Text Identity Mess -> Parsec Void Text Versioning
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mess -> Versioning
Complex ParsecT Void Text Identity Mess
mess''         Parsec Void Text Versioning
-> ParsecT Void Text Identity () -> Parsec Void Text Versioning
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ]

-- | Parse a (Ideal) Semantic Version.
semver :: Text -> Either ParsingError SemVer
semver :: Text -> Either ParsingError SemVer
semver = ParsecT Void Text Identity SemVer
-> String -> Text -> Either ParsingError SemVer
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void Text Identity SemVer
semver'' ParsecT Void Text Identity SemVer
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity SemVer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"Semantic Version"

-- | Internal megaparsec parser of `semver`.
semver' :: Parsec Void Text SemVer
semver' :: ParsecT Void Text Identity SemVer
semver' = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity SemVer
-> ParsecT Void Text Identity SemVer
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity SemVer
semver''

semver'' :: Parsec Void Text SemVer
semver'' :: ParsecT Void Text Identity SemVer
semver'' = Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer
SemVer (Word -> Word -> Word -> [VChunk] -> [VChunk] -> SemVer)
-> ParsecT Void Text Identity Word
-> ParsecT
     Void Text Identity (Word -> Word -> [VChunk] -> [VChunk] -> SemVer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Word
majorP ParsecT
  Void Text Identity (Word -> Word -> [VChunk] -> [VChunk] -> SemVer)
-> ParsecT Void Text Identity Word
-> ParsecT
     Void Text Identity (Word -> [VChunk] -> [VChunk] -> SemVer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Word
minorP ParsecT Void Text Identity (Word -> [VChunk] -> [VChunk] -> SemVer)
-> ParsecT Void Text Identity Word
-> ParsecT Void Text Identity ([VChunk] -> [VChunk] -> SemVer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Word
patchP ParsecT Void Text Identity ([VChunk] -> [VChunk] -> SemVer)
-> ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity ([VChunk] -> SemVer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [VChunk]
preRel ParsecT Void Text Identity ([VChunk] -> SemVer)
-> ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity SemVer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [VChunk]
metaData

-- | Parse a group of digits, which can't be lead by a 0, unless it is 0.
digitsP :: Parsec Void Text Word
digitsP :: ParsecT Void Text Identity Word
digitsP = String -> Word
forall a. Read a => String -> a
read (String -> Word)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> String
T.unpack (Text -> String)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"0") ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)

majorP :: Parsec Void Text Word
majorP :: ParsecT Void Text Identity Word
majorP = ParsecT Void Text Identity Word
digitsP ParsecT Void Text Identity Word
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'

minorP :: Parsec Void Text Word
minorP :: ParsecT Void Text Identity Word
minorP = ParsecT Void Text Identity Word
majorP

patchP :: Parsec Void Text Word
patchP :: ParsecT Void Text Identity Word
patchP = ParsecT Void Text Identity Word
digitsP

preRel :: Parsec Void Text [VChunk]
preRel :: ParsecT Void Text Identity [VChunk]
preRel = (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity [VChunk]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity [VChunk]
chunks) ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity [VChunk]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [VChunk] -> ParsecT Void Text Identity [VChunk]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

metaData :: Parsec Void Text [VChunk]
metaData :: ParsecT Void Text Identity [VChunk]
metaData = (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity [VChunk]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity [VChunk]
chunks) ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity [VChunk]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [VChunk] -> ParsecT Void Text Identity [VChunk]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

chunksNE :: Parsec Void Text (NonEmpty VChunk)
chunksNE :: Parsec Void Text (NonEmpty VChunk)
chunksNE = Parsec Void Text VChunk
chunk Parsec Void Text VChunk
-> ParsecT Void Text Identity Char
-> Parsec Void Text (NonEmpty VChunk)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`PC.sepBy1` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'

chunks :: Parsec Void Text [VChunk]
chunks :: ParsecT Void Text Identity [VChunk]
chunks = Parsec Void Text VChunk
chunk Parsec Void Text VChunk
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [VChunk]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'

-- | 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 Text VChunk
chunk = Parsec Void Text VChunk -> Parsec Void Text VChunk
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parsec Void Text VChunk
zeroWithLetters Parsec Void Text VChunk
-> Parsec Void Text VChunk -> Parsec Void Text VChunk
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text VChunk
oneZero Parsec Void Text VChunk
-> Parsec Void Text VChunk -> Parsec Void Text VChunk
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity VUnit -> Parsec Void Text VChunk
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
PC.some (ParsecT Void Text Identity VUnit
iunit ParsecT Void Text Identity VUnit
-> ParsecT Void Text Identity VUnit
-> ParsecT Void Text Identity VUnit
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity VUnit
sunit)
  where
    oneZero :: Parsec Void Text (NonEmpty VUnit)
    oneZero :: Parsec Void Text VChunk
oneZero = (Word -> VUnit
Digits Word
0 VUnit -> [VUnit] -> VChunk
forall a. a -> [a] -> NonEmpty a
:| []) VChunk
-> ParsecT Void Text Identity Char -> Parsec Void Text VChunk
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'0'

    zeroWithLetters :: Parsec Void Text (NonEmpty VUnit)
    zeroWithLetters :: Parsec Void Text VChunk
zeroWithLetters = do
      VUnit
z <- Word -> VUnit
Digits Word
0 VUnit
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity VUnit
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'0'
      VChunk
s <- ParsecT Void Text Identity VUnit -> Parsec Void Text VChunk
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
PC.some ParsecT Void Text Identity VUnit
sunit
      Maybe VChunk
c <- Parsec Void Text VChunk
-> ParsecT Void Text Identity (Maybe VChunk)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parsec Void Text VChunk
chunk
      case Maybe VChunk
c of
        Maybe VChunk
Nothing -> VChunk -> Parsec Void Text VChunk
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VChunk -> Parsec Void Text VChunk)
-> VChunk -> Parsec Void Text VChunk
forall a b. (a -> b) -> a -> b
$ VUnit -> VChunk -> VChunk
forall a. a -> NonEmpty a -> NonEmpty a
NEL.cons VUnit
z VChunk
s
        Just VChunk
c' -> VChunk -> Parsec Void Text VChunk
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VChunk -> Parsec Void Text VChunk)
-> VChunk -> Parsec Void Text VChunk
forall a b. (a -> b) -> a -> b
$ VUnit -> VChunk -> VChunk
forall a. a -> NonEmpty a -> NonEmpty a
NEL.cons VUnit
z VChunk
s VChunk -> VChunk -> VChunk
forall a. Semigroup a => a -> a -> a
<> VChunk
c'

iunit :: Parsec Void Text VUnit
iunit :: ParsecT Void Text Identity VUnit
iunit = Word -> VUnit
Digits (Word -> VUnit)
-> ParsecT Void Text Identity Word
-> ParsecT Void Text Identity VUnit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word
0 Word
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'0') ParsecT Void Text Identity Word
-> ParsecT Void Text Identity Word
-> ParsecT Void Text Identity Word
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Word
forall a. Read a => String -> a
read (String -> Word)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar))

sunit :: Parsec Void Text VUnit
sunit :: ParsecT Void Text Identity VUnit
sunit = Text -> VUnit
Str (Text -> VUnit) -> (String -> Text) -> String -> VUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> VUnit)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity VUnit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar

-- | Parse a (Haskell) `PVP`, as defined above.
pvp :: Text -> Either ParsingError PVP
pvp :: Text -> Either ParsingError PVP
pvp = Parsec Void Text PVP -> String -> Text -> Either ParsingError PVP
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void Text PVP
pvp' Parsec Void Text PVP
-> ParsecT Void Text Identity () -> Parsec Void Text PVP
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"PVP"

-- | Internal megaparsec parser of `pvp`.
pvp' :: Parsec Void Text PVP
pvp' :: Parsec Void Text PVP
pvp' = ParsecT Void Text Identity ()
-> Parsec Void Text PVP -> Parsec Void Text PVP
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP)
-> ([Word] -> NonEmpty Word) -> [Word] -> PVP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word] -> NonEmpty Word
forall a. [a] -> NonEmpty a
NEL.fromList ([Word] -> PVP)
-> ParsecT Void Text Identity [Word] -> Parsec Void Text PVP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT Void Text Identity Word
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Word]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.')

-- | Parse a (General) `Version`, as defined above.
version :: Text -> Either ParsingError Version
version :: Text -> Either ParsingError Version
version = ParsecT Void Text Identity Version
-> String -> Text -> Either ParsingError Version
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void Text Identity Version
version'' ParsecT Void Text Identity Version
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"Version"

-- | Internal megaparsec parser of `version`.
version' :: Parsec Void Text Version
version' :: ParsecT Void Text Identity Version
version' = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Version
-> ParsecT Void Text Identity Version
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity Version
version''

version'' :: Parsec Void Text Version
version'' :: ParsecT Void Text Identity Version
version'' = Maybe Word -> NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version
Version (Maybe Word -> NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version)
-> ParsecT Void Text Identity (Maybe Word)
-> ParsecT
     Void
     Text
     Identity
     (NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Word
-> ParsecT Void Text Identity (Maybe Word)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Word -> ParsecT Void Text Identity Word
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Word
epochP) ParsecT
  Void
  Text
  Identity
  (NonEmpty VChunk -> [VChunk] -> [VChunk] -> Version)
-> Parsec Void Text (NonEmpty VChunk)
-> ParsecT Void Text Identity ([VChunk] -> [VChunk] -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text (NonEmpty VChunk)
chunksNE ParsecT Void Text Identity ([VChunk] -> [VChunk] -> Version)
-> ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity ([VChunk] -> Version)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [VChunk]
metaData ParsecT Void Text Identity ([VChunk] -> Version)
-> ParsecT Void Text Identity [VChunk]
-> ParsecT Void Text Identity Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [VChunk]
preRel

epochP :: Parsec Void Text Word
epochP :: ParsecT Void Text Identity Word
epochP = String -> Word
forall a. Read a => String -> a
read (String -> Word)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT Void Text Identity String
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':')

-- | Parse a (Complex) `Mess`, as defined above.
mess :: Text -> Either ParsingError Mess
mess :: Text -> Either ParsingError Mess
mess = ParsecT Void Text Identity Mess
-> String -> Text -> Either ParsingError Mess
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void Text Identity Mess
mess'' ParsecT Void Text Identity Mess
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Mess
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"Mess"

-- | Internal megaparsec parser of `mess`.
mess' :: Parsec Void Text Mess
mess' :: ParsecT Void Text Identity Mess
mess' = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Mess
-> ParsecT Void Text Identity Mess
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity Mess
mess''

mess'' :: Parsec Void Text Mess
mess'' :: ParsecT Void Text Identity Mess
mess'' = NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess
Mess (NonEmpty MChunk -> Maybe (VSep, Mess) -> Mess)
-> ParsecT Void Text Identity (NonEmpty MChunk)
-> ParsecT Void Text Identity (Maybe (VSep, Mess) -> Mess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (NonEmpty MChunk)
mchunks ParsecT Void Text Identity (Maybe (VSep, Mess) -> Mess)
-> ParsecT Void Text Identity (Maybe (VSep, Mess))
-> ParsecT Void Text Identity Mess
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (VSep, Mess)
-> ParsecT Void Text Identity (Maybe (VSep, Mess))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((,) (VSep -> Mess -> (VSep, Mess))
-> ParsecT Void Text Identity VSep
-> ParsecT Void Text Identity (Mess -> (VSep, Mess))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity VSep
sep ParsecT Void Text Identity (Mess -> (VSep, Mess))
-> ParsecT Void Text Identity Mess
-> ParsecT Void Text Identity (VSep, Mess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Mess
mess')

mchunks :: Parsec Void Text (NonEmpty MChunk)
mchunks :: ParsecT Void Text Identity (NonEmpty MChunk)
mchunks = Parsec Void Text MChunk
mchunk Parsec Void Text MChunk
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (NonEmpty MChunk)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`PC.sepBy1` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'

mchunk :: Parsec Void Text MChunk
mchunk :: Parsec Void Text MChunk
mchunk = [Parsec Void Text MChunk] -> Parsec Void Text MChunk
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Parsec Void Text MChunk -> Parsec Void Text MChunk
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text MChunk -> Parsec Void Text MChunk)
-> Parsec Void Text MChunk -> Parsec Void Text MChunk
forall a b. (a -> b) -> a -> b
$ (\(Text
t, Word
i) -> Word -> Text -> MChunk
MDigit Word
i Text
t) ((Text, Word) -> MChunk)
-> ParsecT Void Text Identity (Text, Word)
-> Parsec Void Text MChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Word
-> ParsecT Void Text Identity (Tokens Text, Word)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (ParsecT Void Text Identity Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT Void Text Identity Word
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
next)
                , Parsec Void Text MChunk -> Parsec Void Text MChunk
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text MChunk -> Parsec Void Text MChunk)
-> Parsec Void Text MChunk -> Parsec Void Text MChunk
forall a b. (a -> b) -> a -> b
$ (\(Text
t, Word
i) -> Word -> Text -> MChunk
MRev Word
i Text
t) ((Text, Word) -> MChunk)
-> ParsecT Void Text Identity (Text, Word)
-> Parsec Void Text MChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Word
-> ParsecT Void Text Identity (Tokens Text, Word)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'r' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Word
-> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT Void Text Identity Word
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
next))
                , Text -> MChunk
MPlain (Text -> MChunk) -> (String -> Text) -> String -> MChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> MChunk)
-> ParsecT Void Text Identity String -> Parsec Void Text MChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar) ]
  where
    next :: Parsec Void Text ()
    next :: ParsecT Void Text Identity ()
next = ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'.') ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity VSep -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity VSep
sep ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

sep :: Parsec Void Text VSep
sep :: ParsecT Void Text Identity VSep
sep = [ParsecT Void Text Identity VSep]
-> ParsecT Void Text Identity VSep
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ VSep
VColon  VSep
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity VSep
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
             , VSep
VHyphen VSep
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity VSep
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-'
             , VSep
VPlus   VSep
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity VSep
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+'
             , VSep
VUnder  VSep
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity VSep
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_' ]

sepCh :: VSep -> Char
sepCh :: VSep -> Char
sepCh VSep
VColon  = Char
':'
sepCh VSep
VHyphen = Char
'-'
sepCh VSep
VPlus   = Char
'+'
sepCh VSep
VUnder  = Char
'_'

-- | Convert any parsed Versioning type to its textual representation.
prettyV :: Versioning -> Text
prettyV :: Versioning -> Text
prettyV (Ideal SemVer
sv)  = SemVer -> Text
prettySemVer SemVer
sv
prettyV (General Version
v) = Version -> Text
prettyVer Version
v
prettyV (Complex Mess
m) = Mess -> Text
prettyMess Mess
m

-- | Convert a `SemVer` back to its textual representation.
prettySemVer :: SemVer -> Text
prettySemVer :: SemVer -> Text
prettySemVer (SemVer Word
ma Word
mi Word
pa [VChunk]
pr [VChunk]
me) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
ver [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
pr' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
me'
  where
    ver :: [Text]
ver = Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"." [ Word -> Text
forall a. Show a => a -> Text
showt Word
ma, Word -> Text
forall a. Show a => a -> Text
showt Word
mi, Word -> Text
forall a. Show a => a -> Text
showt Word
pa ]
    pr' :: [Text]
pr' = [Text] -> ([Text] -> [Text]) -> [Text] -> [Text]
forall (f :: * -> *) b a.
Foldable f =>
f b -> (f a -> f b) -> f a -> f b
foldable [] (Text
"-" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"." ([VChunk] -> [Text]
forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT [VChunk]
pr)
    me' :: [Text]
me' = [Text] -> ([Text] -> [Text]) -> [Text] -> [Text]
forall (f :: * -> *) b a.
Foldable f =>
f b -> (f a -> f b) -> f a -> f b
foldable [] (Text
"+" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"." ([VChunk] -> [Text]
forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT [VChunk]
me)

-- | Convert a `PVP` back to its textual representation.
prettyPVP :: PVP -> Text
prettyPVP :: PVP -> Text
prettyPVP (PVP (Word
m :| [Word]
rs)) = Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text) -> ([Word] -> [Text]) -> [Word] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Text) -> [Word] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Text
forall a. Show a => a -> Text
showt ([Word] -> Text) -> [Word] -> Text
forall a b. (a -> b) -> a -> b
$ Word
m Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
rs

-- | Convert a `Version` back to its textual representation.
prettyVer :: Version -> Text
prettyVer :: Version -> Text
prettyVer (Version Maybe Word
ep NonEmpty VChunk
cs [VChunk]
me [VChunk]
pr) = Text
ep' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text]
ver [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
me' [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
pr')
  where
    ver :: [Text]
ver = Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"." ([Text] -> [Text]) -> ([VChunk] -> [Text]) -> [VChunk] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VChunk] -> [Text]
forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT ([VChunk] -> [Text]) -> [VChunk] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty VChunk -> [VChunk]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty VChunk
cs
    me' :: [Text]
me' = [Text] -> ([Text] -> [Text]) -> [Text] -> [Text]
forall (f :: * -> *) b a.
Foldable f =>
f b -> (f a -> f b) -> f a -> f b
foldable [] (Text
"+" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"." ([VChunk] -> [Text]
forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT [VChunk]
me)
    pr' :: [Text]
pr' = [Text] -> ([Text] -> [Text]) -> [Text] -> [Text]
forall (f :: * -> *) b a.
Foldable f =>
f b -> (f a -> f b) -> f a -> f b
foldable [] (Text
"-" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"." ([VChunk] -> [Text]
forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT [VChunk]
pr)
    ep' :: Text
ep' = Text -> (Word -> Text) -> Maybe Word -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Word
e -> Word -> Text
forall a. Show a => a -> Text
showt Word
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") Maybe Word
ep

-- | Convert a `Mess` back to its textual representation.
prettyMess :: Mess -> Text
prettyMess :: Mess -> Text
prettyMess (Mess NonEmpty MChunk
t Maybe (VSep, Mess)
m) = case Maybe (VSep, Mess)
m of
  Maybe (VSep, Mess)
Nothing     -> Text
t'
  Just (VSep
s, Mess
v) -> Text -> Char -> Text
T.snoc Text
t' (VSep -> Char
sepCh VSep
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Mess -> Text
prettyMess Mess
v
  where
    t' :: Text
    t' :: Text
t' = NonEmpty Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (NonEmpty Text -> Text)
-> (NonEmpty Text -> NonEmpty Text) -> NonEmpty Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NonEmpty Text -> NonEmpty Text
forall a. a -> NonEmpty a -> NonEmpty a
NEL.intersperse Text
"." (NonEmpty Text -> Text) -> NonEmpty Text -> Text
forall a b. (a -> b) -> a -> b
$ (MChunk -> Text) -> NonEmpty MChunk -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map MChunk -> Text
mchunkText NonEmpty MChunk
t

chunksAsT :: Functor t => t VChunk -> t Text
chunksAsT :: t VChunk -> t Text
chunksAsT = (VChunk -> Text) -> t VChunk -> t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((VUnit -> Text) -> VChunk -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VUnit -> Text
f)
  where
    f :: VUnit -> Text
    f :: VUnit -> Text
f (Digits Word
i) = Word -> Text
forall a. Show a => a -> Text
showt Word
i
    f (Str Text
s)    = Text
s

chunksAsM :: Functor t => t VChunk -> t MChunk
chunksAsM :: t VChunk -> t MChunk
chunksAsM = (VChunk -> MChunk) -> t VChunk -> t MChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VChunk -> MChunk
f
  where
    f :: VChunk -> MChunk
    f :: VChunk -> MChunk
f (Digits Word
i :| [])        = Word -> Text -> MChunk
MDigit Word
i (Text -> MChunk) -> Text -> MChunk
forall a b. (a -> b) -> a -> b
$ Word -> Text
forall a. Show a => a -> Text
showt Word
i
    f (Str Text
"r" :| [Digits Word
i]) = Word -> Text -> MChunk
MRev Word
i (Text -> MChunk) -> (Text -> Text) -> Text -> MChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
'r' (Text -> MChunk) -> Text -> MChunk
forall a b. (a -> b) -> a -> b
$ Word -> Text
forall a. Show a => a -> Text
showt Word
i
    f VChunk
vc                      = Text -> MChunk
MPlain (Text -> MChunk) -> ([Text] -> Text) -> [Text] -> MChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> MChunk) -> [Text] -> MChunk
forall a b. (a -> b) -> a -> b
$ [VChunk] -> [Text]
forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT [VChunk
vc]

-- | Analogous to `maybe` and `either`. If a given Foldable is empty,
-- a default value is returned. Else, a function is applied to that Foldable.
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable :: f b -> (f a -> f b) -> f a -> f b
foldable f b
d f a -> f b
g f a
f | f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
f    = f b
d
               | Bool
otherwise = f a -> f b
g f a
f

-- | Flip an Ordering.
opposite :: Ordering -> Ordering
opposite :: Ordering -> Ordering
opposite Ordering
EQ = Ordering
EQ
opposite Ordering
LT = Ordering
GT
opposite Ordering
GT = Ordering
LT

-- Yes, `text-show` exists, but this reduces external dependencies.
showt :: Show a => a -> Text
showt :: a -> Text
showt = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

hush :: Either a b -> Maybe b
hush :: Either a b -> Maybe b
hush (Left a
_)  = Maybe b
forall a. Maybe a
Nothing
hush (Right b
b) = b -> Maybe b
forall a. a -> Maybe a
Just b
b