{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TemplateHaskell, TypeSynonymInstances #-}
module Debian.Debianize.SourceDebDescription
    ( SourceDebDescription
    , newSourceDebDescription
    , newSourceDebDescription'
    , source
    , maintainer
    , changedBy
    , uploaders
    , dmUploadAllowed
    , priority
    , section
    , rulesRequiresRoot
    , 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 -> Bool
_rulesRequiresRoot :: Bool
      -- ^ <https://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-rules-requires-root>
      , 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
$c== :: SourceDebDescription -> SourceDebDescription -> Bool
== :: SourceDebDescription -> SourceDebDescription -> Bool
$c/= :: SourceDebDescription -> SourceDebDescription -> Bool
/= :: 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
$ccompare :: SourceDebDescription -> SourceDebDescription -> Ordering
compare :: SourceDebDescription -> SourceDebDescription -> Ordering
$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
>= :: SourceDebDescription -> SourceDebDescription -> Bool
$cmax :: SourceDebDescription
-> SourceDebDescription -> SourceDebDescription
max :: SourceDebDescription
-> SourceDebDescription -> SourceDebDescription
$cmin :: SourceDebDescription
-> SourceDebDescription -> SourceDebDescription
min :: SourceDebDescription
-> SourceDebDescription -> 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
$cshowsPrec :: Int -> SourceDebDescription -> ShowS
showsPrec :: Int -> SourceDebDescription -> ShowS
$cshow :: SourceDebDescription -> String
show :: SourceDebDescription -> String
$cshowList :: [SourceDebDescription] -> ShowS
showList :: [SourceDebDescription] -> ShowS
Show, Typeable SourceDebDescription
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 -> Constr
SourceDebDescription -> DataType
(forall b. Data b => b -> b)
-> SourceDebDescription -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceDebDescription
-> c SourceDebDescription
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceDebDescription
-> c SourceDebDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceDebDescription
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceDebDescription
$ctoConstr :: SourceDebDescription -> Constr
toConstr :: SourceDebDescription -> Constr
$cdataTypeOf :: SourceDebDescription -> DataType
dataTypeOf :: SourceDebDescription -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceDebDescription)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceDebDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceDebDescription)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceDebDescription)
$cgmapT :: (forall b. Data b => b -> b)
-> SourceDebDescription -> SourceDebDescription
gmapT :: (forall b. Data b => b -> b)
-> SourceDebDescription -> SourceDebDescription
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceDebDescription -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SourceDebDescription -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SourceDebDescription -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SourceDebDescription -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SourceDebDescription -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SourceDebDescription -> m SourceDebDescription
Data, Typeable)

instance Canonical SourceDebDescription where
    canonical :: SourceDebDescription -> SourceDebDescription
canonical SourceDebDescription
x = SourceDebDescription
x { _binaryPackages = canonical (_binaryPackages x)
                    , _buildDepends = canonical (_buildDepends x)
                    , _buildConflicts = canonical (_buildConflicts x)
                    , _buildDependsIndep = canonical (_buildDependsIndep x)
                    , _buildConflictsIndep = canonical (_buildConflictsIndep x)
                    }

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

$(makeLenses ''SourceDebDescription)