{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell #-}
{-# OPTIONS -Wall #-}
module Debian.Debianize.BinaryDebDescription
    ( Canonical(canonical)
    , BinaryDebDescription
    , newBinaryDebDescription
    , package
    , multiArch
    , description
    , packageType
    , architecture
    , binarySection
    , binaryPriority
    , essential
    , relations

    , PackageType(..)

    , PackageRelations
    , newPackageRelations
    , depends
    , recommends
    , suggests
    , preDepends
    , breaks
    , conflicts
    , provides
    , replaces
    , builtUsing
    ) where

import Data.Function (on)
import Data.Generics (Data, Typeable)
import Control.Lens.TH (makeLenses)
import Data.List (sort, sortBy)
import Data.Text (Text)
import Debian.Policy (PackageArchitectures, PackagePriority, Section, MultiArch)
import Debian.Relation (BinPkgName, Relations)
import Prelude hiding ((.))

class Canonical a where
    canonical :: a -> a

-- | This type represents a section of the control file other than the
-- first, which in turn represent one of the binary packages or debs
-- produced by this debianization.
data BinaryDebDescription
    = BinaryDebDescription
      { BinaryDebDescription -> BinPkgName
_package :: BinPkgName
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Package>
      , BinaryDebDescription -> Maybe PackageType
_packageType :: Maybe PackageType
      , BinaryDebDescription -> Maybe PackageArchitectures
_architecture :: Maybe PackageArchitectures
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Architecture>
      , BinaryDebDescription -> Maybe Section
_binarySection :: Maybe Section
      , BinaryDebDescription -> Maybe PackagePriority
_binaryPriority :: Maybe PackagePriority
      , BinaryDebDescription -> Maybe MultiArch
_multiArch :: Maybe MultiArch
      , BinaryDebDescription -> Maybe Bool
_essential :: Maybe Bool
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Essential>
      , BinaryDebDescription -> Maybe Text
_description :: Maybe Text
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Description>
      , BinaryDebDescription -> PackageRelations
_relations :: PackageRelations
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.6.10>
      } deriving (BinaryDebDescription -> BinaryDebDescription -> Bool
(BinaryDebDescription -> BinaryDebDescription -> Bool)
-> (BinaryDebDescription -> BinaryDebDescription -> Bool)
-> Eq BinaryDebDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinaryDebDescription -> BinaryDebDescription -> Bool
== :: BinaryDebDescription -> BinaryDebDescription -> Bool
$c/= :: BinaryDebDescription -> BinaryDebDescription -> Bool
/= :: BinaryDebDescription -> BinaryDebDescription -> Bool
Eq, Eq BinaryDebDescription
Eq BinaryDebDescription =>
(BinaryDebDescription -> BinaryDebDescription -> Ordering)
-> (BinaryDebDescription -> BinaryDebDescription -> Bool)
-> (BinaryDebDescription -> BinaryDebDescription -> Bool)
-> (BinaryDebDescription -> BinaryDebDescription -> Bool)
-> (BinaryDebDescription -> BinaryDebDescription -> Bool)
-> (BinaryDebDescription
    -> BinaryDebDescription -> BinaryDebDescription)
-> (BinaryDebDescription
    -> BinaryDebDescription -> BinaryDebDescription)
-> Ord BinaryDebDescription
BinaryDebDescription -> BinaryDebDescription -> Bool
BinaryDebDescription -> BinaryDebDescription -> Ordering
BinaryDebDescription
-> BinaryDebDescription -> BinaryDebDescription
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
$ccompare :: BinaryDebDescription -> BinaryDebDescription -> Ordering
compare :: BinaryDebDescription -> BinaryDebDescription -> Ordering
$c< :: BinaryDebDescription -> BinaryDebDescription -> Bool
< :: BinaryDebDescription -> BinaryDebDescription -> Bool
$c<= :: BinaryDebDescription -> BinaryDebDescription -> Bool
<= :: BinaryDebDescription -> BinaryDebDescription -> Bool
$c> :: BinaryDebDescription -> BinaryDebDescription -> Bool
> :: BinaryDebDescription -> BinaryDebDescription -> Bool
$c>= :: BinaryDebDescription -> BinaryDebDescription -> Bool
>= :: BinaryDebDescription -> BinaryDebDescription -> Bool
$cmax :: BinaryDebDescription
-> BinaryDebDescription -> BinaryDebDescription
max :: BinaryDebDescription
-> BinaryDebDescription -> BinaryDebDescription
$cmin :: BinaryDebDescription
-> BinaryDebDescription -> BinaryDebDescription
min :: BinaryDebDescription
-> BinaryDebDescription -> BinaryDebDescription
Ord, ReadPrec [BinaryDebDescription]
ReadPrec BinaryDebDescription
Int -> ReadS BinaryDebDescription
ReadS [BinaryDebDescription]
(Int -> ReadS BinaryDebDescription)
-> ReadS [BinaryDebDescription]
-> ReadPrec BinaryDebDescription
-> ReadPrec [BinaryDebDescription]
-> Read BinaryDebDescription
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BinaryDebDescription
readsPrec :: Int -> ReadS BinaryDebDescription
$creadList :: ReadS [BinaryDebDescription]
readList :: ReadS [BinaryDebDescription]
$creadPrec :: ReadPrec BinaryDebDescription
readPrec :: ReadPrec BinaryDebDescription
$creadListPrec :: ReadPrec [BinaryDebDescription]
readListPrec :: ReadPrec [BinaryDebDescription]
Read, Int -> BinaryDebDescription -> ShowS
[BinaryDebDescription] -> ShowS
BinaryDebDescription -> String
(Int -> BinaryDebDescription -> ShowS)
-> (BinaryDebDescription -> String)
-> ([BinaryDebDescription] -> ShowS)
-> Show BinaryDebDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinaryDebDescription -> ShowS
showsPrec :: Int -> BinaryDebDescription -> ShowS
$cshow :: BinaryDebDescription -> String
show :: BinaryDebDescription -> String
$cshowList :: [BinaryDebDescription] -> ShowS
showList :: [BinaryDebDescription] -> ShowS
Show, Typeable BinaryDebDescription
Typeable BinaryDebDescription =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> BinaryDebDescription
 -> c BinaryDebDescription)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BinaryDebDescription)
-> (BinaryDebDescription -> Constr)
-> (BinaryDebDescription -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BinaryDebDescription))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BinaryDebDescription))
-> ((forall b. Data b => b -> b)
    -> BinaryDebDescription -> BinaryDebDescription)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BinaryDebDescription -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BinaryDebDescription -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> BinaryDebDescription -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BinaryDebDescription -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> BinaryDebDescription -> m BinaryDebDescription)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BinaryDebDescription -> m BinaryDebDescription)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BinaryDebDescription -> m BinaryDebDescription)
-> Data BinaryDebDescription
BinaryDebDescription -> Constr
BinaryDebDescription -> DataType
(forall b. Data b => b -> b)
-> BinaryDebDescription -> BinaryDebDescription
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) -> BinaryDebDescription -> u
forall u.
(forall d. Data d => d -> u) -> BinaryDebDescription -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryDebDescription -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryDebDescription -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BinaryDebDescription -> m BinaryDebDescription
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BinaryDebDescription -> m BinaryDebDescription
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinaryDebDescription
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> BinaryDebDescription
-> c BinaryDebDescription
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinaryDebDescription)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BinaryDebDescription)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> BinaryDebDescription
-> c BinaryDebDescription
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> BinaryDebDescription
-> c BinaryDebDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinaryDebDescription
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinaryDebDescription
$ctoConstr :: BinaryDebDescription -> Constr
toConstr :: BinaryDebDescription -> Constr
$cdataTypeOf :: BinaryDebDescription -> DataType
dataTypeOf :: BinaryDebDescription -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinaryDebDescription)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinaryDebDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BinaryDebDescription)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BinaryDebDescription)
$cgmapT :: (forall b. Data b => b -> b)
-> BinaryDebDescription -> BinaryDebDescription
gmapT :: (forall b. Data b => b -> b)
-> BinaryDebDescription -> BinaryDebDescription
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryDebDescription -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryDebDescription -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryDebDescription -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryDebDescription -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> BinaryDebDescription -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> BinaryDebDescription -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> BinaryDebDescription -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> BinaryDebDescription -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BinaryDebDescription -> m BinaryDebDescription
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BinaryDebDescription -> m BinaryDebDescription
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BinaryDebDescription -> m BinaryDebDescription
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BinaryDebDescription -> m BinaryDebDescription
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BinaryDebDescription -> m BinaryDebDescription
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BinaryDebDescription -> m BinaryDebDescription
Data, Typeable)

-- ^ The different types of binary debs we can produce from a haskell package
data PackageType
    = Development   -- ^ The libghc-foo-dev package.
    | Profiling     -- ^ The libghc-foo-prof package.
    | Documentation -- ^ The libghc-foo-doc package.
    | Exec          -- ^ A package related to a particular executable, perhaps
                    -- but not necessarily a server.
    | Utilities     -- ^ A package that holds the package's data files
                    -- and any executables not assigned to other
                    -- packages.
    | Source        -- ^ The source package (not a binary deb actually.)
    | HaskellSource -- ^ The source package of a haskell library (add
                    -- prefix haskell- to source package name.)
    | Cabal         -- ^ This is used to construct the value for
                    -- DEB_CABAL_PACKAGE in the rules file
    deriving (PackageType -> PackageType -> Bool
(PackageType -> PackageType -> Bool)
-> (PackageType -> PackageType -> Bool) -> Eq PackageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageType -> PackageType -> Bool
== :: PackageType -> PackageType -> Bool
$c/= :: PackageType -> PackageType -> Bool
/= :: PackageType -> PackageType -> Bool
Eq, Eq PackageType
Eq PackageType =>
(PackageType -> PackageType -> Ordering)
-> (PackageType -> PackageType -> Bool)
-> (PackageType -> PackageType -> Bool)
-> (PackageType -> PackageType -> Bool)
-> (PackageType -> PackageType -> Bool)
-> (PackageType -> PackageType -> PackageType)
-> (PackageType -> PackageType -> PackageType)
-> Ord PackageType
PackageType -> PackageType -> Bool
PackageType -> PackageType -> Ordering
PackageType -> PackageType -> PackageType
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
$ccompare :: PackageType -> PackageType -> Ordering
compare :: PackageType -> PackageType -> Ordering
$c< :: PackageType -> PackageType -> Bool
< :: PackageType -> PackageType -> Bool
$c<= :: PackageType -> PackageType -> Bool
<= :: PackageType -> PackageType -> Bool
$c> :: PackageType -> PackageType -> Bool
> :: PackageType -> PackageType -> Bool
$c>= :: PackageType -> PackageType -> Bool
>= :: PackageType -> PackageType -> Bool
$cmax :: PackageType -> PackageType -> PackageType
max :: PackageType -> PackageType -> PackageType
$cmin :: PackageType -> PackageType -> PackageType
min :: PackageType -> PackageType -> PackageType
Ord, Int -> PackageType -> ShowS
[PackageType] -> ShowS
PackageType -> String
(Int -> PackageType -> ShowS)
-> (PackageType -> String)
-> ([PackageType] -> ShowS)
-> Show PackageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageType -> ShowS
showsPrec :: Int -> PackageType -> ShowS
$cshow :: PackageType -> String
show :: PackageType -> String
$cshowList :: [PackageType] -> ShowS
showList :: [PackageType] -> ShowS
Show, ReadPrec [PackageType]
ReadPrec PackageType
Int -> ReadS PackageType
ReadS [PackageType]
(Int -> ReadS PackageType)
-> ReadS [PackageType]
-> ReadPrec PackageType
-> ReadPrec [PackageType]
-> Read PackageType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PackageType
readsPrec :: Int -> ReadS PackageType
$creadList :: ReadS [PackageType]
readList :: ReadS [PackageType]
$creadPrec :: ReadPrec PackageType
readPrec :: ReadPrec PackageType
$creadListPrec :: ReadPrec [PackageType]
readListPrec :: ReadPrec [PackageType]
Read, Typeable PackageType
Typeable PackageType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PackageType -> c PackageType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PackageType)
-> (PackageType -> Constr)
-> (PackageType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PackageType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PackageType))
-> ((forall b. Data b => b -> b) -> PackageType -> PackageType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PackageType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PackageType -> r)
-> (forall u. (forall d. Data d => d -> u) -> PackageType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PackageType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PackageType -> m PackageType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PackageType -> m PackageType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PackageType -> m PackageType)
-> Data PackageType
PackageType -> Constr
PackageType -> DataType
(forall b. Data b => b -> b) -> PackageType -> PackageType
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) -> PackageType -> u
forall u. (forall d. Data d => d -> u) -> PackageType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageType -> m PackageType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageType -> m PackageType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageType -> c PackageType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageType -> c PackageType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageType -> c PackageType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageType
$ctoConstr :: PackageType -> Constr
toConstr :: PackageType -> Constr
$cdataTypeOf :: PackageType -> DataType
dataTypeOf :: PackageType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageType)
$cgmapT :: (forall b. Data b => b -> b) -> PackageType -> PackageType
gmapT :: (forall b. Data b => b -> b) -> PackageType -> PackageType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PackageType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PackageType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PackageType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PackageType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageType -> m PackageType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageType -> m PackageType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageType -> m PackageType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageType -> m PackageType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageType -> m PackageType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageType -> m PackageType
Data, Typeable)

-- ^ Package interrelationship information.
data PackageRelations
    = PackageRelations
      { PackageRelations -> Relations
_depends :: Relations
      , PackageRelations -> Relations
_recommends :: Relations
      , PackageRelations -> Relations
_suggests :: Relations
      , PackageRelations -> Relations
_preDepends :: Relations
      , PackageRelations -> Relations
_breaks :: Relations
      , PackageRelations -> Relations
_conflicts :: Relations
      , PackageRelations -> Relations
_provides :: Relations
      , PackageRelations -> Relations
_replaces :: Relations
      , PackageRelations -> Relations
_builtUsing :: Relations
      } deriving (PackageRelations -> PackageRelations -> Bool
(PackageRelations -> PackageRelations -> Bool)
-> (PackageRelations -> PackageRelations -> Bool)
-> Eq PackageRelations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageRelations -> PackageRelations -> Bool
== :: PackageRelations -> PackageRelations -> Bool
$c/= :: PackageRelations -> PackageRelations -> Bool
/= :: PackageRelations -> PackageRelations -> Bool
Eq, Eq PackageRelations
Eq PackageRelations =>
(PackageRelations -> PackageRelations -> Ordering)
-> (PackageRelations -> PackageRelations -> Bool)
-> (PackageRelations -> PackageRelations -> Bool)
-> (PackageRelations -> PackageRelations -> Bool)
-> (PackageRelations -> PackageRelations -> Bool)
-> (PackageRelations -> PackageRelations -> PackageRelations)
-> (PackageRelations -> PackageRelations -> PackageRelations)
-> Ord PackageRelations
PackageRelations -> PackageRelations -> Bool
PackageRelations -> PackageRelations -> Ordering
PackageRelations -> PackageRelations -> PackageRelations
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
$ccompare :: PackageRelations -> PackageRelations -> Ordering
compare :: PackageRelations -> PackageRelations -> Ordering
$c< :: PackageRelations -> PackageRelations -> Bool
< :: PackageRelations -> PackageRelations -> Bool
$c<= :: PackageRelations -> PackageRelations -> Bool
<= :: PackageRelations -> PackageRelations -> Bool
$c> :: PackageRelations -> PackageRelations -> Bool
> :: PackageRelations -> PackageRelations -> Bool
$c>= :: PackageRelations -> PackageRelations -> Bool
>= :: PackageRelations -> PackageRelations -> Bool
$cmax :: PackageRelations -> PackageRelations -> PackageRelations
max :: PackageRelations -> PackageRelations -> PackageRelations
$cmin :: PackageRelations -> PackageRelations -> PackageRelations
min :: PackageRelations -> PackageRelations -> PackageRelations
Ord, ReadPrec [PackageRelations]
ReadPrec PackageRelations
Int -> ReadS PackageRelations
ReadS [PackageRelations]
(Int -> ReadS PackageRelations)
-> ReadS [PackageRelations]
-> ReadPrec PackageRelations
-> ReadPrec [PackageRelations]
-> Read PackageRelations
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PackageRelations
readsPrec :: Int -> ReadS PackageRelations
$creadList :: ReadS [PackageRelations]
readList :: ReadS [PackageRelations]
$creadPrec :: ReadPrec PackageRelations
readPrec :: ReadPrec PackageRelations
$creadListPrec :: ReadPrec [PackageRelations]
readListPrec :: ReadPrec [PackageRelations]
Read, Int -> PackageRelations -> ShowS
[PackageRelations] -> ShowS
PackageRelations -> String
(Int -> PackageRelations -> ShowS)
-> (PackageRelations -> String)
-> ([PackageRelations] -> ShowS)
-> Show PackageRelations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageRelations -> ShowS
showsPrec :: Int -> PackageRelations -> ShowS
$cshow :: PackageRelations -> String
show :: PackageRelations -> String
$cshowList :: [PackageRelations] -> ShowS
showList :: [PackageRelations] -> ShowS
Show, Typeable PackageRelations
Typeable PackageRelations =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PackageRelations -> c PackageRelations)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PackageRelations)
-> (PackageRelations -> Constr)
-> (PackageRelations -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PackageRelations))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PackageRelations))
-> ((forall b. Data b => b -> b)
    -> PackageRelations -> PackageRelations)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PackageRelations -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PackageRelations -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PackageRelations -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PackageRelations -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PackageRelations -> m PackageRelations)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PackageRelations -> m PackageRelations)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PackageRelations -> m PackageRelations)
-> Data PackageRelations
PackageRelations -> Constr
PackageRelations -> DataType
(forall b. Data b => b -> b)
-> PackageRelations -> PackageRelations
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) -> PackageRelations -> u
forall u. (forall d. Data d => d -> u) -> PackageRelations -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageRelations -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageRelations -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackageRelations -> m PackageRelations
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageRelations -> m PackageRelations
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageRelations
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageRelations -> c PackageRelations
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageRelations)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageRelations)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageRelations -> c PackageRelations
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageRelations -> c PackageRelations
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageRelations
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageRelations
$ctoConstr :: PackageRelations -> Constr
toConstr :: PackageRelations -> Constr
$cdataTypeOf :: PackageRelations -> DataType
dataTypeOf :: PackageRelations -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageRelations)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageRelations)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageRelations)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageRelations)
$cgmapT :: (forall b. Data b => b -> b)
-> PackageRelations -> PackageRelations
gmapT :: (forall b. Data b => b -> b)
-> PackageRelations -> PackageRelations
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageRelations -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageRelations -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageRelations -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageRelations -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PackageRelations -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PackageRelations -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PackageRelations -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PackageRelations -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackageRelations -> m PackageRelations
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PackageRelations -> m PackageRelations
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageRelations -> m PackageRelations
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageRelations -> m PackageRelations
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageRelations -> m PackageRelations
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PackageRelations -> m PackageRelations
Data, Typeable)

instance Canonical [BinaryDebDescription] where
    canonical :: [BinaryDebDescription] -> [BinaryDebDescription]
canonical [BinaryDebDescription]
xs = (BinaryDebDescription -> BinaryDebDescription -> Ordering)
-> [BinaryDebDescription] -> [BinaryDebDescription]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (BinPkgName -> BinPkgName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BinPkgName -> BinPkgName -> Ordering)
-> (BinaryDebDescription -> BinPkgName)
-> BinaryDebDescription
-> BinaryDebDescription
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BinaryDebDescription -> BinPkgName
_package) ((BinaryDebDescription -> BinaryDebDescription)
-> [BinaryDebDescription] -> [BinaryDebDescription]
forall a b. (a -> b) -> [a] -> [b]
map BinaryDebDescription -> BinaryDebDescription
forall a. Canonical a => a -> a
canonical [BinaryDebDescription]
xs)

instance Canonical BinaryDebDescription where
    canonical :: BinaryDebDescription -> BinaryDebDescription
canonical BinaryDebDescription
x = BinaryDebDescription
x {_relations = canonical (_relations x)}

instance Canonical PackageRelations where
    canonical :: PackageRelations -> PackageRelations
canonical PackageRelations
x = PackageRelations
x { _depends = canonical (_depends x)
                    , _recommends = canonical (_recommends x)
                    , _suggests = canonical (_suggests x)
                    , _preDepends = canonical (_preDepends x)
                    , _breaks = canonical (_breaks x)
                    , _conflicts = canonical (_conflicts x)
                    , _provides = canonical (_provides x)
                    , _replaces = canonical (_replaces x)
                    , _builtUsing = canonical (_builtUsing x) }

instance Canonical Relations where
    canonical :: Relations -> Relations
canonical Relations
xss = Relations -> Relations
forall a. Ord a => [a] -> [a]
sort Relations
xss

newBinaryDebDescription :: BinPkgName -> BinaryDebDescription
newBinaryDebDescription :: BinPkgName -> BinaryDebDescription
newBinaryDebDescription BinPkgName
name =
    BinaryDebDescription
      { _package :: BinPkgName
_package = BinPkgName
name
      , _packageType :: Maybe PackageType
_packageType = Maybe PackageType
forall a. Maybe a
Nothing
      , _architecture :: Maybe PackageArchitectures
_architecture = Maybe PackageArchitectures
forall a. Maybe a
Nothing
      , _multiArch :: Maybe MultiArch
_multiArch = Maybe MultiArch
forall a. Maybe a
Nothing
      , _binarySection :: Maybe Section
_binarySection = Maybe Section
forall a. Maybe a
Nothing
      , _binaryPriority :: Maybe PackagePriority
_binaryPriority = Maybe PackagePriority
forall a. Maybe a
Nothing
      , _essential :: Maybe Bool
_essential = Maybe Bool
forall a. Maybe a
Nothing
      , _description :: Maybe Text
_description = Maybe Text
forall a. Monoid a => a
mempty
      , _relations :: PackageRelations
_relations = PackageRelations
newPackageRelations }

newPackageRelations :: PackageRelations
newPackageRelations :: PackageRelations
newPackageRelations =
    PackageRelations
      { _depends :: Relations
_depends = []
      , _recommends :: Relations
_recommends = []
      , _suggests :: Relations
_suggests = []
      , _preDepends :: Relations
_preDepends = []
      , _breaks :: Relations
_breaks = []
      , _conflicts :: Relations
_conflicts = []
      , _provides :: Relations
_provides = []
      , _replaces :: Relations
_replaces = []
      , _builtUsing :: Relations
_builtUsing = [] }

$(makeLenses ''BinaryDebDescription)
$(makeLenses ''PackageRelations)