{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module: Codec.RPM.Parse
-- Copyright: (c) 2017 Red Hat, Inc.
-- License: LGPL
--
-- Maintainer: https://github.com/weldr
-- Stability: stable
-- Portability: portable
-- 
-- Functions and types for working with version numbers, as understood by RPM.

module Codec.RPM.Version(
    -- * Types
    DepOrdering(..),
    DepRequirement(..),
    EVR(..),
    -- * Functions
    parseEVR,
    parseDepRequirement,
    satisfies,
    vercmp)
 where

import           Data.Char(digitToInt, isAsciiLower, isAsciiUpper, isDigit, isSpace)
import           Data.Maybe(fromMaybe)
import           Data.Monoid((<>))
import qualified Data.Ord as Ord
import qualified Data.Text as T
import           Data.Word(Word32)
import           Text.Parsec

import Prelude hiding(EQ, GT, LT)

-- | The versioning information portion of a package's name - epoch, version, release.
data EVR = EVR {
    -- | The epoch of a package.  This is sort of a super version number, used when a package with
    -- an earlier version number must upgrade a package with a later version number.  The package
    -- with a larger epoch will always in version comparisons.  Most packages do not have an epoch.
    EVR -> Maybe Word32
epoch :: Maybe Word32,
    -- | The version number provided by the package's upstream, represented as 'Data.Text.Text'.
    EVR -> Text
version :: T.Text,
    -- | The release number, represented as 'Data.Text.Text'.  The release value is added on by a
    -- distribution and allows them to make multiple releases of the same upstream version, fixing
    -- bugs and applying distribution-specific tweaks.
    EVR -> Text
release :: T.Text }
 deriving(Int -> EVR -> ShowS
[EVR] -> ShowS
EVR -> String
(Int -> EVR -> ShowS)
-> (EVR -> String) -> ([EVR] -> ShowS) -> Show EVR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EVR] -> ShowS
$cshowList :: [EVR] -> ShowS
show :: EVR -> String
$cshow :: EVR -> String
showsPrec :: Int -> EVR -> ShowS
$cshowsPrec :: Int -> EVR -> ShowS
Show)

-- for Ord and Eq, an epoch of Nothing is the same as an epoch of 0.
-- for Eq, version and release strings need to go through vercmp, since they can be equivalent
-- without being the same String.
instance Eq EVR where
    == :: EVR -> EVR -> Bool
(==) evr1 :: EVR
evr1 evr2 :: EVR
evr2 = EVR
evr1 EVR -> EVR -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` EVR
evr2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
Ord.EQ

instance Ord EVR where
    compare :: EVR -> EVR -> Ordering
compare evr1 :: EVR
evr1 evr2 :: EVR
evr2 = Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe 0 (EVR -> Maybe Word32
epoch EVR
evr1) Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe 0 (EVR -> Maybe Word32
epoch EVR
evr2) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
                        EVR -> Text
version EVR
evr1 Text -> Text -> Ordering
`vercmp` EVR -> Text
version EVR
evr2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
                        EVR -> Text
release EVR
evr1 Text -> Text -> Ordering
`vercmp` EVR -> Text
release EVR
evr2

-- | Like 'Ordering', but with support for less-than-or-equal and greater-than-or-equal.
data DepOrdering = LT | LTE | EQ | GTE | GT
 deriving(DepOrdering -> DepOrdering -> Bool
(DepOrdering -> DepOrdering -> Bool)
-> (DepOrdering -> DepOrdering -> Bool) -> Eq DepOrdering
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DepOrdering -> DepOrdering -> Bool
$c/= :: DepOrdering -> DepOrdering -> Bool
== :: DepOrdering -> DepOrdering -> Bool
$c== :: DepOrdering -> DepOrdering -> Bool
Eq, Eq DepOrdering
Eq DepOrdering =>
(DepOrdering -> DepOrdering -> Ordering)
-> (DepOrdering -> DepOrdering -> Bool)
-> (DepOrdering -> DepOrdering -> Bool)
-> (DepOrdering -> DepOrdering -> Bool)
-> (DepOrdering -> DepOrdering -> Bool)
-> (DepOrdering -> DepOrdering -> DepOrdering)
-> (DepOrdering -> DepOrdering -> DepOrdering)
-> Ord DepOrdering
DepOrdering -> DepOrdering -> Bool
DepOrdering -> DepOrdering -> Ordering
DepOrdering -> DepOrdering -> DepOrdering
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 :: DepOrdering -> DepOrdering -> DepOrdering
$cmin :: DepOrdering -> DepOrdering -> DepOrdering
max :: DepOrdering -> DepOrdering -> DepOrdering
$cmax :: DepOrdering -> DepOrdering -> DepOrdering
>= :: DepOrdering -> DepOrdering -> Bool
$c>= :: DepOrdering -> DepOrdering -> Bool
> :: DepOrdering -> DepOrdering -> Bool
$c> :: DepOrdering -> DepOrdering -> Bool
<= :: DepOrdering -> DepOrdering -> Bool
$c<= :: DepOrdering -> DepOrdering -> Bool
< :: DepOrdering -> DepOrdering -> Bool
$c< :: DepOrdering -> DepOrdering -> Bool
compare :: DepOrdering -> DepOrdering -> Ordering
$ccompare :: DepOrdering -> DepOrdering -> Ordering
$cp1Ord :: Eq DepOrdering
Ord, Int -> DepOrdering -> ShowS
[DepOrdering] -> ShowS
DepOrdering -> String
(Int -> DepOrdering -> ShowS)
-> (DepOrdering -> String)
-> ([DepOrdering] -> ShowS)
-> Show DepOrdering
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DepOrdering] -> ShowS
$cshowList :: [DepOrdering] -> ShowS
show :: DepOrdering -> String
$cshow :: DepOrdering -> String
showsPrec :: Int -> DepOrdering -> ShowS
$cshowsPrec :: Int -> DepOrdering -> ShowS
Show)

-- | RPM supports the concept of dependencies between packages.  Collectively, these dependencies
-- are commonly referred to as PRCO - Provides, Requires, Conflicts, and Obsoletes.  These
-- dependencies can optionally include version information.  These relationships can be examined
-- with various RPM inspection tools or can be found in the spec files that define how a package
-- is built.  Examples include:
--
-- @
-- Requires: python-six
-- Requires: python3-blivet >= 1:1.0
-- Obsoletes: booty <= 0.107-1
-- @
--
-- This data type expresses a single dependency relationship.  The example dependencies above
-- would be represented like so:
--
-- @
-- DepRequirement "python-six" Nothing
-- DepRequirement "python3-blivet" (Just (GTE, EVR (Just 1) "1.0" ""))
-- DepRequirement "booty" (Just (LTE, EVR Nothing "0.107" "1"))
-- @
--
-- It is not in the scope of this type to know what kind of relationship a 'DepRequirement'
-- describes.
--
-- This type derives 'Ord' so that it can be easily be used with collection types, but the
-- derived ordering will not make sense for the purpose of comparing requirements. Use
-- 'satisfies' to determine if requirements match one another.
data DepRequirement = DepRequirement T.Text (Maybe (DepOrdering, EVR))
 deriving (DepRequirement -> DepRequirement -> Bool
(DepRequirement -> DepRequirement -> Bool)
-> (DepRequirement -> DepRequirement -> Bool) -> Eq DepRequirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DepRequirement -> DepRequirement -> Bool
$c/= :: DepRequirement -> DepRequirement -> Bool
== :: DepRequirement -> DepRequirement -> Bool
$c== :: DepRequirement -> DepRequirement -> Bool
Eq, Eq DepRequirement
Eq DepRequirement =>
(DepRequirement -> DepRequirement -> Ordering)
-> (DepRequirement -> DepRequirement -> Bool)
-> (DepRequirement -> DepRequirement -> Bool)
-> (DepRequirement -> DepRequirement -> Bool)
-> (DepRequirement -> DepRequirement -> Bool)
-> (DepRequirement -> DepRequirement -> DepRequirement)
-> (DepRequirement -> DepRequirement -> DepRequirement)
-> Ord DepRequirement
DepRequirement -> DepRequirement -> Bool
DepRequirement -> DepRequirement -> Ordering
DepRequirement -> DepRequirement -> DepRequirement
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 :: DepRequirement -> DepRequirement -> DepRequirement
$cmin :: DepRequirement -> DepRequirement -> DepRequirement
max :: DepRequirement -> DepRequirement -> DepRequirement
$cmax :: DepRequirement -> DepRequirement -> DepRequirement
>= :: DepRequirement -> DepRequirement -> Bool
$c>= :: DepRequirement -> DepRequirement -> Bool
> :: DepRequirement -> DepRequirement -> Bool
$c> :: DepRequirement -> DepRequirement -> Bool
<= :: DepRequirement -> DepRequirement -> Bool
$c<= :: DepRequirement -> DepRequirement -> Bool
< :: DepRequirement -> DepRequirement -> Bool
$c< :: DepRequirement -> DepRequirement -> Bool
compare :: DepRequirement -> DepRequirement -> Ordering
$ccompare :: DepRequirement -> DepRequirement -> Ordering
$cp1Ord :: Eq DepRequirement
Ord, Int -> DepRequirement -> ShowS
[DepRequirement] -> ShowS
DepRequirement -> String
(Int -> DepRequirement -> ShowS)
-> (DepRequirement -> String)
-> ([DepRequirement] -> ShowS)
-> Show DepRequirement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DepRequirement] -> ShowS
$cshowList :: [DepRequirement] -> ShowS
show :: DepRequirement -> String
$cshow :: DepRequirement -> String
showsPrec :: Int -> DepRequirement -> ShowS
$cshowsPrec :: Int -> DepRequirement -> ShowS
Show)

-- | Compare two version numbers and return an 'Ordering'.
vercmp :: T.Text -> T.Text -> Ordering
vercmp :: Text -> Text -> Ordering
vercmp a :: Text
a b :: Text
b = let
    -- strip out all non-version characters
    -- keep in mind the strings may be empty after this
    a' :: Text
a' = Text -> Text
dropSeparators Text
a
    b' :: Text
b' = Text -> Text
dropSeparators Text
b

    -- rpm compares strings by digit and non-digit components, so grab the first
    -- component of one type
    fn :: Char -> Bool
fn = if Char -> Bool
isDigit (Text -> Char
T.head Text
a') then Char -> Bool
isDigit else Char -> Bool
isAsciiAlpha
    (prefixA :: Text
prefixA, suffixA :: Text
suffixA) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
fn Text
a'
    (prefixB :: Text
prefixB, suffixB :: Text
suffixB) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
fn Text
b'
 in
       -- Nothing left means the versions are equal
    if | Text -> Bool
T.null Text
a' Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
b'                             -> Ordering
Ord.EQ
       -- tilde ls less than everything, including an empty string
       | ("~" Text -> Text -> Bool
`T.isPrefixOf` Text
a') Bool -> Bool -> Bool
&& ("~" Text -> Text -> Bool
`T.isPrefixOf` Text
b') -> Text -> Text -> Ordering
vercmp (Text -> Text
T.tail Text
a') (Text -> Text
T.tail Text
b')
       | ("~" Text -> Text -> Bool
`T.isPrefixOf` Text
a')                            -> Ordering
Ord.LT
       | ("~" Text -> Text -> Bool
`T.isPrefixOf` Text
b')                            -> Ordering
Ord.GT
       -- otherwise, if one of the strings is null, the other is greater
       | (Text -> Bool
T.null Text
a')                                        -> Ordering
Ord.LT
       | (Text -> Bool
T.null Text
b')                                        -> Ordering
Ord.GT
       -- Now we have two non-null strings, starting with a non-tilde version character
       -- If one prefix is a number and the other is a string, the one that is a number
       -- is greater.
       | Char -> Bool
isDigit (Text -> Char
T.head Text
a') Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) (Text -> Char
T.head Text
b') -> Ordering
Ord.GT
       | (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) (Text -> Char
T.head Text
a') Bool -> Bool -> Bool
&& Char -> Bool
isDigit (Text -> Char
T.head Text
b') -> Ordering
Ord.LT
       | Char -> Bool
isDigit (Text -> Char
T.head Text
a')                                -> (Text
prefixA Text -> Text -> Ordering
`compareAsInts` Text
prefixB) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (Text
suffixA Text -> Text -> Ordering
`vercmp` Text
suffixB)
       | Bool
otherwise                                          -> (Text
prefixA Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Text
prefixB) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (Text
suffixA Text -> Text -> Ordering
`vercmp` Text
suffixB)
 where
    compareAsInts :: T.Text -> T.Text -> Ordering
    -- the version numbers can overflow Int, so strip leading 0's and do a string compare,
    -- longest string wins
    compareAsInts :: Text -> Text -> Ordering
compareAsInts x :: Text
x y :: Text
y =
        let x' :: Text
x' = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0') Text
x
            y' :: Text
y' = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0') Text
y
        in 
            if Text -> Int
T.length Text
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
T.length Text
y' then Ordering
Ord.GT
            else Text
x' Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Text
y'

    -- isAlpha returns any unicode alpha, but we just want ASCII characters
    isAsciiAlpha :: Char -> Bool
    isAsciiAlpha :: Char -> Bool
isAsciiAlpha x :: Char
x = Char -> Bool
isAsciiLower Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
x

    -- RPM only cares about ascii digits, ascii alpha, and ~
    isVersionChar :: Char -> Bool
    isVersionChar :: Char -> Bool
isVersionChar x :: Char
x = Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAsciiAlpha Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '~'

    dropSeparators :: T.Text -> T.Text
    dropSeparators :: Text -> Text
dropSeparators = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isVersionChar)

{-# ANN satisfies ("HLint: ignore Redundant if" :: String) #-}
-- | Determine if a candidate package satisfies the dependency relationship required by some other
-- package.
satisfies :: DepRequirement         -- ^ The package in question, represented as a 'DepRequirement'.
          -> DepRequirement         -- ^ The requirement.
          -> Bool
satisfies :: DepRequirement -> DepRequirement -> Bool
satisfies (DepRequirement name1 :: Text
name1 ver1 :: Maybe (DepOrdering, EVR)
ver1) (DepRequirement name2 :: Text
name2 ver2 :: Maybe (DepOrdering, EVR)
ver2) =
    -- names have to match
    if Text
name1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name2 then Bool
False
    else Maybe (DepOrdering, EVR) -> Maybe (DepOrdering, EVR) -> Bool
satisfiesVersion Maybe (DepOrdering, EVR)
ver1 Maybe (DepOrdering, EVR)
ver2
 where
    -- If either half has no version expression, it's a match
    satisfiesVersion :: Maybe (DepOrdering, EVR) -> Maybe (DepOrdering, EVR) -> Bool
satisfiesVersion Nothing _ = Bool
True
    satisfiesVersion _ Nothing = Bool
True

    -- There is a special case for matching versions with no release component.
    -- If one side is equal to (or >=, or <=) a version with no release component, it will match any non-empty
    -- release on the other side, regardless of operator.
    -- For example: x >= 1.0 `satisfies` x < 1.0-47.
    -- If *both* sides have no release, the regular rules apply, so x >= 1.0 does not satisfy x < 1.0

    satisfiesVersion (Just (o1 :: DepOrdering
o1, v1 :: EVR
v1)) (Just (o2 :: DepOrdering
o2, v2 :: EVR
v2))
        | Text -> Bool
T.null (EVR -> Text
release EVR
v1) Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (EVR -> Text
release EVR
v2) Bool -> Bool -> Bool
&& EVR -> EVR -> Bool
compareEV EVR
v1 EVR
v2 Bool -> Bool -> Bool
&& DepOrdering -> Bool
isEq DepOrdering
o1 = Bool
True
        | Text -> Bool
T.null (EVR -> Text
release EVR
v2) Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (EVR -> Text
release EVR
v1) Bool -> Bool -> Bool
&& EVR -> EVR -> Bool
compareEV EVR
v1 EVR
v2 Bool -> Bool -> Bool
&& DepOrdering -> Bool
isEq DepOrdering
o2 = Bool
True
        | Bool
otherwise =
            case EVR -> EVR -> Ordering
forall a. Ord a => a -> a -> Ordering
compare EVR
v1 EVR
v2 of
                -- e1 < e2, true if >[=] e1 || <[=] e2
                Ord.LT -> DepOrdering -> Bool
isGt DepOrdering
o1 Bool -> Bool -> Bool
|| DepOrdering -> Bool
isLt DepOrdering
o2
                -- e1 > e2, true if <[=] e1 || >[=] e2
                Ord.GT -> DepOrdering -> Bool
isLt DepOrdering
o1 Bool -> Bool -> Bool
|| DepOrdering -> Bool
isGt DepOrdering
o2
                -- e1 == e2, true if both sides are the same direction
                Ord.EQ -> (DepOrdering -> Bool
isLt DepOrdering
o1 Bool -> Bool -> Bool
&& DepOrdering -> Bool
isLt DepOrdering
o2) Bool -> Bool -> Bool
|| (DepOrdering -> Bool
isEq DepOrdering
o1 Bool -> Bool -> Bool
&& DepOrdering -> Bool
isEq DepOrdering
o2) Bool -> Bool -> Bool
|| (DepOrdering -> Bool
isGt DepOrdering
o1 Bool -> Bool -> Bool
&& DepOrdering -> Bool
isGt DepOrdering
o2)

    isEq :: DepOrdering -> Bool
isEq EQ  = Bool
True
    isEq GTE = Bool
True
    isEq LTE = Bool
True
    isEq _   = Bool
False

    isLt :: DepOrdering -> Bool
isLt LT  = Bool
True
    isLt LTE = Bool
True
    isLt _   = Bool
False

    isGt :: DepOrdering -> Bool
isGt GT  = Bool
True
    isGt GTE = Bool
True
    isGt _   = Bool
False

    compareEV :: EVR -> EVR -> Bool
compareEV v1 :: EVR
v1 v2 :: EVR
v2 = Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe 0 (EVR -> Maybe Word32
epoch EVR
v1) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe 0 (EVR -> Maybe Word32
epoch EVR
v2) Bool -> Bool -> Bool
&& EVR -> Text
version EVR
v1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== EVR -> Text
version EVR
v2

-- parsers for version strings
-- the EVR Parsec is shared by the EVR and DepRequirement parsers
parseEVRParsec :: Parsec T.Text () EVR
parseEVRParsec :: Parsec Text () EVR
parseEVRParsec = do
    Maybe Word32
e <- ParsecT Text () Identity Word32
-> ParsecT Text () Identity (Maybe Word32)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT Text () Identity Word32
 -> ParsecT Text () Identity (Maybe Word32))
-> ParsecT Text () Identity Word32
-> ParsecT Text () Identity (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity Word32 -> ParsecT Text () Identity Word32
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text () Identity Word32
parseEpoch
    String
v <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall u. ParsecT Text u Identity Char
versionChar
    String
r <- ParsecT Text () Identity String -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text () Identity String
forall u. ParsecT Text u Identity String
parseRelease ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
    ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

    EVR -> Parsec Text () EVR
forall (m :: * -> *) a. Monad m => a -> m a
return EVR :: Maybe Word32 -> Text -> Text -> EVR
EVR{epoch :: Maybe Word32
epoch=Maybe Word32
e, version :: Text
version=String -> Text
T.pack String
v, release :: Text
release=String -> Text
T.pack String
r}
 where
    parseEpoch :: Parsec T.Text () Word32
    parseEpoch :: ParsecT Text () Identity Word32
parseEpoch = do
        String
e <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
        Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'

        -- parse the digit string as an Integer until it ends or overflows Word32
        Integer -> String -> ParsecT Text () Identity Word32
parseInteger 0 String
e
     where
        maxW32 :: Integer
maxW32 = Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32
forall a. Bounded a => a
maxBound :: Word32)

        parseInteger :: Integer -> String -> Parsec T.Text () Word32
        parseInteger :: Integer -> String -> ParsecT Text () Identity Word32
parseInteger acc :: Integer
acc []     = Word32 -> ParsecT Text () Identity Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ParsecT Text () Identity Word32)
-> Word32 -> ParsecT Text () Identity Word32
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
acc
        parseInteger acc :: Integer
acc (x :: Char
x:xs :: String
xs) = let
            newAcc :: Integer
newAcc = (Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (10 :: Integer)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
digitToInt Char
x)
         in
            if Integer
newAcc Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxW32 then String -> ParsecT Text () Identity Word32
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail ""
            else Integer -> String -> ParsecT Text () Identity Word32
parseInteger Integer
newAcc String
xs

    parseRelease :: ParsecT Text u Identity String
parseRelease = do
        Char
_ <- Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '-'
        ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text u Identity Char
forall u. ParsecT Text u Identity Char
versionChar

    versionChar :: ParsecT Text u Identity Char
versionChar = ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "._+%{}~"

-- | Convert a 'Data.Text.Text' representation into an 'EVR' or a 'ParseError' if something goes wrong.
parseEVR :: T.Text -> Either ParseError EVR
parseEVR :: Text -> Either ParseError EVR
parseEVR = Parsec Text () EVR -> String -> Text -> Either ParseError EVR
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () EVR
parseEVRParsec ""

-- | Convert a 'Data.Text.Text' representation into a 'DepRequirement' or a 'ParseError' if something
-- goes wrong.
parseDepRequirement :: T.Text -> Either ParseError DepRequirement
parseDepRequirement :: Text -> Either ParseError DepRequirement
parseDepRequirement input :: Text
input = Parsec Text () DepRequirement
-> String -> Text -> Either ParseError DepRequirement
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () DepRequirement
parseDepRequirement' "" Text
input
 where
    parseDepRequirement' :: Parsec Text () DepRequirement
parseDepRequirement' = do
        String
reqname <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text () Identity Char -> ParsecT Text () Identity String)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
        ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
        Maybe (DepOrdering, EVR)
reqver <- ParsecT Text () Identity (DepOrdering, EVR)
-> ParsecT Text () Identity (Maybe (DepOrdering, EVR))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT Text () Identity (DepOrdering, EVR)
 -> ParsecT Text () Identity (Maybe (DepOrdering, EVR)))
-> ParsecT Text () Identity (DepOrdering, EVR)
-> ParsecT Text () Identity (Maybe (DepOrdering, EVR))
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity (DepOrdering, EVR)
-> ParsecT Text () Identity (DepOrdering, EVR)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text () Identity (DepOrdering, EVR)
parseDepVersion

        -- If anything went wrong in parsing the version (invalid operator, malformed EVR), treat the entire
        -- string as a name. This way RPMs with bad version strings in Requires, which of course exist, will
        -- match against the full string.
        case Maybe (DepOrdering, EVR)
reqver of
            Just _  -> DepRequirement -> Parsec Text () DepRequirement
forall (m :: * -> *) a. Monad m => a -> m a
return (DepRequirement -> Parsec Text () DepRequirement)
-> DepRequirement -> Parsec Text () DepRequirement
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (DepOrdering, EVR) -> DepRequirement
DepRequirement (String -> Text
T.pack String
reqname) Maybe (DepOrdering, EVR)
reqver
            Nothing -> DepRequirement -> Parsec Text () DepRequirement
forall (m :: * -> *) a. Monad m => a -> m a
return (DepRequirement -> Parsec Text () DepRequirement)
-> DepRequirement -> Parsec Text () DepRequirement
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (DepOrdering, EVR) -> DepRequirement
DepRequirement Text
input Maybe (DepOrdering, EVR)
forall a. Maybe a
Nothing

    -- check lte and gte first, since they overlap lt and gt
    parseOperator :: Parsec T.Text () DepOrdering
    parseOperator :: Parsec Text () DepOrdering
parseOperator = Parsec Text () DepOrdering
forall u. ParsecT Text u Identity DepOrdering
lte Parsec Text () DepOrdering
-> Parsec Text () DepOrdering -> Parsec Text () DepOrdering
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () DepOrdering
forall u. ParsecT Text u Identity DepOrdering
gte Parsec Text () DepOrdering
-> Parsec Text () DepOrdering -> Parsec Text () DepOrdering
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () DepOrdering
forall u. ParsecT Text u Identity DepOrdering
eq Parsec Text () DepOrdering
-> Parsec Text () DepOrdering -> Parsec Text () DepOrdering
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () DepOrdering
forall u. ParsecT Text u Identity DepOrdering
lt Parsec Text () DepOrdering
-> Parsec Text () DepOrdering -> Parsec Text () DepOrdering
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () DepOrdering
forall u. ParsecT Text u Identity DepOrdering
gt

    eq :: ParsecT Text u Identity DepOrdering
eq  = ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "=")  ParsecT Text u Identity String
-> ParsecT Text u Identity DepOrdering
-> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepOrdering -> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a. Monad m => a -> m a
return DepOrdering
EQ
    lt :: ParsecT Text u Identity DepOrdering
lt  = ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "<")  ParsecT Text u Identity String
-> ParsecT Text u Identity DepOrdering
-> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepOrdering -> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a. Monad m => a -> m a
return DepOrdering
LT
    gt :: ParsecT Text u Identity DepOrdering
gt  = ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ">")  ParsecT Text u Identity String
-> ParsecT Text u Identity DepOrdering
-> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepOrdering -> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a. Monad m => a -> m a
return DepOrdering
GT
    lte :: ParsecT Text u Identity DepOrdering
lte = ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "<=") ParsecT Text u Identity String
-> ParsecT Text u Identity DepOrdering
-> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepOrdering -> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a. Monad m => a -> m a
return DepOrdering
LTE
    gte :: ParsecT Text u Identity DepOrdering
gte = ParsecT Text u Identity String -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ">=") ParsecT Text u Identity String
-> ParsecT Text u Identity DepOrdering
-> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DepOrdering -> ParsecT Text u Identity DepOrdering
forall (m :: * -> *) a. Monad m => a -> m a
return DepOrdering
GTE

    parseDepVersion :: Parsec T.Text () (DepOrdering, EVR)
    parseDepVersion :: ParsecT Text () Identity (DepOrdering, EVR)
parseDepVersion = do
        DepOrdering
oper <- Parsec Text () DepOrdering
parseOperator
        ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
        EVR
evr <- Parsec Text () EVR
parseEVRParsec
        ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

        (DepOrdering, EVR) -> ParsecT Text () Identity (DepOrdering, EVR)
forall (m :: * -> *) a. Monad m => a -> m a
return (DepOrdering
oper, EVR
evr)