{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Debian.Debianize.Optparse (
  CommandLineOptions(..),
  BehaviorAdjustment,
  Flags(..),
  parseProgramArguments,
  parseProgramArguments',
  handleBehaviorAdjustment) where

import Control.Applicative (many, (<|>))
import Control.Lens
import Control.Monad.State.Class (MonadState)
import Control.Monad.Trans
import Control.Newtype.Generics
import Data.Bifunctor (first)
import Data.Char(toUpper)
import Data.Foldable (forM_)
import Data.Maybe.Extended (fromMaybe)
import Data.Maybe.Extended (nothingIf)
import Debian.Debianize.BasicInfo (EnvSet(EnvSet), cleanOS, dependOS, buildOS, Flags(..))
import Debian.Debianize.DebInfo (TestsStatus(..))
import Debian.Debianize.Monad
import Debian.Debianize.Prelude (maybeRead)
import Debian.Debianize.VersionSplits
import Debian.GHC ()
import Debian.Policy
import Debian.Relation
import Debian.Version (DebianVersion, parseDebianVersion')
import Distribution.Compiler (CompilerFlavor(..))
import Distribution.Package (PackageName, mkPackageName, unPackageName)
import Distribution.PackageDescription (FlagName, mkFlagName)
import GHC.Generics
import System.Environment (getArgs)
import System.FilePath(splitFileName, (</>))
import System.Process (showCommandForUser)
import Text.Parsec.Rfc2822 (NameAddr(..))
import Text.PrettyPrint.ANSI.Leijen (linebreak, (<+>), string, indent)
import qualified  Debian.Debianize.DebInfo as D
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Debian.Debianize.BinaryDebDescription as B
import qualified Debian.Debianize.CabalInfo as A
import qualified Debian.Debianize.SourceDebDescription as S
import qualified Options.Applicative as O

data HaddockStatus = HaddockEnabled | HaddockDisabled deriving HaddockStatus -> HaddockStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HaddockStatus -> HaddockStatus -> Bool
$c/= :: HaddockStatus -> HaddockStatus -> Bool
== :: HaddockStatus -> HaddockStatus -> Bool
$c== :: HaddockStatus -> HaddockStatus -> Bool
Eq
data ProfilingStatus = ProfilingEnabled | ProfilingDisabled deriving ProfilingStatus -> ProfilingStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilingStatus -> ProfilingStatus -> Bool
$c/= :: ProfilingStatus -> ProfilingStatus -> Bool
== :: ProfilingStatus -> ProfilingStatus -> Bool
$c== :: ProfilingStatus -> ProfilingStatus -> Bool
Eq
data OfficialStatus = Official| NonOfficial deriving OfficialStatus -> OfficialStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OfficialStatus -> OfficialStatus -> Bool
$c/= :: OfficialStatus -> OfficialStatus -> Bool
== :: OfficialStatus -> OfficialStatus -> Bool
$c== :: OfficialStatus -> OfficialStatus -> Bool
Eq
newtype BuildDep = BuildDep Relations deriving forall x. Rep BuildDep x -> BuildDep
forall x. BuildDep -> Rep BuildDep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildDep x -> BuildDep
$cfrom :: forall x. BuildDep -> Rep BuildDep x
Generic
instance Newtype BuildDep
newtype BuildDepIndep = BuildDepIndep Relations deriving forall x. Rep BuildDepIndep x -> BuildDepIndep
forall x. BuildDepIndep -> Rep BuildDepIndep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildDepIndep x -> BuildDepIndep
$cfrom :: forall x. BuildDepIndep -> Rep BuildDepIndep x
Generic
instance Newtype BuildDepIndep
newtype DevDep = DevDep Relations deriving forall x. Rep DevDep x -> DevDep
forall x. DevDep -> Rep DevDep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DevDep x -> DevDep
$cfrom :: forall x. DevDep -> Rep DevDep x
Generic
instance Newtype DevDep
newtype ExtraDepends = ExtraDepends (BinPkgName, Relations) deriving forall x. Rep ExtraDepends x -> ExtraDepends
forall x. ExtraDepends -> Rep ExtraDepends x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtraDepends x -> ExtraDepends
$cfrom :: forall x. ExtraDepends -> Rep ExtraDepends x
Generic
instance Newtype ExtraDepends
newtype ExtraConflicts = ExtraConflicts (BinPkgName, Relations) deriving forall x. Rep ExtraConflicts x -> ExtraConflicts
forall x. ExtraConflicts -> Rep ExtraConflicts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtraConflicts x -> ExtraConflicts
$cfrom :: forall x. ExtraConflicts -> Rep ExtraConflicts x
Generic
instance Newtype ExtraConflicts
newtype ExtraProvides = ExtraProvides (BinPkgName, Relations) deriving forall x. Rep ExtraProvides x -> ExtraProvides
forall x. ExtraProvides -> Rep ExtraProvides x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtraProvides x -> ExtraProvides
$cfrom :: forall x. ExtraProvides -> Rep ExtraProvides x
Generic
instance Newtype ExtraProvides
newtype ExtraReplaces = ExtraReplaces (BinPkgName, Relations) deriving forall x. Rep ExtraReplaces x -> ExtraReplaces
forall x. ExtraReplaces -> Rep ExtraReplaces x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtraReplaces x -> ExtraReplaces
$cfrom :: forall x. ExtraReplaces -> Rep ExtraReplaces x
Generic
instance Newtype ExtraReplaces
newtype ExtraRecommends = ExtraRecommends (BinPkgName, Relations) deriving forall x. Rep ExtraRecommends x -> ExtraRecommends
forall x. ExtraRecommends -> Rep ExtraRecommends x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtraRecommends x -> ExtraRecommends
$cfrom :: forall x. ExtraRecommends -> Rep ExtraRecommends x
Generic
instance Newtype ExtraRecommends
newtype ExtraSuggests = ExtraSuggests (BinPkgName, Relations) deriving forall x. Rep ExtraSuggests x -> ExtraSuggests
forall x. ExtraSuggests -> Rep ExtraSuggests x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtraSuggests x -> ExtraSuggests
$cfrom :: forall x. ExtraSuggests -> Rep ExtraSuggests x
Generic
instance Newtype ExtraSuggests
newtype CabalDebMapping = CabalDebMapping (PackageName, Relations) deriving forall x. Rep CabalDebMapping x -> CabalDebMapping
forall x. CabalDebMapping -> Rep CabalDebMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CabalDebMapping x -> CabalDebMapping
$cfrom :: forall x. CabalDebMapping -> Rep CabalDebMapping x
Generic
instance Newtype CabalDebMapping
newtype ExecDebMapping = ExecDebMapping (String, Relations) deriving forall x. Rep ExecDebMapping x -> ExecDebMapping
forall x. ExecDebMapping -> Rep ExecDebMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExecDebMapping x -> ExecDebMapping
$cfrom :: forall x. ExecDebMapping -> Rep ExecDebMapping x
Generic
instance Newtype ExecDebMapping
newtype Revision = Revision String deriving forall x. Rep Revision x -> Revision
forall x. Revision -> Rep Revision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Revision x -> Revision
$cfrom :: forall x. Revision -> Rep Revision x
Generic
instance Newtype Revision
newtype CabalEpochMapping = CabalEpochMapping (PackageName, Int) deriving forall x. Rep CabalEpochMapping x -> CabalEpochMapping
forall x. CabalEpochMapping -> Rep CabalEpochMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CabalEpochMapping x -> CabalEpochMapping
$cfrom :: forall x. CabalEpochMapping -> Rep CabalEpochMapping x
Generic
instance Newtype CabalEpochMapping
newtype CabalFlagMapping = CabalFlagMapping (FlagName, Bool) deriving forall x. Rep CabalFlagMapping x -> CabalFlagMapping
forall x. CabalFlagMapping -> Rep CabalFlagMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CabalFlagMapping x -> CabalFlagMapping
$cfrom :: forall x. CabalFlagMapping -> Rep CabalFlagMapping x
Generic
instance Newtype CabalFlagMapping

-- | This data type is an abomination. It represent information,
-- provided on command line. Part of such information provides
-- means to create initial 'CabalT' state and is stored in
-- '_flags' field. See 'newCabalInfo'.
--
-- Other, much greater part represent changes to already created
-- state. They are stored in '_adjustment' field.
--
-- All this can be understood from (simplified) types:
--
-- > type CabalT m a = StateT CabalInfo m a
-- > newCabalInfo :: Flags -> IO CabalInfo
-- > handleBehaviorAdjustment :: BehaviorAdjustment -> CabalT IO ()

data CommandLineOptions = CommandLineOptions {
  CommandLineOptions -> Flags
_flags :: Flags,
  CommandLineOptions -> BehaviorAdjustment
_adjustment :: BehaviorAdjustment
}
-- | This data type represents changes to 'CabalT' state,
-- requested at command line.
data BehaviorAdjustment = BehaviorAdjustment {
  BehaviorAdjustment -> NameAddr
_maintainer        :: NameAddr,
  BehaviorAdjustment -> [NameAddr]
_uploaders         :: [NameAddr],
  BehaviorAdjustment -> [(BinPkgName, InstallFile)]
_executable        :: [(BinPkgName, D.InstallFile)],
  BehaviorAdjustment -> Maybe [Char]
_defaultPackage    :: Maybe String,
  BehaviorAdjustment -> [BinPkgName]
_missingDependency :: [BinPkgName],
  BehaviorAdjustment -> Maybe DebBase
_debianNameBase    :: Maybe DebBase,
  BehaviorAdjustment -> Maybe DebianVersion
_debianVersion     :: Maybe DebianVersion,
  BehaviorAdjustment -> Maybe Revision
_revision          :: Maybe Revision,
  BehaviorAdjustment -> Maybe SrcPkgName
_sourcePackageName :: Maybe SrcPkgName,
  BehaviorAdjustment -> Section
_sourceSection     :: Section,
  BehaviorAdjustment -> StandardsVersion
_standardsVersion  :: StandardsVersion,
  BehaviorAdjustment -> [BuildDep]
_buildDep          :: [BuildDep],
  BehaviorAdjustment -> [BuildDepIndep]
_buildDepIndep     :: [BuildDepIndep],
  BehaviorAdjustment -> [DevDep]
_devDep            :: [DevDep],
  BehaviorAdjustment -> [ExtraDepends]
_extraDepends      :: [ExtraDepends],
  BehaviorAdjustment -> [ExtraConflicts]
_extraConflicts    :: [ExtraConflicts],
  BehaviorAdjustment -> [ExtraProvides]
_extraProvides     :: [ExtraProvides],
  BehaviorAdjustment -> [ExtraReplaces]
_extraReplaces     :: [ExtraReplaces],
  BehaviorAdjustment -> [ExtraRecommends]
_extraRecommends   :: [ExtraRecommends],
  BehaviorAdjustment -> [ExtraSuggests]
_extraSuggests     :: [ExtraSuggests],
  BehaviorAdjustment -> [CabalDebMapping]
_cabalDebMapping   :: [CabalDebMapping],
  BehaviorAdjustment -> [CabalEpochMapping]
_cabalEpochMapping :: [CabalEpochMapping],
  BehaviorAdjustment -> [ExecDebMapping]
_execDebMapping    :: [ExecDebMapping],
  BehaviorAdjustment -> ProfilingStatus
_profiling         :: ProfilingStatus,
  BehaviorAdjustment -> [HaddockStatus]
_haddock           :: [HaddockStatus],
  BehaviorAdjustment -> OfficialStatus
_official          :: OfficialStatus,
  BehaviorAdjustment -> SourceFormat
_sourceFormat      :: SourceFormat,
  BehaviorAdjustment -> TestsStatus
_tests             :: TestsStatus
}

-- Brief instruction to save you, dear developer from scrutinizing
-- `optparse-applicative` documentation.
--
-- There is two main types in command line parsing.
--
-- 'ReadM' is description how make object from string.
-- For every object of type 'a' with some parsing logic
-- we define auxiliary function with 'R' suffix and
-- type 'ReadM a'.
--
-- 'Parser' is type, containing information about
-- which string in command line should be converted
-- to object. Every field in 'BehaviorAdjustment'
-- and 'Flags' type of type 'b' have corresponding function
-- of type 'Parser' with suffix 'P'.


-- Here are all 'ReadM' values.

executableR :: O.ReadM (BinPkgName, D.InstallFile)
executableR :: ReadM (BinPkgName, InstallFile)
executableR = ([Char], [Char]) -> (BinPkgName, InstallFile)
parsePair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
':') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str where
  parsePair :: (String, String) -> (BinPkgName, D.InstallFile)
  parsePair :: ([Char], [Char]) -> (BinPkgName, InstallFile)
parsePair ([Char]
sp, [Char]
md) = let ([Char]
sd, [Char]
name) = [Char] -> ([Char], [Char])
splitFileName [Char]
sp in
    ([Char] -> BinPkgName
BinPkgName [Char]
name, D.InstallFile { execName :: [Char]
D.execName  = [Char]
name,
                                      destName :: [Char]
D.destName  = [Char]
name,
                                      sourceDir :: Maybe [Char]
D.sourceDir = forall a. (a -> Bool) -> a -> Maybe a
nothingIf ( forall a. Eq a => a -> a -> Bool
== [Char]
"./") [Char]
sd,
                                      destDir :: Maybe [Char]
D.destDir   = case [Char]
md of
                                                      (Char
':' : [Char]
dd) -> forall a. a -> Maybe a
Just [Char]
dd
                                                      [Char]
_          -> forall a. Maybe a
Nothing })

binPkgNameR :: O.ReadM BinPkgName
binPkgNameR :: ReadM BinPkgName
binPkgNameR = [Char] -> BinPkgName
BinPkgName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str

nameAddrR :: O.ReadM NameAddr
nameAddrR :: ReadM NameAddr
nameAddrR = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> Either [Char] NameAddr
parseMaintainer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str

relationsR :: O.ReadM Relations
relationsR :: ReadM Relations
relationsR = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. IsString s => ReadM s
O.str :: O.ReadM String)

mappingR :: O.ReadM (String, Relations)
mappingR :: ReadM ([Char], Relations)
mappingR = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
':') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ([Char]
str, [Char]
"") -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Does not contains colon: `" forall a. [a] -> [a] -> [a]
++ [Char]
str forall a. [a] -> [a] -> [a]
++ [Char]
"'"
  ([Char]
pkgstr, Char
_ : [Char]
relstr) -> do
    Relations
rels <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations [Char]
relstr
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
pkgstr, Relations
rels)

epochMappingR :: O.ReadM (String, Int)
epochMappingR :: ReadM ([Char], Int)
epochMappingR = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'=') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ([Char]
pkgstr, Char
'=' : [Char]
numstr) -> do
    let epoch :: Int
epoch = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error ([Char]
"Invalid epoch: " forall a. [a] -> [a] -> [a]
++ [Char]
numstr)) (forall a. Read a => [Char] -> Maybe a
maybeRead [Char]
numstr :: Maybe Int)
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
pkgstr, Int
epoch)
  ([Char]
str, [Char]
_) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Does not contains equals: `" forall a. [a] -> [a] -> [a]
++ [Char]
str forall a. [a] -> [a] -> [a]
++ [Char]
"'"

extraRelationsR :: O.ReadM (BinPkgName, Relations)
extraRelationsR :: ReadM (BinPkgName, Relations)
extraRelationsR = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> BinPkgName
BinPkgName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM ([Char], Relations)
mappingR

cabalDebMappingR :: O.ReadM CabalDebMapping
cabalDebMappingR :: ReadM CabalDebMapping
cabalDebMappingR = (PackageName, Relations) -> CabalDebMapping
CabalDebMapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> PackageName
mkPackageName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM ([Char], Relations)
mappingR

cabalEpochMappingR :: O.ReadM CabalEpochMapping
cabalEpochMappingR :: ReadM CabalEpochMapping
cabalEpochMappingR = (PackageName, Int) -> CabalEpochMapping
CabalEpochMapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> PackageName
mkPackageName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM ([Char], Int)
epochMappingR

cabalFlagMappingR :: O.ReadM CabalFlagMapping
cabalFlagMappingR :: ReadM CabalFlagMapping
cabalFlagMappingR = forall s. IsString s => ReadM s
O.str forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  (Char
'-' : [Char]
str) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (FlagName, Bool) -> CabalFlagMapping
CabalFlagMapping ([Char] -> FlagName
mkFlagName [Char]
str, Bool
False)
  [Char]
str -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (FlagName, Bool) -> CabalFlagMapping
CabalFlagMapping ([Char] -> FlagName
mkFlagName [Char]
str, Bool
True)

-- Here are parser for BehaviorAdjustment and next are parsers for
-- every field of this data.  Please, keep parsers declarations in
-- same order, as are fields.

behaviorAdjustmentP :: O.Parser BehaviorAdjustment
behaviorAdjustmentP :: Parser BehaviorAdjustment
behaviorAdjustmentP = NameAddr
-> [NameAddr]
-> [(BinPkgName, InstallFile)]
-> Maybe [Char]
-> [BinPkgName]
-> Maybe DebBase
-> Maybe DebianVersion
-> Maybe Revision
-> Maybe SrcPkgName
-> Section
-> StandardsVersion
-> [BuildDep]
-> [BuildDepIndep]
-> [DevDep]
-> [ExtraDepends]
-> [ExtraConflicts]
-> [ExtraProvides]
-> [ExtraReplaces]
-> [ExtraRecommends]
-> [ExtraSuggests]
-> [CabalDebMapping]
-> [CabalEpochMapping]
-> [ExecDebMapping]
-> ProfilingStatus
-> [HaddockStatus]
-> OfficialStatus
-> SourceFormat
-> TestsStatus
-> BehaviorAdjustment
BehaviorAdjustment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NameAddr
maintainerP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [NameAddr]
uploadersP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(BinPkgName, InstallFile)]
executableP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe [Char])
defaultPackageP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [BinPkgName]
missingDependencyP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DebBase)
debianNameBaseP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DebianVersion)
debianVersionP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Revision)
debianRevisionP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SrcPkgName)
sourcePackageNameP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Section
sourceSectionP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StandardsVersion
standardsVersionP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [BuildDep]
buildDepP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [BuildDepIndep]
buildDepIndepP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [DevDep]
devDepP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraDepends]
extraDependsP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraConflicts]
extraConflictsP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraProvides]
extraProvidesP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraReplaces]
extraReplacesP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraRecommends]
extraRecommendsP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraSuggests]
extraSuggestsP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [CabalDebMapping]
cabalDebMappingP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [CabalEpochMapping]
cabalEpochMappingP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExecDebMapping]
execDebMappingP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProfilingStatus
profilingP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [HaddockStatus]
haddockP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OfficialStatus
officialP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SourceFormat
sourceFormatP
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TestsStatus
testsP

maintainerP :: O.Parser NameAddr
maintainerP :: Parser NameAddr
maintainerP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ReadM NameAddr
nameAddrR Mod OptionFields NameAddr
m where
  m :: Mod OptionFields NameAddr
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"maintainer"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'm'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value (Maybe [Char] -> [Char] -> NameAddr
NameAddr (forall a. a -> Maybe a
Just [Char]
"Debian Haskell Group")
                           [Char]
"pkg-haskell-maintainers@lists.alioth.debian.org")
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"'NAME <EMAIL>'"
  helpMsg :: [Char]
helpMsg = [Char]
"Set the `Maintainer' field in debian/control file."

uploadersP :: O.Parser [NameAddr]
uploadersP :: Parser [NameAddr]
uploadersP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ReadM NameAddr
nameAddrR Mod OptionFields NameAddr
m where
  m :: Mod OptionFields NameAddr
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"uploader"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'u'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"'NAME <EMAIL>'"
  helpMsg :: [Char]
helpMsg = [Char]
"Add entry to `Uploaders' field in debian/control file."

executableP :: O.Parser [(BinPkgName, D.InstallFile)]
executableP :: Parser [(BinPkgName, InstallFile)]
executableP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ReadM (BinPkgName, InstallFile)
executableR forall {a}. Mod OptionFields a
m where
  m :: Mod OptionFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"executable"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'e'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"SOURCEPATH[:DESTDIR]"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
   [Char]
"Create an individual binary package to hold this executable.",
   [Char]
"Other executables and data files are gathered into a single package",
   [Char]
"named `haskell-PACKAGENAME-utils'"
   ]

defaultPackageP :: O.Parser (Maybe String)
defaultPackageP :: Parser (Maybe [Char])
defaultPackageP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str) forall {a}. Mod OptionFields (Maybe a)
m where
  m :: Mod OptionFields (Maybe a)
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"default-package"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'd'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. Maybe a
Nothing
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"PKGNAME"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Set the name of the catch-all package that receives",
    [Char]
"all the files not included in a library package or some",
    [Char]
"other executable package. By default this is `haskell-PACKAGENAME-utils'"
    ]

missingDependencyP :: O.Parser [BinPkgName]
missingDependencyP :: Parser [BinPkgName]
missingDependencyP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ReadM BinPkgName
binPkgNameR forall {a}. Mod OptionFields a
m where
  m :: Mod OptionFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"missing-dependency"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"DEB"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"This is the counterpart to --disable-haddock.  It prevents a package",
    [Char]
"from being added to the build dependencies.  This is necessary,",
    [Char]
"for example, when a dependency package was built with the",
    [Char]
"--disable-haddock option, because normally cabal-debian assumes",
    [Char]
"that the -doc package exists and adds it as a build dependency."
    ]

debianNameBaseP :: O.Parser (Maybe DebBase)
debianNameBaseP :: Parser (Maybe DebBase)
debianNameBaseP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> DebBase
DebBase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str) forall {a}. Mod OptionFields (Maybe a)
m where
  m :: Mod OptionFields (Maybe a)
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"debian-name-base"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'b'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. Maybe a
Nothing
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"NAME"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Use this name for the base of the debian binary packages - the string between",
    [Char]
"'libghc-' and '-dev'. Normally this is derived from the hackage package name."
    ]

debianVersionP :: O.Parser (Maybe DebianVersion)
debianVersionP :: Parser (Maybe DebianVersion)
debianVersionP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. IsString s => ReadM s
O.str :: O.ReadM String)) forall {a}. Mod OptionFields (Maybe a)
m where
  m :: Mod OptionFields (Maybe a)
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"deb-version"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"DEBIANVERSION"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. Maybe a
Nothing
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Specify the version number for the debian package.",
    [Char]
"This will pin the version and should be considered dangerous."
    ]

debianRevisionP :: O.Parser (Maybe Revision)
debianRevisionP :: Parser (Maybe Revision)
debianRevisionP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Revision
Revision forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str) forall {a}. Mod OptionFields (Maybe a)
m where
  m :: Mod OptionFields (Maybe a)
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"revision"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. Maybe a
Nothing
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"DEBIANREVISION"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Add this string to the cabal version to get the debian version number.",
    [Char]
"Debian policy says this must either be empty (--revision '')",
    [Char]
"or begin with a dash."
    ]

sourcePackageNameP :: O.Parser (Maybe SrcPkgName)
sourcePackageNameP :: Parser (Maybe SrcPkgName)
sourcePackageNameP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> SrcPkgName
SrcPkgName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str) forall {a}. Mod OptionFields (Maybe a)
m where
  m :: Mod OptionFields (Maybe a)
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"source-package-name"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
's'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. Maybe a
Nothing
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"DEBIANNAME"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Use this name for the debian source package, the name in the Source field",
    [Char]
"at the top of the debian/control file, and also at the very beginning",
    [Char]
"of the debian/changelog file.  By default it is haskell-<cabalname>,",
    [Char]
"where the cabal package name is downcased."
    ]

sourceSectionP :: O.Parser Section
sourceSectionP :: Parser Section
sourceSectionP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ([Char] -> Section
MainSection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str) Mod OptionFields Section
m where
  m :: Mod OptionFields Section
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"source-section"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'S'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value ([Char] -> Section
MainSection [Char]
"haskell")
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"SECTION"
  helpMsg :: [Char]
helpMsg = [Char]
"Set the `Section' field in debian/control file."

standardsVersionP :: O.Parser StandardsVersion
standardsVersionP :: Parser StandardsVersion
standardsVersionP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ([Char] -> StandardsVersion
parseStandardsVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str) Mod OptionFields StandardsVersion
m where
  m :: Mod OptionFields StandardsVersion
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"standards-version"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value ([Char] -> StandardsVersion
parseStandardsVersion [Char]
"4.6.1")
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"CABALVERSION"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Claim compatibility to this version of the Debian policy",
    [Char]
"(i.e. the value of the Standards-Version field)"
    ]

buildDepP :: O.Parser [BuildDep]
buildDepP :: Parser [BuildDep]
buildDepP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (Relations -> BuildDep
BuildDep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Relations
relationsR) forall {a}. Mod OptionFields a
m where
  m :: Mod OptionFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"build-dep"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"DEBIANRELATIONS"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Add a dependency relation to the `Build-Depends'",
    [Char]
"field for this source package."
    ]

buildDepIndepP :: O.Parser [BuildDepIndep]
buildDepIndepP :: Parser [BuildDepIndep]
buildDepIndepP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (Relations -> BuildDepIndep
BuildDepIndep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Relations
relationsR) forall {a}. Mod OptionFields a
m where
  m :: Mod OptionFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"build-dep-indep"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"DEBIANRELATIONS"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Add a dependency relation to the `Build-Depends-Indep'",
    [Char]
"field for this source package."
    ]

devDepP :: O.Parser [DevDep]
devDepP :: Parser [DevDep]
devDepP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (Relations -> DevDep
DevDep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Relations
relationsR) Mod OptionFields DevDep
m where
  m :: Mod OptionFields DevDep
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"dev-dep"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"RELATION"
  helpMsg :: [Char]
helpMsg = [Char]
"Add an entry to the `Depends' field of the -dev package"


-- Since `depends', `conflicts' and so on options are totally same,
-- we can avoid code via this function, which, given long option name
-- makes correct O.Parser. Newtype around (BinPkgName, Relations)
-- is inferred, but there is still some duplication.
--
-- Long option name can also be inferred from Typeable instance of
-- mentioned newtype, but this would introduce some amount of
-- low-level string manipulations.
--
-- Nice to know, but now, to me, it would introduce more complexity,
-- than eliminate.
mkExtraP :: (Newtype n, O n ~ (BinPkgName, Relations))
            => String -> O.Parser [n]
mkExtraP :: forall n.
(Newtype n, O n ~ (BinPkgName, Relations)) =>
[Char] -> Parser [n]
mkExtraP long :: [Char]
long@(Char
c:[Char]
cr) = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (forall n. Newtype n => O n -> n
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (BinPkgName, Relations)
extraRelationsR) Mod OptionFields n
m where
    fieldName :: [Char]
fieldName = Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: [Char]
cr
    m :: Mod OptionFields n
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
long
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"DEB:RELATION"
    helpMsg :: [Char]
helpMsg = [Char]
"Add extry to '" forall a. [a] -> [a] -> [a]
++ [Char]
fieldName forall a. [a] -> [a] -> [a]
++ [Char]
" 'field of DEB binary package"
mkExtraP [Char]
"" = forall a. HasCallStack => [Char] -> a
error [Char]
"mkExtraP: empty long option"

extraDependsP :: O.Parser [ExtraDepends]
extraDependsP :: Parser [ExtraDepends]
extraDependsP = forall n.
(Newtype n, O n ~ (BinPkgName, Relations)) =>
[Char] -> Parser [n]
mkExtraP [Char]
"depends"

extraConflictsP :: O.Parser [ExtraConflicts]
extraConflictsP :: Parser [ExtraConflicts]
extraConflictsP = forall n.
(Newtype n, O n ~ (BinPkgName, Relations)) =>
[Char] -> Parser [n]
mkExtraP [Char]
"conflicts"

extraProvidesP :: O.Parser [ExtraProvides]
extraProvidesP :: Parser [ExtraProvides]
extraProvidesP = forall n.
(Newtype n, O n ~ (BinPkgName, Relations)) =>
[Char] -> Parser [n]
mkExtraP [Char]
"provides"

extraReplacesP :: O.Parser [ExtraReplaces]
extraReplacesP :: Parser [ExtraReplaces]
extraReplacesP = forall n.
(Newtype n, O n ~ (BinPkgName, Relations)) =>
[Char] -> Parser [n]
mkExtraP [Char]
"replaces"

extraRecommendsP :: O.Parser [ExtraRecommends]
extraRecommendsP :: Parser [ExtraRecommends]
extraRecommendsP = forall n.
(Newtype n, O n ~ (BinPkgName, Relations)) =>
[Char] -> Parser [n]
mkExtraP [Char]
"recommends"

extraSuggestsP :: O.Parser [ExtraSuggests]
extraSuggestsP :: Parser [ExtraSuggests]
extraSuggestsP = forall n.
(Newtype n, O n ~ (BinPkgName, Relations)) =>
[Char] -> Parser [n]
mkExtraP [Char]
"suggests"

cabalDebMappingP :: O.Parser [CabalDebMapping]
cabalDebMappingP :: Parser [CabalDebMapping]
cabalDebMappingP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ReadM CabalDebMapping
cabalDebMappingR forall {a}. Mod OptionFields a
m where
  m :: Mod OptionFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"dep-map"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"CABAL:DEBIANBINARYPACKAGE"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Specify what debian package name corresponds with a name that appears",
    [Char]
"in the Extra-Library field of a cabal file,",
    [Char]
"e.g. --map-dep cryptopp:libcrypto-dev."
    ]

execDebMappingP :: O.Parser [ExecDebMapping]
execDebMappingP :: Parser [ExecDebMapping]
execDebMappingP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (([Char], Relations) -> ExecDebMapping
ExecDebMapping forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM ([Char], Relations)
mappingR) forall {a}. Mod OptionFields a
m where
  m :: Mod OptionFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"exec-map"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"CABAL:DEBIANBINARYPACKAGE"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Specify a mapping from the name appearing in the Build-Tool",
    [Char]
"field of the cabal file to a debian binary package name,",
    [Char]
"e.g. --exec-map trhsx:haskell-hsx-utils"
    ]

cabalEpochMappingP :: O.Parser [CabalEpochMapping]
cabalEpochMappingP :: Parser [CabalEpochMapping]
cabalEpochMappingP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (ReadM CabalEpochMapping
cabalEpochMappingR) forall {a}. Mod OptionFields a
m where
  m :: Mod OptionFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"epoch-map"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"CABALPACKAGE=DIGIT"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Specify a mapping from the cabal package name to a digit to use",
    [Char]
"as the debian package epoch number, e.g. --epoch-map HTTP=1"
    ]

cabalFlagsP :: O.Parser [CabalFlagMapping]
cabalFlagsP :: Parser [CabalFlagMapping]
cabalFlagsP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (ReadM CabalFlagMapping
cabalFlagMappingR) Mod OptionFields CabalFlagMapping
m where
  m :: Mod OptionFields CabalFlagMapping
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"cabal-flags"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"cabal-flag"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"CABALFLAG or -CABALFLAG"
  helpMsg :: [Char]
helpMsg = [Char]
"Flags to pass to cabal configure with the --flags= option"


profilingP :: O.Parser ProfilingStatus
profilingP :: Parser ProfilingStatus
profilingP = forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag ProfilingStatus
ProfilingEnabled ProfilingStatus
ProfilingDisabled forall {a}. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"disable-profiling"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Do not generate profiling (-prof) library package, do not",
    [Char]
"add -prof packages to the build dependency list."
     ]

haddockP :: O.Parser [HaddockStatus]
haddockP :: Parser [HaddockStatus]
haddockP = (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag HaddockStatus
HaddockEnabled HaddockStatus
HaddockDisabled Mod FlagFields HaddockStatus
m) where
  m :: Mod FlagFields HaddockStatus
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"disable-haddock"
  helpMsg :: [Char]
helpMsg = [Char]
"Do not create a -doc package"

officialP :: O.Parser OfficialStatus
officialP :: Parser OfficialStatus
officialP = forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag OfficialStatus
NonOfficial OfficialStatus
Official Mod FlagFields OfficialStatus
m where
  m :: Mod FlagFields OfficialStatus
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"official"
  helpMsg :: [Char]
helpMsg = [Char]
"Follow guidelines of Debian Haskell Group"

sourceFormatP :: O.Parser SourceFormat
sourceFormatP :: Parser SourceFormat
sourceFormatP = forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag SourceFormat
Quilt3 SourceFormat
Native3 forall {a}. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"native"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Package has an no upstream tarball,",
    [Char]
"write '3.0 (native)' into source/format."
    ]

testsP :: O.Parser TestsStatus
testsP :: Parser TestsStatus
testsP = Parser TestsStatus
buildOnlyTestsP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TestsStatus
disableTestsP

disableTestsP :: O.Parser TestsStatus
disableTestsP :: Parser TestsStatus
disableTestsP = forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag TestsStatus
TestsRun TestsStatus
TestsDisable forall {a}. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
"disable test suite"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"disable-tests"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"no-tests"

buildOnlyTestsP :: O.Parser TestsStatus
buildOnlyTestsP :: Parser TestsStatus
buildOnlyTestsP = forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag TestsStatus
TestsRun TestsStatus
TestsBuild forall {a}. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
"build, but do not run test suite"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"no-run-tests"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"disable-running-tests"

-- Here is 'Flags' parser and parsers for every it's field.

flagsP :: O.Parser Flags
flagsP :: Parser Flags
flagsP = Int
-> Bool
-> Bool
-> Bool
-> Bool
-> CompilerFlavor
-> Set (FlagName, Bool)
-> EnvSet
-> Flags
Flags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
verbosityP
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
dryRunP
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
upgradeP
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
roundtripP
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False     -- validate
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CompilerFlavor
hcFlavorP         -- CompilerFlavor
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([CabalFlagMapping] -> Set (FlagName, Bool)
flagSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [CabalFlagMapping]
cabalFlagsP)    -- cabalFlagAssignments
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser EnvSet
buildEnvDirP
    where
      flagSet :: [CabalFlagMapping] -> Set (FlagName, Bool)
flagSet [CabalFlagMapping]
cfms = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map (\ (CabalFlagMapping (FlagName
name, Bool
bool)) -> (FlagName
name, Bool
bool)) [CabalFlagMapping]
cfms)

verbosityP :: O.Parser Int
verbosityP :: Parser Int
verbosityP = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. a -> Mod FlagFields a -> Parser a
O.flag' () forall {a}. Mod FlagFields a
m) where
  m :: Mod FlagFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'v'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"verbose"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Every instance of this flag increases amount",
    [Char]
"of progress messages generated"
    ]

dryRunP :: O.Parser Bool
dryRunP :: Parser Bool
dryRunP = Mod FlagFields Bool -> Parser Bool
O.switch forall {a}. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'n'
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"dry-run"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Just compare the existing debianization",
    [Char]
"to the one we would generate."
    ]

upgradeP :: O.Parser Bool
upgradeP :: Parser Bool
upgradeP = Mod FlagFields Bool -> Parser Bool
O.switch forall {a}. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"upgrade"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Upgrade an existing debianization carefully",
    [Char]
"preserving fields that are commonly hand-edited."
    ]

roundtripP :: O.Parser Bool
roundtripP :: Parser Bool
roundtripP = Mod FlagFields Bool -> Parser Bool
O.switch forall {a}. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"roundtrip"
  helpMsg :: [Char]
helpMsg = [[Char]] -> [Char]
unlines [
    [Char]
"Roundtrip a debianization to normalize it."
    ]

-- versionR :: O.ReadM Version
-- versionR = (maybe (error "Invalid compiler version") id . parseVersion') <$> O.str

hcFlavorP :: O.Parser CompilerFlavor
hcFlavorP :: Parser CompilerFlavor
hcFlavorP = forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag CompilerFlavor
GHC
                    CompilerFlavor
GHCJS
                          Mod FlagFields CompilerFlavor
m where
  m :: Mod FlagFields CompilerFlavor
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
helpMsg
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"ghcjs"
  helpMsg :: [Char]
helpMsg = [Char]
"Set compiler flavor to GHCJS."

buildEnvDirP :: O.Parser EnvSet
buildEnvDirP :: Parser EnvSet
buildEnvDirP = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ((\[Char]
s -> EnvSet {cleanOS :: [Char]
cleanOS = [Char]
s [Char] -> [Char] -> [Char]
</> [Char]
"clean", dependOS :: [Char]
dependOS = [Char]
s [Char] -> [Char] -> [Char]
</> [Char]
"depend", buildOS :: [Char]
buildOS = [Char]
s [Char] -> [Char] -> [Char]
</> [Char]
"build"}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
O.str) Mod OptionFields EnvSet
m where
  m :: Mod OptionFields EnvSet
m = forall (f :: * -> *) a. [Char] -> Mod f a
O.help [Char]
"Directory containing the three build environments, clean, depend, and build."
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
O.long [Char]
"buildenvdir"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value (EnvSet {cleanOS :: [Char]
cleanOS = [Char]
"/", dependOS :: [Char]
dependOS = [Char]
"/", buildOS :: [Char]
buildOS = [Char]
"/"})
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
O.metavar [Char]
"DIR"

commandLineOptionsP :: O.Parser CommandLineOptions
commandLineOptionsP :: Parser CommandLineOptions
commandLineOptionsP = Flags -> BehaviorAdjustment -> CommandLineOptions
CommandLineOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Flags
flagsP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser BehaviorAdjustment
behaviorAdjustmentP

commandLineOptionsParserInfo :: [String] -> O.ParserInfo CommandLineOptions
commandLineOptionsParserInfo :: [[Char]] -> ParserInfo CommandLineOptions
commandLineOptionsParserInfo [[Char]]
args = forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (forall a. Parser (a -> a)
O.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CommandLineOptions
commandLineOptionsP) InfoMod CommandLineOptions
im where
  im :: InfoMod CommandLineOptions
im = forall a. [Char] -> InfoMod a
O.header [Char]
"cabal-debian -- create debianization of cabal package"
       forall a. Semigroup a => a -> a -> a
<> forall a. InfoMod a
O.fullDesc
       forall a. Semigroup a => a -> a -> a
<> forall a. Maybe Doc -> InfoMod a
O.progDescDoc (forall a. a -> Maybe a
Just Doc
descDoc)
  descDoc :: Doc
descDoc =
    Doc
"Typical usage is run in unpacked source root directory"
    Doc -> Doc -> Doc
<+> Doc
linebreak Doc -> Doc -> Doc
<+> Doc
linebreak
    Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
indent Int
2 Doc
"% cabal-debian  --maintainer 'Maintainer Name <maintainer@email>'"
    Doc -> Doc -> Doc
<+> Doc
linebreak Doc -> Doc -> Doc
<+> Doc
linebreak
    Doc -> Doc -> Doc
<+> ([Char] -> Doc
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ [
     [Char]
"This will read the package's cabal file and any existing debian/changelog file and",
     [Char]
"deduce what it can about the debianization, then it will create or modify files in",
     [Char]
"the debian subdirectory.  Note that it will not remove any files in debian, and",
     [Char]
"these could affect the operation of the debianization in unknown ways.  For this",
     [Char]
"reason it is recommended either using a pristine unpacked directory each time, or else",
     [Char]
"using a revision control system to revert the package to a known state before running.",
     [Char]
"",
     [Char]
"Arguments: " forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
showCommandForUser [Char]
"cabal-debian" [[Char]]
args
     ])

-- FIXME: Separation of parsing of `BehaviorAdjustment' and performing
-- of corresponding actions is all great, but now it is pretty easy
-- to not handle particular field in `BehaviorAdjustment' field and
-- ghc will not complain.
handleBehaviorAdjustment :: (MonadIO m) => BehaviorAdjustment -> CabalT m ()
handleBehaviorAdjustment :: forall (m :: * -> *).
MonadIO m =>
BehaviorAdjustment -> CabalT m ()
handleBehaviorAdjustment (BehaviorAdjustment {[(BinPkgName, InstallFile)]
[BinPkgName]
[NameAddr]
[CabalEpochMapping]
[ExecDebMapping]
[CabalDebMapping]
[ExtraSuggests]
[ExtraRecommends]
[ExtraReplaces]
[ExtraProvides]
[ExtraConflicts]
[ExtraDepends]
[DevDep]
[BuildDepIndep]
[BuildDep]
[HaddockStatus]
Maybe [Char]
Maybe SrcPkgName
Maybe DebianVersion
Maybe DebBase
Maybe Revision
NameAddr
Section
SourceFormat
StandardsVersion
TestsStatus
OfficialStatus
ProfilingStatus
_tests :: TestsStatus
_sourceFormat :: SourceFormat
_official :: OfficialStatus
_haddock :: [HaddockStatus]
_profiling :: ProfilingStatus
_execDebMapping :: [ExecDebMapping]
_cabalEpochMapping :: [CabalEpochMapping]
_cabalDebMapping :: [CabalDebMapping]
_extraSuggests :: [ExtraSuggests]
_extraRecommends :: [ExtraRecommends]
_extraReplaces :: [ExtraReplaces]
_extraProvides :: [ExtraProvides]
_extraConflicts :: [ExtraConflicts]
_extraDepends :: [ExtraDepends]
_devDep :: [DevDep]
_buildDepIndep :: [BuildDepIndep]
_buildDep :: [BuildDep]
_standardsVersion :: StandardsVersion
_sourceSection :: Section
_sourcePackageName :: Maybe SrcPkgName
_revision :: Maybe Revision
_debianVersion :: Maybe DebianVersion
_debianNameBase :: Maybe DebBase
_missingDependency :: [BinPkgName]
_defaultPackage :: Maybe [Char]
_executable :: [(BinPkgName, InstallFile)]
_uploaders :: [NameAddr]
_maintainer :: NameAddr
_tests :: BehaviorAdjustment -> TestsStatus
_sourceFormat :: BehaviorAdjustment -> SourceFormat
_official :: BehaviorAdjustment -> OfficialStatus
_haddock :: BehaviorAdjustment -> [HaddockStatus]
_profiling :: BehaviorAdjustment -> ProfilingStatus
_execDebMapping :: BehaviorAdjustment -> [ExecDebMapping]
_cabalEpochMapping :: BehaviorAdjustment -> [CabalEpochMapping]
_cabalDebMapping :: BehaviorAdjustment -> [CabalDebMapping]
_extraSuggests :: BehaviorAdjustment -> [ExtraSuggests]
_extraRecommends :: BehaviorAdjustment -> [ExtraRecommends]
_extraReplaces :: BehaviorAdjustment -> [ExtraReplaces]
_extraProvides :: BehaviorAdjustment -> [ExtraProvides]
_extraConflicts :: BehaviorAdjustment -> [ExtraConflicts]
_extraDepends :: BehaviorAdjustment -> [ExtraDepends]
_devDep :: BehaviorAdjustment -> [DevDep]
_buildDepIndep :: BehaviorAdjustment -> [BuildDepIndep]
_buildDep :: BehaviorAdjustment -> [BuildDep]
_standardsVersion :: BehaviorAdjustment -> StandardsVersion
_sourceSection :: BehaviorAdjustment -> Section
_sourcePackageName :: BehaviorAdjustment -> Maybe SrcPkgName
_revision :: BehaviorAdjustment -> Maybe Revision
_debianVersion :: BehaviorAdjustment -> Maybe DebianVersion
_debianNameBase :: BehaviorAdjustment -> Maybe DebBase
_missingDependency :: BehaviorAdjustment -> [BinPkgName]
_defaultPackage :: BehaviorAdjustment -> Maybe [Char]
_executable :: BehaviorAdjustment -> [(BinPkgName, InstallFile)]
_uploaders :: BehaviorAdjustment -> [NameAddr]
_maintainer :: BehaviorAdjustment -> NameAddr
..}) = do
 forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CabalEpochMapping]
_cabalEpochMapping forall a b. (a -> b) -> a -> b
$ \(CabalEpochMapping (PackageName
pkg, Int
num)) -> Lens' CabalInfo (Map PackageName Int)
A.epochMap forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PackageName
pkg Int
num
 forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' CabalInfo DebInfo
A.debInfo forall a b. (a -> b) -> a -> b
$ do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(BinPkgName, InstallFile)]
_executable forall a b. (a -> b) -> a -> b
$ (Lens' DebInfo (Map BinPkgName InstallFile)
D.executable forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExecDebMapping]
_execDebMapping forall a b. (a -> b) -> a -> b
$ (Lens' DebInfo (Map [Char] Relations)
D.execMap forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Newtype n => n -> O n
unpack
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BinPkgName]
_missingDependency forall a b. (a -> b) -> a -> b
$ (Lens' DebInfo (Set BinPkgName)
D.missingDependencies forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Set a
Set.insert
  Lens' DebInfo (Maybe [Char])
D.utilsPackageNameBase forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe [Char]
_defaultPackage
  Lens' DebInfo Bool
D.noDocumentationLibrary forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (HaddockStatus
HaddockDisabled forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [HaddockStatus]
_haddock)
  Lens' DebInfo Bool
D.noProfilingLibrary forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (ProfilingStatus
_profiling forall a. Eq a => a -> a -> Bool
== ProfilingStatus
ProfilingDisabled)
  Lens' DebInfo (Maybe DebBase)
D.overrideDebianNameBase forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe DebBase
_debianNameBase
  Lens' DebInfo (Maybe SrcPkgName)
D.sourcePackageName forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe SrcPkgName
_sourcePackageName
  Lens' DebInfo (Maybe NameAddr)
D.maintainerOption forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just NameAddr
_maintainer
  Lens' DebInfo SourceFormat
D.sourceFormat forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SourceFormat
_sourceFormat
  Lens' DebInfo (Maybe [Char])
D.revision forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall n. Newtype n => n -> O n
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Revision
_revision
  Lens' DebInfo (Maybe DebianVersion)
D.debVersion forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe DebianVersion
_debianVersion
  Lens' DebInfo [NameAddr]
D.uploadersOption forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. [a] -> [a] -> [a]
++ [NameAddr]
_uploaders)
  Lens' DebInfo Relations
D.extraDevDeps forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Newtype n => n -> O n
unpack [DevDep]
_devDep)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CabalDebMapping]
_cabalDebMapping forall a b. (a -> b) -> a -> b
$ \(CabalDebMapping (PackageName
pkg, Relations
rels)) -> do
    Lens' DebInfo (Map [Char] Relations)
D.extraLibMap forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (PackageName -> [Char]
unPackageName PackageName
pkg) Relations
rels
  forall (m :: * -> *) n.
(MonadState DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) =>
[n] -> Lens' PackageRelations Relations -> m ()
addExtra [ExtraDepends]
_extraDepends Lens' PackageRelations Relations
B.depends
  forall (m :: * -> *) n.
(MonadState DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) =>
[n] -> Lens' PackageRelations Relations -> m ()
addExtra [ExtraConflicts]
_extraConflicts Lens' PackageRelations Relations
B.conflicts
  forall (m :: * -> *) n.
(MonadState DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) =>
[n] -> Lens' PackageRelations Relations -> m ()
addExtra [ExtraProvides]
_extraProvides Lens' PackageRelations Relations
B.provides
  forall (m :: * -> *) n.
(MonadState DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) =>
[n] -> Lens' PackageRelations Relations -> m ()
addExtra [ExtraReplaces]
_extraReplaces Lens' PackageRelations Relations
B.replaces
  forall (m :: * -> *) n.
(MonadState DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) =>
[n] -> Lens' PackageRelations Relations -> m ()
addExtra [ExtraRecommends]
_extraRecommends Lens' PackageRelations Relations
B.recommends
  forall (m :: * -> *) n.
(MonadState DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) =>
[n] -> Lens' PackageRelations Relations -> m ()
addExtra [ExtraSuggests]
_extraSuggests Lens' PackageRelations Relations
B.suggests
  Lens' DebInfo TestsStatus
D.testsStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TestsStatus
_tests
  Lens' DebInfo Bool
D.official forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (OfficialStatus
_official forall a. Eq a => a -> a -> Bool
== OfficialStatus
Official)
  forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' DebInfo SourceDebDescription
D.control forall a b. (a -> b) -> a -> b
$ do
    Lens' SourceDebDescription (Maybe Section)
S.section forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Section
_sourceSection
    Lens' SourceDebDescription (Maybe StandardsVersion)
S.standardsVersion forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just StandardsVersion
_standardsVersion
    Lens' SourceDebDescription Relations
S.buildDepends forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Newtype n => n -> O n
unpack [BuildDep]
_buildDep)
    Lens' SourceDebDescription Relations
S.buildDepends forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Newtype n => n -> O n
unpack [DevDep]
_devDep)
    Lens' SourceDebDescription Relations
S.buildDependsIndep forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall n. Newtype n => n -> O n
unpack [BuildDepIndep]
_buildDepIndep)

addExtra :: (MonadState D.DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) =>
            [n] -> Lens' B.PackageRelations Relations -> m ()
addExtra :: forall (m :: * -> *) n.
(MonadState DebInfo m, Newtype n, O n ~ (BinPkgName, Relations)) =>
[n] -> Lens' PackageRelations Relations -> m ()
addExtra [n]
extra Lens' PackageRelations Relations
lens' = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [n]
extra forall a b. (a -> b) -> a -> b
$ \n
arg -> do
  let (BinPkgName
pkg, Relations
rel) = forall n. Newtype n => n -> O n
unpack n
arg
  BinPkgName -> Lens' DebInfo BinaryDebDescription
D.binaryDebDescription BinPkgName
pkg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
lens' forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. [a] -> [a] -> [a]
++ Relations
rel)

parseProgramArguments' :: [String] -> IO CommandLineOptions
parseProgramArguments' :: [[Char]] -> IO CommandLineOptions
parseProgramArguments' [[Char]]
args =  forall a. ParserResult a -> IO a
O.handleParseResult ParserResult CommandLineOptions
result where
  prefs :: ParserPrefs
prefs = PrefsMod -> ParserPrefs
O.prefs forall m. Monoid m => m
O.idm
  result :: ParserResult CommandLineOptions
result = forall a. ParserPrefs -> ParserInfo a -> [[Char]] -> ParserResult a
O.execParserPure ParserPrefs
prefs ([[Char]] -> ParserInfo CommandLineOptions
commandLineOptionsParserInfo [[Char]]
args) [[Char]]
args

parseProgramArguments :: IO CommandLineOptions
parseProgramArguments :: IO CommandLineOptions
parseProgramArguments = IO [[Char]]
getArgs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]] -> IO CommandLineOptions
parseProgramArguments' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
leaveOne [Char]
"--disable-haddock"
    where
      leaveOne :: String -> [String] -> [String]
      leaveOne :: [Char] -> [[Char]] -> [[Char]]
leaveOne [Char]
s [[Char]]
xs = Bool -> [[Char]] -> [[Char]]
go Bool
False [[Char]]
xs
          where
            go :: Bool -> [[Char]] -> [[Char]]
go Bool
_ [] = []
            go Bool
False ([Char]
x : [[Char]]
xs') | [Char]
x forall a. Eq a => a -> a -> Bool
== [Char]
s = [Char]
x forall a. a -> [a] -> [a]
: Bool -> [[Char]] -> [[Char]]
go Bool
True [[Char]]
xs'
            go Bool
True ([Char]
x : [[Char]]
xs') | [Char]
x forall a. Eq a => a -> a -> Bool
== [Char]
s = Bool -> [[Char]] -> [[Char]]
go Bool
True [[Char]]
xs'
            go Bool
flag ([Char]
x : [[Char]]
xs') = [Char]
x forall a. a -> [a] -> [a]
: Bool -> [[Char]] -> [[Char]]
go Bool
flag [[Char]]
xs'