{-# LANGUAGE FlexibleInstances, PackageImports, TypeSynonymInstances #-}
{-# OPTIONS -fno-warn-unused-do-bind -fno-warn-orphans #-}
-- |A module for working with debian relationships <http://www.debian.org/doc/debian-policy/ch-relationships.html>
module Debian.Relation.String
    ( -- * Types
      AndRelation
    , OrRelation
    , Relations
    , Relation(..)
    , ArchitectureReq(..)
    , VersionReq(..)
    -- * Helper Functions
    , checkVersionReq
    -- * Relation Parser
    , RelParser
    , ParseRelations(..)
    , pRelations
    ) where

-- Standard GHC Modules

import "mtl" Control.Monad.Identity (Identity)
import Data.Set (fromList)
import Text.ParserCombinators.Parsec
import Text.Parsec.Prim (ParsecT)

-- Local Modules

import Debian.Arch (Arch, parseArch)
import Debian.Relation.Common
import Debian.Version

-- * ParseRelations

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

-- * 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 :: RelParser Relations
pRelations = do -- rel <- sepBy pOrRelation (char ',')
                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

-- 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 :: 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)

-- | Ignore the ! if it is present, we already know this list has at
-- least one, and the rest are implicit.
parseArchExcept :: String -> Arch
parseArchExcept :: [Char] -> Arch
parseArchExcept (Char
'!' : [Char]
s) = [Char] -> Arch
parseArch [Char]
s
parseArchExcept [Char]
s = [Char] -> Arch
parseArch [Char]
s