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

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

instance Canonical BinaryDebDescription where
    canonical :: BinaryDebDescription -> BinaryDebDescription
canonical BinaryDebDescription
x = BinaryDebDescription
x {_relations :: PackageRelations
_relations = forall a. Canonical a => a -> a
canonical (BinaryDebDescription -> PackageRelations
_relations BinaryDebDescription
x)}

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

instance Canonical Relations where
    canonical :: Relations -> Relations
canonical Relations
xss = 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 = forall a. Maybe a
Nothing
      , _architecture :: Maybe PackageArchitectures
_architecture = forall a. Maybe a
Nothing
      , _multiArch :: Maybe MultiArch
_multiArch = forall a. Maybe a
Nothing
      , _binarySection :: Maybe Section
_binarySection = forall a. Maybe a
Nothing
      , _binaryPriority :: Maybe PackagePriority
_binaryPriority = forall a. Maybe a
Nothing
      , _essential :: Maybe Bool
_essential = forall a. Maybe a
Nothing
      , _description :: Maybe Text
_description = 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)