{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell, TypeSynonymInstances #-}
module Debian.Debianize.SourceDebDescription
    ( SourceDebDescription
    , newSourceDebDescription
    , newSourceDebDescription'
    , source
    , maintainer
    , changedBy
    , uploaders
    , dmUploadAllowed
    , priority
    , section
    , buildDepends
    , buildConflicts
    , buildDependsIndep
    , buildConflictsIndep
    , standardsVersion
    , homepage
    , vcsFields
    , xFields
    , xDescription
    , binaryPackages
    , VersionControlSpec(..)
    , XField(..)
    , XFieldDest(..)
    ) where

import Control.Lens.TH (makeLenses)
import Data.Generics (Data, Typeable)
import Data.Set as Set (empty, Set)
import Data.Text (Text)
import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, Canonical(canonical))
import Debian.Orphans ()
import Debian.Policy (PackagePriority, Section, StandardsVersion)
import Debian.Relation (Relations, SrcPkgName)
import Prelude hiding (init, init, log, log, unlines)
import Text.Parsec.Rfc2822 (NameAddr)

-- | This type represents the debian/control file, which is the core
-- of the source package debianization.  It includes the information
-- that goes in the first, or source, section, and then a list of the
-- succeeding binary package sections.
data SourceDebDescription
    = SourceDebDescription
      { SourceDebDescription -> Maybe SrcPkgName
_source :: Maybe SrcPkgName
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Source>
      , SourceDebDescription -> Either String NameAddr
_maintainer :: Either String NameAddr
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Maintainer>
      , SourceDebDescription -> Maybe NameAddr
_changedBy :: Maybe NameAddr
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Changed-By>
      , SourceDebDescription -> [NameAddr]
_uploaders :: [NameAddr]
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Uploaders>
      , SourceDebDescription -> Bool
_dmUploadAllowed :: Bool
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-DM-Upload-Allowed>
      , SourceDebDescription -> Maybe PackagePriority
_priority :: Maybe PackagePriority
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Priority>
      , SourceDebDescription -> Maybe Section
_section :: Maybe Section
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Section>
      , SourceDebDescription -> Maybe StandardsVersion
_standardsVersion :: Maybe StandardsVersion
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Standards-Version>
      , SourceDebDescription -> Maybe Text
_homepage :: Maybe Text
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Homepage>
      , SourceDebDescription -> Set VersionControlSpec
_vcsFields :: Set VersionControlSpec
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-VCS-fields>
      , SourceDebDescription -> Set XField
_xFields :: Set XField
      -- ^ <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s5.7>
      , SourceDebDescription -> Relations
_buildDepends :: Relations
      , SourceDebDescription -> Relations
_buildConflicts :: Relations
      , SourceDebDescription -> Relations
_buildDependsIndep :: Relations
      , SourceDebDescription -> Relations
_buildConflictsIndep :: Relations
      , SourceDebDescription -> Maybe Text
_xDescription :: Maybe Text
      , SourceDebDescription -> [BinaryDebDescription]
_binaryPackages :: [BinaryDebDescription]
      -- ^ The binary debs.  This should be a map, but we may need to preserve the order
      } deriving (SourceDebDescription -> SourceDebDescription -> Bool
(SourceDebDescription -> SourceDebDescription -> Bool)
-> (SourceDebDescription -> SourceDebDescription -> Bool)
-> Eq SourceDebDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceDebDescription -> SourceDebDescription -> Bool
$c/= :: SourceDebDescription -> SourceDebDescription -> Bool
== :: SourceDebDescription -> SourceDebDescription -> Bool
$c== :: SourceDebDescription -> SourceDebDescription -> Bool
Eq, Eq SourceDebDescription
Eq SourceDebDescription
-> (SourceDebDescription -> SourceDebDescription -> Ordering)
-> (SourceDebDescription -> SourceDebDescription -> Bool)
-> (SourceDebDescription -> SourceDebDescription -> Bool)
-> (SourceDebDescription -> SourceDebDescription -> Bool)
-> (SourceDebDescription -> SourceDebDescription -> Bool)
-> (SourceDebDescription
    -> SourceDebDescription -> SourceDebDescription)
-> (SourceDebDescription
    -> SourceDebDescription -> SourceDebDescription)
-> Ord SourceDebDescription
SourceDebDescription -> SourceDebDescription -> Bool
SourceDebDescription -> SourceDebDescription -> Ordering
SourceDebDescription
-> SourceDebDescription -> SourceDebDescription
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 :: SourceDebDescription
-> SourceDebDescription -> SourceDebDescription
$cmin :: SourceDebDescription
-> SourceDebDescription -> SourceDebDescription
max :: SourceDebDescription
-> SourceDebDescription -> SourceDebDescription
$cmax :: SourceDebDescription
-> SourceDebDescription -> SourceDebDescription
>= :: SourceDebDescription -> SourceDebDescription -> Bool
$c>= :: SourceDebDescription -> SourceDebDescription -> Bool
> :: SourceDebDescription -> SourceDebDescription -> Bool
$c> :: SourceDebDescription -> SourceDebDescription -> Bool
<= :: SourceDebDescription -> SourceDebDescription -> Bool
$c<= :: SourceDebDescription -> SourceDebDescription -> Bool
< :: SourceDebDescription -> SourceDebDescription -> Bool
$c< :: SourceDebDescription -> SourceDebDescription -> Bool
compare :: SourceDebDescription -> SourceDebDescription -> Ordering
$ccompare :: SourceDebDescription -> SourceDebDescription -> Ordering
$cp1Ord :: Eq SourceDebDescription
Ord, Int -> SourceDebDescription -> ShowS
[SourceDebDescription] -> ShowS
SourceDebDescription -> String
(Int -> SourceDebDescription -> ShowS)
-> (SourceDebDescription -> String)
-> ([SourceDebDescription] -> ShowS)
-> Show SourceDebDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceDebDescription] -> ShowS
$cshowList :: [SourceDebDescription] -> ShowS
show :: SourceDebDescription -> String
$cshow :: SourceDebDescription -> String
showsPrec :: Int -> SourceDebDescription -> ShowS
$cshowsPrec :: Int -> SourceDebDescription -> ShowS
Show, Typeable SourceDebDescription
DataType
Constr
Typeable SourceDebDescription
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SourceDebDescription
    -> c SourceDebDescription)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceDebDescription)
-> (SourceDebDescription -> Constr)
-> (SourceDebDescription -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceDebDescription))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceDebDescription))
-> ((forall b. Data b => b -> b)
    -> SourceDebDescription -> SourceDebDescription)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SourceDebDescription -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceDebDescription -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SourceDebDescription -> m SourceDebDescription)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SourceDebDescription -> m SourceDebDescription)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SourceDebDescription -> m SourceDebDescription)
-> Data SourceDebDescription
SourceDebDescription -> DataType
SourceDebDescription -> Constr
(forall b. Data b => b -> b)
-> SourceDebDescription -> SourceDebDescription
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceDebDescription
-> c SourceDebDescription
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceDebDescription
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) -> SourceDebDescription -> u
forall u.
(forall d. Data d => d -> u) -> SourceDebDescription -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceDebDescription
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceDebDescription
-> c SourceDebDescription
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceDebDescription)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceDebDescription)
$cSourceDebDescription :: Constr
$tSourceDebDescription :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
gmapMp :: (forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
gmapM :: (forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
gmapQi :: Int -> (forall d. Data d => d -> u) -> SourceDebDescription -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SourceDebDescription -> u
gmapQ :: (forall d. Data d => d -> u) -> SourceDebDescription -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SourceDebDescription -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r
gmapT :: (forall b. Data b => b -> b)
-> SourceDebDescription -> SourceDebDescription
$cgmapT :: (forall b. Data b => b -> b)
-> SourceDebDescription -> SourceDebDescription
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceDebDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceDebDescription)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SourceDebDescription)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceDebDescription)
dataTypeOf :: SourceDebDescription -> DataType
$cdataTypeOf :: SourceDebDescription -> DataType
toConstr :: SourceDebDescription -> Constr
$ctoConstr :: SourceDebDescription -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceDebDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceDebDescription
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceDebDescription
-> c SourceDebDescription
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceDebDescription
-> c SourceDebDescription
$cp1Data :: Typeable SourceDebDescription
Data, Typeable)

instance Canonical SourceDebDescription where
    canonical :: SourceDebDescription -> SourceDebDescription
canonical SourceDebDescription
x = SourceDebDescription
x { _binaryPackages :: [BinaryDebDescription]
_binaryPackages = [BinaryDebDescription] -> [BinaryDebDescription]
forall a. Canonical a => a -> a
canonical (SourceDebDescription -> [BinaryDebDescription]
_binaryPackages SourceDebDescription
x)
                    , _buildDepends :: Relations
_buildDepends = Relations -> Relations
forall a. Canonical a => a -> a
canonical (SourceDebDescription -> Relations
_buildDepends SourceDebDescription
x)
                    , _buildConflicts :: Relations
_buildConflicts = Relations -> Relations
forall a. Canonical a => a -> a
canonical (SourceDebDescription -> Relations
_buildConflicts SourceDebDescription
x)
                    , _buildDependsIndep :: Relations
_buildDependsIndep = Relations -> Relations
forall a. Canonical a => a -> a
canonical (SourceDebDescription -> Relations
_buildDependsIndep SourceDebDescription
x)
                    , _buildConflictsIndep :: Relations
_buildConflictsIndep = Relations -> Relations
forall a. Canonical a => a -> a
canonical (SourceDebDescription -> Relations
_buildConflictsIndep SourceDebDescription
x)
                    }

newSourceDebDescription :: SourceDebDescription
newSourceDebDescription :: SourceDebDescription
newSourceDebDescription =
    SourceDebDescription :: Maybe SrcPkgName
-> Either String NameAddr
-> Maybe NameAddr
-> [NameAddr]
-> Bool
-> Maybe PackagePriority
-> Maybe Section
-> Maybe StandardsVersion
-> Maybe Text
-> Set VersionControlSpec
-> Set XField
-> Relations
-> Relations
-> Relations
-> Relations
-> Maybe Text
-> [BinaryDebDescription]
-> SourceDebDescription
SourceDebDescription
      { _source :: Maybe SrcPkgName
_source = Maybe SrcPkgName
forall a. Maybe a
Nothing
      , _maintainer :: Either String NameAddr
_maintainer = String -> Either String NameAddr
forall a b. a -> Either a b
Left String
"Maintainer not set"
      , _changedBy :: Maybe NameAddr
_changedBy = Maybe NameAddr
forall a. Maybe a
Nothing
      , _uploaders :: [NameAddr]
_uploaders = []
      , _dmUploadAllowed :: Bool
_dmUploadAllowed = Bool
False
      , _priority :: Maybe PackagePriority
_priority = Maybe PackagePriority
forall a. Maybe a
Nothing
      , _section :: Maybe Section
_section = Maybe Section
forall a. Maybe a
Nothing
      , _buildDepends :: Relations
_buildDepends = []
      , _buildConflicts :: Relations
_buildConflicts = []
      , _buildDependsIndep :: Relations
_buildDependsIndep  = []
      , _buildConflictsIndep :: Relations
_buildConflictsIndep  = []
      , _standardsVersion :: Maybe StandardsVersion
_standardsVersion = Maybe StandardsVersion
forall a. Maybe a
Nothing
      , _homepage :: Maybe Text
_homepage = Maybe Text
forall a. Maybe a
Nothing
      , _vcsFields :: Set VersionControlSpec
_vcsFields = Set VersionControlSpec
forall a. Set a
Set.empty
      , _xFields :: Set XField
_xFields = Set XField
forall a. Set a
Set.empty
      , _xDescription :: Maybe Text
_xDescription = Maybe Text
forall a. Maybe a
Nothing -- Quick hack, I should maybe put this into _xFields
      , _binaryPackages :: [BinaryDebDescription]
_binaryPackages = [] }

newSourceDebDescription' :: SrcPkgName -> NameAddr -> SourceDebDescription
newSourceDebDescription' :: SrcPkgName -> NameAddr -> SourceDebDescription
newSourceDebDescription' SrcPkgName
src NameAddr
who =
    SourceDebDescription
newSourceDebDescription
      { _source :: Maybe SrcPkgName
_source = SrcPkgName -> Maybe SrcPkgName
forall a. a -> Maybe a
Just SrcPkgName
src
      , _maintainer :: Either String NameAddr
_maintainer = NameAddr -> Either String NameAddr
forall a b. b -> Either a b
Right NameAddr
who }

data VersionControlSpec
    = VCSBrowser Text
    | VCSArch Text
    | VCSBzr Text
    | VCSCvs Text
    | VCSDarcs Text
    | VCSGit Text
    | VCSHg Text
    | VCSMtn Text
    | VCSSvn Text
    deriving (VersionControlSpec -> VersionControlSpec -> Bool
(VersionControlSpec -> VersionControlSpec -> Bool)
-> (VersionControlSpec -> VersionControlSpec -> Bool)
-> Eq VersionControlSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionControlSpec -> VersionControlSpec -> Bool
$c/= :: VersionControlSpec -> VersionControlSpec -> Bool
== :: VersionControlSpec -> VersionControlSpec -> Bool
$c== :: VersionControlSpec -> VersionControlSpec -> Bool
Eq, Eq VersionControlSpec
Eq VersionControlSpec
-> (VersionControlSpec -> VersionControlSpec -> Ordering)
-> (VersionControlSpec -> VersionControlSpec -> Bool)
-> (VersionControlSpec -> VersionControlSpec -> Bool)
-> (VersionControlSpec -> VersionControlSpec -> Bool)
-> (VersionControlSpec -> VersionControlSpec -> Bool)
-> (VersionControlSpec -> VersionControlSpec -> VersionControlSpec)
-> (VersionControlSpec -> VersionControlSpec -> VersionControlSpec)
-> Ord VersionControlSpec
VersionControlSpec -> VersionControlSpec -> Bool
VersionControlSpec -> VersionControlSpec -> Ordering
VersionControlSpec -> VersionControlSpec -> VersionControlSpec
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 :: VersionControlSpec -> VersionControlSpec -> VersionControlSpec
$cmin :: VersionControlSpec -> VersionControlSpec -> VersionControlSpec
max :: VersionControlSpec -> VersionControlSpec -> VersionControlSpec
$cmax :: VersionControlSpec -> VersionControlSpec -> VersionControlSpec
>= :: VersionControlSpec -> VersionControlSpec -> Bool
$c>= :: VersionControlSpec -> VersionControlSpec -> Bool
> :: VersionControlSpec -> VersionControlSpec -> Bool
$c> :: VersionControlSpec -> VersionControlSpec -> Bool
<= :: VersionControlSpec -> VersionControlSpec -> Bool
$c<= :: VersionControlSpec -> VersionControlSpec -> Bool
< :: VersionControlSpec -> VersionControlSpec -> Bool
$c< :: VersionControlSpec -> VersionControlSpec -> Bool
compare :: VersionControlSpec -> VersionControlSpec -> Ordering
$ccompare :: VersionControlSpec -> VersionControlSpec -> Ordering
$cp1Ord :: Eq VersionControlSpec
Ord, Int -> VersionControlSpec -> ShowS
[VersionControlSpec] -> ShowS
VersionControlSpec -> String
(Int -> VersionControlSpec -> ShowS)
-> (VersionControlSpec -> String)
-> ([VersionControlSpec] -> ShowS)
-> Show VersionControlSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionControlSpec] -> ShowS
$cshowList :: [VersionControlSpec] -> ShowS
show :: VersionControlSpec -> String
$cshow :: VersionControlSpec -> String
showsPrec :: Int -> VersionControlSpec -> ShowS
$cshowsPrec :: Int -> VersionControlSpec -> ShowS
Show, Typeable VersionControlSpec
DataType
Constr
Typeable VersionControlSpec
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> VersionControlSpec
    -> c VersionControlSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VersionControlSpec)
-> (VersionControlSpec -> Constr)
-> (VersionControlSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VersionControlSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VersionControlSpec))
-> ((forall b. Data b => b -> b)
    -> VersionControlSpec -> VersionControlSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VersionControlSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VersionControlSpec -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VersionControlSpec -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VersionControlSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VersionControlSpec -> m VersionControlSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VersionControlSpec -> m VersionControlSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VersionControlSpec -> m VersionControlSpec)
-> Data VersionControlSpec
VersionControlSpec -> DataType
VersionControlSpec -> Constr
(forall b. Data b => b -> b)
-> VersionControlSpec -> VersionControlSpec
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VersionControlSpec
-> c VersionControlSpec
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VersionControlSpec
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) -> VersionControlSpec -> u
forall u. (forall d. Data d => d -> u) -> VersionControlSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionControlSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionControlSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VersionControlSpec -> m VersionControlSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VersionControlSpec -> m VersionControlSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VersionControlSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VersionControlSpec
-> c VersionControlSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VersionControlSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VersionControlSpec)
$cVCSSvn :: Constr
$cVCSMtn :: Constr
$cVCSHg :: Constr
$cVCSGit :: Constr
$cVCSDarcs :: Constr
$cVCSCvs :: Constr
$cVCSBzr :: Constr
$cVCSArch :: Constr
$cVCSBrowser :: Constr
$tVersionControlSpec :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VersionControlSpec -> m VersionControlSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VersionControlSpec -> m VersionControlSpec
gmapMp :: (forall d. Data d => d -> m d)
-> VersionControlSpec -> m VersionControlSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VersionControlSpec -> m VersionControlSpec
gmapM :: (forall d. Data d => d -> m d)
-> VersionControlSpec -> m VersionControlSpec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VersionControlSpec -> m VersionControlSpec
gmapQi :: Int -> (forall d. Data d => d -> u) -> VersionControlSpec -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> VersionControlSpec -> u
gmapQ :: (forall d. Data d => d -> u) -> VersionControlSpec -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VersionControlSpec -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionControlSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VersionControlSpec -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionControlSpec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VersionControlSpec -> r
gmapT :: (forall b. Data b => b -> b)
-> VersionControlSpec -> VersionControlSpec
$cgmapT :: (forall b. Data b => b -> b)
-> VersionControlSpec -> VersionControlSpec
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VersionControlSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VersionControlSpec)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VersionControlSpec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VersionControlSpec)
dataTypeOf :: VersionControlSpec -> DataType
$cdataTypeOf :: VersionControlSpec -> DataType
toConstr :: VersionControlSpec -> Constr
$ctoConstr :: VersionControlSpec -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VersionControlSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VersionControlSpec
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VersionControlSpec
-> c VersionControlSpec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VersionControlSpec
-> c VersionControlSpec
$cp1Data :: Typeable VersionControlSpec
Data, Typeable)

-- | User defined fields.  Parse the line "XBS-Comment: I stand
-- between the candle and the star." to get XField (fromList "BS")
-- "Comment" " I stand between the candle and the star."
data XField
    = XField (Set XFieldDest) Text Text
    deriving (XField -> XField -> Bool
(XField -> XField -> Bool)
-> (XField -> XField -> Bool) -> Eq XField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XField -> XField -> Bool
$c/= :: XField -> XField -> Bool
== :: XField -> XField -> Bool
$c== :: XField -> XField -> Bool
Eq, Eq XField
Eq XField
-> (XField -> XField -> Ordering)
-> (XField -> XField -> Bool)
-> (XField -> XField -> Bool)
-> (XField -> XField -> Bool)
-> (XField -> XField -> Bool)
-> (XField -> XField -> XField)
-> (XField -> XField -> XField)
-> Ord XField
XField -> XField -> Bool
XField -> XField -> Ordering
XField -> XField -> XField
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 :: XField -> XField -> XField
$cmin :: XField -> XField -> XField
max :: XField -> XField -> XField
$cmax :: XField -> XField -> XField
>= :: XField -> XField -> Bool
$c>= :: XField -> XField -> Bool
> :: XField -> XField -> Bool
$c> :: XField -> XField -> Bool
<= :: XField -> XField -> Bool
$c<= :: XField -> XField -> Bool
< :: XField -> XField -> Bool
$c< :: XField -> XField -> Bool
compare :: XField -> XField -> Ordering
$ccompare :: XField -> XField -> Ordering
$cp1Ord :: Eq XField
Ord, Int -> XField -> ShowS
[XField] -> ShowS
XField -> String
(Int -> XField -> ShowS)
-> (XField -> String) -> ([XField] -> ShowS) -> Show XField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XField] -> ShowS
$cshowList :: [XField] -> ShowS
show :: XField -> String
$cshow :: XField -> String
showsPrec :: Int -> XField -> ShowS
$cshowsPrec :: Int -> XField -> ShowS
Show, Typeable XField
DataType
Constr
Typeable XField
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> XField -> c XField)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c XField)
-> (XField -> Constr)
-> (XField -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c XField))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c XField))
-> ((forall b. Data b => b -> b) -> XField -> XField)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> XField -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> XField -> r)
-> (forall u. (forall d. Data d => d -> u) -> XField -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> XField -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> XField -> m XField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> XField -> m XField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> XField -> m XField)
-> Data XField
XField -> DataType
XField -> Constr
(forall b. Data b => b -> b) -> XField -> XField
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XField -> c XField
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XField
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) -> XField -> u
forall u. (forall d. Data d => d -> u) -> XField -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> XField -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> XField -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> XField -> m XField
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> XField -> m XField
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XField
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XField -> c XField
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XField)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c XField)
$cXField :: Constr
$tXField :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> XField -> m XField
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> XField -> m XField
gmapMp :: (forall d. Data d => d -> m d) -> XField -> m XField
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> XField -> m XField
gmapM :: (forall d. Data d => d -> m d) -> XField -> m XField
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> XField -> m XField
gmapQi :: Int -> (forall d. Data d => d -> u) -> XField -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> XField -> u
gmapQ :: (forall d. Data d => d -> u) -> XField -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> XField -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> XField -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> XField -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> XField -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> XField -> r
gmapT :: (forall b. Data b => b -> b) -> XField -> XField
$cgmapT :: (forall b. Data b => b -> b) -> XField -> XField
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c XField)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c XField)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c XField)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XField)
dataTypeOf :: XField -> DataType
$cdataTypeOf :: XField -> DataType
toConstr :: XField -> Constr
$ctoConstr :: XField -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XField
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XField
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XField -> c XField
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XField -> c XField
$cp1Data :: Typeable XField
Data, Typeable)

data XFieldDest
    = B -- ^ Field will be copied to the binary packgae control files
    | S -- ^ Field will be copied to the source packgae control files
    | C -- ^ Field will be copied to the upload control (.changes) file
    deriving (XFieldDest -> XFieldDest -> Bool
(XFieldDest -> XFieldDest -> Bool)
-> (XFieldDest -> XFieldDest -> Bool) -> Eq XFieldDest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XFieldDest -> XFieldDest -> Bool
$c/= :: XFieldDest -> XFieldDest -> Bool
== :: XFieldDest -> XFieldDest -> Bool
$c== :: XFieldDest -> XFieldDest -> Bool
Eq, Eq XFieldDest
Eq XFieldDest
-> (XFieldDest -> XFieldDest -> Ordering)
-> (XFieldDest -> XFieldDest -> Bool)
-> (XFieldDest -> XFieldDest -> Bool)
-> (XFieldDest -> XFieldDest -> Bool)
-> (XFieldDest -> XFieldDest -> Bool)
-> (XFieldDest -> XFieldDest -> XFieldDest)
-> (XFieldDest -> XFieldDest -> XFieldDest)
-> Ord XFieldDest
XFieldDest -> XFieldDest -> Bool
XFieldDest -> XFieldDest -> Ordering
XFieldDest -> XFieldDest -> XFieldDest
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 :: XFieldDest -> XFieldDest -> XFieldDest
$cmin :: XFieldDest -> XFieldDest -> XFieldDest
max :: XFieldDest -> XFieldDest -> XFieldDest
$cmax :: XFieldDest -> XFieldDest -> XFieldDest
>= :: XFieldDest -> XFieldDest -> Bool
$c>= :: XFieldDest -> XFieldDest -> Bool
> :: XFieldDest -> XFieldDest -> Bool
$c> :: XFieldDest -> XFieldDest -> Bool
<= :: XFieldDest -> XFieldDest -> Bool
$c<= :: XFieldDest -> XFieldDest -> Bool
< :: XFieldDest -> XFieldDest -> Bool
$c< :: XFieldDest -> XFieldDest -> Bool
compare :: XFieldDest -> XFieldDest -> Ordering
$ccompare :: XFieldDest -> XFieldDest -> Ordering
$cp1Ord :: Eq XFieldDest
Ord, ReadPrec [XFieldDest]
ReadPrec XFieldDest
Int -> ReadS XFieldDest
ReadS [XFieldDest]
(Int -> ReadS XFieldDest)
-> ReadS [XFieldDest]
-> ReadPrec XFieldDest
-> ReadPrec [XFieldDest]
-> Read XFieldDest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XFieldDest]
$creadListPrec :: ReadPrec [XFieldDest]
readPrec :: ReadPrec XFieldDest
$creadPrec :: ReadPrec XFieldDest
readList :: ReadS [XFieldDest]
$creadList :: ReadS [XFieldDest]
readsPrec :: Int -> ReadS XFieldDest
$creadsPrec :: Int -> ReadS XFieldDest
Read, Int -> XFieldDest -> ShowS
[XFieldDest] -> ShowS
XFieldDest -> String
(Int -> XFieldDest -> ShowS)
-> (XFieldDest -> String)
-> ([XFieldDest] -> ShowS)
-> Show XFieldDest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XFieldDest] -> ShowS
$cshowList :: [XFieldDest] -> ShowS
show :: XFieldDest -> String
$cshow :: XFieldDest -> String
showsPrec :: Int -> XFieldDest -> ShowS
$cshowsPrec :: Int -> XFieldDest -> ShowS
Show, Typeable XFieldDest
DataType
Constr
Typeable XFieldDest
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> XFieldDest -> c XFieldDest)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c XFieldDest)
-> (XFieldDest -> Constr)
-> (XFieldDest -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c XFieldDest))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c XFieldDest))
-> ((forall b. Data b => b -> b) -> XFieldDest -> XFieldDest)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> XFieldDest -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> XFieldDest -> r)
-> (forall u. (forall d. Data d => d -> u) -> XFieldDest -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> XFieldDest -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest)
-> Data XFieldDest
XFieldDest -> DataType
XFieldDest -> Constr
(forall b. Data b => b -> b) -> XFieldDest -> XFieldDest
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XFieldDest -> c XFieldDest
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XFieldDest
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) -> XFieldDest -> u
forall u. (forall d. Data d => d -> u) -> XFieldDest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XFieldDest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XFieldDest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XFieldDest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XFieldDest -> c XFieldDest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XFieldDest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c XFieldDest)
$cC :: Constr
$cS :: Constr
$cB :: Constr
$tXFieldDest :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest
gmapMp :: (forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest
gmapM :: (forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> XFieldDest -> m XFieldDest
gmapQi :: Int -> (forall d. Data d => d -> u) -> XFieldDest -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> XFieldDest -> u
gmapQ :: (forall d. Data d => d -> u) -> XFieldDest -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> XFieldDest -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XFieldDest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XFieldDest -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XFieldDest -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XFieldDest -> r
gmapT :: (forall b. Data b => b -> b) -> XFieldDest -> XFieldDest
$cgmapT :: (forall b. Data b => b -> b) -> XFieldDest -> XFieldDest
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c XFieldDest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c XFieldDest)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c XFieldDest)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XFieldDest)
dataTypeOf :: XFieldDest -> DataType
$cdataTypeOf :: XFieldDest -> DataType
toConstr :: XFieldDest -> Constr
$ctoConstr :: XFieldDest -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XFieldDest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XFieldDest
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XFieldDest -> c XFieldDest
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XFieldDest -> c XFieldDest
$cp1Data :: Typeable XFieldDest
Data, Typeable)

$(makeLenses ''SourceDebDescription)