-- |A module for parsing, comparing, and (eventually) modifying debian version
-- numbers. <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version>
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS -fno-warn-orphans -fno-warn-unused-do-bind #-}
module Debian.Version.Common
    ( DebianVersion -- |Exported abstract because the internal representation is likely to change
    , prettyDebianVersion
    , ParseDebianVersion(..)
    , parseDebianVersion'
    , evr               -- DebianVersion -> (Maybe Int, String, Maybe String)
    , epoch
    , version
    , revision
    , buildDebianVersion
    , parseDV
    ) where

import Data.Char (ord, isDigit, isAlpha)
import Debian.Pretty (PP(..))
import Debian.Version.Internal
import Text.ParserCombinators.Parsec
import Text.Regex
import Text.PrettyPrint (Doc, render, text)
import Distribution.Pretty (Pretty(pretty))

prettyDebianVersion :: DebianVersion -> Doc
prettyDebianVersion :: DebianVersion -> Doc
prettyDebianVersion (DebianVersion [Char]
s (Found Int, NonNumeric, Found NonNumeric)
_) = [Char] -> Doc
text [Char]
s

instance Pretty (PP DebianVersion) where
    pretty :: PP DebianVersion -> Doc
pretty = DebianVersion -> Doc
prettyDebianVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PP a -> a
unPP

instance Eq DebianVersion where
    (DebianVersion [Char]
_ (Found Int, NonNumeric, Found NonNumeric)
v1) == :: DebianVersion -> DebianVersion -> Bool
== (DebianVersion [Char]
_ (Found Int, NonNumeric, Found NonNumeric)
v2) = (Found Int, NonNumeric, Found NonNumeric)
v1 forall a. Eq a => a -> a -> Bool
== (Found Int, NonNumeric, Found NonNumeric)
v2

instance Ord DebianVersion where
    compare :: DebianVersion -> DebianVersion -> Ordering
compare (DebianVersion [Char]
_ (Found Int, NonNumeric, Found NonNumeric)
v1) (DebianVersion [Char]
_ (Found Int, NonNumeric, Found NonNumeric)
v2) = forall a. Ord a => a -> a -> Ordering
compare (Found Int, NonNumeric, Found NonNumeric)
v1 (Found Int, NonNumeric, Found NonNumeric)
v2

instance Show DebianVersion where
    show :: DebianVersion -> [Char]
show DebianVersion
v = [Char]
"(Debian.Version.parseDebianVersion (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Doc -> [Char]
render (DebianVersion -> Doc
prettyDebianVersion DebianVersion
v)) forall a. [a] -> [a] -> [a]
++ [Char]
" :: String))"

-- make ~ less than everything, and everything else higher that letters
order :: Char -> Int
order :: Char -> Int
order Char
c
    | Char -> Bool
isDigit Char
c = Int
0
    | Char -> Bool
isAlpha Char
c = Char -> Int
ord Char
c
    | Char
c forall a. Eq a => a -> a -> Bool
== Char
'~' = -Int
1
    | Bool
otherwise = (Char -> Int
ord Char
c) forall a. Num a => a -> a -> a
+ Int
256

-- |We have to do this wackiness because ~ is less than the empty string
compareNonNumeric :: [Char] -> [Char] -> Ordering
compareNonNumeric :: [Char] -> [Char] -> Ordering
compareNonNumeric [Char]
"" [Char]
"" = Ordering
EQ
compareNonNumeric [Char]
"" (Char
'~':[Char]
_cs) = Ordering
GT
compareNonNumeric (Char
'~':[Char]
_cs) [Char]
"" = Ordering
LT
compareNonNumeric [Char]
"" [Char]
_ = Ordering
LT
compareNonNumeric [Char]
_ [Char]
"" = Ordering
GT
compareNonNumeric (Char
c1:[Char]
cs1) (Char
c2:[Char]
cs2) =
    if (Char -> Int
order Char
c1) forall a. Eq a => a -> a -> Bool
== (Char -> Int
order Char
c2)
       then [Char] -> [Char] -> Ordering
compareNonNumeric [Char]
cs1 [Char]
cs2
       else forall a. Ord a => a -> a -> Ordering
compare (Char -> Int
order Char
c1) (Char -> Int
order Char
c2)

instance Eq NonNumeric where
    (NonNumeric [Char]
s1 Found Numeric
n1) == :: NonNumeric -> NonNumeric -> Bool
== (NonNumeric [Char]
s2 Found Numeric
n2) =
        case [Char] -> [Char] -> Ordering
compareNonNumeric [Char]
s1 [Char]
s2 of
          Ordering
EQ -> Found Numeric
n1 forall a. Eq a => a -> a -> Bool
== Found Numeric
n2
          Ordering
_o -> Bool
False

instance Ord NonNumeric where
    compare :: NonNumeric -> NonNumeric -> Ordering
compare (NonNumeric [Char]
s1 Found Numeric
n1) (NonNumeric [Char]
s2 Found Numeric
n2) =
        case [Char] -> [Char] -> Ordering
compareNonNumeric [Char]
s1 [Char]
s2 of
          Ordering
EQ -> forall a. Ord a => a -> a -> Ordering
compare Found Numeric
n1 Found Numeric
n2
          Ordering
o -> Ordering
o

instance Eq Numeric where
    (Numeric Int
n1 Maybe NonNumeric
mnn1) == :: Numeric -> Numeric -> Bool
== (Numeric Int
n2 Maybe NonNumeric
mnn2) =
        case forall a. Ord a => a -> a -> Ordering
compare Int
n1 Int
n2 of
          Ordering
EQ -> case Maybe NonNumeric -> Maybe NonNumeric -> Ordering
compareMaybeNonNumeric Maybe NonNumeric
mnn1 Maybe NonNumeric
mnn2 of
                  Ordering
EQ -> Bool
True
                  Ordering
_ -> Bool
False
          Ordering
_ -> Bool
False

compareMaybeNonNumeric :: Maybe NonNumeric -> Maybe NonNumeric -> Ordering
compareMaybeNonNumeric :: Maybe NonNumeric -> Maybe NonNumeric -> Ordering
compareMaybeNonNumeric Maybe NonNumeric
mnn1 Maybe NonNumeric
mnn2 =
    case (Maybe NonNumeric
mnn1, Maybe NonNumeric
mnn2) of
      (Maybe NonNumeric
Nothing, Maybe NonNumeric
Nothing) -> Ordering
EQ
      (Just (NonNumeric [Char]
nn Found Numeric
_), Maybe NonNumeric
Nothing) -> [Char] -> [Char] -> Ordering
compareNonNumeric [Char]
nn [Char]
""
      (Maybe NonNumeric
Nothing, Just (NonNumeric [Char]
nn Found Numeric
_)) -> [Char] -> [Char] -> Ordering
compareNonNumeric [Char]
"" [Char]
nn
      (Just NonNumeric
nn1, Just NonNumeric
nn2) -> forall a. Ord a => a -> a -> Ordering
compare NonNumeric
nn1 NonNumeric
nn2

instance Ord Numeric where
    compare :: Numeric -> Numeric -> Ordering
compare (Numeric Int
n1 Maybe NonNumeric
mnn1) (Numeric Int
n2 Maybe NonNumeric
mnn2) =
        case forall a. Ord a => a -> a -> Ordering
compare Int
n1 Int
n2 of
          Ordering
EQ -> Maybe NonNumeric -> Maybe NonNumeric -> Ordering
compareMaybeNonNumeric Maybe NonNumeric
mnn1 Maybe NonNumeric
mnn2
          Ordering
o -> Ordering
o

-- * Parser

class ParseDebianVersion a where
    parseDebianVersion :: a-> Either ParseError DebianVersion
-- |Convert a string to a debian version number. May throw an
-- exception if the string is unparsable -- but I am not sure if that
-- can currently happen. Are there any invalid version strings?
-- Perhaps ones with underscore, or something?

parseDebianVersion' :: ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' :: forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' string
str = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParseError
e -> forall a. HasCallStack => [Char] -> a
error (forall a. Show a => a -> [Char]
show ParseError
e)) forall a. a -> a
id (forall a.
ParseDebianVersion a =>
a -> Either ParseError DebianVersion
parseDebianVersion string
str)

{-
showNN :: NonNumeric -> String
showNN (NonNumeric s n) = s ++ showN n

showN :: Found Numeric -> String
showN (Found (Numeric n nn)) = show n ++ maybe "" showNN nn
showN (Simulated _) = ""
-}

parseDV :: CharParser () (Found Int, NonNumeric, Found NonNumeric)
parseDV :: CharParser () (Found Int, NonNumeric, Found NonNumeric)
parseDV =
    do forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" \t"
       Found Int
e <- CharParser () (Found Int)
parseEpoch
       NonNumeric
upstreamVersion <- Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric Bool
True Bool
True
       Found NonNumeric
debianRevision <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (forall a. a -> Found a
Simulated ([Char] -> Found Numeric -> NonNumeric
NonNumeric [Char]
"" (forall a. a -> Found a
Simulated (Int -> Maybe NonNumeric -> Numeric
Numeric Int
0 forall a. Maybe a
Nothing)))) (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric Bool
True Bool
False forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Found a
Found)
       forall (m :: * -> *) a. Monad m => a -> m a
return (Found Int
e, NonNumeric
upstreamVersion, Found NonNumeric
debianRevision)

parseEpoch :: CharParser () (Found Int)
parseEpoch :: CharParser () (Found Int)
parseEpoch =
    forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (forall a. a -> Found a
Simulated Int
0) (forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
d -> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Found a
Found (forall a. Read a => [Char] -> a
read [Char]
d))))


parseNonNumeric :: Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric :: Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric Bool
zeroOk Bool
upstream =
    do [Char]
nn <- (if Bool
zeroOk then forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many else forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1) ((forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"-0123456789") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (if Bool
upstream then ParsecT [Char] () Identity Char
upstreamDash else forall tok st a. GenParser tok st a
pzero))
       Found Numeric
n <- Bool -> CharParser () (Found Numeric)
parseNumeric Bool
upstream
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Found Numeric -> NonNumeric
NonNumeric [Char]
nn Found Numeric
n
    where
      upstreamDash :: CharParser () Char
      upstreamDash :: ParsecT [Char] () Identity Char
upstreamDash = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
                              forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"- \n\t") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
                              forall (m :: * -> *) a. Monad m => a -> m a
return Char
'-'

parseNumeric :: Bool -> CharParser () (Found Numeric)
parseNumeric :: Bool -> CharParser () (Found Numeric)
parseNumeric Bool
upstream =
    do [Char]
n <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDigit)
       Maybe NonNumeric
nn <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing  (Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric Bool
False Bool
upstream forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Found a
Found (Int -> Maybe NonNumeric -> Numeric
Numeric (forall a. Read a => [Char] -> a
read [Char]
n) Maybe NonNumeric
nn)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Found a
Simulated (Int -> Maybe NonNumeric -> Numeric
Numeric Int
0 forall a. Maybe a
Nothing))

{-
compareTest :: String -> String -> Ordering
compareTest str1 str2 =
    let v1 = either (error . show) id $ parse parseDV str1 str1
        v2 = either (error . show) id $ parse parseDV str2 str2
        in
          compare v1 v2
-}

-- |Split a DebianVersion into its three components: epoch, version,
-- revision.  It is not safe to use the parsed version number for
-- this because you will lose information, such as leading zeros.
evr :: DebianVersion -> (Maybe Int, String, Maybe String)
evr :: DebianVersion -> (Maybe Int, [Char], Maybe [Char])
evr (DebianVersion [Char]
s (Found Int, NonNumeric, Found NonNumeric)
_) =
    let re :: Regex
re = [Char] -> Regex
mkRegex [Char]
"^(([0-9]+):)?(([^-]*)|((.*)-([^-]*)))$" in
    --                 (         ) (        (            ))
    --                  (   e  )    (  v  )  (v2) (  r  )
    case Regex -> [Char] -> Maybe [[Char]]
matchRegex Regex
re [Char]
s of
      Just [[Char]
"", [Char]
_, [Char]
_, [Char]
v, [Char]
"", [Char]
_, [Char]
_] -> (forall a. Maybe a
Nothing, [Char]
v, forall a. Maybe a
Nothing)
      Just [[Char]
"", [Char]
_, [Char]
_, [Char]
_, [Char]
_,  [Char]
v, [Char]
r] -> (forall a. Maybe a
Nothing, [Char]
v, forall a. a -> Maybe a
Just [Char]
r)
      Just [[Char]
_,  [Char]
e, [Char]
_, [Char]
v, [Char]
"", [Char]
_, [Char]
_] -> (forall a. a -> Maybe a
Just (forall a. Read a => [Char] -> a
read [Char]
e), [Char]
v, forall a. Maybe a
Nothing)
      Just [[Char]
_,  [Char]
e, [Char]
_, [Char]
_, [Char]
_,  [Char]
v, [Char]
r] -> (forall a. a -> Maybe a
Just (forall a. Read a => [Char] -> a
read [Char]
e), [Char]
v, forall a. a -> Maybe a
Just [Char]
r)
      -- I really don't think this can happen.
      Maybe [[Char]]
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Invalid Debian Version String: " forall a. [a] -> [a] -> [a]
++ [Char]
s)

epoch :: DebianVersion -> Maybe Int
epoch :: DebianVersion -> Maybe Int
epoch DebianVersion
v = case DebianVersion -> (Maybe Int, [Char], Maybe [Char])
evr DebianVersion
v of (Maybe Int
x, [Char]
_, Maybe [Char]
_) -> Maybe Int
x
version :: DebianVersion -> String
version :: DebianVersion -> [Char]
version DebianVersion
v = case DebianVersion -> (Maybe Int, [Char], Maybe [Char])
evr DebianVersion
v of (Maybe Int
_, [Char]
x, Maybe [Char]
_) -> [Char]
x
revision :: DebianVersion -> Maybe String
revision :: DebianVersion -> Maybe [Char]
revision DebianVersion
v = case DebianVersion -> (Maybe Int, [Char], Maybe [Char])
evr DebianVersion
v of (Maybe Int
_, [Char]
_, Maybe [Char]
x) -> Maybe [Char]
x

-- Build a Debian version number from epoch, version, revision
buildDebianVersion :: Maybe Int -> String -> Maybe String -> DebianVersion
buildDebianVersion :: Maybe Int -> [Char] -> Maybe [Char] -> DebianVersion
buildDebianVersion Maybe Int
e [Char]
v Maybe [Char]
r =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) ([Char]
-> (Found Int, NonNumeric, Found NonNumeric) -> DebianVersion
DebianVersion [Char]
str) forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse CharParser () (Found Int, NonNumeric, Found NonNumeric)
parseDV [Char]
str [Char]
str
    where
      str :: [Char]
str = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\ Int
n -> forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
":") Maybe Int
e forall a. [a] -> [a] -> [a]
++ [Char]
v forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\ [Char]
s -> [Char]
"-" forall a. [a] -> [a] -> [a]
++ [Char]
s) Maybe [Char]
r)