{-# LANGUAGE CPP #-}
{-|
    Author      :  Andres Loeh <kosmikus@gentoo.org>
    Stability   :  provisional
    Portability :  haskell98

    Version parser, according to Portage spec.

    Shamelessly borrowed from exi, ported from Parsec to ReadP

-}
module Portage.Version (
    Version(..),
    Suffix(..),
    fromCabalVersion,
    toCabalVersion,
    is_live
  ) where

import qualified Distribution.Version as Cabal

import           Distribution.Pretty (Pretty(..))

import           Distribution.Parsec (Parsec(..))
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
import           Text.PrettyPrint ((<>))
import qualified Data.List.NonEmpty as NE

import           Control.DeepSeq (NFData(..))

#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif

-- | Portage-style version type.
data Version = Version { Version -> [Int]
versionNumber   :: [Int]        -- ^ @[1,42,3]@ ~= 1.42.3
                       , Version -> Maybe Char
versionChar     :: (Maybe Char) -- ^ optional letter
                       , Version -> [Suffix]
versionSuffix   :: [Suffix]
                       , Version -> Int
versionRevision :: Int          -- ^ revision, 0 means none
                       }
  deriving (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, Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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 :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord, 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, ReadPrec [Version]
ReadPrec Version
Int -> ReadS Version
ReadS [Version]
(Int -> ReadS Version)
-> ReadS [Version]
-> ReadPrec Version
-> ReadPrec [Version]
-> Read Version
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Version]
$creadListPrec :: ReadPrec [Version]
readPrec :: ReadPrec Version
$creadPrec :: ReadPrec Version
readList :: ReadS [Version]
$creadList :: ReadS [Version]
readsPrec :: Int -> ReadS Version
$creadsPrec :: Int -> ReadS Version
Read)

instance NFData Version where
  rnf :: Version -> ()
rnf (Version [Int]
n Maybe Char
c [Suffix]
s Int
r) = [Int] -> ()
forall a. NFData a => a -> ()
rnf [Int]
n () -> () -> ()
`seq` Maybe Char -> ()
forall a. NFData a => a -> ()
rnf Maybe Char
c () -> () -> ()
`seq` [Suffix] -> ()
forall a. NFData a => a -> ()
rnf [Suffix]
s () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
r

-- | Prints a valid Portage 'Version' string.
instance Pretty Version where
  pretty :: Version -> Doc
pretty (Version [Int]
ver Maybe Char
c [Suffix]
suf Int
rev) =
    [Int] -> Doc
dispVer [Int]
ver Doc -> Doc -> Doc
<> Maybe Char -> Doc
dispC Maybe Char
c Doc -> Doc -> Doc
<> [Suffix] -> Doc
dispSuf [Suffix]
suf Doc -> Doc -> Doc
<> Int -> Doc
dispRev Int
rev
    where
      dispVer :: [Int] -> Doc
dispVer   = [Doc] -> Doc
Disp.hcat ([Doc] -> Doc) -> ([Int] -> [Doc]) -> [Int] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
Disp.punctuate (Char -> Doc
Disp.char Char
'.') ([Doc] -> [Doc]) -> ([Int] -> [Doc]) -> [Int] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc
Disp.int
      dispC :: Maybe Char -> Doc
dispC     = Doc -> (Char -> Doc) -> Maybe Char -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Disp.empty Char -> Doc
Disp.char
      dispSuf :: [Suffix] -> Doc
dispSuf   = [Doc] -> Doc
Disp.hcat ([Doc] -> Doc) -> ([Suffix] -> [Doc]) -> [Suffix] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Suffix -> Doc) -> [Suffix] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Suffix -> Doc
forall a. Pretty a => a -> Doc
pretty
      dispRev :: Int -> Doc
dispRev Int
0 = Doc
Disp.empty
      dispRev Int
n = String -> Doc
Disp.text String
"-r" Doc -> Doc -> Doc
<> Int -> Doc
Disp.int Int
n

-- | 'Version' parser using 'Parsec'.
instance Parsec Version where
  parsec :: m Version
parsec = do
    NonEmpty Int
ver <- m Int -> m Char -> m (NonEmpty Int)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty m Int
forall (m :: * -> *). CharParsing m => m Int
digits (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'.')
    Maybe Char
c   <- m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional m Char
forall (m :: * -> *). CharParsing m => m Char
P.lower
    [Suffix]
suf <- m Suffix -> m [Suffix]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many m Suffix
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
    Int
rev <- Int -> m Int -> m Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Int
0 (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"-r" m String -> m Int -> m Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Int
forall (m :: * -> *). CharParsing m => m Int
digits
    Version -> m Version
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> m Version) -> Version -> m Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe Char -> [Suffix] -> Int -> Version
Version (NonEmpty Int -> [Int]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Int
ver) Maybe Char
c [Suffix]
suf Int
rev

-- | Check if the ebuild is a live ebuild, i.e. if its 'Version' is @9999@.
--
-- foo-9999* is treated as live ebuild
-- Cabal-1.17.9999* as well
--
-- >>> let (c,s,r) = (Nothing,[],0)
-- >>> is_live (Version [1,0,0] c s r)
-- False
-- >>> is_live (Version [999] c s r)
-- False
-- >>> is_live (Version [1,0,0,9999] c s r)
-- True
-- >>> is_live (Version [9999] c s r)
-- True
--
-- $
-- prop> \verNum char rev -> is_live (Version verNum char [] rev) == if length verNum >= 1 && last verNum >= 9999 then True else False
is_live :: Version -> Bool
is_live :: Version -> Bool
is_live Version
v =
    case [Int]
vs of
        -- nonempty
        (Int
_:[Int]
_) | Int -> Bool
forall a. (Ord a, Num a, Show a) => a -> Bool
many_nines ([Int] -> Int
forall a. [a] -> a
last [Int]
vs) -> Bool
True
        [Int]
_                            -> Bool
False
  where vs :: [Int]
vs = Version -> [Int]
versionNumber Version
v
        many_nines :: a -> Bool
many_nines a
n = a -> Bool
forall a. (Ord a, Num a) => a -> Bool
is_big a
n Bool -> Bool -> Bool
&& a -> Bool
forall a. Show a => a -> Bool
all_nines a
n
        is_big :: a -> Bool
is_big a
n     = a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
9999
        all_nines :: a -> Bool
all_nines a
n  = ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'9') (String -> Bool) -> (a -> String) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) a
n

-- | Various allowed suffixes in Portage versions.
data Suffix = Alpha Int | Beta Int | Pre Int | RC Int | P Int
  deriving (Suffix -> Suffix -> Bool
(Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool) -> Eq Suffix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Suffix -> Suffix -> Bool
$c/= :: Suffix -> Suffix -> Bool
== :: Suffix -> Suffix -> Bool
$c== :: Suffix -> Suffix -> Bool
Eq, Eq Suffix
Eq Suffix
-> (Suffix -> Suffix -> Ordering)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Suffix)
-> (Suffix -> Suffix -> Suffix)
-> Ord Suffix
Suffix -> Suffix -> Bool
Suffix -> Suffix -> Ordering
Suffix -> Suffix -> Suffix
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 :: Suffix -> Suffix -> Suffix
$cmin :: Suffix -> Suffix -> Suffix
max :: Suffix -> Suffix -> Suffix
$cmax :: Suffix -> Suffix -> Suffix
>= :: Suffix -> Suffix -> Bool
$c>= :: Suffix -> Suffix -> Bool
> :: Suffix -> Suffix -> Bool
$c> :: Suffix -> Suffix -> Bool
<= :: Suffix -> Suffix -> Bool
$c<= :: Suffix -> Suffix -> Bool
< :: Suffix -> Suffix -> Bool
$c< :: Suffix -> Suffix -> Bool
compare :: Suffix -> Suffix -> Ordering
$ccompare :: Suffix -> Suffix -> Ordering
$cp1Ord :: Eq Suffix
Ord, Int -> Suffix -> ShowS
[Suffix] -> ShowS
Suffix -> String
(Int -> Suffix -> ShowS)
-> (Suffix -> String) -> ([Suffix] -> ShowS) -> Show Suffix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Suffix] -> ShowS
$cshowList :: [Suffix] -> ShowS
show :: Suffix -> String
$cshow :: Suffix -> String
showsPrec :: Int -> Suffix -> ShowS
$cshowsPrec :: Int -> Suffix -> ShowS
Show, ReadPrec [Suffix]
ReadPrec Suffix
Int -> ReadS Suffix
ReadS [Suffix]
(Int -> ReadS Suffix)
-> ReadS [Suffix]
-> ReadPrec Suffix
-> ReadPrec [Suffix]
-> Read Suffix
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Suffix]
$creadListPrec :: ReadPrec [Suffix]
readPrec :: ReadPrec Suffix
$creadPrec :: ReadPrec Suffix
readList :: ReadS [Suffix]
$creadList :: ReadS [Suffix]
readsPrec :: Int -> ReadS Suffix
$creadsPrec :: Int -> ReadS Suffix
Read)

instance NFData Suffix where
  rnf :: Suffix -> ()
rnf (Alpha Int
n) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
n
  rnf (Beta Int
n)  = Int -> ()
forall a. NFData a => a -> ()
rnf Int
n
  rnf (Pre Int
n)   = Int -> ()
forall a. NFData a => a -> ()
rnf Int
n
  rnf (RC Int
n)    = Int -> ()
forall a. NFData a => a -> ()
rnf Int
n
  rnf (P Int
n)     = Int -> ()
forall a. NFData a => a -> ()
rnf Int
n

instance Pretty Suffix where
  pretty :: Suffix -> Doc
pretty Suffix
suf = case Suffix
suf of
    Alpha Int
n -> String -> Doc
Disp.text String
"_alpha" Doc -> Doc -> Doc
<> Int -> Doc
dispPos Int
n
    Beta Int
n  -> String -> Doc
Disp.text String
"_beta"  Doc -> Doc -> Doc
<> Int -> Doc
dispPos Int
n
    Pre Int
n   -> String -> Doc
Disp.text String
"_pre"   Doc -> Doc -> Doc
<> Int -> Doc
dispPos Int
n
    RC Int
n    -> String -> Doc
Disp.text String
"_rc"    Doc -> Doc -> Doc
<> Int -> Doc
dispPos Int
n
    P  Int
n    -> String -> Doc
Disp.text String
"_p"     Doc -> Doc -> Doc
<> Int -> Doc
dispPos Int
n

    where
      dispPos :: Int -> Disp.Doc
      dispPos :: Int -> Doc
dispPos Int
0 = Doc
Disp.empty
      dispPos Int
n = Int -> Doc
Disp.int Int
n

instance Parsec Suffix where
  parsec :: m Suffix
parsec = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'_'
       m Char -> m Suffix -> m Suffix
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [m Suffix] -> m Suffix
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice
    [ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"alpha"       m String -> m Suffix -> m Suffix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> Suffix) -> m Int -> m Suffix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Suffix
Alpha m Int
maybeDigits
    , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"beta"        m String -> m Suffix -> m Suffix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> Suffix) -> m Int -> m Suffix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Suffix
Beta  m Int
maybeDigits
    , m String -> m String
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try (String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"pre") m String -> m Suffix -> m Suffix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> Suffix) -> m Int -> m Suffix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Suffix
Pre   m Int
maybeDigits
    , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"rc"          m String -> m Suffix -> m Suffix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> Suffix) -> m Int -> m Suffix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Suffix
RC    m Int
maybeDigits
    , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"p"           m String -> m Suffix -> m Suffix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> Suffix) -> m Int -> m Suffix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Suffix
P     m Int
maybeDigits
    ]
    where
      maybeDigits :: m Int
maybeDigits = Int -> m Int -> m Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Int
0 m Int
forall (m :: * -> *). CharParsing m => m Int
digits

-- | Convert from a 'Cabal.Version' to a Portage 'Version'.
-- 
-- prop> \verNum -> fromCabalVersion (Cabal.mkVersion verNum) == Version verNum Nothing [] 0
fromCabalVersion :: Cabal.Version -> Version
fromCabalVersion :: Version -> Version
fromCabalVersion Version
cabal_version = [Int] -> Maybe Char -> [Suffix] -> Int -> Version
Version (Version -> [Int]
Cabal.versionNumbers Version
cabal_version) Maybe Char
forall a. Maybe a
Nothing [] Int
0

-- | Convert from a Portage 'Version' to a 'Cabal.Version'.
-- $
-- prop> \verNum char rev -> toCabalVersion (Version verNum char [] rev) == if char == Nothing then Just (Cabal.mkVersion verNum) else Nothing
toCabalVersion :: Version -> Maybe Cabal.Version
toCabalVersion :: Version -> Maybe Version
toCabalVersion (Version [Int]
nums Maybe Char
Nothing [] Int
_) = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
Cabal.mkVersion [Int]
nums)
toCabalVersion Version
_                           = Maybe Version
forall a. Maybe a
Nothing

-- | Parser which munches digits.
digits :: P.CharParsing m => m Int
digits :: m Int
digits = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> m String -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.some m Char
forall (m :: * -> *). CharParsing m => m Char
P.digit