{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
-- @since 3.0
module Distribution.Types.PkgconfigVersion (
    PkgconfigVersion (..),
    rpmvercmp,
    ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.Generic (isAsciiAlphaNum)

import qualified Data.ByteString                 as BS
import qualified Data.ByteString.Char8           as BS8
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as PP

-- | @pkg-config@ versions.
--
-- In fact, this can be arbitrary 'BS.ByteString',
-- but 'Parsec' instance is a little pickier.
--
-- @since 3.0
newtype PkgconfigVersion = PkgconfigVersion BS.ByteString
  deriving ((forall x. PkgconfigVersion -> Rep PkgconfigVersion x)
-> (forall x. Rep PkgconfigVersion x -> PkgconfigVersion)
-> Generic PkgconfigVersion
forall x. Rep PkgconfigVersion x -> PkgconfigVersion
forall x. PkgconfigVersion -> Rep PkgconfigVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PkgconfigVersion -> Rep PkgconfigVersion x
from :: forall x. PkgconfigVersion -> Rep PkgconfigVersion x
$cto :: forall x. Rep PkgconfigVersion x -> PkgconfigVersion
to :: forall x. Rep PkgconfigVersion x -> PkgconfigVersion
Generic, ReadPrec [PkgconfigVersion]
ReadPrec PkgconfigVersion
Int -> ReadS PkgconfigVersion
ReadS [PkgconfigVersion]
(Int -> ReadS PkgconfigVersion)
-> ReadS [PkgconfigVersion]
-> ReadPrec PkgconfigVersion
-> ReadPrec [PkgconfigVersion]
-> Read PkgconfigVersion
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PkgconfigVersion
readsPrec :: Int -> ReadS PkgconfigVersion
$creadList :: ReadS [PkgconfigVersion]
readList :: ReadS [PkgconfigVersion]
$creadPrec :: ReadPrec PkgconfigVersion
readPrec :: ReadPrec PkgconfigVersion
$creadListPrec :: ReadPrec [PkgconfigVersion]
readListPrec :: ReadPrec [PkgconfigVersion]
Read, Int -> PkgconfigVersion -> ShowS
[PkgconfigVersion] -> ShowS
PkgconfigVersion -> String
(Int -> PkgconfigVersion -> ShowS)
-> (PkgconfigVersion -> String)
-> ([PkgconfigVersion] -> ShowS)
-> Show PkgconfigVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgconfigVersion -> ShowS
showsPrec :: Int -> PkgconfigVersion -> ShowS
$cshow :: PkgconfigVersion -> String
show :: PkgconfigVersion -> String
$cshowList :: [PkgconfigVersion] -> ShowS
showList :: [PkgconfigVersion] -> ShowS
Show, Typeable, Typeable PkgconfigVersion
Typeable PkgconfigVersion =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PkgconfigVersion -> c PkgconfigVersion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PkgconfigVersion)
-> (PkgconfigVersion -> Constr)
-> (PkgconfigVersion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PkgconfigVersion))
-> ((forall b. Data b => b -> b)
    -> PkgconfigVersion -> PkgconfigVersion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PkgconfigVersion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PkgconfigVersion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PkgconfigVersion -> m PkgconfigVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PkgconfigVersion -> m PkgconfigVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PkgconfigVersion -> m PkgconfigVersion)
-> Data PkgconfigVersion
PkgconfigVersion -> Constr
PkgconfigVersion -> DataType
(forall b. Data b => b -> b)
-> PkgconfigVersion -> PkgconfigVersion
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersion -> u
forall u. (forall d. Data d => d -> u) -> PkgconfigVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PkgconfigVersion -> c PkgconfigVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersion)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PkgconfigVersion -> c PkgconfigVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PkgconfigVersion -> c PkgconfigVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersion
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PkgconfigVersion
$ctoConstr :: PkgconfigVersion -> Constr
toConstr :: PkgconfigVersion -> Constr
$cdataTypeOf :: PkgconfigVersion -> DataType
dataTypeOf :: PkgconfigVersion -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PkgconfigVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersion)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PkgconfigVersion)
$cgmapT :: (forall b. Data b => b -> b)
-> PkgconfigVersion -> PkgconfigVersion
gmapT :: (forall b. Data b => b -> b)
-> PkgconfigVersion -> PkgconfigVersion
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PkgconfigVersion -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PkgconfigVersion -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PkgconfigVersion -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersion -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PkgconfigVersion -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PkgconfigVersion -> m PkgconfigVersion
Data)

instance Eq PkgconfigVersion where
    PkgconfigVersion ByteString
a == :: PkgconfigVersion -> PkgconfigVersion -> Bool
== PkgconfigVersion ByteString
b = ByteString -> ByteString -> Ordering
rpmvercmp ByteString
a ByteString
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord PkgconfigVersion where
    PkgconfigVersion ByteString
a compare :: PkgconfigVersion -> PkgconfigVersion -> Ordering
`compare` PkgconfigVersion ByteString
b = ByteString -> ByteString -> Ordering
rpmvercmp ByteString
a ByteString
b

instance Binary PkgconfigVersion
instance Structured PkgconfigVersion
instance NFData PkgconfigVersion where rnf :: PkgconfigVersion -> ()
rnf = PkgconfigVersion -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance Pretty PkgconfigVersion where
    pretty :: PkgconfigVersion -> Doc
pretty (PkgconfigVersion ByteString
bs) = String -> Doc
PP.text (ByteString -> String
BS8.unpack ByteString
bs)

-- |
--
-- >>> simpleParsec "1.0.2n" :: Maybe PkgconfigVersion
-- Just (PkgconfigVersion "1.0.2n")
--
-- >>> simpleParsec "0.3.5+ds" :: Maybe PkgconfigVersion
-- Nothing
--
instance Parsec PkgconfigVersion where
    parsec :: forall (m :: * -> *). CabalParsing m => m PkgconfigVersion
parsec = ByteString -> PkgconfigVersion
PkgconfigVersion (ByteString -> PkgconfigVersion)
-> (String -> ByteString) -> String -> PkgconfigVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> PkgconfigVersion) -> m String -> m PkgconfigVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
predicate where
        predicate :: Char -> Bool
predicate Char
c = Char -> Bool
isAsciiAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

-------------------------------------------------------------------------------
-- rpmvercmp - pure Haskell implementation
-------------------------------------------------------------------------------

-- | Compare two version strings as @pkg-config@ would compare them.
--
-- @since 3.0
rpmvercmp :: BS.ByteString -> BS.ByteString -> Ordering
rpmvercmp :: ByteString -> ByteString -> Ordering
rpmvercmp ByteString
a ByteString
b = [Word8] -> [Word8] -> Ordering
go0 (ByteString -> [Word8]
BS.unpack ByteString
a) (ByteString -> [Word8]
BS.unpack ByteString
b)
  where
    go0 :: [Word8] -> [Word8] -> Ordering
    -- if there is _any_ trailing "garbage", it seems to affect result
    -- https://github.com/haskell/cabal/issues/6805
    go0 :: [Word8] -> [Word8] -> Ordering
go0 [] [] = Ordering
EQ
    go0 [] [Word8]
_  = Ordering
LT
    go0 [Word8]
_  [] = Ordering
GT
    go0 [Word8]
xs [Word8]
ys = [Word8] -> [Word8] -> Ordering
go1 ([Word8] -> [Word8]
dropNonAlnum8 [Word8]
xs) ([Word8] -> [Word8]
dropNonAlnum8 [Word8]
ys)

    go1 :: [Word8] -> [Word8] -> Ordering
    go1 :: [Word8] -> [Word8] -> Ordering
go1 [] [] = Ordering
EQ
    go1 [] [Word8]
_  = Ordering
LT
    go1 [Word8]
_  [] = Ordering
GT
    go1 xs :: [Word8]
xs@(Word8
x:[Word8]
_) [Word8]
ys
      | Word8 -> Bool
isDigit8 Word8
x =
          let ([Word8]
xs1, [Word8]
xs2) = (Word8 -> Bool) -> [Word8] -> ([Word8], [Word8])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Word8 -> Bool
isDigit8 [Word8]
xs
              ([Word8]
ys1, [Word8]
ys2) = (Word8 -> Bool) -> [Word8] -> ([Word8], [Word8])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Word8 -> Bool
isDigit8 [Word8]
ys
            -- numeric segments are always newer than alpha segments
          in if [Word8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
ys1
             then Ordering
GT
             else [Word8] -> [Word8] -> Ordering
compareInt [Word8]
xs1 [Word8]
ys1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [Word8] -> [Word8] -> Ordering
go0 [Word8]
xs2 [Word8]
ys2

      -- isAlpha
      | Bool
otherwise =
          let ([Word8]
xs1, [Word8]
xs2) = (Word8 -> Bool) -> [Word8] -> ([Word8], [Word8])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Word8 -> Bool
isAlpha8 [Word8]
xs
              ([Word8]
ys1, [Word8]
ys2) = (Word8 -> Bool) -> [Word8] -> ([Word8], [Word8])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Word8 -> Bool
isAlpha8 [Word8]
ys
          in if [Word8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
ys1
             then Ordering
LT
             else [Word8] -> [Word8] -> Ordering
compareStr [Word8]
xs1 [Word8]
ys1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [Word8] -> [Word8] -> Ordering
go0 [Word8]
xs2 [Word8]
ys2

-- compare as numbers
compareInt :: [Word8] -> [Word8] -> Ordering
compareInt :: [Word8] -> [Word8] -> Ordering
compareInt [Word8]
xs [Word8]
ys =
    -- whichever number has more digits wins
    Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
xs') ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
ys') Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
    -- equal length: use per character compare, "strcmp"
    [Word8] -> [Word8] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Word8]
xs' [Word8]
ys'
  where
    -- drop  leading zeros
    xs' :: [Word8]
xs' = (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x30) [Word8]
xs
    ys' :: [Word8]
ys' = (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x30) [Word8]
ys

-- strcmp
compareStr :: [Word8] -> [Word8] -> Ordering
compareStr :: [Word8] -> [Word8] -> Ordering
compareStr = [Word8] -> [Word8] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

dropNonAlnum8 :: [Word8] -> [Word8]
dropNonAlnum8 :: [Word8] -> [Word8]
dropNonAlnum8 = (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Word8
w -> Bool -> Bool
not (Word8 -> Bool
isDigit8 Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isAlpha8 Word8
w))

isDigit8 :: Word8 -> Bool
isDigit8 :: Word8 -> Bool
isDigit8 Word8
w = Word8
0x30 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39

isAlpha8 :: Word8 -> Bool
isAlpha8 :: Word8 -> Bool
isAlpha8 Word8
w = (Word8
0x41 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x5A) Bool -> Bool -> Bool
|| (Word8
0x61 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7A)