{-# 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
(HaddockStatus -> HaddockStatus -> Bool)
-> (HaddockStatus -> HaddockStatus -> Bool) -> Eq HaddockStatus
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
(ProfilingStatus -> ProfilingStatus -> Bool)
-> (ProfilingStatus -> ProfilingStatus -> Bool)
-> Eq ProfilingStatus
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
(OfficialStatus -> OfficialStatus -> Bool)
-> (OfficialStatus -> OfficialStatus -> Bool) -> Eq OfficialStatus
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. BuildDep -> Rep BuildDep x)
-> (forall x. Rep BuildDep x -> BuildDep) -> Generic BuildDep
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. BuildDepIndep -> Rep BuildDepIndep x)
-> (forall x. Rep BuildDepIndep x -> BuildDepIndep)
-> Generic BuildDepIndep
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. DevDep -> Rep DevDep x)
-> (forall x. Rep DevDep x -> DevDep) -> Generic DevDep
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. ExtraDepends -> Rep ExtraDepends x)
-> (forall x. Rep ExtraDepends x -> ExtraDepends)
-> Generic ExtraDepends
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. ExtraConflicts -> Rep ExtraConflicts x)
-> (forall x. Rep ExtraConflicts x -> ExtraConflicts)
-> Generic ExtraConflicts
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. ExtraProvides -> Rep ExtraProvides x)
-> (forall x. Rep ExtraProvides x -> ExtraProvides)
-> Generic ExtraProvides
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. ExtraReplaces -> Rep ExtraReplaces x)
-> (forall x. Rep ExtraReplaces x -> ExtraReplaces)
-> Generic ExtraReplaces
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. ExtraRecommends -> Rep ExtraRecommends x)
-> (forall x. Rep ExtraRecommends x -> ExtraRecommends)
-> Generic ExtraRecommends
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. ExtraSuggests -> Rep ExtraSuggests x)
-> (forall x. Rep ExtraSuggests x -> ExtraSuggests)
-> Generic ExtraSuggests
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. CabalDebMapping -> Rep CabalDebMapping x)
-> (forall x. Rep CabalDebMapping x -> CabalDebMapping)
-> Generic CabalDebMapping
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. ExecDebMapping -> Rep ExecDebMapping x)
-> (forall x. Rep ExecDebMapping x -> ExecDebMapping)
-> Generic ExecDebMapping
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. Revision -> Rep Revision x)
-> (forall x. Rep Revision x -> Revision) -> Generic Revision
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. CabalEpochMapping -> Rep CabalEpochMapping x)
-> (forall x. Rep CabalEpochMapping x -> CabalEpochMapping)
-> Generic CabalEpochMapping
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. CabalFlagMapping -> Rep CabalFlagMapping x)
-> (forall x. Rep CabalFlagMapping x -> CabalFlagMapping)
-> Generic CabalFlagMapping
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 String
_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 = (String, String) -> (BinPkgName, InstallFile)
parsePair ((String, String) -> (BinPkgName, InstallFile))
-> (String -> (String, String))
-> String
-> (BinPkgName, InstallFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') (String -> (BinPkgName, InstallFile))
-> ReadM String -> ReadM (BinPkgName, InstallFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM String
forall s. IsString s => ReadM s
O.str where
  parsePair :: (String, String) -> (BinPkgName, D.InstallFile)
  parsePair :: (String, String) -> (BinPkgName, InstallFile)
parsePair (String
sp, String
md) = let (String
sd, String
name) = String -> (String, String)
splitFileName String
sp in
    (String -> BinPkgName
BinPkgName String
name, InstallFile :: String -> Maybe String -> Maybe String -> String -> InstallFile
D.InstallFile { execName :: String
D.execName  = String
name,
                                      destName :: String
D.destName  = String
name,
                                      sourceDir :: Maybe String
D.sourceDir = (String -> Bool) -> String -> Maybe String
forall a. (a -> Bool) -> a -> Maybe a
nothingIf ( String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"./") String
sd,
                                      destDir :: Maybe String
D.destDir   = case String
md of
                                                      (Char
':' : String
dd) -> String -> Maybe String
forall a. a -> Maybe a
Just String
dd
                                                      String
_          -> Maybe String
forall a. Maybe a
Nothing })

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

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

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

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

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

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

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

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

cabalFlagMappingR :: O.ReadM CabalFlagMapping
cabalFlagMappingR :: ReadM CabalFlagMapping
cabalFlagMappingR = ReadM String
forall s. IsString s => ReadM s
O.str ReadM String
-> (String -> ReadM CabalFlagMapping) -> ReadM CabalFlagMapping
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  (Char
'-' : String
str) -> CabalFlagMapping -> ReadM CabalFlagMapping
forall (m :: * -> *) a. Monad m => a -> m a
return (CabalFlagMapping -> ReadM CabalFlagMapping)
-> CabalFlagMapping -> ReadM CabalFlagMapping
forall a b. (a -> b) -> a -> b
$ (FlagName, Bool) -> CabalFlagMapping
CabalFlagMapping (String -> FlagName
mkFlagName String
str, Bool
False)
  String
str -> CabalFlagMapping -> ReadM CabalFlagMapping
forall (m :: * -> *) a. Monad m => a -> m a
return (CabalFlagMapping -> ReadM CabalFlagMapping)
-> CabalFlagMapping -> ReadM CabalFlagMapping
forall a b. (a -> b) -> a -> b
$ (FlagName, Bool) -> CabalFlagMapping
CabalFlagMapping (String -> FlagName
mkFlagName String
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 String
-> [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 (NameAddr
 -> [NameAddr]
 -> [(BinPkgName, InstallFile)]
 -> Maybe String
 -> [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)
-> Parser NameAddr
-> Parser
     ([NameAddr]
      -> [(BinPkgName, InstallFile)]
      -> Maybe String
      -> [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)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NameAddr
maintainerP
                                         Parser
  ([NameAddr]
   -> [(BinPkgName, InstallFile)]
   -> Maybe String
   -> [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)
-> Parser [NameAddr]
-> Parser
     ([(BinPkgName, InstallFile)]
      -> Maybe String
      -> [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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [NameAddr]
uploadersP
                                         Parser
  ([(BinPkgName, InstallFile)]
   -> Maybe String
   -> [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)
-> Parser [(BinPkgName, InstallFile)]
-> Parser
     (Maybe String
      -> [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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(BinPkgName, InstallFile)]
executableP
                                         Parser
  (Maybe String
   -> [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)
-> Parser (Maybe String)
-> Parser
     ([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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe String)
defaultPackageP
                                         Parser
  ([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)
-> Parser [BinPkgName]
-> Parser
     (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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [BinPkgName]
missingDependencyP
                                         Parser
  (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)
-> Parser (Maybe DebBase)
-> Parser
     (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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DebBase)
debianNameBaseP
                                         Parser
  (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)
-> Parser (Maybe DebianVersion)
-> Parser
     (Maybe Revision
      -> Maybe SrcPkgName
      -> Section
      -> StandardsVersion
      -> [BuildDep]
      -> [BuildDepIndep]
      -> [DevDep]
      -> [ExtraDepends]
      -> [ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DebianVersion)
debianVersionP
                                         Parser
  (Maybe Revision
   -> Maybe SrcPkgName
   -> Section
   -> StandardsVersion
   -> [BuildDep]
   -> [BuildDepIndep]
   -> [DevDep]
   -> [ExtraDepends]
   -> [ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser (Maybe Revision)
-> Parser
     (Maybe SrcPkgName
      -> Section
      -> StandardsVersion
      -> [BuildDep]
      -> [BuildDepIndep]
      -> [DevDep]
      -> [ExtraDepends]
      -> [ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Revision)
debianRevisionP
                                         Parser
  (Maybe SrcPkgName
   -> Section
   -> StandardsVersion
   -> [BuildDep]
   -> [BuildDepIndep]
   -> [DevDep]
   -> [ExtraDepends]
   -> [ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser (Maybe SrcPkgName)
-> Parser
     (Section
      -> StandardsVersion
      -> [BuildDep]
      -> [BuildDepIndep]
      -> [DevDep]
      -> [ExtraDepends]
      -> [ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SrcPkgName)
sourcePackageNameP
                                         Parser
  (Section
   -> StandardsVersion
   -> [BuildDep]
   -> [BuildDepIndep]
   -> [DevDep]
   -> [ExtraDepends]
   -> [ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser Section
-> Parser
     (StandardsVersion
      -> [BuildDep]
      -> [BuildDepIndep]
      -> [DevDep]
      -> [ExtraDepends]
      -> [ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Section
sourceSectionP
                                         Parser
  (StandardsVersion
   -> [BuildDep]
   -> [BuildDepIndep]
   -> [DevDep]
   -> [ExtraDepends]
   -> [ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser StandardsVersion
-> Parser
     ([BuildDep]
      -> [BuildDepIndep]
      -> [DevDep]
      -> [ExtraDepends]
      -> [ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StandardsVersion
standardsVersionP
                                         Parser
  ([BuildDep]
   -> [BuildDepIndep]
   -> [DevDep]
   -> [ExtraDepends]
   -> [ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [BuildDep]
-> Parser
     ([BuildDepIndep]
      -> [DevDep]
      -> [ExtraDepends]
      -> [ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [BuildDep]
buildDepP
                                         Parser
  ([BuildDepIndep]
   -> [DevDep]
   -> [ExtraDepends]
   -> [ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [BuildDepIndep]
-> Parser
     ([DevDep]
      -> [ExtraDepends]
      -> [ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [BuildDepIndep]
buildDepIndepP
                                         Parser
  ([DevDep]
   -> [ExtraDepends]
   -> [ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [DevDep]
-> Parser
     ([ExtraDepends]
      -> [ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [DevDep]
devDepP
                                         Parser
  ([ExtraDepends]
   -> [ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [ExtraDepends]
-> Parser
     ([ExtraConflicts]
      -> [ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraDepends]
extraDependsP
                                         Parser
  ([ExtraConflicts]
   -> [ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [ExtraConflicts]
-> Parser
     ([ExtraProvides]
      -> [ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraConflicts]
extraConflictsP
                                         Parser
  ([ExtraProvides]
   -> [ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [ExtraProvides]
-> Parser
     ([ExtraReplaces]
      -> [ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraProvides]
extraProvidesP
                                         Parser
  ([ExtraReplaces]
   -> [ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [ExtraReplaces]
-> Parser
     ([ExtraRecommends]
      -> [ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraReplaces]
extraReplacesP
                                         Parser
  ([ExtraRecommends]
   -> [ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [ExtraRecommends]
-> Parser
     ([ExtraSuggests]
      -> [CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraRecommends]
extraRecommendsP
                                         Parser
  ([ExtraSuggests]
   -> [CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [ExtraSuggests]
-> Parser
     ([CabalDebMapping]
      -> [CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExtraSuggests]
extraSuggestsP
                                         Parser
  ([CabalDebMapping]
   -> [CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [CabalDebMapping]
-> Parser
     ([CabalEpochMapping]
      -> [ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [CabalDebMapping]
cabalDebMappingP
                                         Parser
  ([CabalEpochMapping]
   -> [ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [CabalEpochMapping]
-> Parser
     ([ExecDebMapping]
      -> ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [CabalEpochMapping]
cabalEpochMappingP
                                         Parser
  ([ExecDebMapping]
   -> ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [ExecDebMapping]
-> Parser
     (ProfilingStatus
      -> [HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ExecDebMapping]
execDebMappingP
                                         Parser
  (ProfilingStatus
   -> [HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser ProfilingStatus
-> Parser
     ([HaddockStatus]
      -> OfficialStatus
      -> SourceFormat
      -> TestsStatus
      -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ProfilingStatus
profilingP
                                         Parser
  ([HaddockStatus]
   -> OfficialStatus
   -> SourceFormat
   -> TestsStatus
   -> BehaviorAdjustment)
-> Parser [HaddockStatus]
-> Parser
     (OfficialStatus
      -> SourceFormat -> TestsStatus -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [HaddockStatus]
haddockP
                                         Parser
  (OfficialStatus
   -> SourceFormat -> TestsStatus -> BehaviorAdjustment)
-> Parser OfficialStatus
-> Parser (SourceFormat -> TestsStatus -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OfficialStatus
officialP
                                         Parser (SourceFormat -> TestsStatus -> BehaviorAdjustment)
-> Parser SourceFormat
-> Parser (TestsStatus -> BehaviorAdjustment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SourceFormat
sourceFormatP
                                         Parser (TestsStatus -> BehaviorAdjustment)
-> Parser TestsStatus -> Parser BehaviorAdjustment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TestsStatus
testsP

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

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

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

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

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

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

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

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

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

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

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

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

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

devDepP :: O.Parser [DevDep]
devDepP :: Parser [DevDep]
devDepP = Parser DevDep -> Parser [DevDep]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser DevDep -> Parser [DevDep])
-> Parser DevDep -> Parser [DevDep]
forall a b. (a -> b) -> a -> b
$ ReadM DevDep -> Mod OptionFields DevDep -> Parser DevDep
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (Relations -> DevDep
DevDep (Relations -> DevDep) -> ReadM Relations -> ReadM 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 = String -> Mod OptionFields DevDep
forall (f :: * -> *) a. String -> Mod f a
O.help String
helpMsg
      Mod OptionFields DevDep
-> Mod OptionFields DevDep -> Mod OptionFields DevDep
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DevDep
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"dev-dep"
      Mod OptionFields DevDep
-> Mod OptionFields DevDep -> Mod OptionFields DevDep
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DevDep
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"RELATION"
  helpMsg :: String
helpMsg = String
"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 :: String -> Parser [n]
mkExtraP long :: String
long@(Char
c:String
cr) = Parser n -> Parser [n]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser n -> Parser [n]) -> Parser n -> Parser [n]
forall a b. (a -> b) -> a -> b
$ ReadM n -> Mod OptionFields n -> Parser n
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ((BinPkgName, Relations) -> n
forall n. Newtype n => O n -> n
pack ((BinPkgName, Relations) -> n)
-> ReadM (BinPkgName, Relations) -> ReadM n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (BinPkgName, Relations)
extraRelationsR) Mod OptionFields n
m where
    fieldName :: String
fieldName = Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cr
    m :: Mod OptionFields n
m = String -> Mod OptionFields n
forall (f :: * -> *) a. String -> Mod f a
O.help String
helpMsg
        Mod OptionFields n -> Mod OptionFields n -> Mod OptionFields n
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields n
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
long
        Mod OptionFields n -> Mod OptionFields n -> Mod OptionFields n
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields n
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"DEB:RELATION"
    helpMsg :: String
helpMsg = String
"Add extry to '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 'field of DEB binary package"
mkExtraP String
"" = String -> Parser [n]
forall a. HasCallStack => String -> a
error String
"mkExtraP: empty long option"

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

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

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

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

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

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

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

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

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

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


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

haddockP :: O.Parser [HaddockStatus]
haddockP :: Parser [HaddockStatus]
haddockP = (HaddockStatus -> [HaddockStatus] -> [HaddockStatus]
forall a. a -> [a] -> [a]
: []) (HaddockStatus -> [HaddockStatus])
-> Parser HaddockStatus -> Parser [HaddockStatus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HaddockStatus
-> HaddockStatus
-> Mod FlagFields HaddockStatus
-> Parser HaddockStatus
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 = String -> Mod FlagFields HaddockStatus
forall (f :: * -> *) a. String -> Mod f a
O.help String
helpMsg
      Mod FlagFields HaddockStatus
-> Mod FlagFields HaddockStatus -> Mod FlagFields HaddockStatus
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields HaddockStatus
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"disable-haddock"
  helpMsg :: String
helpMsg = String
"Do not create a -doc package"

officialP :: O.Parser OfficialStatus
officialP :: Parser OfficialStatus
officialP = OfficialStatus
-> OfficialStatus
-> Mod FlagFields OfficialStatus
-> Parser OfficialStatus
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 = String -> Mod FlagFields OfficialStatus
forall (f :: * -> *) a. String -> Mod f a
O.help String
helpMsg
      Mod FlagFields OfficialStatus
-> Mod FlagFields OfficialStatus -> Mod FlagFields OfficialStatus
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields OfficialStatus
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"official"
  helpMsg :: String
helpMsg = String
"Follow guidelines of Debian Haskell Group"

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

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

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

buildOnlyTestsP :: O.Parser TestsStatus
buildOnlyTestsP :: Parser TestsStatus
buildOnlyTestsP = TestsStatus
-> TestsStatus -> Mod FlagFields TestsStatus -> Parser TestsStatus
forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag TestsStatus
TestsRun TestsStatus
TestsBuild Mod FlagFields TestsStatus
forall a. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = String -> Mod FlagFields a
forall (f :: * -> *) a. String -> Mod f a
O.help String
"build, but do not run test suite"
      Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"no-run-tests"
      Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"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 (Int
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> CompilerFlavor
 -> Set (FlagName, Bool)
 -> EnvSet
 -> Flags)
-> Parser Int
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> CompilerFlavor
      -> Set (FlagName, Bool)
      -> EnvSet
      -> Flags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
verbosityP
               Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> CompilerFlavor
   -> Set (FlagName, Bool)
   -> EnvSet
   -> Flags)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> CompilerFlavor
      -> Set (FlagName, Bool)
      -> EnvSet
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
dryRunP
               Parser
  (Bool
   -> Bool
   -> Bool
   -> CompilerFlavor
   -> Set (FlagName, Bool)
   -> EnvSet
   -> Flags)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> CompilerFlavor
      -> Set (FlagName, Bool)
      -> EnvSet
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
upgradeP
               Parser
  (Bool
   -> Bool
   -> CompilerFlavor
   -> Set (FlagName, Bool)
   -> EnvSet
   -> Flags)
-> Parser Bool
-> Parser
     (Bool -> CompilerFlavor -> Set (FlagName, Bool) -> EnvSet -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
roundtripP
               Parser
  (Bool -> CompilerFlavor -> Set (FlagName, Bool) -> EnvSet -> Flags)
-> Parser Bool
-> Parser
     (CompilerFlavor -> Set (FlagName, Bool) -> EnvSet -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False     -- validate
               Parser (CompilerFlavor -> Set (FlagName, Bool) -> EnvSet -> Flags)
-> Parser CompilerFlavor
-> Parser (Set (FlagName, Bool) -> EnvSet -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CompilerFlavor
hcFlavorP         -- CompilerFlavor
               Parser (Set (FlagName, Bool) -> EnvSet -> Flags)
-> Parser (Set (FlagName, Bool)) -> Parser (EnvSet -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([CabalFlagMapping] -> Set (FlagName, Bool)
flagSet ([CabalFlagMapping] -> Set (FlagName, Bool))
-> Parser [CabalFlagMapping] -> Parser (Set (FlagName, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [CabalFlagMapping]
cabalFlagsP)    -- cabalFlagAssignments
               Parser (EnvSet -> Flags) -> Parser EnvSet -> Parser Flags
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 = [(FlagName, Bool)] -> Set (FlagName, Bool)
forall a. Ord a => [a] -> Set a
Set.fromList ((CabalFlagMapping -> (FlagName, Bool))
-> [CabalFlagMapping] -> [(FlagName, Bool)]
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 = [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([()] -> Int) -> Parser [()] -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (() -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
O.flag' () Mod FlagFields ()
forall a. Mod FlagFields a
m) where
  m :: Mod FlagFields a
m = String -> Mod FlagFields a
forall (f :: * -> *) a. String -> Mod f a
O.help String
helpMsg
      Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'v'
      Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"verbose"
  helpMsg :: String
helpMsg = [String] -> String
unlines [
    String
"Every instance of this flag increases amount",
    String
"of progress messages generated"
    ]

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

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

roundtripP :: O.Parser Bool
roundtripP :: Parser Bool
roundtripP = Mod FlagFields Bool -> Parser Bool
O.switch Mod FlagFields Bool
forall a. Mod FlagFields a
m where
  m :: Mod FlagFields a
m = String -> Mod FlagFields a
forall (f :: * -> *) a. String -> Mod f a
O.help String
helpMsg
      Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"roundtrip"
  helpMsg :: String
helpMsg = [String] -> String
unlines [
    String
"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 = CompilerFlavor
-> CompilerFlavor
-> Mod FlagFields CompilerFlavor
-> Parser CompilerFlavor
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 = String -> Mod FlagFields CompilerFlavor
forall (f :: * -> *) a. String -> Mod f a
O.help String
helpMsg
      Mod FlagFields CompilerFlavor
-> Mod FlagFields CompilerFlavor -> Mod FlagFields CompilerFlavor
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields CompilerFlavor
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"ghcjs"
  helpMsg :: String
helpMsg = String
"Set compiler flavor to GHCJS."

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

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

commandLineOptionsParserInfo :: [String] -> O.ParserInfo CommandLineOptions
commandLineOptionsParserInfo :: [String] -> ParserInfo CommandLineOptions
commandLineOptionsParserInfo [String]
args = Parser CommandLineOptions
-> InfoMod CommandLineOptions -> ParserInfo CommandLineOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (Parser (CommandLineOptions -> CommandLineOptions)
forall a. Parser (a -> a)
O.helper Parser (CommandLineOptions -> CommandLineOptions)
-> Parser CommandLineOptions -> Parser CommandLineOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CommandLineOptions
commandLineOptionsP) InfoMod CommandLineOptions
im where
  im :: InfoMod CommandLineOptions
im = String -> InfoMod CommandLineOptions
forall a. String -> InfoMod a
O.header String
"cabal-debian -- create debianization of cabal package"
       InfoMod CommandLineOptions
-> InfoMod CommandLineOptions -> InfoMod CommandLineOptions
forall a. Semigroup a => a -> a -> a
<> InfoMod CommandLineOptions
forall a. InfoMod a
O.fullDesc
       InfoMod CommandLineOptions
-> InfoMod CommandLineOptions -> InfoMod CommandLineOptions
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod CommandLineOptions
forall a. Maybe Doc -> InfoMod a
O.progDescDoc (Doc -> Maybe Doc
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
<+> (String -> Doc
string (String -> Doc) -> ([String] -> String) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ [
     String
"This will read the package's cabal file and any existing debian/changelog file and",
     String
"deduce what it can about the debianization, then it will create or modify files in",
     String
"the debian subdirectory.  Note that it will not remove any files in debian, and",
     String
"these could affect the operation of the debianization in unknown ways.  For this",
     String
"reason it is recommended either using a pristine unpacked directory each time, or else",
     String
"using a revision control system to revert the package to a known state before running.",
     String
"",
     String
"Arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showCommandForUser String
"cabal-debian" [String]
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 :: BehaviorAdjustment -> CabalT m ()
handleBehaviorAdjustment (BehaviorAdjustment {[(BinPkgName, InstallFile)]
[BinPkgName]
[NameAddr]
[CabalEpochMapping]
[ExecDebMapping]
[CabalDebMapping]
[ExtraSuggests]
[ExtraRecommends]
[ExtraReplaces]
[ExtraProvides]
[ExtraConflicts]
[ExtraDepends]
[DevDep]
[BuildDepIndep]
[BuildDep]
[HaddockStatus]
Maybe String
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 String
_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 String
_executable :: BehaviorAdjustment -> [(BinPkgName, InstallFile)]
_uploaders :: BehaviorAdjustment -> [NameAddr]
_maintainer :: BehaviorAdjustment -> NameAddr
..}) = do
 [CabalEpochMapping]
-> (CabalEpochMapping -> CabalT m ()) -> CabalT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CabalEpochMapping]
_cabalEpochMapping ((CabalEpochMapping -> CabalT m ()) -> CabalT m ())
-> (CabalEpochMapping -> CabalT m ()) -> CabalT m ()
forall a b. (a -> b) -> a -> b
$ \(CabalEpochMapping (PackageName
pkg, Int
num)) -> (Map PackageName Int -> Identity (Map PackageName Int))
-> CabalInfo -> Identity CabalInfo
Lens' CabalInfo (Map PackageName Int)
A.epochMap ((Map PackageName Int -> Identity (Map PackageName Int))
 -> CabalInfo -> Identity CabalInfo)
-> (Map PackageName Int -> Map PackageName Int) -> CabalT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= PackageName -> Int -> Map PackageName Int -> Map PackageName Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PackageName
pkg Int
num
 LensLike' (Zoomed (StateT DebInfo m) ()) CabalInfo DebInfo
-> StateT DebInfo m () -> CabalT m ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike' (Zoomed (StateT DebInfo m) ()) CabalInfo DebInfo
Lens' CabalInfo DebInfo
A.debInfo (StateT DebInfo m () -> CabalT m ())
-> StateT DebInfo m () -> CabalT m ()
forall a b. (a -> b) -> a -> b
$ do
  [(BinPkgName, InstallFile)]
-> ((BinPkgName, InstallFile) -> StateT DebInfo m ())
-> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(BinPkgName, InstallFile)]
_executable (((BinPkgName, InstallFile) -> StateT DebInfo m ())
 -> StateT DebInfo m ())
-> ((BinPkgName, InstallFile) -> StateT DebInfo m ())
-> StateT DebInfo m ()
forall a b. (a -> b) -> a -> b
$ ((Map BinPkgName InstallFile
 -> Identity (Map BinPkgName InstallFile))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName InstallFile)
D.executable ((Map BinPkgName InstallFile
  -> Identity (Map BinPkgName InstallFile))
 -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName InstallFile -> Map BinPkgName InstallFile)
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=) ((Map BinPkgName InstallFile -> Map BinPkgName InstallFile)
 -> StateT DebInfo m ())
-> ((BinPkgName, InstallFile)
    -> Map BinPkgName InstallFile -> Map BinPkgName InstallFile)
-> (BinPkgName, InstallFile)
-> StateT DebInfo m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BinPkgName
 -> InstallFile
 -> Map BinPkgName InstallFile
 -> Map BinPkgName InstallFile)
-> (BinPkgName, InstallFile)
-> Map BinPkgName InstallFile
-> Map BinPkgName InstallFile
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BinPkgName
-> InstallFile
-> Map BinPkgName InstallFile
-> Map BinPkgName InstallFile
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
  [ExecDebMapping]
-> (ExecDebMapping -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExecDebMapping]
_execDebMapping ((ExecDebMapping -> StateT DebInfo m ()) -> StateT DebInfo m ())
-> (ExecDebMapping -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b. (a -> b) -> a -> b
$ ((Map String Relations -> Identity (Map String Relations))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map String Relations)
D.execMap ((Map String Relations -> Identity (Map String Relations))
 -> DebInfo -> Identity DebInfo)
-> (Map String Relations -> Map String Relations)
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=) ((Map String Relations -> Map String Relations)
 -> StateT DebInfo m ())
-> (ExecDebMapping -> Map String Relations -> Map String Relations)
-> ExecDebMapping
-> StateT DebInfo m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
 -> Relations -> Map String Relations -> Map String Relations)
-> (String, Relations)
-> Map String Relations
-> Map String Relations
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Relations -> Map String Relations -> Map String Relations
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ((String, Relations)
 -> Map String Relations -> Map String Relations)
-> (ExecDebMapping -> (String, Relations))
-> ExecDebMapping
-> Map String Relations
-> Map String Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecDebMapping -> (String, Relations)
forall n. Newtype n => n -> O n
unpack
  [BinPkgName]
-> (BinPkgName -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BinPkgName]
_missingDependency ((BinPkgName -> StateT DebInfo m ()) -> StateT DebInfo m ())
-> (BinPkgName -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b. (a -> b) -> a -> b
$ ((Set BinPkgName -> Identity (Set BinPkgName))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Set BinPkgName)
D.missingDependencies ((Set BinPkgName -> Identity (Set BinPkgName))
 -> DebInfo -> Identity DebInfo)
-> (Set BinPkgName -> Set BinPkgName) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=) ((Set BinPkgName -> Set BinPkgName) -> StateT DebInfo m ())
-> (BinPkgName -> Set BinPkgName -> Set BinPkgName)
-> BinPkgName
-> StateT DebInfo m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> Set BinPkgName -> Set BinPkgName
forall a. Ord a => a -> Set a -> Set a
Set.insert
  (Maybe String -> Identity (Maybe String))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe String)
D.utilsPackageNameBase ((Maybe String -> Identity (Maybe String))
 -> DebInfo -> Identity DebInfo)
-> Maybe String -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe String
_defaultPackage
  (Bool -> Identity Bool) -> DebInfo -> Identity DebInfo
Lens' DebInfo Bool
D.noDocumentationLibrary ((Bool -> Identity Bool) -> DebInfo -> Identity DebInfo)
-> Bool -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (HaddockStatus
HaddockDisabled HaddockStatus -> [HaddockStatus] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [HaddockStatus]
_haddock)
  (Bool -> Identity Bool) -> DebInfo -> Identity DebInfo
Lens' DebInfo Bool
D.noProfilingLibrary ((Bool -> Identity Bool) -> DebInfo -> Identity DebInfo)
-> Bool -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (ProfilingStatus
_profiling ProfilingStatus -> ProfilingStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ProfilingStatus
ProfilingDisabled)
  (Maybe DebBase -> Identity (Maybe DebBase))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe DebBase)
D.overrideDebianNameBase ((Maybe DebBase -> Identity (Maybe DebBase))
 -> DebInfo -> Identity DebInfo)
-> Maybe DebBase -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe DebBase
_debianNameBase
  (Maybe SrcPkgName -> Identity (Maybe SrcPkgName))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe SrcPkgName)
D.sourcePackageName ((Maybe SrcPkgName -> Identity (Maybe SrcPkgName))
 -> DebInfo -> Identity DebInfo)
-> Maybe SrcPkgName -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe SrcPkgName
_sourcePackageName
  (Maybe NameAddr -> Identity (Maybe NameAddr))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe NameAddr)
D.maintainerOption ((Maybe NameAddr -> Identity (Maybe NameAddr))
 -> DebInfo -> Identity DebInfo)
-> Maybe NameAddr -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NameAddr -> Maybe NameAddr
forall a. a -> Maybe a
Just NameAddr
_maintainer
  (SourceFormat -> Identity SourceFormat)
-> DebInfo -> Identity DebInfo
Lens' DebInfo SourceFormat
D.sourceFormat ((SourceFormat -> Identity SourceFormat)
 -> DebInfo -> Identity DebInfo)
-> SourceFormat -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SourceFormat
_sourceFormat
  (Maybe String -> Identity (Maybe String))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe String)
D.revision ((Maybe String -> Identity (Maybe String))
 -> DebInfo -> Identity DebInfo)
-> Maybe String -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Revision -> String
forall n. Newtype n => n -> O n
unpack (Revision -> String) -> Maybe Revision -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Revision
_revision
  (Maybe DebianVersion -> Identity (Maybe DebianVersion))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe DebianVersion)
D.debVersion ((Maybe DebianVersion -> Identity (Maybe DebianVersion))
 -> DebInfo -> Identity DebInfo)
-> Maybe DebianVersion -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe DebianVersion
_debianVersion
  ([NameAddr] -> Identity [NameAddr]) -> DebInfo -> Identity DebInfo
Lens' DebInfo [NameAddr]
D.uploadersOption (([NameAddr] -> Identity [NameAddr])
 -> DebInfo -> Identity DebInfo)
-> ([NameAddr] -> [NameAddr]) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([NameAddr] -> [NameAddr] -> [NameAddr]
forall a. [a] -> [a] -> [a]
++ [NameAddr]
_uploaders)
  (Relations -> Identity Relations) -> DebInfo -> Identity DebInfo
Lens' DebInfo Relations
D.extraDevDeps ((Relations -> Identity Relations) -> DebInfo -> Identity DebInfo)
-> (Relations -> Relations) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ (DevDep -> Relations) -> [DevDep] -> Relations
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DevDep -> Relations
forall n. Newtype n => n -> O n
unpack [DevDep]
_devDep)
  [CabalDebMapping]
-> (CabalDebMapping -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CabalDebMapping]
_cabalDebMapping ((CabalDebMapping -> StateT DebInfo m ()) -> StateT DebInfo m ())
-> (CabalDebMapping -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b. (a -> b) -> a -> b
$ \(CabalDebMapping (PackageName
pkg, Relations
rels)) -> do
    (Map String Relations -> Identity (Map String Relations))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map String Relations)
D.extraLibMap ((Map String Relations -> Identity (Map String Relations))
 -> DebInfo -> Identity DebInfo)
-> (Map String Relations -> Map String Relations)
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= String -> Relations -> Map String Relations -> Map String Relations
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (PackageName -> String
unPackageName PackageName
pkg) Relations
rels
  [ExtraDepends]
-> Lens' PackageRelations Relations -> StateT DebInfo m ()
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
  [ExtraConflicts]
-> Lens' PackageRelations Relations -> StateT DebInfo m ()
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
  [ExtraProvides]
-> Lens' PackageRelations Relations -> StateT DebInfo m ()
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
  [ExtraReplaces]
-> Lens' PackageRelations Relations -> StateT DebInfo m ()
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
  [ExtraRecommends]
-> Lens' PackageRelations Relations -> StateT DebInfo m ()
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
  [ExtraSuggests]
-> Lens' PackageRelations Relations -> StateT DebInfo m ()
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
  (TestsStatus -> Identity TestsStatus)
-> DebInfo -> Identity DebInfo
Lens' DebInfo TestsStatus
D.testsStatus ((TestsStatus -> Identity TestsStatus)
 -> DebInfo -> Identity DebInfo)
-> TestsStatus -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TestsStatus
_tests
  (Bool -> Identity Bool) -> DebInfo -> Identity DebInfo
Lens' DebInfo Bool
D.official ((Bool -> Identity Bool) -> DebInfo -> Identity DebInfo)
-> Bool -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (OfficialStatus
_official OfficialStatus -> OfficialStatus -> Bool
forall a. Eq a => a -> a -> Bool
== OfficialStatus
Official)
  LensLike'
  (Zoomed (StateT SourceDebDescription m) ())
  DebInfo
  SourceDebDescription
-> StateT SourceDebDescription m () -> StateT DebInfo m ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT SourceDebDescription m) ())
  DebInfo
  SourceDebDescription
Lens' DebInfo SourceDebDescription
D.control (StateT SourceDebDescription m () -> StateT DebInfo m ())
-> StateT SourceDebDescription m () -> StateT DebInfo m ()
forall a b. (a -> b) -> a -> b
$ do
    (Maybe Section -> Identity (Maybe Section))
-> SourceDebDescription -> Identity SourceDebDescription
Lens' SourceDebDescription (Maybe Section)
S.section ((Maybe Section -> Identity (Maybe Section))
 -> SourceDebDescription -> Identity SourceDebDescription)
-> Maybe Section -> StateT SourceDebDescription m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Section -> Maybe Section
forall a. a -> Maybe a
Just Section
_sourceSection
    (Maybe StandardsVersion -> Identity (Maybe StandardsVersion))
-> SourceDebDescription -> Identity SourceDebDescription
Lens' SourceDebDescription (Maybe StandardsVersion)
S.standardsVersion ((Maybe StandardsVersion -> Identity (Maybe StandardsVersion))
 -> SourceDebDescription -> Identity SourceDebDescription)
-> Maybe StandardsVersion -> StateT SourceDebDescription m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= StandardsVersion -> Maybe StandardsVersion
forall a. a -> Maybe a
Just StandardsVersion
_standardsVersion
    (Relations -> Identity Relations)
-> SourceDebDescription -> Identity SourceDebDescription
Lens' SourceDebDescription Relations
S.buildDepends ((Relations -> Identity Relations)
 -> SourceDebDescription -> Identity SourceDebDescription)
-> (Relations -> Relations) -> StateT SourceDebDescription m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ (BuildDep -> Relations) -> [BuildDep] -> Relations
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildDep -> Relations
forall n. Newtype n => n -> O n
unpack [BuildDep]
_buildDep)
    (Relations -> Identity Relations)
-> SourceDebDescription -> Identity SourceDebDescription
Lens' SourceDebDescription Relations
S.buildDepends ((Relations -> Identity Relations)
 -> SourceDebDescription -> Identity SourceDebDescription)
-> (Relations -> Relations) -> StateT SourceDebDescription m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ (DevDep -> Relations) -> [DevDep] -> Relations
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DevDep -> Relations
forall n. Newtype n => n -> O n
unpack [DevDep]
_devDep)
    (Relations -> Identity Relations)
-> SourceDebDescription -> Identity SourceDebDescription
Lens' SourceDebDescription Relations
S.buildDependsIndep ((Relations -> Identity Relations)
 -> SourceDebDescription -> Identity SourceDebDescription)
-> (Relations -> Relations) -> StateT SourceDebDescription m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ (BuildDepIndep -> Relations) -> [BuildDepIndep] -> Relations
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildDepIndep -> Relations
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 :: [n] -> Lens' PackageRelations Relations -> m ()
addExtra [n]
extra Lens' PackageRelations Relations
lens' = [n] -> (n -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [n]
extra ((n -> m ()) -> m ()) -> (n -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \n
arg -> do
  let (BinPkgName
pkg, Relations
rel) = n -> O n
forall n. Newtype n => n -> O n
unpack n
arg
  BinPkgName -> Lens' DebInfo BinaryDebDescription
D.binaryDebDescription BinPkgName
pkg ((BinaryDebDescription -> Identity BinaryDebDescription)
 -> DebInfo -> Identity DebInfo)
-> ((Relations -> Identity Relations)
    -> BinaryDebDescription -> Identity BinaryDebDescription)
-> (Relations -> Identity Relations)
-> DebInfo
-> Identity DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> (Relations -> Identity Relations)
-> BinaryDebDescription
-> Identity BinaryDebDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
lens' ((Relations -> Identity Relations) -> DebInfo -> Identity DebInfo)
-> (Relations -> Relations) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ Relations
rel)

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

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