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
|
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-- |A module for working with debian relationships <http://www.debian.org/doc/debian-policy/ch-relationships.html>
module Debian.Relation.String
( -- * Types
PkgName
, AndRelation
, OrRelation
, Relations
, Relation(..)
, ArchitectureReq(..)
, VersionReq(..)
-- * Helper Functions
, checkVersionReq
-- * Relation Parser
, RelParser
, ParseRelations(..)
, pRelations
) where
-- Standard GHC Modules
import Text.ParserCombinators.Parsec
-- Local Modules
import Debian.Relation.Common
import Debian.Version
-- * ParseRelations
instance ParseRelations String where
parseRelations str =
let str' = scrub str in
case parse pRelations str' str' of
Right relations -> Right (filter (/= []) relations)
x -> x
where
scrub = unlines . filter (not . comment) . lines
comment s = case dropWhile (`elem` " \t") s of
('#' : _) -> True
_ -> False
-- * Relation Parser
type RelParser a = CharParser () a
-- "Correct" dependency lists are separated by commas, but sometimes they
-- are omitted and it is possible to parse relations without them.
pRelations :: RelParser Relations
pRelations = do -- rel <- sepBy pOrRelation (char ',')
rel <- many pOrRelation
eof
return rel
pOrRelation :: RelParser OrRelation
pOrRelation = do skipMany (char ',' <|> whiteChar)
rel <- sepBy1 pRelation (char '|')
skipMany (char ',' <|> whiteChar)
return rel
whiteChar = oneOf [' ','\t','\n']
pRelation :: RelParser Relation
pRelation =
do skipMany whiteChar
pkgName <- many1 (noneOf [' ',',','|','\t','\n','('])
skipMany whiteChar
mVerReq <- pMaybeVerReq
skipMany whiteChar
mArch <- pMaybeArch
return $ Rel (BinPkgName (PkgName pkgName)) mVerReq mArch
pMaybeVerReq :: RelParser (Maybe VersionReq)
pMaybeVerReq =
do char '('
skipMany whiteChar
op <- pVerReq
skipMany whiteChar
version <- many1 (noneOf [' ',')','\t','\n'])
skipMany whiteChar
char ')'
return $ Just (op (parseDebianVersion version))
<|>
do return $ Nothing
pVerReq =
do char '<'
(do char '<' <|> char ' ' <|> char '\t'
return $ SLT
<|>
do char '='
return $ LTE)
<|>
do string "="
return $ EEQ
<|>
do char '>'
(do char '='
return $ GRE
<|>
do char '>' <|> char ' ' <|> char '\t'
return $ SGR)
pMaybeArch :: RelParser (Maybe ArchitectureReq)
pMaybeArch =
do char '['
(do archs <- pArchExcept
char ']'
skipMany whiteChar
return (Just (ArchExcept archs))
<|>
do archs <- pArchOnly
char ']'
skipMany whiteChar
return (Just (ArchOnly archs))
)
<|>
return Nothing
-- Some packages (e.g. coreutils) have architecture specs like [!i386
-- !hppa], even though this doesn't really make sense: once you have
-- one !, anything else you include must also be (implicitly) a !.
pArchExcept :: RelParser [String]
pArchExcept = sepBy (char '!' >> many1 (noneOf [']',' '])) (skipMany1 whiteChar)
pArchOnly :: RelParser [String]
pArchOnly = sepBy (many1 (noneOf [']',' '])) (skipMany1 whiteChar)
|