{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS -fno-warn-orphans -fno-warn-unused-do-bind #-}
module Debian.Version.Common
( DebianVersion
, prettyDebianVersion
, ParseDebianVersion(..)
, parseDebianVersion'
, evr
, 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 String
s (Found Int, NonNumeric, Found NonNumeric)
_) = String -> Doc
text String
s
instance Pretty (PP DebianVersion) where
pretty :: PP DebianVersion -> Doc
pretty = DebianVersion -> Doc
prettyDebianVersion (DebianVersion -> Doc)
-> (PP DebianVersion -> DebianVersion) -> PP DebianVersion -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP DebianVersion -> DebianVersion
forall a. PP a -> a
unPP
instance Eq DebianVersion where
(DebianVersion String
_ (Found Int, NonNumeric, Found NonNumeric)
v1) == :: DebianVersion -> DebianVersion -> Bool
== (DebianVersion String
_ (Found Int, NonNumeric, Found NonNumeric)
v2) = (Found Int, NonNumeric, Found NonNumeric)
v1 (Found Int, NonNumeric, Found NonNumeric)
-> (Found Int, NonNumeric, Found NonNumeric) -> Bool
forall a. Eq a => a -> a -> Bool
== (Found Int, NonNumeric, Found NonNumeric)
v2
instance Ord DebianVersion where
compare :: DebianVersion -> DebianVersion -> Ordering
compare (DebianVersion String
_ (Found Int, NonNumeric, Found NonNumeric)
v1) (DebianVersion String
_ (Found Int, NonNumeric, Found NonNumeric)
v2) = (Found Int, NonNumeric, Found NonNumeric)
-> (Found Int, NonNumeric, Found NonNumeric) -> Ordering
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 -> String
show DebianVersion
v = String
"(Debian.Version.parseDebianVersion (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (Doc -> String
render (DebianVersion -> Doc
prettyDebianVersion DebianVersion
v)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :: String))"
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~' = -Int
1
| Bool
otherwise = (Char -> Int
ord Char
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
256
compareNonNumeric :: [Char] -> [Char] -> Ordering
compareNonNumeric :: String -> String -> Ordering
compareNonNumeric String
"" String
"" = Ordering
EQ
compareNonNumeric String
"" (Char
'~':String
_cs) = Ordering
GT
compareNonNumeric (Char
'~':String
_cs) String
"" = Ordering
LT
compareNonNumeric String
"" String
_ = Ordering
LT
compareNonNumeric String
_ String
"" = Ordering
GT
compareNonNumeric (Char
c1:String
cs1) (Char
c2:String
cs2) =
if (Char -> Int
order Char
c1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Int
order Char
c2)
then String -> String -> Ordering
compareNonNumeric String
cs1 String
cs2
else Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Char -> Int
order Char
c1) (Char -> Int
order Char
c2)
instance Eq NonNumeric where
(NonNumeric String
s1 Found Numeric
n1) == :: NonNumeric -> NonNumeric -> Bool
== (NonNumeric String
s2 Found Numeric
n2) =
case String -> String -> Ordering
compareNonNumeric String
s1 String
s2 of
Ordering
EQ -> Found Numeric
n1 Found Numeric -> Found Numeric -> Bool
forall a. Eq a => a -> a -> Bool
== Found Numeric
n2
Ordering
_o -> Bool
False
instance Ord NonNumeric where
compare :: NonNumeric -> NonNumeric -> Ordering
compare (NonNumeric String
s1 Found Numeric
n1) (NonNumeric String
s2 Found Numeric
n2) =
case String -> String -> Ordering
compareNonNumeric String
s1 String
s2 of
Ordering
EQ -> Found Numeric -> Found Numeric -> Ordering
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 Int -> Int -> Ordering
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 String
nn Found Numeric
_), Maybe NonNumeric
Nothing) -> String -> String -> Ordering
compareNonNumeric String
nn String
""
(Maybe NonNumeric
Nothing, Just (NonNumeric String
nn Found Numeric
_)) -> String -> String -> Ordering
compareNonNumeric String
"" String
nn
(Just NonNumeric
nn1, Just NonNumeric
nn2) -> NonNumeric -> NonNumeric -> Ordering
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 Int -> Int -> Ordering
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
class ParseDebianVersion a where
parseDebianVersion :: a-> Either ParseError DebianVersion
parseDebianVersion' :: ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' :: string -> DebianVersion
parseDebianVersion' string
str = (ParseError -> DebianVersion)
-> (DebianVersion -> DebianVersion)
-> Either ParseError DebianVersion
-> DebianVersion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParseError
e -> String -> DebianVersion
forall a. HasCallStack => String -> a
error (ParseError -> String
forall a. Show a => a -> String
show ParseError
e)) DebianVersion -> DebianVersion
forall a. a -> a
id (string -> Either ParseError DebianVersion
forall a.
ParseDebianVersion a =>
a -> Either ParseError DebianVersion
parseDebianVersion string
str)
parseDV :: CharParser () (Found Int, NonNumeric, Found NonNumeric)
parseDV :: CharParser () (Found Int, NonNumeric, Found NonNumeric)
parseDV =
do ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
Found Int
e <- CharParser () (Found Int)
parseEpoch
NonNumeric
upstreamVersion <- Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric Bool
True Bool
True
Found NonNumeric
debianRevision <- Found NonNumeric
-> ParsecT String () Identity (Found NonNumeric)
-> ParsecT String () Identity (Found NonNumeric)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (NonNumeric -> Found NonNumeric
forall a. a -> Found a
Simulated (String -> Found Numeric -> NonNumeric
NonNumeric String
"" (Numeric -> Found Numeric
forall a. a -> Found a
Simulated (Int -> Maybe NonNumeric -> Numeric
Numeric Int
0 Maybe NonNumeric
forall a. Maybe a
Nothing)))) (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String () Identity Char
-> CharParser () NonNumeric -> CharParser () NonNumeric
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric Bool
True Bool
False CharParser () NonNumeric
-> (NonNumeric -> ParsecT String () Identity (Found NonNumeric))
-> ParsecT String () Identity (Found NonNumeric)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Found NonNumeric -> ParsecT String () Identity (Found NonNumeric)
forall (m :: * -> *) a. Monad m => a -> m a
return (Found NonNumeric -> ParsecT String () Identity (Found NonNumeric))
-> (NonNumeric -> Found NonNumeric)
-> NonNumeric
-> ParsecT String () Identity (Found NonNumeric)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNumeric -> Found NonNumeric
forall a. a -> Found a
Found)
(Found Int, NonNumeric, Found NonNumeric)
-> CharParser () (Found Int, NonNumeric, Found NonNumeric)
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 =
Found Int -> CharParser () (Found Int) -> CharParser () (Found Int)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Int -> Found Int
forall a. a -> Found a
Simulated Int
0) (CharParser () (Found Int) -> CharParser () (Found Int)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String () Identity String
-> (String -> CharParser () (Found Int))
-> CharParser () (Found Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
d -> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT String () Identity Char
-> CharParser () (Found Int) -> CharParser () (Found Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Found Int -> CharParser () (Found Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Found Int
forall a. a -> Found a
Found (String -> Int
forall a. Read a => String -> a
read String
d))))
parseNonNumeric :: Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric :: Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric Bool
zeroOk Bool
upstream =
do String
nn <- (if Bool
zeroOk then ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many else ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1) ((String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"-0123456789") ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
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 String () Identity Char
upstreamDash else ParsecT String () Identity Char
forall tok st a. GenParser tok st a
pzero))
Found Numeric
n <- Bool -> CharParser () (Found Numeric)
parseNumeric Bool
upstream
NonNumeric -> CharParser () NonNumeric
forall (m :: * -> *) a. Monad m => a -> m a
return (NonNumeric -> CharParser () NonNumeric)
-> NonNumeric -> CharParser () NonNumeric
forall a b. (a -> b) -> a -> b
$ String -> Found Numeric -> NonNumeric
NonNumeric String
nn Found Numeric
n
where
upstreamDash :: CharParser () Char
upstreamDash :: ParsecT String () Identity Char
upstreamDash = ParsecT String () Identity Char -> ParsecT String () Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity Char
-> ParsecT String () Identity Char)
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b. (a -> b) -> a -> b
$ do Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT String () Identity Char
-> ParsecT String () Identity Char)
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b. (a -> b) -> a -> b
$ (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"- \n\t") ParsecT String () Identity String
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
Char -> ParsecT String () Identity 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 String
n <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDigit)
Maybe NonNumeric
nn <- Maybe NonNumeric
-> ParsecT String () Identity (Maybe NonNumeric)
-> ParsecT String () Identity (Maybe NonNumeric)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe NonNumeric
forall a. Maybe a
Nothing (Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric Bool
False Bool
upstream CharParser () NonNumeric
-> (NonNumeric -> ParsecT String () Identity (Maybe NonNumeric))
-> ParsecT String () Identity (Maybe NonNumeric)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe NonNumeric -> ParsecT String () Identity (Maybe NonNumeric)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NonNumeric -> ParsecT String () Identity (Maybe NonNumeric))
-> (NonNumeric -> Maybe NonNumeric)
-> NonNumeric
-> ParsecT String () Identity (Maybe NonNumeric)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNumeric -> Maybe NonNumeric
forall a. a -> Maybe a
Just)
Found Numeric -> CharParser () (Found Numeric)
forall (m :: * -> *) a. Monad m => a -> m a
return (Found Numeric -> CharParser () (Found Numeric))
-> Found Numeric -> CharParser () (Found Numeric)
forall a b. (a -> b) -> a -> b
$ Numeric -> Found Numeric
forall a. a -> Found a
Found (Int -> Maybe NonNumeric -> Numeric
Numeric (String -> Int
forall a. Read a => String -> a
read String
n) Maybe NonNumeric
nn)
CharParser () (Found Numeric)
-> CharParser () (Found Numeric) -> CharParser () (Found Numeric)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Found Numeric -> CharParser () (Found Numeric)
forall (m :: * -> *) a. Monad m => a -> m a
return (Numeric -> Found Numeric
forall a. a -> Found a
Simulated (Int -> Maybe NonNumeric -> Numeric
Numeric Int
0 Maybe NonNumeric
forall a. Maybe a
Nothing))
evr :: DebianVersion -> (Maybe Int, String, Maybe String)
evr :: DebianVersion -> (Maybe Int, String, Maybe String)
evr (DebianVersion String
s (Found Int, NonNumeric, Found NonNumeric)
_) =
let re :: Regex
re = String -> Regex
mkRegex String
"^(([0-9]+):)?(([^-]*)|((.*)-([^-]*)))$" in
case Regex -> String -> Maybe [String]
matchRegex Regex
re String
s of
Just [String
"", String
_, String
_, String
v, String
"", String
_, String
_] -> (Maybe Int
forall a. Maybe a
Nothing, String
v, Maybe String
forall a. Maybe a
Nothing)
Just [String
"", String
_, String
_, String
_, String
_, String
v, String
r] -> (Maybe Int
forall a. Maybe a
Nothing, String
v, String -> Maybe String
forall a. a -> Maybe a
Just String
r)
Just [String
_, String
e, String
_, String
v, String
"", String
_, String
_] -> (Int -> Maybe Int
forall a. a -> Maybe a
Just (String -> Int
forall a. Read a => String -> a
read String
e), String
v, Maybe String
forall a. Maybe a
Nothing)
Just [String
_, String
e, String
_, String
_, String
_, String
v, String
r] -> (Int -> Maybe Int
forall a. a -> Maybe a
Just (String -> Int
forall a. Read a => String -> a
read String
e), String
v, String -> Maybe String
forall a. a -> Maybe a
Just String
r)
Maybe [String]
_ -> String -> (Maybe Int, String, Maybe String)
forall a. HasCallStack => String -> a
error (String
"Invalid Debian Version String: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)
epoch :: DebianVersion -> Maybe Int
epoch :: DebianVersion -> Maybe Int
epoch DebianVersion
v = case DebianVersion -> (Maybe Int, String, Maybe String)
evr DebianVersion
v of (Maybe Int
x, String
_, Maybe String
_) -> Maybe Int
x
version :: DebianVersion -> String
version :: DebianVersion -> String
version DebianVersion
v = case DebianVersion -> (Maybe Int, String, Maybe String)
evr DebianVersion
v of (Maybe Int
_, String
x, Maybe String
_) -> String
x
revision :: DebianVersion -> Maybe String
revision :: DebianVersion -> Maybe String
revision DebianVersion
v = case DebianVersion -> (Maybe Int, String, Maybe String)
evr DebianVersion
v of (Maybe Int
_, String
_, Maybe String
x) -> Maybe String
x
buildDebianVersion :: Maybe Int -> String -> Maybe String -> DebianVersion
buildDebianVersion :: Maybe Int -> String -> Maybe String -> DebianVersion
buildDebianVersion Maybe Int
e String
v Maybe String
r =
(ParseError -> DebianVersion)
-> ((Found Int, NonNumeric, Found NonNumeric) -> DebianVersion)
-> Either ParseError (Found Int, NonNumeric, Found NonNumeric)
-> DebianVersion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> DebianVersion
forall a. HasCallStack => String -> a
error (String -> DebianVersion)
-> (ParseError -> String) -> ParseError -> DebianVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) (String
-> (Found Int, NonNumeric, Found NonNumeric) -> DebianVersion
DebianVersion String
str) (Either ParseError (Found Int, NonNumeric, Found NonNumeric)
-> DebianVersion)
-> Either ParseError (Found Int, NonNumeric, Found NonNumeric)
-> DebianVersion
forall a b. (a -> b) -> a -> b
$ CharParser () (Found Int, NonNumeric, Found NonNumeric)
-> String
-> String
-> Either ParseError (Found Int, NonNumeric, Found NonNumeric)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse CharParser () (Found Int, NonNumeric, Found NonNumeric)
parseDV String
str String
str
where
str :: String
str = (String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\ Int
n -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":") Maybe Int
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\ String
s -> String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) Maybe String
r)