-- | This module holds a long list of lenses that access the Atoms
-- record, the record that holds the input data from which the
-- debianization is to be constructed.
{-# LANGUAGE CPP, DeriveDataTypeable, Rank2Types, TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}
module Debian.Debianize.DebInfo
    ( -- * Types
#if __HADDOCK__
      -- Is this ifdef working?
      DebInfo(..)
#else
      DebInfo
#endif
    , Atom(File, Install, InstallCabalExec, InstallCabalExecTo, InstallData, InstallDir, InstallTo, Link)
    , Site(Site, domain, server, serverAdmin)
    , Server(Server, headerMessage, hostname, installFile, port, retry, serverFlags)
    , InstallFile(InstallFile, destDir, destName, execName, sourceDir)
    , TestsStatus(..)

      -- * Lenses
    , flags
    , warning
    , sourceFormat
    , watch
    , rulesHead
    , rulesSettings
    , rulesIncludes
    , rulesFragments
    , copyright
    , control
    , intermediateFiles
    , compat
    , changelog
    , installInit
    , logrotateStanza
    , postInst
    , postRm
    , preInst
    , preRm
    , atomSet
    , noDocumentationLibrary
    , noProfilingLibrary
    , omitProfVersionDeps
    , omitLTDeps
    , buildDir
    , sourcePackageName
    , overrideDebianNameBase
    , revision
    , debVersion
    , maintainerOption
    , uploadersOption
    , utilsPackageNameBase
    , xDescriptionText
    , comments
    , missingDependencies
    , extraLibMap
    , execMap
    , apacheSite
    , sourceArchitectures
    , binaryArchitectures
    , sourcePriority
    , binaryPriorities
    , sourceSection
    , binarySections
    , executable
    , serverInfo
    , website
    , backups
    , extraDevDeps
    , official
    , testsStatus
    , allowDebianSelfBuildDeps

    , binaryDebDescription

      -- * Atom builders
    , link
    , install
    , installTo
    , installData
    , file
    , installCabalExec
    , installCabalExecTo
    , installDir

      -- * DebInfo Builder
    , makeDebInfo
    ) where

import Control.Lens
import Control.Monad.State (StateT)
import Data.Generics (Data, Typeable)
import Data.Map as Map (Map)
import Data.Set as Set (insert, Set)
import Data.Text (Text)
import Debian.Changes (ChangeLog)
import Debian.Debianize.BasicInfo (Flags)
import Debian.Debianize.Prelude (listElemLens, maybeLens)
import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, Canonical(canonical), newBinaryDebDescription, package)
import Debian.Debianize.CopyrightDescription (CopyrightDescription)
import qualified Debian.Debianize.SourceDebDescription as S (newSourceDebDescription, SourceDebDescription, binaryPackages)
import Debian.Debianize.VersionSplits (DebBase)
import Debian.Orphans ()
import Debian.Policy (PackageArchitectures, PackagePriority, Section, SourceFormat(..))
import Debian.Relation (BinPkgName, Relations, SrcPkgName)
import Debian.Version (DebianVersion)
import Prelude hiding (init, init, log, log)
import Text.Parsec.Rfc2822 (NameAddr)

-- | Information required to represent a non-cabal debianization.
data DebInfo
    = DebInfo
      { DebInfo -> Flags
_flags :: Flags
      -- ^ Information regarding mode of operation - verbosity, dry-run, usage, etc
      , DebInfo -> Set Text
_warning :: Set Text
      -- ^ A warning to be reported later
      , DebInfo -> SourceFormat
_sourceFormat :: SourceFormat
      -- ^ Write debian/source/format
      , DebInfo -> Maybe Text
_watch :: Maybe Text
      -- ^ the @debian\/watch@ file
      , DebInfo -> Maybe Text
_rulesHead :: Maybe Text
      -- ^ The rules file header
      , DebInfo -> [Text]
_rulesSettings :: [Text]
      -- ^ The rules file assignments
      , DebInfo -> [Text]
_rulesIncludes :: [Text]
      -- ^ The rules file include directives
      , DebInfo -> Set Text
_rulesFragments :: Set Text
      -- ^ Additional fragments of the rules file
      , DebInfo -> Maybe CopyrightDescription
_copyright :: Maybe CopyrightDescription
      -- ^ Override the copyright value computed from the cabal package description.
      , DebInfo -> SourceDebDescription
_control :: S.SourceDebDescription
      -- ^ The parsed contents of the control file
      , DebInfo -> Set (FilePath, Text)
_intermediateFiles :: Set (FilePath, Text)
      -- ^ Put this text into a file with the given name in the debianization.
      , DebInfo -> Maybe Int
_compat :: Maybe Int
      -- ^ The debhelper compatibility level, from debian/compat.
      , DebInfo -> Maybe ChangeLog
_changelog :: Maybe ChangeLog
      -- ^ The changelog, first entry contains the source package name and version
      , DebInfo -> Map BinPkgName Text
_installInit :: Map BinPkgName Text
      -- ^ Add an init.d file to the binary package
      , DebInfo -> Map BinPkgName (Set Text)
_logrotateStanza :: Map BinPkgName (Set Text)
      -- ^ Add a stanza of a logrotate file to the binary package
      , DebInfo -> Map BinPkgName Text
_postInst :: Map BinPkgName Text
      -- ^ Map of @debian/postinst@ scripts - to be run after install,
      -- should contain #DEBHELPER# line before exit 0
      , DebInfo -> Map BinPkgName Text
_postRm :: Map BinPkgName Text
      -- ^ Map of @debian/postrm@ scripts - scripts to run after
      -- remove, should contain #DEBHELPER# line before exit 0
      , DebInfo -> Map BinPkgName Text
_preInst :: Map BinPkgName Text
      -- ^ Map of @debian/preinst@ scripts - to be run before install,
      -- should contain #DEBHELPER# line before exit 0
      , DebInfo -> Map BinPkgName Text
_preRm :: Map BinPkgName Text
      -- ^ Map of @debian/prerm@ scripts - to be run before remove,
      -- should contain #DEBHELPER# line before exit 0
      , DebInfo -> Set Atom
_atomSet :: Set Atom
      -- ^ set of items describing file installation requests
      , DebInfo -> Bool
_noDocumentationLibrary :: Bool
      -- ^ Do not produce a libghc-foo-doc package.
      , DebInfo -> Bool
_noProfilingLibrary :: Bool
      -- ^ Do not produce a libghc-foo-prof package.
      , DebInfo -> Bool
_omitProfVersionDeps :: Bool
      -- ^ If present, Do not put the version dependencies on the prof packages that we put on the dev packages.
      , DebInfo -> Bool
_omitLTDeps :: Bool
      -- ^ If present, don't generate the << dependency when we see a cabal
      -- equals dependency.  (The implementation of this was somehow lost.)
      , DebInfo -> Maybe FilePath
_buildDir :: Maybe FilePath
      -- ^ The build directory used by cabal, typically dist/build when
      -- building manually or dist-ghc/build when building using GHC and
      -- haskell-devscripts.  This value is used to locate files
      -- produced by cabal so we can move them into the deb.  Note that
      -- the --builddir option of runhaskell Setup appends the "/build"
      -- to the value it receives, so, yes, try not to get confused.
      -- FIXME: make this FilePath or Maybe FilePath
      , DebInfo -> Maybe SrcPkgName
_sourcePackageName :: Maybe SrcPkgName
      -- ^ Name to give to the debian source package.  If not supplied
      -- the name is constructed from the cabal package name.  Note that
      -- DebianNameMap could encode this information if we already knew
      -- the cabal package name, but we can't assume that.
      , DebInfo -> Maybe DebBase
_overrideDebianNameBase :: Maybe DebBase
      -- ^ If given, use this name for the base of the debian binary
      -- packages - the string between 'libghc-' and '-dev'.  Normally
      -- this is derived from the hackage package name.
      , DebInfo -> Maybe FilePath
_revision :: Maybe String
      -- ^ Specify the revision string to use when converting the
      -- cabal version to debian.
      , DebInfo -> Maybe DebianVersion
_debVersion :: Maybe DebianVersion
      -- ^ Specify the exact debian version of the resulting package,
      -- including epoch.  One use case is to work around the the
      -- "buildN" versions that are often uploaded to the debian and
      -- ubuntu repositories.  Say the latest cabal version of
      -- transformers is 0.3.0.0, but the debian repository contains
      -- version 0.3.0.0-1build3, we need to specify
      -- debVersion="0.3.0.0-1build3" or the version we produce will
      -- look older than the one already available upstream.
      , DebInfo -> Maybe NameAddr
_maintainerOption :: Maybe NameAddr
      , DebInfo -> [NameAddr]
_uploadersOption :: [NameAddr]
      -- ^ Value for the maintainer field in the control file.  Note that
      -- the cabal maintainer field can have multiple addresses, but debian
      -- only one.  If this is not explicitly set, it is obtained from the
      -- cabal file, and if it is not there then from the environment.  As a
      -- last resort, there is a hard coded string in here somewhere.
      , DebInfo -> Maybe FilePath
_utilsPackageNameBase :: Maybe String
      -- ^ Name of a package that will get left-over data files and executables.
      -- If there are more than one, each package will get those files.
      , DebInfo -> Maybe Text
_xDescriptionText :: Maybe Text
      -- ^ The text for the X-Description field of the Source package stanza.
      , DebInfo -> Maybe [[Text]]
_comments :: Maybe [[Text]]
      -- ^ Each element is a comment to be added to the changelog, where the
      -- element's text elements are the lines of the comment.
      , DebInfo -> Set BinPkgName
_missingDependencies :: Set BinPkgName
      -- ^ Lets cabal-debian know that a package it might expect to exist
      -- actually does not, so omit all uses in resulting debianization.
      , DebInfo -> Map FilePath Relations
_extraLibMap :: Map String Relations
      -- ^ Map a cabal Extra-Library name to a debian binary package name,
      -- e.g. @ExtraLibMapping extraLibMap "cryptopp" "libcrypto-dev"@ adds a
      -- build dependency *and* a regular dependency on @libcrypto-dev@ to
      -- any package that has @cryptopp@ in its cabal Extra-Library list.
      , DebInfo -> Map FilePath Relations
_execMap :: Map String Relations
      -- ^ Map a cabal Build-Tool name to a debian binary package name,
      -- e.g. @ExecMapping "trhsx" "haskell-hsx-utils"@ adds a build
      -- dependency on @haskell-hsx-utils@ to any package that has @trhsx@ in its
      -- cabal build-tool list.
      , DebInfo -> Map BinPkgName (FilePath, FilePath, Text)
_apacheSite :: Map BinPkgName (String, FilePath, Text)
      -- ^ Have Apache configure a site using PACKAGE, DOMAIN, LOGDIR, and APACHECONFIGFILE
      , DebInfo -> Maybe PackageArchitectures
_sourceArchitectures :: Maybe PackageArchitectures
      -- ^ Set the Architecture field of the source package
      , DebInfo -> Map BinPkgName PackageArchitectures
_binaryArchitectures :: Map BinPkgName PackageArchitectures
      -- ^ Set the Architecture field of a binary package
      , DebInfo -> Maybe PackagePriority
_sourcePriority :: Maybe PackagePriority
      -- ^ Set the Priority field of the source package
      , DebInfo -> Map BinPkgName PackagePriority
_binaryPriorities :: Map BinPkgName PackagePriority
      -- ^ Set the Priority field of a binary package
      , DebInfo -> Maybe Section
_sourceSection :: Maybe Section
      -- ^ Set the Section field of the source package
      , DebInfo -> Map BinPkgName Section
_binarySections :: Map BinPkgName Section
      -- ^ Set the Section field of a binary package
      , DebInfo -> Map BinPkgName InstallFile
_executable :: Map BinPkgName InstallFile
      -- ^ Create a binary package to hold a cabal executable
      , DebInfo -> Map BinPkgName Server
_serverInfo :: Map BinPkgName Server
      -- ^ Like DHExecutable, but configure the executable as a server process
      , DebInfo -> Map BinPkgName Site
_website :: Map BinPkgName Site
      -- ^ Like DHServer, but configure the server as a web server
      , DebInfo -> Map BinPkgName FilePath
_backups :: Map BinPkgName String
      -- ^ Configure the executable to do incremental backups
      , DebInfo -> Relations
_extraDevDeps :: Relations
      -- ^ Limited version of Depends, put a dependency on the dev library package.  The only
      -- reason to use this is because we don't yet know the name of the dev library package.
      , DebInfo -> Bool
_official :: Bool
      -- ^ Whether this packaging is created by the Debian Haskell Group
      , DebInfo -> TestsStatus
_testsStatus :: TestsStatus
      -- ^ Whether or not to build and/or run the test suite
      , DebInfo -> Bool
_allowDebianSelfBuildDeps :: Bool
      -- ^ Normally self dependencies are filtered out of the debian
      -- build dependency list because they usually reflect
      -- interdependencies between the library and the executable in
      -- the Cabal packages.  This flag turns off that filtering.
      } deriving (Int -> DebInfo -> ShowS
[DebInfo] -> ShowS
DebInfo -> FilePath
(Int -> DebInfo -> ShowS)
-> (DebInfo -> FilePath) -> ([DebInfo] -> ShowS) -> Show DebInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DebInfo] -> ShowS
$cshowList :: [DebInfo] -> ShowS
show :: DebInfo -> FilePath
$cshow :: DebInfo -> FilePath
showsPrec :: Int -> DebInfo -> ShowS
$cshowsPrec :: Int -> DebInfo -> ShowS
Show, Typeable DebInfo
DataType
Constr
Typeable DebInfo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DebInfo -> c DebInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DebInfo)
-> (DebInfo -> Constr)
-> (DebInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DebInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DebInfo))
-> ((forall b. Data b => b -> b) -> DebInfo -> DebInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DebInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DebInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> DebInfo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DebInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DebInfo -> m DebInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DebInfo -> m DebInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DebInfo -> m DebInfo)
-> Data DebInfo
DebInfo -> DataType
DebInfo -> Constr
(forall b. Data b => b -> b) -> DebInfo -> DebInfo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DebInfo -> c DebInfo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DebInfo
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) -> DebInfo -> u
forall u. (forall d. Data d => d -> u) -> DebInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DebInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DebInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DebInfo -> m DebInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DebInfo -> m DebInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DebInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DebInfo -> c DebInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DebInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DebInfo)
$cDebInfo :: Constr
$tDebInfo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DebInfo -> m DebInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DebInfo -> m DebInfo
gmapMp :: (forall d. Data d => d -> m d) -> DebInfo -> m DebInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DebInfo -> m DebInfo
gmapM :: (forall d. Data d => d -> m d) -> DebInfo -> m DebInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DebInfo -> m DebInfo
gmapQi :: Int -> (forall d. Data d => d -> u) -> DebInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DebInfo -> u
gmapQ :: (forall d. Data d => d -> u) -> DebInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DebInfo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DebInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DebInfo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DebInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DebInfo -> r
gmapT :: (forall b. Data b => b -> b) -> DebInfo -> DebInfo
$cgmapT :: (forall b. Data b => b -> b) -> DebInfo -> DebInfo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DebInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DebInfo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DebInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DebInfo)
dataTypeOf :: DebInfo -> DataType
$cdataTypeOf :: DebInfo -> DataType
toConstr :: DebInfo -> Constr
$ctoConstr :: DebInfo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DebInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DebInfo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DebInfo -> c DebInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DebInfo -> c DebInfo
$cp1Data :: Typeable DebInfo
Data, Typeable)

data Atom
    = Link BinPkgName FilePath FilePath
      -- ^ Create a symbolic link in the binary package
    | Install BinPkgName FilePath FilePath
      -- ^ Install a build file into the binary package
    | InstallTo BinPkgName FilePath FilePath
      -- ^ Install a build file into the binary package at an exact location
    | InstallData BinPkgName FilePath FilePath
      -- ^ DHInstallTo somewhere relative to DataDir (see above)
    | File BinPkgName FilePath Text
      -- ^ Create a file with the given text at the given path
    | InstallCabalExec BinPkgName String FilePath
      -- ^ Install a cabal executable into the binary package
    | InstallCabalExecTo BinPkgName String FilePath
      -- ^ Install a cabal executable into the binary package at an exact location
    | InstallDir BinPkgName FilePath
      -- ^ Create a directory in the binary package
    deriving (Int -> Atom -> ShowS
[Atom] -> ShowS
Atom -> FilePath
(Int -> Atom -> ShowS)
-> (Atom -> FilePath) -> ([Atom] -> ShowS) -> Show Atom
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Atom] -> ShowS
$cshowList :: [Atom] -> ShowS
show :: Atom -> FilePath
$cshow :: Atom -> FilePath
showsPrec :: Int -> Atom -> ShowS
$cshowsPrec :: Int -> Atom -> ShowS
Show, Atom -> Atom -> Bool
(Atom -> Atom -> Bool) -> (Atom -> Atom -> Bool) -> Eq Atom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq, Eq Atom
Eq Atom
-> (Atom -> Atom -> Ordering)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Bool)
-> (Atom -> Atom -> Atom)
-> (Atom -> Atom -> Atom)
-> Ord Atom
Atom -> Atom -> Bool
Atom -> Atom -> Ordering
Atom -> Atom -> Atom
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 :: Atom -> Atom -> Atom
$cmin :: Atom -> Atom -> Atom
max :: Atom -> Atom -> Atom
$cmax :: Atom -> Atom -> Atom
>= :: Atom -> Atom -> Bool
$c>= :: Atom -> Atom -> Bool
> :: Atom -> Atom -> Bool
$c> :: Atom -> Atom -> Bool
<= :: Atom -> Atom -> Bool
$c<= :: Atom -> Atom -> Bool
< :: Atom -> Atom -> Bool
$c< :: Atom -> Atom -> Bool
compare :: Atom -> Atom -> Ordering
$ccompare :: Atom -> Atom -> Ordering
$cp1Ord :: Eq Atom
Ord, Typeable Atom
DataType
Constr
Typeable Atom
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Atom -> c Atom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Atom)
-> (Atom -> Constr)
-> (Atom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Atom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom))
-> ((forall b. Data b => b -> b) -> Atom -> Atom)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r)
-> (forall u. (forall d. Data d => d -> u) -> Atom -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Atom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Atom -> m Atom)
-> Data Atom
Atom -> DataType
Atom -> Constr
(forall b. Data b => b -> b) -> Atom -> Atom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
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) -> Atom -> u
forall u. (forall d. Data d => d -> u) -> Atom -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Atom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
$cInstallDir :: Constr
$cInstallCabalExecTo :: Constr
$cInstallCabalExec :: Constr
$cFile :: Constr
$cInstallData :: Constr
$cInstallTo :: Constr
$cInstall :: Constr
$cLink :: Constr
$tAtom :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapMp :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapM :: (forall d. Data d => d -> m d) -> Atom -> m Atom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Atom -> m Atom
gmapQi :: Int -> (forall d. Data d => d -> u) -> Atom -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Atom -> u
gmapQ :: (forall d. Data d => d -> u) -> Atom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Atom -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r
gmapT :: (forall b. Data b => b -> b) -> Atom -> Atom
$cgmapT :: (forall b. Data b => b -> b) -> Atom -> Atom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Atom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Atom)
dataTypeOf :: Atom -> DataType
$cdataTypeOf :: Atom -> DataType
toConstr :: Atom -> Constr
$ctoConstr :: Atom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Atom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atom -> c Atom
$cp1Data :: Typeable Atom
Data, Typeable)

data InstallFile
    = InstallFile
      { InstallFile -> FilePath
execName :: String -- ^ The name of the executable file
      , InstallFile -> Maybe FilePath
sourceDir :: Maybe FilePath -- ^ where to find it, default is dist/build/<execName>/
      , InstallFile -> Maybe FilePath
destDir :: Maybe FilePath -- ^ where to put it, default is usr/bin/<execName>
      , InstallFile -> FilePath
destName :: String  -- ^ name to give installed executable
      } deriving (ReadPrec [InstallFile]
ReadPrec InstallFile
Int -> ReadS InstallFile
ReadS [InstallFile]
(Int -> ReadS InstallFile)
-> ReadS [InstallFile]
-> ReadPrec InstallFile
-> ReadPrec [InstallFile]
-> Read InstallFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstallFile]
$creadListPrec :: ReadPrec [InstallFile]
readPrec :: ReadPrec InstallFile
$creadPrec :: ReadPrec InstallFile
readList :: ReadS [InstallFile]
$creadList :: ReadS [InstallFile]
readsPrec :: Int -> ReadS InstallFile
$creadsPrec :: Int -> ReadS InstallFile
Read, Int -> InstallFile -> ShowS
[InstallFile] -> ShowS
InstallFile -> FilePath
(Int -> InstallFile -> ShowS)
-> (InstallFile -> FilePath)
-> ([InstallFile] -> ShowS)
-> Show InstallFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InstallFile] -> ShowS
$cshowList :: [InstallFile] -> ShowS
show :: InstallFile -> FilePath
$cshow :: InstallFile -> FilePath
showsPrec :: Int -> InstallFile -> ShowS
$cshowsPrec :: Int -> InstallFile -> ShowS
Show, InstallFile -> InstallFile -> Bool
(InstallFile -> InstallFile -> Bool)
-> (InstallFile -> InstallFile -> Bool) -> Eq InstallFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallFile -> InstallFile -> Bool
$c/= :: InstallFile -> InstallFile -> Bool
== :: InstallFile -> InstallFile -> Bool
$c== :: InstallFile -> InstallFile -> Bool
Eq, Eq InstallFile
Eq InstallFile
-> (InstallFile -> InstallFile -> Ordering)
-> (InstallFile -> InstallFile -> Bool)
-> (InstallFile -> InstallFile -> Bool)
-> (InstallFile -> InstallFile -> Bool)
-> (InstallFile -> InstallFile -> Bool)
-> (InstallFile -> InstallFile -> InstallFile)
-> (InstallFile -> InstallFile -> InstallFile)
-> Ord InstallFile
InstallFile -> InstallFile -> Bool
InstallFile -> InstallFile -> Ordering
InstallFile -> InstallFile -> InstallFile
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 :: InstallFile -> InstallFile -> InstallFile
$cmin :: InstallFile -> InstallFile -> InstallFile
max :: InstallFile -> InstallFile -> InstallFile
$cmax :: InstallFile -> InstallFile -> InstallFile
>= :: InstallFile -> InstallFile -> Bool
$c>= :: InstallFile -> InstallFile -> Bool
> :: InstallFile -> InstallFile -> Bool
$c> :: InstallFile -> InstallFile -> Bool
<= :: InstallFile -> InstallFile -> Bool
$c<= :: InstallFile -> InstallFile -> Bool
< :: InstallFile -> InstallFile -> Bool
$c< :: InstallFile -> InstallFile -> Bool
compare :: InstallFile -> InstallFile -> Ordering
$ccompare :: InstallFile -> InstallFile -> Ordering
$cp1Ord :: Eq InstallFile
Ord, Typeable InstallFile
DataType
Constr
Typeable InstallFile
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> InstallFile -> c InstallFile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InstallFile)
-> (InstallFile -> Constr)
-> (InstallFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InstallFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InstallFile))
-> ((forall b. Data b => b -> b) -> InstallFile -> InstallFile)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InstallFile -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InstallFile -> r)
-> (forall u. (forall d. Data d => d -> u) -> InstallFile -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InstallFile -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> InstallFile -> m InstallFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InstallFile -> m InstallFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InstallFile -> m InstallFile)
-> Data InstallFile
InstallFile -> DataType
InstallFile -> Constr
(forall b. Data b => b -> b) -> InstallFile -> InstallFile
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstallFile -> c InstallFile
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstallFile
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) -> InstallFile -> u
forall u. (forall d. Data d => d -> u) -> InstallFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstallFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstallFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InstallFile -> m InstallFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InstallFile -> m InstallFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstallFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstallFile -> c InstallFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InstallFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InstallFile)
$cInstallFile :: Constr
$tInstallFile :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> InstallFile -> m InstallFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InstallFile -> m InstallFile
gmapMp :: (forall d. Data d => d -> m d) -> InstallFile -> m InstallFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InstallFile -> m InstallFile
gmapM :: (forall d. Data d => d -> m d) -> InstallFile -> m InstallFile
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InstallFile -> m InstallFile
gmapQi :: Int -> (forall d. Data d => d -> u) -> InstallFile -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InstallFile -> u
gmapQ :: (forall d. Data d => d -> u) -> InstallFile -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InstallFile -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstallFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstallFile -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstallFile -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstallFile -> r
gmapT :: (forall b. Data b => b -> b) -> InstallFile -> InstallFile
$cgmapT :: (forall b. Data b => b -> b) -> InstallFile -> InstallFile
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InstallFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InstallFile)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InstallFile)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InstallFile)
dataTypeOf :: InstallFile -> DataType
$cdataTypeOf :: InstallFile -> DataType
toConstr :: InstallFile -> Constr
$ctoConstr :: InstallFile -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstallFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstallFile
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstallFile -> c InstallFile
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstallFile -> c InstallFile
$cp1Data :: Typeable InstallFile
Data, Typeable)

-- | Information about the web site we are packaging.
data Site
    = Site
      { Site -> FilePath
domain :: String   -- ^ The domain name assigned to the server.
                           -- An apache configuration will be generated to
                           -- redirect requests from this domain to hostname:port
      , Site -> FilePath
serverAdmin :: String   -- ^ Apache ServerAdmin parameter
      , Site -> Server
server :: Server   -- ^ The hint to install the server job
      } deriving (ReadPrec [Site]
ReadPrec Site
Int -> ReadS Site
ReadS [Site]
(Int -> ReadS Site)
-> ReadS [Site] -> ReadPrec Site -> ReadPrec [Site] -> Read Site
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Site]
$creadListPrec :: ReadPrec [Site]
readPrec :: ReadPrec Site
$creadPrec :: ReadPrec Site
readList :: ReadS [Site]
$creadList :: ReadS [Site]
readsPrec :: Int -> ReadS Site
$creadsPrec :: Int -> ReadS Site
Read, Int -> Site -> ShowS
[Site] -> ShowS
Site -> FilePath
(Int -> Site -> ShowS)
-> (Site -> FilePath) -> ([Site] -> ShowS) -> Show Site
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Site] -> ShowS
$cshowList :: [Site] -> ShowS
show :: Site -> FilePath
$cshow :: Site -> FilePath
showsPrec :: Int -> Site -> ShowS
$cshowsPrec :: Int -> Site -> ShowS
Show, Site -> Site -> Bool
(Site -> Site -> Bool) -> (Site -> Site -> Bool) -> Eq Site
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Site -> Site -> Bool
$c/= :: Site -> Site -> Bool
== :: Site -> Site -> Bool
$c== :: Site -> Site -> Bool
Eq, Eq Site
Eq Site
-> (Site -> Site -> Ordering)
-> (Site -> Site -> Bool)
-> (Site -> Site -> Bool)
-> (Site -> Site -> Bool)
-> (Site -> Site -> Bool)
-> (Site -> Site -> Site)
-> (Site -> Site -> Site)
-> Ord Site
Site -> Site -> Bool
Site -> Site -> Ordering
Site -> Site -> Site
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 :: Site -> Site -> Site
$cmin :: Site -> Site -> Site
max :: Site -> Site -> Site
$cmax :: Site -> Site -> Site
>= :: Site -> Site -> Bool
$c>= :: Site -> Site -> Bool
> :: Site -> Site -> Bool
$c> :: Site -> Site -> Bool
<= :: Site -> Site -> Bool
$c<= :: Site -> Site -> Bool
< :: Site -> Site -> Bool
$c< :: Site -> Site -> Bool
compare :: Site -> Site -> Ordering
$ccompare :: Site -> Site -> Ordering
$cp1Ord :: Eq Site
Ord, Typeable Site
DataType
Constr
Typeable Site
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Site -> c Site)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Site)
-> (Site -> Constr)
-> (Site -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Site))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Site))
-> ((forall b. Data b => b -> b) -> Site -> Site)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Site -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Site -> r)
-> (forall u. (forall d. Data d => d -> u) -> Site -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Site -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Site -> m Site)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Site -> m Site)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Site -> m Site)
-> Data Site
Site -> DataType
Site -> Constr
(forall b. Data b => b -> b) -> Site -> Site
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Site -> c Site
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Site
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) -> Site -> u
forall u. (forall d. Data d => d -> u) -> Site -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Site -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Site -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Site -> m Site
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Site -> m Site
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Site
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Site -> c Site
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Site)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Site)
$cSite :: Constr
$tSite :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Site -> m Site
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Site -> m Site
gmapMp :: (forall d. Data d => d -> m d) -> Site -> m Site
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Site -> m Site
gmapM :: (forall d. Data d => d -> m d) -> Site -> m Site
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Site -> m Site
gmapQi :: Int -> (forall d. Data d => d -> u) -> Site -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Site -> u
gmapQ :: (forall d. Data d => d -> u) -> Site -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Site -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Site -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Site -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Site -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Site -> r
gmapT :: (forall b. Data b => b -> b) -> Site -> Site
$cgmapT :: (forall b. Data b => b -> b) -> Site -> Site
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Site)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Site)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Site)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Site)
dataTypeOf :: Site -> DataType
$cdataTypeOf :: Site -> DataType
toConstr :: Site -> Constr
$ctoConstr :: Site -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Site
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Site
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Site -> c Site
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Site -> c Site
$cp1Data :: Typeable Site
Data, Typeable)

-- | Information about the server we are packaging.
data Server
    = Server
      { Server -> FilePath
hostname :: String      -- ^ Host on which the server will run
      , Server -> Int
port :: Int             -- ^ Port on which the server will run.
                                -- Obviously, this must assign each and
                                -- every server package to a different
                                -- port.
      , Server -> FilePath
headerMessage :: String -- ^ A comment that will be inserted to
                                -- explain how the file was generated
      , Server -> FilePath
retry :: String         -- ^ start-stop-daemon --retry argument
      , Server -> [FilePath]
serverFlags :: [String] -- ^ Extra flags to pass to the server via the init script
      , Server -> InstallFile
installFile :: InstallFile -- ^ The hint to install the server executable
      } deriving (ReadPrec [Server]
ReadPrec Server
Int -> ReadS Server
ReadS [Server]
(Int -> ReadS Server)
-> ReadS [Server]
-> ReadPrec Server
-> ReadPrec [Server]
-> Read Server
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Server]
$creadListPrec :: ReadPrec [Server]
readPrec :: ReadPrec Server
$creadPrec :: ReadPrec Server
readList :: ReadS [Server]
$creadList :: ReadS [Server]
readsPrec :: Int -> ReadS Server
$creadsPrec :: Int -> ReadS Server
Read, Int -> Server -> ShowS
[Server] -> ShowS
Server -> FilePath
(Int -> Server -> ShowS)
-> (Server -> FilePath) -> ([Server] -> ShowS) -> Show Server
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> FilePath
$cshow :: Server -> FilePath
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show, Server -> Server -> Bool
(Server -> Server -> Bool)
-> (Server -> Server -> Bool) -> Eq Server
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Server -> Server -> Bool
$c/= :: Server -> Server -> Bool
== :: Server -> Server -> Bool
$c== :: Server -> Server -> Bool
Eq, Eq Server
Eq Server
-> (Server -> Server -> Ordering)
-> (Server -> Server -> Bool)
-> (Server -> Server -> Bool)
-> (Server -> Server -> Bool)
-> (Server -> Server -> Bool)
-> (Server -> Server -> Server)
-> (Server -> Server -> Server)
-> Ord Server
Server -> Server -> Bool
Server -> Server -> Ordering
Server -> Server -> Server
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 :: Server -> Server -> Server
$cmin :: Server -> Server -> Server
max :: Server -> Server -> Server
$cmax :: Server -> Server -> Server
>= :: Server -> Server -> Bool
$c>= :: Server -> Server -> Bool
> :: Server -> Server -> Bool
$c> :: Server -> Server -> Bool
<= :: Server -> Server -> Bool
$c<= :: Server -> Server -> Bool
< :: Server -> Server -> Bool
$c< :: Server -> Server -> Bool
compare :: Server -> Server -> Ordering
$ccompare :: Server -> Server -> Ordering
$cp1Ord :: Eq Server
Ord, Typeable Server
DataType
Constr
Typeable Server
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Server -> c Server)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Server)
-> (Server -> Constr)
-> (Server -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Server))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server))
-> ((forall b. Data b => b -> b) -> Server -> Server)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Server -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Server -> r)
-> (forall u. (forall d. Data d => d -> u) -> Server -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Server -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Server -> m Server)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Server -> m Server)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Server -> m Server)
-> Data Server
Server -> DataType
Server -> Constr
(forall b. Data b => b -> b) -> Server -> Server
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Server -> c Server
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Server
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) -> Server -> u
forall u. (forall d. Data d => d -> u) -> Server -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Server -> m Server
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Server -> m Server
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Server
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Server -> c Server
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Server)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server)
$cServer :: Constr
$tServer :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Server -> m Server
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Server -> m Server
gmapMp :: (forall d. Data d => d -> m d) -> Server -> m Server
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Server -> m Server
gmapM :: (forall d. Data d => d -> m d) -> Server -> m Server
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Server -> m Server
gmapQi :: Int -> (forall d. Data d => d -> u) -> Server -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Server -> u
gmapQ :: (forall d. Data d => d -> u) -> Server -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Server -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Server -> r
gmapT :: (forall b. Data b => b -> b) -> Server -> Server
$cgmapT :: (forall b. Data b => b -> b) -> Server -> Server
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Server)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Server)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Server)
dataTypeOf :: Server -> DataType
$cdataTypeOf :: Server -> DataType
toConstr :: Server -> Constr
$ctoConstr :: Server -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Server
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Server
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Server -> c Server
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Server -> c Server
$cp1Data :: Typeable Server
Data, Typeable)

data TestsStatus = TestsDisable | TestsBuild | TestsRun deriving (TestsStatus -> TestsStatus -> Bool
(TestsStatus -> TestsStatus -> Bool)
-> (TestsStatus -> TestsStatus -> Bool) -> Eq TestsStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestsStatus -> TestsStatus -> Bool
$c/= :: TestsStatus -> TestsStatus -> Bool
== :: TestsStatus -> TestsStatus -> Bool
$c== :: TestsStatus -> TestsStatus -> Bool
Eq, Int -> TestsStatus -> ShowS
[TestsStatus] -> ShowS
TestsStatus -> FilePath
(Int -> TestsStatus -> ShowS)
-> (TestsStatus -> FilePath)
-> ([TestsStatus] -> ShowS)
-> Show TestsStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TestsStatus] -> ShowS
$cshowList :: [TestsStatus] -> ShowS
show :: TestsStatus -> FilePath
$cshow :: TestsStatus -> FilePath
showsPrec :: Int -> TestsStatus -> ShowS
$cshowsPrec :: Int -> TestsStatus -> ShowS
Show, Typeable TestsStatus
DataType
Constr
Typeable TestsStatus
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TestsStatus -> c TestsStatus)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TestsStatus)
-> (TestsStatus -> Constr)
-> (TestsStatus -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TestsStatus))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TestsStatus))
-> ((forall b. Data b => b -> b) -> TestsStatus -> TestsStatus)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TestsStatus -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TestsStatus -> r)
-> (forall u. (forall d. Data d => d -> u) -> TestsStatus -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TestsStatus -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus)
-> Data TestsStatus
TestsStatus -> DataType
TestsStatus -> Constr
(forall b. Data b => b -> b) -> TestsStatus -> TestsStatus
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TestsStatus -> c TestsStatus
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TestsStatus
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) -> TestsStatus -> u
forall u. (forall d. Data d => d -> u) -> TestsStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TestsStatus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TestsStatus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TestsStatus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TestsStatus -> c TestsStatus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TestsStatus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TestsStatus)
$cTestsRun :: Constr
$cTestsBuild :: Constr
$cTestsDisable :: Constr
$tTestsStatus :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus
gmapMp :: (forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus
gmapM :: (forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TestsStatus -> m TestsStatus
gmapQi :: Int -> (forall d. Data d => d -> u) -> TestsStatus -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TestsStatus -> u
gmapQ :: (forall d. Data d => d -> u) -> TestsStatus -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TestsStatus -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TestsStatus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TestsStatus -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TestsStatus -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TestsStatus -> r
gmapT :: (forall b. Data b => b -> b) -> TestsStatus -> TestsStatus
$cgmapT :: (forall b. Data b => b -> b) -> TestsStatus -> TestsStatus
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TestsStatus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TestsStatus)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TestsStatus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TestsStatus)
dataTypeOf :: TestsStatus -> DataType
$cdataTypeOf :: TestsStatus -> DataType
toConstr :: TestsStatus -> Constr
$ctoConstr :: TestsStatus -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TestsStatus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TestsStatus
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TestsStatus -> c TestsStatus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TestsStatus -> c TestsStatus
$cp1Data :: Typeable TestsStatus
Data, Typeable)

makeDebInfo :: Flags -> DebInfo
makeDebInfo :: Flags -> DebInfo
makeDebInfo Flags
fs =
    DebInfo :: Flags
-> Set Text
-> SourceFormat
-> Maybe Text
-> Maybe Text
-> [Text]
-> [Text]
-> Set Text
-> Maybe CopyrightDescription
-> SourceDebDescription
-> Set (FilePath, Text)
-> Maybe Int
-> Maybe ChangeLog
-> Map BinPkgName Text
-> Map BinPkgName (Set Text)
-> Map BinPkgName Text
-> Map BinPkgName Text
-> Map BinPkgName Text
-> Map BinPkgName Text
-> Set Atom
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe FilePath
-> Maybe SrcPkgName
-> Maybe DebBase
-> Maybe FilePath
-> Maybe DebianVersion
-> Maybe NameAddr
-> [NameAddr]
-> Maybe FilePath
-> Maybe Text
-> Maybe [[Text]]
-> Set BinPkgName
-> Map FilePath Relations
-> Map FilePath Relations
-> Map BinPkgName (FilePath, FilePath, Text)
-> Maybe PackageArchitectures
-> Map BinPkgName PackageArchitectures
-> Maybe PackagePriority
-> Map BinPkgName PackagePriority
-> Maybe Section
-> Map BinPkgName Section
-> Map BinPkgName InstallFile
-> Map BinPkgName Server
-> Map BinPkgName Site
-> Map BinPkgName FilePath
-> Relations
-> Bool
-> TestsStatus
-> Bool
-> DebInfo
DebInfo
    { _flags :: Flags
_flags = Flags
fs
    , _warning :: Set Text
_warning = Set Text
forall a. Monoid a => a
mempty
    , _sourceFormat :: SourceFormat
_sourceFormat = SourceFormat
Quilt3
    , _watch :: Maybe Text
_watch = Maybe Text
forall a. Maybe a
Nothing
    , _rulesHead :: Maybe Text
_rulesHead = Maybe Text
forall a. Maybe a
Nothing
    , _rulesSettings :: [Text]
_rulesSettings = [Text]
forall a. Monoid a => a
mempty
    , _rulesIncludes :: [Text]
_rulesIncludes = [Text]
forall a. Monoid a => a
mempty
    , _rulesFragments :: Set Text
_rulesFragments = Set Text
forall a. Monoid a => a
mempty
    , _copyright :: Maybe CopyrightDescription
_copyright = Maybe CopyrightDescription
forall a. Maybe a
Nothing
    , _control :: SourceDebDescription
_control = SourceDebDescription
S.newSourceDebDescription
    , _intermediateFiles :: Set (FilePath, Text)
_intermediateFiles = Set (FilePath, Text)
forall a. Monoid a => a
mempty
    , _compat :: Maybe Int
_compat = Maybe Int
forall a. Maybe a
Nothing
    , _changelog :: Maybe ChangeLog
_changelog = Maybe ChangeLog
forall a. Maybe a
Nothing
    , _installInit :: Map BinPkgName Text
_installInit = Map BinPkgName Text
forall a. Monoid a => a
mempty
    , _logrotateStanza :: Map BinPkgName (Set Text)
_logrotateStanza = Map BinPkgName (Set Text)
forall a. Monoid a => a
mempty
    , _postInst :: Map BinPkgName Text
_postInst = Map BinPkgName Text
forall a. Monoid a => a
mempty
    , _postRm :: Map BinPkgName Text
_postRm = Map BinPkgName Text
forall a. Monoid a => a
mempty
    , _preInst :: Map BinPkgName Text
_preInst = Map BinPkgName Text
forall a. Monoid a => a
mempty
    , _preRm :: Map BinPkgName Text
_preRm = Map BinPkgName Text
forall a. Monoid a => a
mempty
    , _atomSet :: Set Atom
_atomSet = Set Atom
forall a. Monoid a => a
mempty
    , _noDocumentationLibrary :: Bool
_noDocumentationLibrary = Bool
False
    , _noProfilingLibrary :: Bool
_noProfilingLibrary = Bool
False
    , _omitProfVersionDeps :: Bool
_omitProfVersionDeps = Bool
False
    , _omitLTDeps :: Bool
_omitLTDeps = Bool
False
    , _buildDir :: Maybe FilePath
_buildDir = Maybe FilePath
forall a. Maybe a
Nothing
    , _sourcePackageName :: Maybe SrcPkgName
_sourcePackageName = Maybe SrcPkgName
forall a. Maybe a
Nothing
    , _overrideDebianNameBase :: Maybe DebBase
_overrideDebianNameBase = Maybe DebBase
forall a. Maybe a
Nothing
    , _revision :: Maybe FilePath
_revision = Maybe FilePath
forall a. Maybe a
Nothing
    , _debVersion :: Maybe DebianVersion
_debVersion = Maybe DebianVersion
forall a. Maybe a
Nothing
    , _maintainerOption :: Maybe NameAddr
_maintainerOption = Maybe NameAddr
forall a. Maybe a
Nothing
    , _uploadersOption :: [NameAddr]
_uploadersOption = []
    , _utilsPackageNameBase :: Maybe FilePath
_utilsPackageNameBase = Maybe FilePath
forall a. Maybe a
Nothing
    , _xDescriptionText :: Maybe Text
_xDescriptionText = Maybe Text
forall a. Maybe a
Nothing
    , _comments :: Maybe [[Text]]
_comments = Maybe [[Text]]
forall a. Maybe a
Nothing
    , _missingDependencies :: Set BinPkgName
_missingDependencies = Set BinPkgName
forall a. Monoid a => a
mempty
    , _extraLibMap :: Map FilePath Relations
_extraLibMap = Map FilePath Relations
forall a. Monoid a => a
mempty
    , _execMap :: Map FilePath Relations
_execMap = Map FilePath Relations
forall a. Monoid a => a
mempty
    , _apacheSite :: Map BinPkgName (FilePath, FilePath, Text)
_apacheSite = Map BinPkgName (FilePath, FilePath, Text)
forall a. Monoid a => a
mempty
    , _sourceArchitectures :: Maybe PackageArchitectures
_sourceArchitectures = Maybe PackageArchitectures
forall a. Maybe a
Nothing
    , _binaryArchitectures :: Map BinPkgName PackageArchitectures
_binaryArchitectures = Map BinPkgName PackageArchitectures
forall a. Monoid a => a
mempty
    , _sourcePriority :: Maybe PackagePriority
_sourcePriority = Maybe PackagePriority
forall a. Maybe a
Nothing
    , _binaryPriorities :: Map BinPkgName PackagePriority
_binaryPriorities = Map BinPkgName PackagePriority
forall a. Monoid a => a
mempty
    , _sourceSection :: Maybe Section
_sourceSection = Maybe Section
forall a. Maybe a
Nothing
    , _binarySections :: Map BinPkgName Section
_binarySections = Map BinPkgName Section
forall a. Monoid a => a
mempty
    , _executable :: Map BinPkgName InstallFile
_executable = Map BinPkgName InstallFile
forall a. Monoid a => a
mempty
    , _serverInfo :: Map BinPkgName Server
_serverInfo = Map BinPkgName Server
forall a. Monoid a => a
mempty
    , _website :: Map BinPkgName Site
_website = Map BinPkgName Site
forall a. Monoid a => a
mempty
    , _backups :: Map BinPkgName FilePath
_backups = Map BinPkgName FilePath
forall a. Monoid a => a
mempty
    , _extraDevDeps :: Relations
_extraDevDeps = Relations
forall a. Monoid a => a
mempty
    , _official :: Bool
_official = Bool
False
    , _testsStatus :: TestsStatus
_testsStatus = TestsStatus
TestsRun
    , _allowDebianSelfBuildDeps :: Bool
_allowDebianSelfBuildDeps = Bool
False
    }

instance Canonical DebInfo where
    canonical :: DebInfo -> DebInfo
canonical DebInfo
x = DebInfo
x {_control :: SourceDebDescription
_control = SourceDebDescription -> SourceDebDescription
forall a. Canonical a => a -> a
canonical (DebInfo -> SourceDebDescription
_control DebInfo
x)}

$(makeLenses ''DebInfo)

-- We need (%=_)
link :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
link :: BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
link BinPkgName
b FilePath
src FilePath
dest = (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
atomSet ((Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Set Atom) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> FilePath -> FilePath -> Atom
Link BinPkgName
b FilePath
src FilePath
dest) StateT DebInfo m () -> StateT DebInfo m () -> StateT DebInfo m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT DebInfo m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
install :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
install :: BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
install BinPkgName
b FilePath
src FilePath
dest = (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
atomSet ((Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Set Atom) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> FilePath -> FilePath -> Atom
Install BinPkgName
b FilePath
src FilePath
dest) StateT DebInfo m () -> StateT DebInfo m () -> StateT DebInfo m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT DebInfo m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
installTo :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
installTo :: BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
installTo BinPkgName
b FilePath
src FilePath
dest = (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
atomSet ((Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Set Atom) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> FilePath -> FilePath -> Atom
InstallTo BinPkgName
b FilePath
src FilePath
dest) StateT DebInfo m () -> StateT DebInfo m () -> StateT DebInfo m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT DebInfo m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
installData :: Monad m => BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
installData :: BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
installData BinPkgName
b FilePath
src FilePath
dest = (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
atomSet ((Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Set Atom) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> FilePath -> FilePath -> Atom
InstallData BinPkgName
b FilePath
src FilePath
dest) StateT DebInfo m () -> StateT DebInfo m () -> StateT DebInfo m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT DebInfo m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
file :: Monad m => BinPkgName -> FilePath -> Text -> StateT DebInfo m ()
file :: BinPkgName -> FilePath -> Text -> StateT DebInfo m ()
file BinPkgName
b FilePath
dest Text
content = (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
atomSet ((Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Set Atom) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> FilePath -> Text -> Atom
File BinPkgName
b FilePath
dest Text
content) StateT DebInfo m () -> StateT DebInfo m () -> StateT DebInfo m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT DebInfo m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
installCabalExec :: Monad m => BinPkgName -> String -> FilePath -> StateT DebInfo m ()
installCabalExec :: BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
installCabalExec BinPkgName
b FilePath
name FilePath
dest = (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
atomSet ((Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Set Atom) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> FilePath -> FilePath -> Atom
InstallCabalExec BinPkgName
b FilePath
name FilePath
dest) StateT DebInfo m () -> StateT DebInfo m () -> StateT DebInfo m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT DebInfo m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
installCabalExecTo :: Monad m => BinPkgName -> String -> FilePath -> StateT DebInfo m ()
installCabalExecTo :: BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
installCabalExecTo BinPkgName
b FilePath
name FilePath
dest = (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
atomSet ((Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Set Atom) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> FilePath -> FilePath -> Atom
InstallCabalExecTo BinPkgName
b FilePath
name FilePath
dest) StateT DebInfo m () -> StateT DebInfo m () -> StateT DebInfo m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT DebInfo m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
installDir :: Monad m => BinPkgName -> FilePath -> StateT DebInfo m ()
installDir :: BinPkgName -> FilePath -> StateT DebInfo m ()
installDir BinPkgName
b FilePath
dir = (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
atomSet ((Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Set Atom) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> FilePath -> Atom
InstallDir BinPkgName
b FilePath
dir) StateT DebInfo m () -> StateT DebInfo m () -> StateT DebInfo m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> StateT DebInfo m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Lens to look up the binary deb description by name and create it if absent.
-- <http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Package>
binaryDebDescription :: BinPkgName -> Lens' DebInfo BinaryDebDescription
binaryDebDescription :: BinPkgName -> Lens' DebInfo BinaryDebDescription
binaryDebDescription BinPkgName
b =
    (SourceDebDescription -> f SourceDebDescription)
-> DebInfo -> f DebInfo
Lens' DebInfo SourceDebDescription
control ((SourceDebDescription -> f SourceDebDescription)
 -> DebInfo -> f DebInfo)
-> ((BinaryDebDescription -> f BinaryDebDescription)
    -> SourceDebDescription -> f SourceDebDescription)
-> (BinaryDebDescription -> f BinaryDebDescription)
-> DebInfo
-> f DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BinaryDebDescription] -> f [BinaryDebDescription])
-> SourceDebDescription -> f SourceDebDescription
Lens' SourceDebDescription [BinaryDebDescription]
S.binaryPackages (([BinaryDebDescription] -> f [BinaryDebDescription])
 -> SourceDebDescription -> f SourceDebDescription)
-> ((BinaryDebDescription -> f BinaryDebDescription)
    -> [BinaryDebDescription] -> f [BinaryDebDescription])
-> (BinaryDebDescription -> f BinaryDebDescription)
-> SourceDebDescription
-> f SourceDebDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BinaryDebDescription -> Bool)
-> Lens' [BinaryDebDescription] (Maybe BinaryDebDescription)
forall a. (a -> Bool) -> Lens' [a] (Maybe a)
listElemLens ((BinPkgName -> BinPkgName -> Bool
forall a. Eq a => a -> a -> Bool
== BinPkgName
b) (BinPkgName -> Bool)
-> (BinaryDebDescription -> BinPkgName)
-> BinaryDebDescription
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting BinPkgName BinaryDebDescription BinPkgName
-> BinaryDebDescription -> BinPkgName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BinPkgName BinaryDebDescription BinPkgName
Lens' BinaryDebDescription BinPkgName
package) ((Maybe BinaryDebDescription -> f (Maybe BinaryDebDescription))
 -> [BinaryDebDescription] -> f [BinaryDebDescription])
-> ((BinaryDebDescription -> f BinaryDebDescription)
    -> Maybe BinaryDebDescription -> f (Maybe BinaryDebDescription))
-> (BinaryDebDescription -> f BinaryDebDescription)
-> [BinaryDebDescription]
-> f [BinaryDebDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryDebDescription
-> Lens' BinaryDebDescription BinaryDebDescription
-> Lens' (Maybe BinaryDebDescription) BinaryDebDescription
forall a b. a -> Lens' a b -> Lens' (Maybe a) b
maybeLens (BinPkgName -> BinaryDebDescription
newBinaryDebDescription BinPkgName
b) ((BinaryDebDescription -> BinaryDebDescription)
-> (BinaryDebDescription -> BinaryDebDescription)
-> Iso
     BinaryDebDescription
     BinaryDebDescription
     BinaryDebDescription
     BinaryDebDescription
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso BinaryDebDescription -> BinaryDebDescription
forall a. a -> a
id BinaryDebDescription -> BinaryDebDescription
forall a. a -> a
id)