{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-}
module Debian.Relation.Common where

-- Standard GHC Modules

import Data.Data (Data)
import Data.List as List (map, intersperse)
import Data.Monoid (mconcat, (<>))
import Data.Function
import Data.Set as Set (Set, toList)
import Data.Typeable (Typeable)
import Debian.Arch (Arch, prettyArch)
import Debian.Pretty (PP(..))
import Prelude hiding (map)
import Text.ParserCombinators.Parsec
import Text.PrettyPrint (Doc, text, empty)
import Distribution.Pretty (Pretty(pretty))

-- Local Modules

import Debian.Version

-- Datatype for relations

type Relations = AndRelation
type AndRelation = [OrRelation]
type OrRelation = [Relation]

data Relation = Rel BinPkgName (Maybe VersionReq) (Maybe ArchitectureReq) deriving (Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, ReadPrec [Relation]
ReadPrec Relation
Int -> ReadS Relation
ReadS [Relation]
(Int -> ReadS Relation)
-> ReadS [Relation]
-> ReadPrec Relation
-> ReadPrec [Relation]
-> Read Relation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Relation]
$creadListPrec :: ReadPrec [Relation]
readPrec :: ReadPrec Relation
$creadPrec :: ReadPrec Relation
readList :: ReadS [Relation]
$creadList :: ReadS [Relation]
readsPrec :: Int -> ReadS Relation
$creadsPrec :: Int -> ReadS Relation
Read, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
(Int -> Relation -> ShowS)
-> (Relation -> String) -> ([Relation] -> ShowS) -> Show Relation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relation] -> ShowS
$cshowList :: [Relation] -> ShowS
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: Int -> Relation -> ShowS
$cshowsPrec :: Int -> Relation -> ShowS
Show)

newtype SrcPkgName = SrcPkgName {SrcPkgName -> String
unSrcPkgName :: String} deriving (ReadPrec [SrcPkgName]
ReadPrec SrcPkgName
Int -> ReadS SrcPkgName
ReadS [SrcPkgName]
(Int -> ReadS SrcPkgName)
-> ReadS [SrcPkgName]
-> ReadPrec SrcPkgName
-> ReadPrec [SrcPkgName]
-> Read SrcPkgName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SrcPkgName]
$creadListPrec :: ReadPrec [SrcPkgName]
readPrec :: ReadPrec SrcPkgName
$creadPrec :: ReadPrec SrcPkgName
readList :: ReadS [SrcPkgName]
$creadList :: ReadS [SrcPkgName]
readsPrec :: Int -> ReadS SrcPkgName
$creadsPrec :: Int -> ReadS SrcPkgName
Read, Int -> SrcPkgName -> ShowS
[SrcPkgName] -> ShowS
SrcPkgName -> String
(Int -> SrcPkgName -> ShowS)
-> (SrcPkgName -> String)
-> ([SrcPkgName] -> ShowS)
-> Show SrcPkgName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcPkgName] -> ShowS
$cshowList :: [SrcPkgName] -> ShowS
show :: SrcPkgName -> String
$cshow :: SrcPkgName -> String
showsPrec :: Int -> SrcPkgName -> ShowS
$cshowsPrec :: Int -> SrcPkgName -> ShowS
Show, SrcPkgName -> SrcPkgName -> Bool
(SrcPkgName -> SrcPkgName -> Bool)
-> (SrcPkgName -> SrcPkgName -> Bool) -> Eq SrcPkgName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcPkgName -> SrcPkgName -> Bool
$c/= :: SrcPkgName -> SrcPkgName -> Bool
== :: SrcPkgName -> SrcPkgName -> Bool
$c== :: SrcPkgName -> SrcPkgName -> Bool
Eq, Eq SrcPkgName
Eq SrcPkgName
-> (SrcPkgName -> SrcPkgName -> Ordering)
-> (SrcPkgName -> SrcPkgName -> Bool)
-> (SrcPkgName -> SrcPkgName -> Bool)
-> (SrcPkgName -> SrcPkgName -> Bool)
-> (SrcPkgName -> SrcPkgName -> Bool)
-> (SrcPkgName -> SrcPkgName -> SrcPkgName)
-> (SrcPkgName -> SrcPkgName -> SrcPkgName)
-> Ord SrcPkgName
SrcPkgName -> SrcPkgName -> Bool
SrcPkgName -> SrcPkgName -> Ordering
SrcPkgName -> SrcPkgName -> SrcPkgName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SrcPkgName -> SrcPkgName -> SrcPkgName
$cmin :: SrcPkgName -> SrcPkgName -> SrcPkgName
max :: SrcPkgName -> SrcPkgName -> SrcPkgName
$cmax :: SrcPkgName -> SrcPkgName -> SrcPkgName
>= :: SrcPkgName -> SrcPkgName -> Bool
$c>= :: SrcPkgName -> SrcPkgName -> Bool
> :: SrcPkgName -> SrcPkgName -> Bool
$c> :: SrcPkgName -> SrcPkgName -> Bool
<= :: SrcPkgName -> SrcPkgName -> Bool
$c<= :: SrcPkgName -> SrcPkgName -> Bool
< :: SrcPkgName -> SrcPkgName -> Bool
$c< :: SrcPkgName -> SrcPkgName -> Bool
compare :: SrcPkgName -> SrcPkgName -> Ordering
$ccompare :: SrcPkgName -> SrcPkgName -> Ordering
$cp1Ord :: Eq SrcPkgName
Ord, Typeable SrcPkgName
DataType
Constr
Typeable SrcPkgName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SrcPkgName -> c SrcPkgName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SrcPkgName)
-> (SrcPkgName -> Constr)
-> (SrcPkgName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SrcPkgName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SrcPkgName))
-> ((forall b. Data b => b -> b) -> SrcPkgName -> SrcPkgName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcPkgName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcPkgName -> r)
-> (forall u. (forall d. Data d => d -> u) -> SrcPkgName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SrcPkgName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName)
-> Data SrcPkgName
SrcPkgName -> DataType
SrcPkgName -> Constr
(forall b. Data b => b -> b) -> SrcPkgName -> SrcPkgName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcPkgName -> c SrcPkgName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcPkgName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SrcPkgName -> u
forall u. (forall d. Data d => d -> u) -> SrcPkgName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcPkgName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcPkgName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcPkgName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcPkgName -> c SrcPkgName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcPkgName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcPkgName)
$cSrcPkgName :: Constr
$tSrcPkgName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName
gmapMp :: (forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName
gmapM :: (forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcPkgName -> m SrcPkgName
gmapQi :: Int -> (forall d. Data d => d -> u) -> SrcPkgName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcPkgName -> u
gmapQ :: (forall d. Data d => d -> u) -> SrcPkgName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcPkgName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcPkgName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcPkgName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcPkgName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcPkgName -> r
gmapT :: (forall b. Data b => b -> b) -> SrcPkgName -> SrcPkgName
$cgmapT :: (forall b. Data b => b -> b) -> SrcPkgName -> SrcPkgName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcPkgName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcPkgName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SrcPkgName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcPkgName)
dataTypeOf :: SrcPkgName -> DataType
$cdataTypeOf :: SrcPkgName -> DataType
toConstr :: SrcPkgName -> Constr
$ctoConstr :: SrcPkgName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcPkgName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcPkgName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcPkgName -> c SrcPkgName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcPkgName -> c SrcPkgName
$cp1Data :: Typeable SrcPkgName
Data, Typeable)
newtype BinPkgName = BinPkgName {BinPkgName -> String
unBinPkgName :: String} deriving (ReadPrec [BinPkgName]
ReadPrec BinPkgName
Int -> ReadS BinPkgName
ReadS [BinPkgName]
(Int -> ReadS BinPkgName)
-> ReadS [BinPkgName]
-> ReadPrec BinPkgName
-> ReadPrec [BinPkgName]
-> Read BinPkgName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinPkgName]
$creadListPrec :: ReadPrec [BinPkgName]
readPrec :: ReadPrec BinPkgName
$creadPrec :: ReadPrec BinPkgName
readList :: ReadS [BinPkgName]
$creadList :: ReadS [BinPkgName]
readsPrec :: Int -> ReadS BinPkgName
$creadsPrec :: Int -> ReadS BinPkgName
Read, Int -> BinPkgName -> ShowS
[BinPkgName] -> ShowS
BinPkgName -> String
(Int -> BinPkgName -> ShowS)
-> (BinPkgName -> String)
-> ([BinPkgName] -> ShowS)
-> Show BinPkgName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinPkgName] -> ShowS
$cshowList :: [BinPkgName] -> ShowS
show :: BinPkgName -> String
$cshow :: BinPkgName -> String
showsPrec :: Int -> BinPkgName -> ShowS
$cshowsPrec :: Int -> BinPkgName -> ShowS
Show, BinPkgName -> BinPkgName -> Bool
(BinPkgName -> BinPkgName -> Bool)
-> (BinPkgName -> BinPkgName -> Bool) -> Eq BinPkgName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinPkgName -> BinPkgName -> Bool
$c/= :: BinPkgName -> BinPkgName -> Bool
== :: BinPkgName -> BinPkgName -> Bool
$c== :: BinPkgName -> BinPkgName -> Bool
Eq, Eq BinPkgName
Eq BinPkgName
-> (BinPkgName -> BinPkgName -> Ordering)
-> (BinPkgName -> BinPkgName -> Bool)
-> (BinPkgName -> BinPkgName -> Bool)
-> (BinPkgName -> BinPkgName -> Bool)
-> (BinPkgName -> BinPkgName -> Bool)
-> (BinPkgName -> BinPkgName -> BinPkgName)
-> (BinPkgName -> BinPkgName -> BinPkgName)
-> Ord BinPkgName
BinPkgName -> BinPkgName -> Bool
BinPkgName -> BinPkgName -> Ordering
BinPkgName -> BinPkgName -> BinPkgName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BinPkgName -> BinPkgName -> BinPkgName
$cmin :: BinPkgName -> BinPkgName -> BinPkgName
max :: BinPkgName -> BinPkgName -> BinPkgName
$cmax :: BinPkgName -> BinPkgName -> BinPkgName
>= :: BinPkgName -> BinPkgName -> Bool
$c>= :: BinPkgName -> BinPkgName -> Bool
> :: BinPkgName -> BinPkgName -> Bool
$c> :: BinPkgName -> BinPkgName -> Bool
<= :: BinPkgName -> BinPkgName -> Bool
$c<= :: BinPkgName -> BinPkgName -> Bool
< :: BinPkgName -> BinPkgName -> Bool
$c< :: BinPkgName -> BinPkgName -> Bool
compare :: BinPkgName -> BinPkgName -> Ordering
$ccompare :: BinPkgName -> BinPkgName -> Ordering
$cp1Ord :: Eq BinPkgName
Ord, Typeable BinPkgName
DataType
Constr
Typeable BinPkgName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BinPkgName -> c BinPkgName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BinPkgName)
-> (BinPkgName -> Constr)
-> (BinPkgName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BinPkgName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BinPkgName))
-> ((forall b. Data b => b -> b) -> BinPkgName -> BinPkgName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BinPkgName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BinPkgName -> r)
-> (forall u. (forall d. Data d => d -> u) -> BinPkgName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BinPkgName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName)
-> Data BinPkgName
BinPkgName -> DataType
BinPkgName -> Constr
(forall b. Data b => b -> b) -> BinPkgName -> BinPkgName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinPkgName -> c BinPkgName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinPkgName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BinPkgName -> u
forall u. (forall d. Data d => d -> u) -> BinPkgName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinPkgName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinPkgName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinPkgName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinPkgName -> c BinPkgName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinPkgName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinPkgName)
$cBinPkgName :: Constr
$tBinPkgName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName
gmapMp :: (forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName
gmapM :: (forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinPkgName -> m BinPkgName
gmapQi :: Int -> (forall d. Data d => d -> u) -> BinPkgName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BinPkgName -> u
gmapQ :: (forall d. Data d => d -> u) -> BinPkgName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BinPkgName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinPkgName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinPkgName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinPkgName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinPkgName -> r
gmapT :: (forall b. Data b => b -> b) -> BinPkgName -> BinPkgName
$cgmapT :: (forall b. Data b => b -> b) -> BinPkgName -> BinPkgName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinPkgName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinPkgName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BinPkgName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinPkgName)
dataTypeOf :: BinPkgName -> DataType
$cdataTypeOf :: BinPkgName -> DataType
toConstr :: BinPkgName -> Constr
$ctoConstr :: BinPkgName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinPkgName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinPkgName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinPkgName -> c BinPkgName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinPkgName -> c BinPkgName
$cp1Data :: Typeable BinPkgName
Data, Typeable)

class Pretty (PP a) => PkgName a where
    pkgNameFromString :: String -> a

instance PkgName BinPkgName where
    pkgNameFromString :: String -> BinPkgName
pkgNameFromString = String -> BinPkgName
BinPkgName

instance PkgName SrcPkgName where
    pkgNameFromString :: String -> SrcPkgName
pkgNameFromString = String -> SrcPkgName
SrcPkgName

class ParseRelations a where
    -- |'parseRelations' parse a debian relation (i.e. the value of a
    -- Depends field). Return a parsec error or a value of type
    -- 'Relations'
    parseRelations :: a -> Either ParseError Relations

-- | This needs to be indented for use in a control file: intercalate "\n     " . lines . show
prettyRelations :: [[Relation]] -> Doc
prettyRelations :: [[Relation]] -> Doc
prettyRelations [[Relation]]
xss = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> ([[Relation]] -> [Doc]) -> [[Relation]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
"\n, ") ([Doc] -> [Doc])
-> ([[Relation]] -> [Doc]) -> [[Relation]] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Relation] -> Doc) -> [[Relation]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
List.map [Relation] -> Doc
prettyOrRelation ([[Relation]] -> Doc) -> [[Relation]] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Relation]]
xss

prettyOrRelation :: [Relation] -> Doc
prettyOrRelation :: [Relation] -> Doc
prettyOrRelation [Relation]
xs = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> ([Relation] -> [Doc]) -> [Relation] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
" | ") ([Doc] -> [Doc]) -> ([Relation] -> [Doc]) -> [Relation] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relation -> Doc) -> [Relation] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
List.map Relation -> Doc
prettyRelation ([Relation] -> Doc) -> [Relation] -> Doc
forall a b. (a -> b) -> a -> b
$ [Relation]
xs

prettyRelation :: Relation -> Doc
prettyRelation :: Relation -> Doc
prettyRelation (Rel BinPkgName
name Maybe VersionReq
ver Maybe ArchitectureReq
arch) =
    PP BinPkgName -> Doc
forall a. Pretty a => a -> Doc
pretty (BinPkgName -> PP BinPkgName
forall a. a -> PP a
PP BinPkgName
name) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> (VersionReq -> Doc) -> Maybe VersionReq -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty VersionReq -> Doc
prettyVersionReq Maybe VersionReq
ver Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> (ArchitectureReq -> Doc) -> Maybe ArchitectureReq -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty ArchitectureReq -> Doc
prettyArchitectureReq Maybe ArchitectureReq
arch

instance Ord Relation where
    compare :: Relation -> Relation -> Ordering
compare (Rel BinPkgName
pkgName1 Maybe VersionReq
mVerReq1 Maybe ArchitectureReq
_mArch1) (Rel BinPkgName
pkgName2 Maybe VersionReq
mVerReq2 Maybe ArchitectureReq
_mArch2) =
        case BinPkgName -> BinPkgName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare BinPkgName
pkgName1 BinPkgName
pkgName2 of
             Ordering
LT -> Ordering
LT
             Ordering
GT -> Ordering
GT
             Ordering
EQ -> Maybe VersionReq -> Maybe VersionReq -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe VersionReq
mVerReq1 Maybe VersionReq
mVerReq2

data ArchitectureReq
    = ArchOnly (Set Arch)
    | ArchExcept (Set Arch)
    deriving (ArchitectureReq -> ArchitectureReq -> Bool
(ArchitectureReq -> ArchitectureReq -> Bool)
-> (ArchitectureReq -> ArchitectureReq -> Bool)
-> Eq ArchitectureReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArchitectureReq -> ArchitectureReq -> Bool
$c/= :: ArchitectureReq -> ArchitectureReq -> Bool
== :: ArchitectureReq -> ArchitectureReq -> Bool
$c== :: ArchitectureReq -> ArchitectureReq -> Bool
Eq, Eq ArchitectureReq
Eq ArchitectureReq
-> (ArchitectureReq -> ArchitectureReq -> Ordering)
-> (ArchitectureReq -> ArchitectureReq -> Bool)
-> (ArchitectureReq -> ArchitectureReq -> Bool)
-> (ArchitectureReq -> ArchitectureReq -> Bool)
-> (ArchitectureReq -> ArchitectureReq -> Bool)
-> (ArchitectureReq -> ArchitectureReq -> ArchitectureReq)
-> (ArchitectureReq -> ArchitectureReq -> ArchitectureReq)
-> Ord ArchitectureReq
ArchitectureReq -> ArchitectureReq -> Bool
ArchitectureReq -> ArchitectureReq -> Ordering
ArchitectureReq -> ArchitectureReq -> ArchitectureReq
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArchitectureReq -> ArchitectureReq -> ArchitectureReq
$cmin :: ArchitectureReq -> ArchitectureReq -> ArchitectureReq
max :: ArchitectureReq -> ArchitectureReq -> ArchitectureReq
$cmax :: ArchitectureReq -> ArchitectureReq -> ArchitectureReq
>= :: ArchitectureReq -> ArchitectureReq -> Bool
$c>= :: ArchitectureReq -> ArchitectureReq -> Bool
> :: ArchitectureReq -> ArchitectureReq -> Bool
$c> :: ArchitectureReq -> ArchitectureReq -> Bool
<= :: ArchitectureReq -> ArchitectureReq -> Bool
$c<= :: ArchitectureReq -> ArchitectureReq -> Bool
< :: ArchitectureReq -> ArchitectureReq -> Bool
$c< :: ArchitectureReq -> ArchitectureReq -> Bool
compare :: ArchitectureReq -> ArchitectureReq -> Ordering
$ccompare :: ArchitectureReq -> ArchitectureReq -> Ordering
$cp1Ord :: Eq ArchitectureReq
Ord, ReadPrec [ArchitectureReq]
ReadPrec ArchitectureReq
Int -> ReadS ArchitectureReq
ReadS [ArchitectureReq]
(Int -> ReadS ArchitectureReq)
-> ReadS [ArchitectureReq]
-> ReadPrec ArchitectureReq
-> ReadPrec [ArchitectureReq]
-> Read ArchitectureReq
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArchitectureReq]
$creadListPrec :: ReadPrec [ArchitectureReq]
readPrec :: ReadPrec ArchitectureReq
$creadPrec :: ReadPrec ArchitectureReq
readList :: ReadS [ArchitectureReq]
$creadList :: ReadS [ArchitectureReq]
readsPrec :: Int -> ReadS ArchitectureReq
$creadsPrec :: Int -> ReadS ArchitectureReq
Read, Int -> ArchitectureReq -> ShowS
[ArchitectureReq] -> ShowS
ArchitectureReq -> String
(Int -> ArchitectureReq -> ShowS)
-> (ArchitectureReq -> String)
-> ([ArchitectureReq] -> ShowS)
-> Show ArchitectureReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArchitectureReq] -> ShowS
$cshowList :: [ArchitectureReq] -> ShowS
show :: ArchitectureReq -> String
$cshow :: ArchitectureReq -> String
showsPrec :: Int -> ArchitectureReq -> ShowS
$cshowsPrec :: Int -> ArchitectureReq -> ShowS
Show)

prettyArchitectureReq :: ArchitectureReq -> Doc
prettyArchitectureReq :: ArchitectureReq -> Doc
prettyArchitectureReq (ArchOnly Set Arch
arch) = String -> Doc
text String
" [" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((Arch -> Doc) -> [Arch] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
List.map Arch -> Doc
prettyArch (Set Arch -> [Arch]
forall a. Set a -> [a]
toList Set Arch
arch)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"
prettyArchitectureReq (ArchExcept Set Arch
arch) = String -> Doc
text String
" [" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
List.map ((String -> Doc
text String
"!") Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) ((Arch -> Doc) -> [Arch] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
List.map Arch -> Doc
prettyArch (Set Arch -> [Arch]
forall a. Set a -> [a]
toList Set Arch
arch))) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"

data VersionReq
    = SLT DebianVersion
    | LTE DebianVersion
    | EEQ  DebianVersion
    | GRE  DebianVersion
    | SGR DebianVersion
      deriving (VersionReq -> VersionReq -> Bool
(VersionReq -> VersionReq -> Bool)
-> (VersionReq -> VersionReq -> Bool) -> Eq VersionReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionReq -> VersionReq -> Bool
$c/= :: VersionReq -> VersionReq -> Bool
== :: VersionReq -> VersionReq -> Bool
$c== :: VersionReq -> VersionReq -> Bool
Eq, ReadPrec [VersionReq]
ReadPrec VersionReq
Int -> ReadS VersionReq
ReadS [VersionReq]
(Int -> ReadS VersionReq)
-> ReadS [VersionReq]
-> ReadPrec VersionReq
-> ReadPrec [VersionReq]
-> Read VersionReq
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VersionReq]
$creadListPrec :: ReadPrec [VersionReq]
readPrec :: ReadPrec VersionReq
$creadPrec :: ReadPrec VersionReq
readList :: ReadS [VersionReq]
$creadList :: ReadS [VersionReq]
readsPrec :: Int -> ReadS VersionReq
$creadsPrec :: Int -> ReadS VersionReq
Read, Int -> VersionReq -> ShowS
[VersionReq] -> ShowS
VersionReq -> String
(Int -> VersionReq -> ShowS)
-> (VersionReq -> String)
-> ([VersionReq] -> ShowS)
-> Show VersionReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionReq] -> ShowS
$cshowList :: [VersionReq] -> ShowS
show :: VersionReq -> String
$cshow :: VersionReq -> String
showsPrec :: Int -> VersionReq -> ShowS
$cshowsPrec :: Int -> VersionReq -> ShowS
Show)

prettyVersionReq :: VersionReq -> Doc
prettyVersionReq :: VersionReq -> Doc
prettyVersionReq (SLT DebianVersion
v) = String -> Doc
text String
" (<< " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DebianVersion -> Doc
prettyDebianVersion DebianVersion
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
prettyVersionReq (LTE DebianVersion
v) = String -> Doc
text String
" (<= " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DebianVersion -> Doc
prettyDebianVersion DebianVersion
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
prettyVersionReq (EEQ DebianVersion
v) = String -> Doc
text String
" (= " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DebianVersion -> Doc
prettyDebianVersion DebianVersion
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
prettyVersionReq (GRE DebianVersion
v) = String -> Doc
text String
" (>= " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DebianVersion -> Doc
prettyDebianVersion DebianVersion
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
prettyVersionReq (SGR DebianVersion
v) = String -> Doc
text String
" (>> " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DebianVersion -> Doc
prettyDebianVersion DebianVersion
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"

-- |The sort order is based on version number first, then on the kind of
-- relation, sorting in the order <<, <= , ==, >= , >>
instance Ord VersionReq where
    compare :: VersionReq -> VersionReq -> Ordering
compare = (DebianVersion, Int) -> (DebianVersion, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((DebianVersion, Int) -> (DebianVersion, Int) -> Ordering)
-> (VersionReq -> (DebianVersion, Int))
-> VersionReq
-> VersionReq
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` VersionReq -> (DebianVersion, Int)
extr
      where extr :: VersionReq -> (DebianVersion, Int)
extr (SLT DebianVersion
v) = (DebianVersion
v,Int
0 :: Int)
            extr (LTE DebianVersion
v) = (DebianVersion
v,Int
1 :: Int)
            extr (EEQ DebianVersion
v) = (DebianVersion
v,Int
2 :: Int)
            extr (GRE DebianVersion
v) = (DebianVersion
v,Int
3 :: Int)
            extr (SGR DebianVersion
v) = (DebianVersion
v,Int
4 :: Int)

-- |Check if a version number satisfies a version requirement.
checkVersionReq :: Maybe VersionReq -> Maybe DebianVersion -> Bool
checkVersionReq :: Maybe VersionReq -> Maybe DebianVersion -> Bool
checkVersionReq Maybe VersionReq
Nothing Maybe DebianVersion
_ = Bool
True
checkVersionReq Maybe VersionReq
_ Maybe DebianVersion
Nothing = Bool
False
checkVersionReq (Just (SLT DebianVersion
v1)) (Just DebianVersion
v2) = DebianVersion
v2 DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
< DebianVersion
v1
checkVersionReq (Just (LTE DebianVersion
v1)) (Just DebianVersion
v2) = DebianVersion
v2 DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
<= DebianVersion
v1
checkVersionReq (Just (EEQ DebianVersion
v1)) (Just DebianVersion
v2) = DebianVersion
v2 DebianVersion -> DebianVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DebianVersion
v1
checkVersionReq (Just (GRE DebianVersion
v1)) (Just DebianVersion
v2) = DebianVersion
v2 DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= DebianVersion
v1
checkVersionReq (Just (SGR DebianVersion
v1)) (Just DebianVersion
v2) = DebianVersion
v2 DebianVersion -> DebianVersion -> Bool
forall a. Ord a => a -> a -> Bool
> DebianVersion
v1

instance Pretty (PP BinPkgName) where
    pretty :: PP BinPkgName -> Doc
pretty = String -> Doc
text (String -> Doc)
-> (PP BinPkgName -> String) -> PP BinPkgName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> String
unBinPkgName (BinPkgName -> String)
-> (PP BinPkgName -> BinPkgName) -> PP BinPkgName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP BinPkgName -> BinPkgName
forall a. PP a -> a
unPP

instance Pretty (PP SrcPkgName) where
    pretty :: PP SrcPkgName -> Doc
pretty = String -> Doc
text (String -> Doc)
-> (PP SrcPkgName -> String) -> PP SrcPkgName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcPkgName -> String
unSrcPkgName (SrcPkgName -> String)
-> (PP SrcPkgName -> SrcPkgName) -> PP SrcPkgName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP SrcPkgName -> SrcPkgName
forall a. PP a -> a
unPP

-- | Wrap `PP` around type synonyms that might overlap with the
-- `Pretty [a]` instance.
instance Pretty (PP Relations) where
    pretty :: PP [[Relation]] -> Doc
pretty = [[Relation]] -> Doc
prettyRelations ([[Relation]] -> Doc)
-> (PP [[Relation]] -> [[Relation]]) -> PP [[Relation]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP [[Relation]] -> [[Relation]]
forall a. PP a -> a
unPP

instance Pretty (PP OrRelation) where
    pretty :: PP [Relation] -> Doc
pretty = [Relation] -> Doc
prettyOrRelation ([Relation] -> Doc)
-> (PP [Relation] -> [Relation]) -> PP [Relation] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP [Relation] -> [Relation]
forall a. PP a -> a
unPP

instance Pretty (PP Relation) where
    pretty :: PP Relation -> Doc
pretty = Relation -> Doc
prettyRelation (Relation -> Doc)
-> (PP Relation -> Relation) -> PP Relation -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP Relation -> Relation
forall a. PP a -> a
unPP

instance Pretty (PP VersionReq) where
    pretty :: PP VersionReq -> Doc
pretty = VersionReq -> Doc
prettyVersionReq (VersionReq -> Doc)
-> (PP VersionReq -> VersionReq) -> PP VersionReq -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP VersionReq -> VersionReq
forall a. PP a -> a
unPP

instance Pretty (PP ArchitectureReq) where
    pretty :: PP ArchitectureReq -> Doc
pretty = ArchitectureReq -> Doc
prettyArchitectureReq (ArchitectureReq -> Doc)
-> (PP ArchitectureReq -> ArchitectureReq)
-> PP ArchitectureReq
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP ArchitectureReq -> ArchitectureReq
forall a. PP a -> a
unPP