{-# 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 [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))"
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
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
class ParseDebianVersion a where
parseDebianVersion :: a-> Either ParseError DebianVersion
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)
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))
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
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)
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
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)