1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
-- |A module for parsing, comparing, and (eventually) modifying debian version
-- numbers. <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version>
{-# 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(..)
, evr -- DebianVersion -> (Maybe Int, String, Maybe String)
, epoch
, version
, revision
, buildDebianVersion
, parseDV
) where
import Data.Char
import Text.ParserCombinators.Parsec
import Text.Regex
import Debian.Version.Internal
import Text.PrettyPrint (Doc, text)
prettyDebianVersion :: DebianVersion -> Doc
prettyDebianVersion (DebianVersion s _) = text s
instance Eq DebianVersion where
(DebianVersion _ v1) == (DebianVersion _ v2) = v1 == v2
instance Ord DebianVersion where
compare (DebianVersion _ v1) (DebianVersion _ v2) = compare v1 v2
-- * Ord instance
-- make ~ less than everything, and everything else higher that letters
order :: Char -> Int
order c
| isDigit c = 0
| isAlpha c = ord c
| c == '~' = -1
| otherwise = (ord c) + 256
-- |We have to do this wackiness because ~ is less than the empty string
compareNonNumeric :: [Char] -> [Char] -> Ordering
compareNonNumeric "" "" = EQ
compareNonNumeric "" ('~':_cs) = GT
compareNonNumeric ('~':_cs) "" = LT
compareNonNumeric "" _ = LT
compareNonNumeric _ "" = GT
compareNonNumeric (c1:cs1) (c2:cs2) =
if (order c1) == (order c2)
then compareNonNumeric cs1 cs2
else compare (order c1) (order c2)
instance Eq NonNumeric where
(NonNumeric s1 n1) == (NonNumeric s2 n2) =
case compareNonNumeric s1 s2 of
EQ -> n1 == n2
_o -> False
instance Ord NonNumeric where
compare (NonNumeric s1 n1) (NonNumeric s2 n2) =
case compareNonNumeric s1 s2 of
EQ -> compare n1 n2
o -> o
instance Eq Numeric where
(Numeric n1 mnn1) == (Numeric n2 mnn2) =
case compare n1 n2 of
EQ -> case compareMaybeNonNumeric mnn1 mnn2 of
EQ -> True
_ -> False
_ -> False
compareMaybeNonNumeric :: Maybe NonNumeric -> Maybe NonNumeric -> Ordering
compareMaybeNonNumeric mnn1 mnn2 =
case (mnn1, mnn2) of
(Nothing, Nothing) -> EQ
(Just (NonNumeric nn _), Nothing) -> compareNonNumeric nn ""
(Nothing, Just (NonNumeric nn _)) -> compareNonNumeric "" nn
(Just nn1, Just nn2) -> compare nn1 nn2
instance Ord Numeric where
compare (Numeric n1 mnn1) (Numeric n2 mnn2) =
case compare n1 n2 of
EQ -> compareMaybeNonNumeric mnn1 mnn2
o -> o
-- * Parser
class ParseDebianVersion a where
parseDebianVersion :: a-> 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?
{-
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 =
do skipMany $ oneOf " \t"
e <- parseEpoch
upstreamVersion <- parseNonNumeric True True
debianRevision <- option (Simulated (NonNumeric "" (Simulated (Numeric 0 Nothing)))) (char '-' >> parseNonNumeric True False >>= return . Found)
return (e, upstreamVersion, debianRevision)
parseEpoch :: CharParser () (Found Int)
parseEpoch =
option (Simulated 0) (try (many1 digit >>= \d -> char ':' >> return (Found (read d))))
parseNonNumeric :: Bool -> Bool -> CharParser () NonNumeric
parseNonNumeric zeroOk upstream =
do nn <- (if zeroOk then many else many1) ((noneOf "-0123456789") <|> (if upstream then upstreamDash else pzero))
n <- parseNumeric upstream
return $ NonNumeric nn n
where
upstreamDash :: CharParser () Char
upstreamDash = try $ do char '-'
lookAhead $ (many (noneOf "- \n\t") >> char '-')
return '-'
parseNumeric :: Bool -> CharParser () (Found Numeric)
parseNumeric upstream =
do n <- many1 (satisfy isDigit)
nn <- option Nothing (parseNonNumeric False upstream >>= return . Just)
return $ Found (Numeric (read n) nn)
<|>
return (Simulated (Numeric 0 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 s _) =
let re = mkRegex "^(([0-9]+):)?(([^-]*)|((.*)-([^-]*)))$" in
-- ( ) ( ( ))
-- ( e ) ( v ) (v2) ( r )
case matchRegex re s of
Just ["", _, _, v, "", _, _] -> (Nothing, v, Nothing)
Just ["", _, _, _, _, v, r] -> (Nothing, v, Just r)
Just [_, e, _, v, "", _, _] -> (Just (read e), v, Nothing)
Just [_, e, _, _, _, v, r] -> (Just (read e), v, Just r)
-- I really don't think this can happen.
_ -> error ("Invalid Debian Version String: " ++ s)
epoch :: DebianVersion -> Maybe Int
epoch v = case evr v of (x, _, _) -> x
version :: DebianVersion -> String
version v = case evr v of (_, x, _) -> x
revision :: DebianVersion -> Maybe String
revision v = case evr v of (_, _, x) -> x
-- Build a Debian version number from epoch, version, revision
buildDebianVersion :: Maybe Int -> String -> Maybe String -> DebianVersion
buildDebianVersion e v r =
either (error . show) (DebianVersion str) $ parse parseDV str str
where
str = (maybe "" (\ n -> show n ++ ":") e ++ v ++ maybe "" (\ s -> "-" ++ s) r)
|
