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