{-# LANGUAGE FlexibleInstances, PackageImports, TypeSynonymInstances #-}
{-# OPTIONS -fno-warn-unused-do-bind -fno-warn-orphans #-}
module Debian.Relation.String
(
AndRelation
, OrRelation
, Relations
, Relation(..)
, ArchitectureReq(..)
, VersionReq(..)
, checkVersionReq
, RelParser
, ParseRelations(..)
, pRelations
) where
import "mtl" Control.Monad.Identity (Identity)
import Data.Set (fromList)
import Text.ParserCombinators.Parsec
import Text.Parsec.Prim (ParsecT)
import Debian.Arch (Arch, parseArch)
import Debian.Relation.Common
import Debian.Version
instance ParseRelations String where
parseRelations :: [Char] -> Either ParseError Relations
parseRelations [Char]
str =
let str' :: [Char]
str' = [Char] -> [Char]
scrub [Char]
str in
case forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse RelParser Relations
pRelations [Char]
str' [Char]
str' of
Right Relations
relations -> forall a b. b -> Either a b
Right (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= []) Relations
relations)
Either ParseError Relations
x -> Either ParseError Relations
x
where
scrub :: [Char] -> [Char]
scrub = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
comment) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
comment :: [Char] -> Bool
comment [Char]
s = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ', Char
'\t']) [Char]
s of
(Char
'#' : [Char]
_) -> Bool
True
[Char]
_ -> Bool
False
type RelParser a = CharParser () a
pRelations :: RelParser Relations
pRelations :: RelParser Relations
pRelations = do
Relations
rel <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many RelParser OrRelation
pOrRelation
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) a. Monad m => a -> m a
return Relations
rel
pOrRelation :: RelParser OrRelation
pOrRelation :: RelParser OrRelation
pOrRelation = do forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall u. ParsecT [Char] u Identity Char
whiteChar)
OrRelation
rel <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 RelParser Relation
pRelation (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall u. ParsecT [Char] u Identity Char
whiteChar)
forall (m :: * -> *) a. Monad m => a -> m a
return OrRelation
rel
whiteChar :: ParsecT String u Identity Char
whiteChar :: forall u. ParsecT [Char] u Identity Char
whiteChar = forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char
' ',Char
'\t',Char
'\n']
pRelation :: RelParser Relation
pRelation :: RelParser Relation
pRelation =
do forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall u. ParsecT [Char] u Identity Char
whiteChar
[Char]
pkgName <- 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
' ',Char
',',Char
'|',Char
'\t',Char
'\n',Char
'('])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall u. ParsecT [Char] u Identity Char
whiteChar
Maybe VersionReq
mVerReq <- RelParser (Maybe VersionReq)
pMaybeVerReq
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall u. ParsecT [Char] u Identity Char
whiteChar
Maybe ArchitectureReq
mArch <- RelParser (Maybe ArchitectureReq)
pMaybeArch
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
Rel ([Char] -> BinPkgName
BinPkgName [Char]
pkgName) Maybe VersionReq
mVerReq Maybe ArchitectureReq
mArch
pMaybeVerReq :: RelParser (Maybe VersionReq)
pMaybeVerReq :: RelParser (Maybe VersionReq)
pMaybeVerReq =
do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall u. ParsecT [Char] u Identity Char
whiteChar
DebianVersion -> VersionReq
op <- forall u. ParsecT [Char] u Identity (DebianVersion -> VersionReq)
pVerReq
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall u. ParsecT [Char] u Identity Char
whiteChar
[Char]
ver <- 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
' ',Char
')',Char
'\t',Char
'\n'])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall u. ParsecT [Char] u Identity Char
whiteChar
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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (DebianVersion -> VersionReq
op (forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' [Char]
ver))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
do forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing
pVerReq :: ParsecT [Char] u Identity (DebianVersion -> VersionReq)
pVerReq :: forall u. ParsecT [Char] u Identity (DebianVersion -> VersionReq)
pVerReq =
do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
(do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\t'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DebianVersion -> VersionReq
SLT
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
do 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 forall a b. (a -> b) -> a -> b
$ DebianVersion -> VersionReq
LTE)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
do forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"="
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DebianVersion -> VersionReq
EEQ
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
(do 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 forall a b. (a -> b) -> a -> b
$ DebianVersion -> VersionReq
GRE
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\t'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DebianVersion -> VersionReq
SGR)
pMaybeArch :: RelParser (Maybe ArchitectureReq)
pMaybeArch :: RelParser (Maybe ArchitectureReq)
pMaybeArch =
do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
(do [[Char]]
archs <- RelParser [[Char]]
pArchExcept
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall u. ParsecT [Char] u Identity Char
whiteChar
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Set Arch -> ArchitectureReq
ArchExcept (forall a. Ord a => [a] -> Set a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Arch
parseArchExcept forall a b. (a -> b) -> a -> b
$ [[Char]]
archs)))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
do [[Char]]
archs <- RelParser [[Char]]
pArchOnly
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall u. ParsecT [Char] u Identity Char
whiteChar
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Set Arch -> ArchitectureReq
ArchOnly (forall a. Ord a => [a] -> Set a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Arch
parseArch forall a b. (a -> b) -> a -> b
$ [[Char]]
archs)))
)
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. Maybe a
Nothing
pArchExcept :: RelParser [String]
pArchExcept :: RelParser [[Char]]
pArchExcept = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (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 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
']',Char
' '])) (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall u. ParsecT [Char] u Identity Char
whiteChar)
pArchOnly :: RelParser [String]
pArchOnly :: RelParser [[Char]]
pArchOnly = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (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
']',Char
' '])) (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall u. ParsecT [Char] u Identity Char
whiteChar)
parseArchExcept :: String -> Arch
parseArchExcept :: [Char] -> Arch
parseArchExcept (Char
'!' : [Char]
s) = [Char] -> Arch
parseArch [Char]
s
parseArchExcept [Char]
s = [Char] -> Arch
parseArch [Char]
s