--  Copyright (C) 2002-2004 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

{-# LANGUAGE OverloadedStrings #-}

module Darcs.UI.Commands.Send ( send ) where

import Darcs.Prelude

import System.Directory ( renameFile )
import System.Exit ( exitSuccess )
import System.IO ( hClose )
import Control.Exception ( catch, IOException, onException )
import Control.Monad ( when, unless, forM_ )
import Darcs.Util.Tree ( Tree )
import Data.List ( intercalate, isPrefixOf )
import Data.List ( stripPrefix )
import Data.Maybe ( isNothing, fromMaybe )

import Darcs.UI.Commands
    ( DarcsCommand(..), withStdOpts
    , putInfo
    , putVerbose
    , setEnvDarcsPatches
    , defaultRepo
    , amInHashedRepository
    )
import Darcs.UI.Commands.Clone ( otherHelpInheritDefault )
import Darcs.UI.Commands.Util ( printDryRunMessageAndExit, checkUnrelatedRepos )
import Darcs.UI.Flags
    ( DarcsFlag
    , willRemoveLogFile, changesReverse, dryRun, useCache, setDefault
    , fixUrl
    , getCc
    , getAuthor
    , getSubject
    , getInReplyTo
    , getSendmailCmd
    , getOutput
    , charset
    , verbosity
    , isInteractive
    , author
    , hasLogfile
    , selectDeps
    , minimize
    , editDescription
    )
import Darcs.UI.Options ( (?), (^) )
import qualified Darcs.UI.Options.All as O

import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, patchDesc )
import Darcs.Repository
    ( Repository
    , AccessType(..)
    , repoLocation
    , PatchSet
    , identifyRepositoryFor
    , ReadingOrWriting(..)
    , withRepository
    , RepoJob(..)
    , readPatches
    , readPristine
    , prefsUrl )
import Darcs.Patch.Set ( Origin )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch ( RepoPatch, description, applyToTree, effect, invert )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Patch.Witnesses.Ordered
    ( FL(..), (:>)(..), (:\/:)(..),
    mapFL, mapFL_FL, lengthFL, nullFL )
import Darcs.Patch.Bundle
    ( makeBundle
    , minContext
    , readContextFile
    )
import Darcs.Repository.Prefs
    ( Pref(Defaultrepo, Email, Post, Repos)
    , addRepoSource
    , getPreflist
    )
import Darcs.Repository.Flags ( DryRun(..) )
import Darcs.Util.File ( fetchFilePS, Cachable(..) )
import Darcs.UI.External
    ( signString
    , sendEmailDoc
    , generateEmail
    , editFile
    , checkDefaultSendmail
    )
import Darcs.Util.ByteString ( mmapFilePS, isAscii )
import qualified Data.ByteString.Char8 as BC (unpack)
import Darcs.Util.File ( withOpenTemp )
import Darcs.Util.Lock
    ( writeDocBinFile
    , readDocBinFile
    , removeFileMayNotExist
    )
import Darcs.UI.SelectChanges
    ( WhichChanges(..)
    , selectionConfig
    , runSelection
    )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
import Darcs.Patch.Depends ( findCommonWithThem )
import Darcs.Util.Prompt ( askUser, promptYorn )
import Data.Text.Encoding       ( decodeUtf8' )
import Darcs.Util.Progress ( debugMessage )
import Darcs.UI.Email ( makeEmail )
import Darcs.UI.Completion ( prefArgs )
import Darcs.UI.Commands.Util ( getUniqueDPatchName )
import Darcs.Util.Printer
    ( Doc, formatWords, vsep, text, ($$), (<+>), putDoc, putDocLn
    , quoted, renderPS, sentence, vcat
    )
import Darcs.Util.English ( englishNum, Noun(..) )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Path ( FilePathLike, toFilePath, AbsolutePath, AbsolutePathOrStd,
                        getCurrentDirectory, useAbsoluteOrStd, makeAbsoluteOrStd )
import Darcs.Util.HTTP ( postUrl )
import Darcs.Util.Global ( darcsSendMessage, darcsSendMessageFinal )
import Darcs.Util.SignalHandler ( catchInterrupt )

patchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
patchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
flags = S.PatchSelectionOptions
    { verbosity :: Verbosity
S.verbosity = PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , matchFlags :: [MatchFlag]
S.matchFlags = PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchSeveral MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
flags
    , selectDeps :: SelectDeps
S.selectDeps = PrimOptSpec DarcsOptDescr DarcsFlag a SelectDeps
PrimDarcsOption SelectDeps
selectDeps PrimDarcsOption SelectDeps -> [DarcsFlag] -> SelectDeps
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , withSummary :: WithSummary
S.withSummary = PrimOptSpec DarcsOptDescr DarcsFlag a WithSummary
PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    }

send :: DarcsCommand
send :: DarcsCommand
send = DarcsCommand
    { commandProgramName :: [Char]
commandProgramName = [Char]
"darcs"
    , commandName :: [Char]
commandName = [Char]
"send"
    , commandHelp :: Doc
commandHelp = Doc
cmdHelp
    , commandDescription :: [Char]
commandDescription = [Char]
cmdDescription
    , commandExtraArgs :: Int
commandExtraArgs = Int
1
    , commandExtraArgHelp :: [[Char]]
commandExtraArgHelp = [[Char]
"[REPOSITORY]"]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
sendCmd
    , commandPrereq :: [DarcsFlag] -> IO (Either [Char] ())
commandPrereq = [DarcsFlag] -> IO (Either [Char] ())
amInHashedRepository
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
commandCompleteArgs = Pref
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [[Char]]
-> IO [[Char]]
prefArgs Pref
Repos
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
defaultRepo
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
sendOpts
    }
  where
    sendBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
sendBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  [MatchFlag]
MatchOption
O.matchSeveral
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  [MatchFlag]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption SelectDeps
O.selectDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive -- True
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption HeaderFields
O.headerFields
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption (Maybe [Char])
O.author
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption (Maybe [Char])
O.charset
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption Bool
O.mail
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption (Maybe [Char])
O.sendmailCmd
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption (Maybe Output)
O.output
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption Sign
O.sign
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     (WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  (WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption WithSummary
O.withSummary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
     (Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
  (Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
PrimDarcsOption Bool
O.editDescription
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
     (Maybe Bool -> InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
  (Maybe Bool -> InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
PrimDarcsOption (Maybe Bool)
O.setDefault
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char] -> Bool -> Bool -> a)
     (InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char] -> Bool -> Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char] -> Bool -> Bool -> a)
  (InheritDefault -> Maybe [Char] -> Bool -> Bool -> a)
PrimDarcsOption InheritDefault
O.inheritDefault
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char] -> Bool -> Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Bool -> a)
     (Maybe [Char] -> Bool -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Bool -> a)
  (Maybe [Char] -> Bool -> Bool -> a)
PrimDarcsOption (Maybe [Char])
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag (Bool -> a) (Bool -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag (Bool -> a) (Bool -> Bool -> a)
PrimDarcsOption Bool
O.minimize
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> HeaderFields
      -> Maybe [Char]
      -> Maybe [Char]
      -> Bool
      -> Maybe [Char]
      -> Maybe Output
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Bool
      -> Maybe Bool
      -> InheritDefault
      -> Maybe [Char]
      -> Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
PrimDarcsOption Bool
O.allowUnrelatedRepos
    sendAdvancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Logfile -> Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
sendAdvancedOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
  Logfile
PrimDarcsOption Logfile
O.logfile
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
  Logfile
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> RemoteDarcs -> a)
     (Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> RemoteDarcs -> a)
     (Logfile -> Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> RemoteDarcs -> a)
  (Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
PrimDarcsOption (Maybe AbsolutePath)
O.sendToContext 
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> RemoteDarcs -> a)
  (Logfile -> Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (RemoteDarcs -> a)
     (Bool -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (RemoteDarcs -> a)
     (Logfile -> Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (RemoteDarcs -> a)
  (Bool -> RemoteDarcs -> a)
PrimDarcsOption Bool
O.changesReverse
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (RemoteDarcs -> a)
  (Logfile -> Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Logfile -> Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (RemoteDarcs -> a)
PrimDarcsOption RemoteDarcs
O.remoteDarcs
    sendOpts :: CommandOptions
sendOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Logfile
   -> Maybe AbsolutePath
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> Logfile
   -> Maybe AbsolutePath
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> a)
sendBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Logfile
   -> Maybe AbsolutePath
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> HeaderFields
   -> Maybe [Char]
   -> Maybe [Char]
   -> Bool
   -> Maybe [Char]
   -> Maybe Output
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Bool
   -> Maybe Bool
   -> InheritDefault
   -> Maybe [Char]
   -> Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Verbosity
   -> Logfile
   -> Maybe AbsolutePath
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (Logfile
      -> Maybe AbsolutePath
      -> Bool
      -> RemoteDarcs
      -> UseCache
      -> UseIndex
      -> HooksConfig
      -> Bool
      -> Bool
      -> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache
   -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
  (Logfile
   -> Maybe AbsolutePath
   -> Bool
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Logfile -> Maybe AbsolutePath -> Bool -> RemoteDarcs -> a)
sendAdvancedOpts

sendCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
sendCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
sendCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [[Char]
""] = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
sendCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts []
sendCmd (AbsolutePath
_,AbsolutePath
o) [DarcsFlag]
opts [[Char]
unfixedrepodir] =
 UseCache -> RepoJob 'RO () -> IO ()
forall a. UseCache -> RepoJob 'RO a -> IO a
withRepository (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RO () -> IO ()) -> RepoJob 'RO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO () -> RepoJob 'RO ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO () -> RepoJob 'RO ())
-> TreePatchJob 'RO () -> RepoJob 'RO ()
forall a b. (a -> b) -> a -> b
$
  \(Repository 'RO p wU wR
repository :: Repository 'RO p wU wR) -> do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.mail PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts Bool -> Bool -> Bool
&& PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts DryRun -> DryRun -> Bool
forall a. Eq a => a -> a -> Bool
== DryRun
O.NoDryRun) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- If --mail is used and the user has not provided a --sendmail-command
    -- and we can detect that the system has no default way to send emails, 
    -- then we want to fail early i.e. before asking the user any questions.
    Maybe [Char]
sm_cmd <- [DarcsFlag] -> IO (Maybe [Char])
getSendmailCmd [DarcsFlag]
opts
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [Char]
sm_cmd) IO ()
checkDefaultSendmail
  case PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AbsolutePath)
PrimDarcsOption (Maybe AbsolutePath)
O.sendToContext PrimDarcsOption (Maybe AbsolutePath)
-> [DarcsFlag] -> Maybe AbsolutePath
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
    Just AbsolutePath
contextfile -> do
        [WhatToDo]
wtds <- [DarcsFlag] -> Maybe (Repository Any p wU wR) -> IO [WhatToDo]
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
[DarcsFlag] -> Maybe (Repository rt p wU wR) -> IO [WhatToDo]
decideOnBehavior [DarcsFlag]
opts (Maybe (Repository rt p wU wR)
forall a. Maybe a
forall {rt :: AccessType}. Maybe (Repository rt p wU wR)
Nothing :: Maybe (Repository rt p wU wR))
        PatchSet p Origin wR
ref <- Repository 'RO p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RO p wU wR
repository
        Sealed PatchSet p Origin wX
them <- PatchSet p Origin wR -> [Char] -> IO (Sealed (PatchSet p Origin))
forall (p :: * -> * -> *) wX.
Commute p =>
PatchSet p Origin wX -> [Char] -> IO (SealedPatchSet p Origin)
readContextFile PatchSet p Origin wR
ref (AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
contextfile)
        Repository 'RO p wU wR
-> [DarcsFlag]
-> [WhatToDo]
-> [Char]
-> PatchSet p Origin wX
-> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR wX.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR
-> [DarcsFlag]
-> [WhatToDo]
-> [Char]
-> PatchSet p Origin wX
-> IO ()
sendToThem Repository 'RO p wU wR
repository [DarcsFlag]
opts [WhatToDo]
wtds [Char]
"CONTEXT" PatchSet p Origin wX
them
    Maybe AbsolutePath
Nothing -> do
        [Char]
repodir <- AbsolutePath -> [Char] -> IO [Char]
fixUrl AbsolutePath
o [Char]
unfixedrepodir
        -- Test to make sure we aren't trying to push to the current repo
        AbsolutePath
here <- IO AbsolutePath
getCurrentDirectory
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
repodir [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
here) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
           [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
cannotSendToSelf
        [[Char]]
old_default <- Pref -> IO [[Char]]
getPreflist Pref
Defaultrepo
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([[Char]]
old_default [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Char]
repodir]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts ([Char] -> Doc
creatingPatch [Char]
repodir)
        Repository 'RO p Any Any
repo <- ReadingOrWriting
-> Repository 'RO p wU wR
-> UseCache
-> [Char]
-> IO (Repository 'RO p Any Any)
forall (rt :: AccessType) (p :: * -> * -> *) wU wR vR vU.
ReadingOrWriting
-> Repository rt p wU wR
-> UseCache
-> [Char]
-> IO (Repository 'RO p vR vU)
identifyRepositoryFor ReadingOrWriting
Reading Repository 'RO p wU wR
repository (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) [Char]
repodir
        PatchSet p Origin Any
them <- Repository 'RO p Any Any -> IO (PatchSet p Origin Any)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RO p Any Any
repo
        [Char] -> DryRun -> SetDefault -> InheritDefault -> IO ()
addRepoSource [Char]
repodir (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (Bool -> [DarcsFlag] -> SetDefault
setDefault Bool
False [DarcsFlag]
opts)
          (PrimOptSpec DarcsOptDescr DarcsFlag a InheritDefault
PrimDarcsOption InheritDefault
O.inheritDefault PrimDarcsOption InheritDefault -> [DarcsFlag] -> InheritDefault
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
        [WhatToDo]
wtds <- [DarcsFlag] -> Maybe (Repository 'RO p Any Any) -> IO [WhatToDo]
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
[DarcsFlag] -> Maybe (Repository rt p wU wR) -> IO [WhatToDo]
decideOnBehavior [DarcsFlag]
opts (Repository 'RO p Any Any -> Maybe (Repository 'RO p Any Any)
forall a. a -> Maybe a
Just Repository 'RO p Any Any
repo)
        Repository 'RO p wU wR
-> [DarcsFlag]
-> [WhatToDo]
-> [Char]
-> PatchSet p Origin Any
-> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR wX.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR
-> [DarcsFlag]
-> [WhatToDo]
-> [Char]
-> PatchSet p Origin wX
-> IO ()
sendToThem Repository 'RO p wU wR
repository [DarcsFlag]
opts [WhatToDo]
wtds [Char]
repodir PatchSet p Origin Any
them
sendCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [[Char]]
_ = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"

sendToThem :: (RepoPatch p, ApplyState p ~ Tree)
           => Repository rt p wU wR -> [DarcsFlag] -> [WhatToDo] -> String
           -> PatchSet p Origin wX -> IO ()
sendToThem :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR wX.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR
-> [DarcsFlag]
-> [WhatToDo]
-> [Char]
-> PatchSet p Origin wX
-> IO ()
sendToThem Repository rt p wU wR
repo [DarcsFlag]
opts [WhatToDo]
wtds [Char]
their_name PatchSet p Origin wX
them = do
  PatchSet p Origin wR
us <- Repository rt p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository rt p wU wR
repo
  PatchSet p Origin wZ
common :> FL (PatchInfoAnd p) wZ wR
us' <- (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR
 -> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR))
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wR
-> PatchSet p Origin wX
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wR
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
findCommonWithThem PatchSet p Origin wR
us PatchSet p Origin wX
them
  Bool -> PatchSet p Origin wR -> PatchSet p Origin wX -> IO ()
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
Bool -> PatchSet p Origin wX -> PatchSet p Origin wY -> IO ()
checkUnrelatedRepos (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.allowUnrelatedRepos PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) PatchSet p Origin wR
us PatchSet p Origin wX
them
  case FL (PatchInfoAnd p) wZ wR
us' of
      FL (PatchInfoAnd p) wZ wR
NilFL -> do [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
nothingSendable
                  IO ()
forall a. IO a
exitSuccess
      FL (PatchInfoAnd p) wZ wR
_     -> [DarcsFlag] -> Doc -> IO ()
putVerbose [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
selectionIs ((forall wW wZ. PatchInfoAnd p wW wZ -> Doc)
-> FL (PatchInfoAnd p) wZ wR -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAnd p wW wZ -> Doc
forall wW wZ. PatchInfoAnd p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description FL (PatchInfoAnd p) wZ wR
us')
  Tree IO
pristine <- Repository rt p wU wR -> IO (Tree IO)
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO (Tree IO)
readPristine Repository rt p wU wR
repo
  let direction :: WhichChanges
direction = if PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
changesReverse PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts then WhichChanges
FirstReversed else WhichChanges
First
      selection_config :: SelectionConfig (PatchInfoAnd p)
selection_config = WhichChanges
-> [Char]
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd p))
-> Maybe [AnchoredPath]
-> SelectionConfig (PatchInfoAnd p)
forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> [Char]
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
direction [Char]
"send" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) Maybe (Splitter (PatchInfoAnd p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing
  (FL (PatchInfoAnd p) wZ wZ
to_be_sent :> FL (PatchInfoAnd p) wZ wR
_) <- FL (PatchInfoAnd p) wZ wR
-> SelectionConfig (PatchInfoAnd p)
-> IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wR)
forall (p :: * -> * -> *) wX wY.
(MatchableRP p, ShowPatch p, ShowContextPatch p,
 ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)) =>
FL p wX wY -> SelectionConfig p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (PatchInfoAnd p) wZ wR
us' SelectionConfig (PatchInfoAnd p)
selection_config
  [Char]
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd p) wZ wZ
-> IO ()
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
[Char]
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd p) wX wY
-> IO ()
printDryRunMessageAndExit [Char]
"send"
      (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      (PrimOptSpec DarcsOptDescr DarcsFlag a WithSummary
PrimDarcsOption WithSummary
O.withSummary PrimDarcsOption WithSummary -> [DarcsFlag] -> WithSummary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      XmlOutput
O.NoXml
      (Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
opts)
      FL (PatchInfoAnd p) wZ wZ
to_be_sent
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (PatchInfoAnd p) wZ wZ -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd p) wZ wZ
to_be_sent) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
selectionIsNull
      IO ()
forall a. IO a
exitSuccess
  FL (PatchInfoAnd p) wZ wZ -> IO ()
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
FL (PatchInfoAnd p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd p) wZ wZ
to_be_sent

  let genFullBundle :: IO Doc
genFullBundle = [DarcsFlag]
-> PatchSet p Origin wZ
-> Either
     (FL (PatchInfoAnd p) wR wZ)
     (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wR wZ)
-> IO Doc
forall (p :: * -> * -> *) wX wY wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet p Origin wZ
-> Either
     (FL (PatchInfoAnd p) wX wY)
     (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY)
-> IO Doc
prepareBundle [DarcsFlag]
opts PatchSet p Origin wZ
common  ((Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wR wZ)
-> Either
     (FL (PatchInfoAnd p) wR wZ)
     (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wR wZ)
forall a b. b -> Either a b
Right (Tree IO
pristine, FL (PatchInfoAnd p) wZ wR
us'FL (PatchInfoAnd p) wZ wR
-> FL (PatchInfoAnd p) wZ wZ
-> (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wR wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/:FL (PatchInfoAnd p) wZ wZ
to_be_sent))
  Doc
bundle <- if Bool -> Bool
not (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
minimize PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
             then IO Doc
genFullBundle
             else do [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
"Minimizing context, to send with full context hit ctrl-C..."
                     ( case PatchSet p Origin wZ
-> FL (PatchInfoAnd p) wZ wZ
-> Sealed ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin)
forall (p :: * -> * -> *) wStart wB wC.
RepoPatch p =>
PatchSet p wStart wB
-> FL (PatchInfoAnd p) wB wC
-> Sealed ((:>) (PatchSet p) (FL (PatchInfoAnd p)) wStart)
minContext PatchSet p Origin wZ
common FL (PatchInfoAnd p) wZ wZ
to_be_sent of
                         Sealed (PatchSet p Origin wZ
common' :> FL (PatchInfoAnd p) wZ wX
to_be_sent') -> [DarcsFlag]
-> PatchSet p Origin wZ
-> Either
     (FL (PatchInfoAnd p) wZ wX)
     (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wX)
-> IO Doc
forall (p :: * -> * -> *) wX wY wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet p Origin wZ
-> Either
     (FL (PatchInfoAnd p) wX wY)
     (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY)
-> IO Doc
prepareBundle [DarcsFlag]
opts PatchSet p Origin wZ
common' (FL (PatchInfoAnd p) wZ wX
-> Either
     (FL (PatchInfoAnd p) wZ wX)
     (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wX)
forall a b. a -> Either a b
Left FL (PatchInfoAnd p) wZ wX
to_be_sent') )
                     IO Doc -> IO Doc -> IO Doc
forall a. IO a -> IO a -> IO a
`catchInterrupt` IO Doc
genFullBundle
  AbsolutePath
here   <- IO AbsolutePath
getCurrentDirectory
  let make_fname :: FL (PatchInfoAndG (Named p)) wX wZ -> IO [Char]
make_fname (PatchInfoAndG (Named p) wX wY
tb:>:FL (PatchInfoAndG (Named p)) wY wZ
_) = [Char] -> IO [Char]
getUniqueDPatchName ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG (Named p) wX wY -> [Char]
forall (p :: * -> * -> *) wX wY. PatchInfoAnd p wX wY -> [Char]
patchDesc PatchInfoAndG (Named p) wX wY
tb
      make_fname FL (PatchInfoAndG (Named p)) wX wZ
_ = [Char] -> IO [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
  let fname :: IO [Char]
fname = FL (PatchInfoAnd p) wZ wZ -> IO [Char]
forall {p :: * -> * -> *} {wX} {wZ}.
FL (PatchInfoAndG (Named p)) wX wZ -> IO [Char]
make_fname FL (PatchInfoAnd p) wZ wZ
to_be_sent
  let outname :: Maybe (IO AbsolutePathOrStd)
outname = case [DarcsFlag] -> IO [Char] -> Maybe (IO AbsolutePathOrStd)
getOutput [DarcsFlag]
opts IO [Char]
fname of
                    Just IO AbsolutePathOrStd
f  -> IO AbsolutePathOrStd -> Maybe (IO AbsolutePathOrStd)
forall a. a -> Maybe a
Just IO AbsolutePathOrStd
f
                    Maybe (IO AbsolutePathOrStd)
Nothing | PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.mail PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts -> Maybe (IO AbsolutePathOrStd)
forall a. Maybe a
Nothing
                            | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ [Char]
p | PostHttp [Char]
p <- [WhatToDo]
wtds] -> Maybe (IO AbsolutePathOrStd)
forall a. Maybe a
Nothing
                            | Bool
otherwise        -> IO AbsolutePathOrStd -> Maybe (IO AbsolutePathOrStd)
forall a. a -> Maybe a
Just (AbsolutePath -> [Char] -> AbsolutePathOrStd
makeAbsoluteOrStd AbsolutePath
here ([Char] -> AbsolutePathOrStd) -> IO [Char] -> IO AbsolutePathOrStd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Char]
fname)
  case Maybe (IO AbsolutePathOrStd)
outname of
    Just IO AbsolutePathOrStd
fname' -> IO AbsolutePathOrStd
fname' IO AbsolutePathOrStd -> (AbsolutePathOrStd -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AbsolutePathOrStd
f -> [DarcsFlag]
-> FL (PatchInfoAnd p) wZ wZ
-> Doc
-> AbsolutePathOrStd
-> [WhatToDo]
-> [Char]
-> IO ()
forall (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd p) wX wY
-> Doc
-> AbsolutePathOrStd
-> [WhatToDo]
-> [Char]
-> IO ()
writeBundleToFile [DarcsFlag]
opts FL (PatchInfoAnd p) wZ wZ
to_be_sent Doc
bundle AbsolutePathOrStd
f [WhatToDo]
wtds [Char]
their_name
    Maybe (IO AbsolutePathOrStd)
Nothing     -> IO [Char]
fname IO [Char] -> ([Char] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
f -> [DarcsFlag]
-> FL (PatchInfoAnd p) wZ wZ
-> Doc
-> [Char]
-> [WhatToDo]
-> [Char]
-> IO ()
forall (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd p) wX wY
-> Doc
-> [Char]
-> [WhatToDo]
-> [Char]
-> IO ()
sendBundle [DarcsFlag]
opts FL (PatchInfoAnd p) wZ wZ
to_be_sent Doc
bundle [Char]
f [WhatToDo]
wtds [Char]
their_name


prepareBundle :: forall p wX wY wZ. (RepoPatch p, ApplyState p ~ Tree)
              => [DarcsFlag] -> PatchSet p Origin wZ
              -> Either (FL (PatchInfoAnd p) wX wY)
                        (Tree IO, (FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) wX wY)
              -> IO Doc
prepareBundle :: forall (p :: * -> * -> *) wX wY wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet p Origin wZ
-> Either
     (FL (PatchInfoAnd p) wX wY)
     (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY)
-> IO Doc
prepareBundle [DarcsFlag]
opts PatchSet p Origin wZ
common Either
  (FL (PatchInfoAnd p) wX wY)
  (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY)
e = do
  Doc
unsig_bundle <-
     case Either
  (FL (PatchInfoAnd p) wX wY)
  (Tree IO, (:\/:) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wX wY)
e of
       (Right (Tree IO
pristine, FL (PatchInfoAnd p) wZ wX
us' :\/: FL (PatchInfoAnd p) wZ wY
to_be_sent)) -> do
         Tree IO
pristine' <- FL (PrimOf p) wX wZ -> Tree IO -> IO (Tree IO)
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, MonadThrow m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree (FL (PrimOf p) wZ wX -> FL (PrimOf p) wX wZ
forall wX wY. FL (PrimOf p) wX wY -> FL (PrimOf p) wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (FL (PrimOf p) wZ wX -> FL (PrimOf p) wX wZ)
-> FL (PrimOf p) wZ wX -> FL (PrimOf p) wX wZ
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd p) wZ wX
-> FL (PrimOf (FL (PatchInfoAnd p))) wZ wX
forall wX wY.
FL (PatchInfoAnd p) wX wY
-> FL (PrimOf (FL (PatchInfoAnd p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd p) wZ wX
us') Tree IO
pristine
         Maybe (ApplyState p IO)
-> PatchSet p Any wZ -> FL (Named p) wZ wY -> IO Doc
forall (p :: * -> * -> *) wStart wX wY.
(RepoPatch p, ApplyMonadTrans (ApplyState p) IO,
 ObjectId (ObjectIdOfPatch p)) =>
Maybe (ApplyState p IO)
-> PatchSet p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle (Tree IO -> Maybe (Tree IO)
forall a. a -> Maybe a
Just Tree IO
pristine')
                     (PatchSet p Origin wZ -> PatchSet p Any wZ
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet p Origin wZ
common)
                     ((forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd p) wZ wY -> FL (Named p) wZ wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL PatchInfoAndG (Named p) wW wY -> Named p wW wY
forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully FL (PatchInfoAnd p) wZ wY
to_be_sent)
       Left FL (PatchInfoAnd p) wX wY
to_be_sent -> Maybe (ApplyState p IO)
-> PatchSet p Any wX -> FL (Named p) wX wY -> IO Doc
forall (p :: * -> * -> *) wStart wX wY.
(RepoPatch p, ApplyMonadTrans (ApplyState p) IO,
 ObjectId (ObjectIdOfPatch p)) =>
Maybe (ApplyState p IO)
-> PatchSet p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (Tree IO)
Maybe (ApplyState p IO)
forall a. Maybe a
Nothing
                                      (PatchSet p Origin wZ -> PatchSet p Any wX
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet p Origin wZ
common)
                                      ((forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd p) wX wY -> FL (Named p) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL PatchInfoAndG (Named p) wW wY -> Named p wW wY
forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> p wA wB
hopefully FL (PatchInfoAnd p) wX wY
to_be_sent)
  Sign -> Doc -> IO Doc
signString (PrimOptSpec DarcsOptDescr DarcsFlag a Sign
PrimDarcsOption Sign
O.sign PrimDarcsOption Sign -> [DarcsFlag] -> Sign
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Doc
unsig_bundle

sendBundle
  :: forall p wX wY
   . (RepoPatch p, ApplyState p ~ Tree)
  => [DarcsFlag]
  -> FL (PatchInfoAnd p) wX wY
  -> Doc
  -> String
  -> [WhatToDo]
  -> String
  -> IO ()
sendBundle :: forall (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd p) wX wY
-> Doc
-> [Char]
-> [WhatToDo]
-> [Char]
-> IO ()
sendBundle [DarcsFlag]
opts FL (PatchInfoAnd p) wX wY
to_be_sent Doc
bundle [Char]
fname [WhatToDo]
wtds [Char]
their_name = do
  let auto_subject :: forall pp wA wB. FL (PatchInfoAnd pp) wA wB -> String
      auto_subject :: forall (pp :: * -> * -> *) wA wB.
FL (PatchInfoAnd pp) wA wB -> [Char]
auto_subject (PatchInfoAnd pp wA wY
p :>: FL (PatchInfoAnd pp) wY wB
NilFL) = [Char]
"darcs patch: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Int -> [Char]
trim (PatchInfoAnd pp wA wY -> [Char]
forall (p :: * -> * -> *) wX wY. PatchInfoAnd p wX wY -> [Char]
patchDesc PatchInfoAnd pp wA wY
p) Int
57
      auto_subject (PatchInfoAnd pp wA wY
p :>: FL (PatchInfoAnd pp) wY wB
ps) =
        [Char]
"darcs patch: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char] -> Int -> [Char]
trim (PatchInfoAnd pp wA wY -> [Char]
forall (p :: * -> * -> *) wX wY. PatchInfoAnd p wX wY -> [Char]
patchDesc PatchInfoAnd pp wA wY
p) Int
43 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (and " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (FL (PatchInfoAnd pp) wY wB -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd pp) wY wB
ps) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" more)"
      auto_subject FL (PatchInfoAnd pp) wA wB
_ = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Tried to get a name from empty patch list."
      trim :: [Char] -> Int -> [Char]
trim [Char]
st Int
n =
        if [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
          then [Char]
st
          else Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) [Char]
st [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
  [WhatToDo]
thetargets <- [WhatToDo] -> IO [WhatToDo]
getTargets [WhatToDo]
wtds
  [Char]
from <- Maybe [Char] -> Bool -> IO [Char]
getAuthor (PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe [Char])
PrimDarcsOption (Maybe [Char])
author PrimDarcsOption (Maybe [Char]) -> [DarcsFlag] -> Maybe [Char]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Bool
False
  let thesubject :: [Char]
thesubject = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe (FL (PatchInfoAnd p) wX wY -> [Char]
forall (pp :: * -> * -> *) wA wB.
FL (PatchInfoAnd pp) wA wB -> [Char]
auto_subject FL (PatchInfoAnd p) wX wY
to_be_sent) (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Maybe [Char]
getSubject [DarcsFlag]
opts
  (Doc
mailcontents, Maybe [Char]
mailfile, Maybe [Char]
mailcharset) <-
    [DarcsFlag]
-> [Char]
-> FL (PatchInfoAnd p) wX wY
-> IO (Doc, Maybe [Char], Maybe [Char])
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
[DarcsFlag]
-> [Char]
-> FL (PatchInfoAnd p) wX wY
-> IO (Doc, Maybe [Char], Maybe [Char])
getDescription [DarcsFlag]
opts [Char]
their_name FL (PatchInfoAnd p) wX wY
to_be_sent
  let warnMailBody :: IO ()
warnMailBody =
        case Maybe [Char]
mailfile of
          Just [Char]
mf -> Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
emailBackedUp [Char]
mf
          Maybe [Char]
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      warnCharset :: [Char] -> IO ()
warnCharset [Char]
msg = do
        Bool
confirmed <- [Char] -> IO Bool
promptYorn ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
promptCharSetWarning [Char]
msg
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Doc -> IO ()
putDocLn Doc
charsetAborted
          IO ()
warnMailBody
          IO ()
forall a. IO a
exitSuccess
  Maybe [Char]
thecharset <-
    case PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe [Char])
PrimDarcsOption (Maybe [Char])
charset PrimDarcsOption (Maybe [Char]) -> [DarcsFlag] -> Maybe [Char]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
      -- Always trust provided charset
      providedCset :: Maybe [Char]
providedCset@(Just [Char]
_) ->
        Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
providedCset
      Maybe [Char]
Nothing ->
        case Maybe [Char]
mailcharset of
          Maybe [Char]
Nothing -> do
            [Char] -> IO ()
warnCharset [Char]
charsetCouldNotGuess
            Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
mailcharset
          Just [Char]
"utf-8" ->
            Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
mailcharset
          -- Trust other cases (us-ascii)
          Just [Char]
_ -> Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
mailcharset
  let body :: Doc
body =
        [Char]
-> [([Char], [Char])]
-> Maybe Doc
-> Maybe [Char]
-> Doc
-> Maybe [Char]
-> Doc
makeEmail
          [Char]
their_name
          ([([Char], [Char])]
-> ([Char] -> [([Char], [Char])])
-> Maybe [Char]
-> [([Char], [Char])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[Char]
x -> [([Char]
"In-Reply-To", [Char]
x), ([Char]
"References", [Char]
x)]) (Maybe [Char] -> [([Char], [Char])])
-> ([DarcsFlag] -> Maybe [Char])
-> [DarcsFlag]
-> [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           [DarcsFlag] -> Maybe [Char]
getInReplyTo ([DarcsFlag] -> [([Char], [Char])])
-> [DarcsFlag] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$
           [DarcsFlag]
opts)
          (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
mailcontents) Maybe [Char]
thecharset Doc
bundle ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fname)
      contentAndBundle :: Maybe (Doc, Doc)
contentAndBundle = (Doc, Doc) -> Maybe (Doc, Doc)
forall a. a -> Maybe a
Just (Doc
mailcontents, Doc
bundle)
      sendmail :: IO ()
sendmail =
        (do let to :: [Char]
to = [WhatToDo] -> [Char]
generateEmailToString [WhatToDo]
thetargets
            Maybe [Char]
sm_cmd <- [DarcsFlag] -> IO (Maybe [Char])
getSendmailCmd [DarcsFlag]
opts
            [Char]
-> [Char]
-> [Char]
-> [Char]
-> Maybe [Char]
-> Maybe (Doc, Doc)
-> Doc
-> IO ()
sendEmailDoc [Char]
from [Char]
to [Char]
thesubject ([DarcsFlag] -> [Char]
getCc [DarcsFlag]
opts) Maybe [Char]
sm_cmd
              Maybe (Doc, Doc)
contentAndBundle Doc
body
            [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts ([Char] -> [Char] -> Doc
success [Char]
to ([DarcsFlag] -> [Char]
getCc [DarcsFlag]
opts)))
        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException`
        IO ()
warnMailBody
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]
p | PostHttp [Char]
p <- [WhatToDo]
thetargets]) IO ()
sendmail
  ByteString
nbody <-
    ((Handle, [Char]) -> IO ByteString) -> IO ByteString
forall a. ((Handle, [Char]) -> IO a) -> IO a
withOpenTemp (((Handle, [Char]) -> IO ByteString) -> IO ByteString)
-> ((Handle, [Char]) -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(Handle
fh, [Char]
fn) -> do
      let to :: [Char]
to = [WhatToDo] -> [Char]
generateEmailToString [WhatToDo]
thetargets
      Handle -> [Char] -> [Char] -> [Char] -> [Char] -> Doc -> IO ()
generateEmail Handle
fh [Char]
from [Char]
to [Char]
thesubject ([DarcsFlag] -> [Char]
getCc [DarcsFlag]
opts) Doc
body
      Handle -> IO ()
hClose Handle
fh
      [Char] -> IO ByteString
mmapFilePS [Char]
fn
  [[Char]] -> ([Char] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
    [[Char]
p | PostHttp [Char]
p <- [WhatToDo]
thetargets]
    (\[Char]
url -> do
       [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
postingPatch [Char]
url
       [Char] -> ByteString -> [Char] -> IO ()
postUrl [Char]
url ByteString
nbody [Char]
"message/rfc822") IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
    (\(IOException
_ :: IOException) -> IO ()
sendmail)
  [DarcsFlag] -> Maybe [Char] -> IO ()
forall t. FilePathLike t => [DarcsFlag] -> Maybe t -> IO ()
cleanup [DarcsFlag]
opts Maybe [Char]
mailfile

generateEmailToString :: [WhatToDo] -> String
generateEmailToString :: [WhatToDo] -> [Char]
generateEmailToString = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" , " ([[Char]] -> [Char])
-> ([WhatToDo] -> [[Char]]) -> [WhatToDo] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"") ([[Char]] -> [[Char]])
-> ([WhatToDo] -> [[Char]]) -> [WhatToDo] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WhatToDo -> [Char]) -> [WhatToDo] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map WhatToDo -> [Char]
extractEmail
  where
    extractEmail :: WhatToDo -> [Char]
extractEmail (SendMail [Char]
t) = [Char]
t
    extractEmail WhatToDo
_ = [Char]
""

cleanup :: (FilePathLike t) => [DarcsFlag] -> Maybe t -> IO ()
cleanup :: forall t. FilePathLike t => [DarcsFlag] -> Maybe t -> IO ()
cleanup [DarcsFlag]
opts (Just t
mailfile) = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AbsolutePath -> Bool
forall a. Maybe a -> Bool
isNothing ([DarcsFlag] -> Maybe AbsolutePath
hasLogfile [DarcsFlag]
opts) Bool -> Bool -> Bool
|| [DarcsFlag] -> Bool
willRemoveLogFile [DarcsFlag]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                                      t -> IO ()
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist t
mailfile
cleanup [DarcsFlag]
_ Maybe t
Nothing = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

writeBundleToFile :: forall p wX wY . (RepoPatch p, ApplyState p ~ Tree)
                  => [DarcsFlag] -> FL (PatchInfoAnd p) wX wY -> Doc ->
                    AbsolutePathOrStd -> [WhatToDo] -> String -> IO ()
writeBundleToFile :: forall (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd p) wX wY
-> Doc
-> AbsolutePathOrStd
-> [WhatToDo]
-> [Char]
-> IO ()
writeBundleToFile [DarcsFlag]
opts FL (PatchInfoAnd p) wX wY
to_be_sent Doc
bundle AbsolutePathOrStd
fname [WhatToDo]
wtds [Char]
their_name =
    do (Doc
d,Maybe [Char]
f,Maybe [Char]
_) <- [DarcsFlag]
-> [Char]
-> FL (PatchInfoAnd p) wX wY
-> IO (Doc, Maybe [Char], Maybe [Char])
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
[DarcsFlag]
-> [Char]
-> FL (PatchInfoAnd p) wX wY
-> IO (Doc, Maybe [Char], Maybe [Char])
getDescription [DarcsFlag]
opts [Char]
their_name FL (PatchInfoAnd p) wX wY
to_be_sent
       let putabs :: a -> IO ()
putabs a
a = do a -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile a
a (Doc
d Doc -> Doc -> Doc
$$ Doc
bundle)
                         Doc -> IO ()
putDocLn (a -> Doc
forall a. FilePathLike a => a -> Doc
wroteBundle a
a)
           putstd :: IO ()
putstd = Doc -> IO ()
putDoc (Doc
d Doc -> Doc -> Doc
$$ Doc
bundle)
       (AbsolutePath -> IO ()) -> IO () -> AbsolutePathOrStd -> IO ()
forall a. (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd AbsolutePath -> IO ()
forall p. FilePathLike p => p -> IO ()
putabs IO ()
putstd AbsolutePathOrStd
fname
       let to :: [Char]
to = [WhatToDo] -> [Char]
generateEmailToString [WhatToDo]
wtds
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
to) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
savedButNotSent [Char]
to
       [DarcsFlag] -> Maybe [Char] -> IO ()
forall t. FilePathLike t => [DarcsFlag] -> Maybe t -> IO ()
cleanup [DarcsFlag]
opts Maybe [Char]
f

data WhatToDo
    = PostHttp String    -- ^ POST the patch via HTTP
    | SendMail String    -- ^ send patch via email

decideOnBehavior :: [DarcsFlag] -> Maybe (Repository rt p wU wR) -> IO [WhatToDo]
decideOnBehavior :: forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
[DarcsFlag] -> Maybe (Repository rt p wU wR) -> IO [WhatToDo]
decideOnBehavior [DarcsFlag]
opts Maybe (Repository rt p wU wR)
remote_repo =
    case [WhatToDo]
the_targets of
    [] -> do [WhatToDo]
wtds <- case Maybe (Repository rt p wU wR)
remote_repo of
                     Maybe (Repository rt p wU wR)
Nothing -> [WhatToDo] -> IO [WhatToDo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                     Just Repository rt p wU wR
r -> Repository rt p wU wR -> IO [WhatToDo]
forall {rt :: AccessType} {p :: * -> * -> *} {wU} {wR}.
Repository rt p wU wR -> IO [WhatToDo]
check_post Repository rt p wU wR
r
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([WhatToDo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WhatToDo]
wtds) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [WhatToDo] -> IO ()
announce_recipients [WhatToDo]
wtds
             [WhatToDo] -> IO [WhatToDo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [WhatToDo]
wtds
    [WhatToDo]
ts -> do [WhatToDo] -> IO ()
announce_recipients [WhatToDo]
ts
             [WhatToDo] -> IO [WhatToDo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [WhatToDo]
ts
    where the_targets :: [WhatToDo]
the_targets = [DarcsFlag] -> [WhatToDo]
collectTargets [DarcsFlag]
opts
          check_post :: Repository rt p wU wR -> IO [WhatToDo]
check_post Repository rt p wU wR
the_remote_repo =
                       do [WhatToDo]
p <- (([Char] -> [WhatToDo]
readPost ([Char] -> [WhatToDo])
-> (ByteString -> [Char]) -> ByteString -> [WhatToDo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BC.unpack) (ByteString -> [WhatToDo]) -> IO ByteString -> IO [WhatToDo]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                                [Char] -> Cachable -> IO ByteString
fetchFilePS ([Char] -> Pref -> [Char]
prefsUrl (Repository rt p wU wR -> [Char]
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> [Char]
repoLocation Repository rt p wU wR
the_remote_repo) Pref
Post)
                                (CInt -> Cachable
MaxAge CInt
600)) IO [WhatToDo] -> IO [WhatToDo] -> IO [WhatToDo]
forall a. IO a -> IO a -> IO a
`catchall` [WhatToDo] -> IO [WhatToDo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                          [WhatToDo]
emails <- Repository rt p wU wR -> IO [WhatToDo]
forall {rt :: AccessType} {p :: * -> * -> *} {wU} {wR}.
Repository rt p wU wR -> IO [WhatToDo]
who_to_email Repository rt p wU wR
the_remote_repo
                          [WhatToDo] -> IO [WhatToDo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([WhatToDo]
p[WhatToDo] -> [WhatToDo] -> [WhatToDo]
forall a. [a] -> [a] -> [a]
++[WhatToDo]
emails)
          readPost :: [Char] -> [WhatToDo]
readPost = ([Char] -> WhatToDo) -> [[Char]] -> [WhatToDo]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> WhatToDo
parseLine ([[Char]] -> [WhatToDo])
-> ([Char] -> [[Char]]) -> [Char] -> [WhatToDo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines where
              parseLine :: [Char] -> WhatToDo
parseLine [Char]
t = WhatToDo -> ([Char] -> WhatToDo) -> Maybe [Char] -> WhatToDo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> WhatToDo
PostHttp [Char]
t) [Char] -> WhatToDo
SendMail (Maybe [Char] -> WhatToDo) -> Maybe [Char] -> WhatToDo
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"mailto:" [Char]
t
          who_to_email :: Repository rt p wU wR -> IO [WhatToDo]
who_to_email Repository rt p wU wR
repo =
              do [Char]
email <- (ByteString -> [Char]
BC.unpack (ByteString -> [Char]) -> IO ByteString -> IO [Char]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                           [Char] -> Cachable -> IO ByteString
fetchFilePS ([Char] -> Pref -> [Char]
prefsUrl (Repository rt p wU wR -> [Char]
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> [Char]
repoLocation Repository rt p wU wR
repo) Pref
Email)
                                       (CInt -> Cachable
MaxAge CInt
600))
                          IO [Char] -> IO [Char] -> IO [Char]
forall a. IO a -> IO a -> IO a
`catchall` [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
                 if Char
'@' Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
email then [WhatToDo] -> IO [WhatToDo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([WhatToDo] -> IO [WhatToDo])
-> ([[Char]] -> [WhatToDo]) -> [[Char]] -> IO [WhatToDo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> WhatToDo) -> [[Char]] -> [WhatToDo]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> WhatToDo
SendMail ([[Char]] -> IO [WhatToDo]) -> [[Char]] -> IO [WhatToDo]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
email
                                     else [WhatToDo] -> IO [WhatToDo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          announce_recipients :: [WhatToDo] -> IO ()
announce_recipients [WhatToDo]
emails =
            let pn :: WhatToDo -> [Char]
pn (SendMail [Char]
s) = [Char]
s
                pn (PostHttp [Char]
p) = [Char]
p
                msg :: Doc
msg = DryRun -> [[Char]] -> Doc
willSendTo (PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ((WhatToDo -> [Char]) -> [WhatToDo] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map WhatToDo -> [Char]
pn [WhatToDo]
emails)
            in case PrimOptSpec DarcsOptDescr DarcsFlag a DryRun
PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
                DryRun
O.YesDryRun -> [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
msg
                DryRun
O.NoDryRun  -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([WhatToDo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WhatToDo]
the_targets Bool -> Bool -> Bool
&& Maybe (IO AbsolutePathOrStd) -> Bool
forall a. Maybe a -> Bool
isNothing ([DarcsFlag] -> IO [Char] -> Maybe (IO AbsolutePathOrStd)
getOutput [DarcsFlag]
opts ([Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""))) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                                [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
msg

getTargets :: [WhatToDo] -> IO [WhatToDo]
getTargets :: [WhatToDo] -> IO [WhatToDo]
getTargets [] = ([Char] -> [WhatToDo]) -> IO [Char] -> IO [WhatToDo]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WhatToDo -> [WhatToDo] -> [WhatToDo]
forall a. a -> [a] -> [a]
:[]) (WhatToDo -> [WhatToDo])
-> ([Char] -> WhatToDo) -> [Char] -> [WhatToDo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> WhatToDo
SendMail) (IO [Char] -> IO [WhatToDo]) -> IO [Char] -> IO [WhatToDo]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
askUser [Char]
promptTarget
getTargets [WhatToDo]
wtds = [WhatToDo] -> IO [WhatToDo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [WhatToDo]
wtds

collectTargets :: [DarcsFlag] -> [WhatToDo]
collectTargets :: [DarcsFlag] -> [WhatToDo]
collectTargets [DarcsFlag]
flags = [ [Char] -> WhatToDo
f [Char]
t | [Char]
t <- HeaderFields -> [[Char]]
O._to (PrimOptSpec DarcsOptDescr DarcsFlag a HeaderFields
PrimDarcsOption HeaderFields
O.headerFields PrimDarcsOption HeaderFields -> [DarcsFlag] -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags) ] where
    f :: [Char] -> WhatToDo
f [Char]
url | [Char]
"http:" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
url = [Char] -> WhatToDo
PostHttp [Char]
url
    f [Char]
em = [Char] -> WhatToDo
SendMail [Char]
em

getDescription :: RepoPatch p
               => [DarcsFlag] -> String -> FL (PatchInfoAnd p) wX wY -> IO (Doc, Maybe String, Maybe String)
getDescription :: forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
[DarcsFlag]
-> [Char]
-> FL (PatchInfoAnd p) wX wY
-> IO (Doc, Maybe [Char], Maybe [Char])
getDescription [DarcsFlag]
opts [Char]
their_name FL (PatchInfoAnd p) wX wY
patches =
    case Maybe [Char]
get_filename of
        Just [Char]
file -> do
                     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
editDescription PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AbsolutePath -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AbsolutePath -> Bool) -> Maybe AbsolutePath -> Bool
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Maybe AbsolutePath
hasLogfile [DarcsFlag]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                            [Char] -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile [Char]
file Doc
patchdesc
                       [Char] -> IO ()
debugMessage ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
aboutToEdit [Char]
file
                       (ExitCode
_, Bool
changed) <- [Char] -> IO (ExitCode, Bool)
forall p. FilePathLike p => p -> IO (ExitCode, Bool)
editFile [Char]
file
                       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
changed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                         Bool
confirmed <- [Char] -> IO Bool
promptYorn [Char]
promptNoDescriptionChange
                         Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do Doc -> IO ()
putDocLn Doc
aborted
                                               IO ()
forall a. IO a
exitSuccess
                       () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     
                     [Char]
updatedFile <- [Char] -> IO [Char]
updateFilename [Char]
file
                     Doc
doc <- [Char] -> IO Doc
forall p. FilePathLike p => p -> IO Doc
readDocBinFile [Char]
updatedFile
                     
                     (Doc, Maybe [Char], Maybe [Char])
-> IO (Doc, Maybe [Char], Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
doc, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
updatedFile, Doc -> Maybe [Char]
forall {a}. IsString a => Doc -> Maybe a
tryGetCharset Doc
doc)
        Maybe [Char]
Nothing -> (Doc, Maybe [Char], Maybe [Char])
-> IO (Doc, Maybe [Char], Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
patchdesc, Maybe [Char]
forall a. Maybe a
Nothing, Doc -> Maybe [Char]
forall {a}. IsString a => Doc -> Maybe a
tryGetCharset Doc
patchdesc)
    where patchdesc :: Doc
patchdesc = [Char] -> Doc
text (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
len)
                      Doc -> Doc -> Doc
<+> [Char] -> Doc
text (Int -> Noun -> [Char] -> [Char]
forall n. Countable n => Int -> n -> [Char] -> [Char]
englishNum Int
len ([Char] -> Noun
Noun [Char]
"patch") [Char]
"")
                      Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"for repository" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
their_name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
":"
                      Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
""
                      Doc -> Doc -> Doc
$$ [Doc] -> Doc
vsep ((forall wW wZ. PatchInfoAnd p wW wZ -> Doc)
-> FL (PatchInfoAnd p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAnd p wW wZ -> Doc
forall wW wZ. PatchInfoAnd p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description FL (PatchInfoAnd p) wX wY
patches)
            where
              len :: Int
len = FL (PatchInfoAnd p) wX wY -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd p) wX wY
patches
          updateFilename :: [Char] -> IO [Char]
updateFilename [Char]
file = 
                IO [Char]
-> (AbsolutePath -> IO [Char]) -> Maybe AbsolutePath -> IO [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> [Char] -> IO ()
renameFile [Char]
file [Char]
darcsSendMessageFinal IO () -> IO [Char] -> IO [Char]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
darcsSendMessageFinal) ([Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char])
-> (AbsolutePath -> [Char]) -> AbsolutePath -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath) (Maybe AbsolutePath -> IO [Char])
-> Maybe AbsolutePath -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Maybe AbsolutePath
hasLogfile [DarcsFlag]
opts
          get_filename :: Maybe [Char]
get_filename = case [DarcsFlag] -> Maybe AbsolutePath
hasLogfile [DarcsFlag]
opts of
                                Just AbsolutePath
f -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
f
                                Maybe AbsolutePath
Nothing -> if PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
editDescription PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
                                              then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
darcsSendMessage
                                              else Maybe [Char]
forall a. Maybe a
Nothing
          tryGetCharset :: Doc -> Maybe a
tryGetCharset Doc
content = let body :: ByteString
body = Doc -> ByteString
renderPS Doc
content in
                                  if ByteString -> Bool
isAscii ByteString
body
                                  then a -> Maybe a
forall a. a -> Maybe a
Just a
"us-ascii"
                                  else (UnicodeException -> Maybe a)
-> (Text -> Maybe a) -> Either UnicodeException Text -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> UnicodeException -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)
                                              (Maybe a -> Text -> Maybe a
forall a b. a -> b -> a
const (Maybe a -> Text -> Maybe a) -> Maybe a -> Text -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
"utf-8")
                                              (ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
body)

cmdDescription :: String
cmdDescription :: [Char]
cmdDescription =
    [Char]
"Prepare a bundle of patches to be applied to some target repository."

cmdHelp :: Doc
cmdHelp :: Doc
cmdHelp = [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
  ([[Char]] -> Doc) -> [[[Char]]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> Doc
formatWords
  [ [ [Char]
"Send is used to prepare a bundle of patches that can be applied to a target"
    , [Char]
"repository.  Send accepts the URL of the repository as an argument.  When"
    , [Char]
"called without an argument, send will use the most recent repository that"
    , [Char]
"was either pushed to, pulled from or sent to.  By default, the patch bundle"
    , [Char]
"is saved to a file, although you may directly send it by mail."
    ]
  , [ [Char]
"The `--output`, `--output-auto-name`, and `--to` flags determine"
    , [Char]
"what darcs does with the patch bundle after creating it.  If you provide an"
    , [Char]
"`--output` argument, the patch bundle is saved to that file.  If you"
    , [Char]
"specify `--output-auto-name`, the patch bundle is saved to a file with an"
    , [Char]
"automatically generated name.  If you give one or more `--to` arguments,"
    , [Char]
"the bundle of patches is sent to those locations. The locations may either"
    , [Char]
"be email addresses or urls that the patch should be submitted to via HTTP."
    ]
  , [ [Char]
"If you provide the `--mail` flag, darcs will look at the contents"
    , [Char]
"of the `_darcs/prefs/email` file in the target repository (if it exists),"
    , [Char]
"and send the patch by email to that address.  In this case, you may use"
    , [Char]
"the `--cc` option to specify additional recipients without overriding the"
    , [Char]
"default repository email address."
    ]
  , [ [Char]
"If `_darcs/prefs/post` exists in the target repository, darcs will"
    , [Char]
"upload to the URL contained in that file, which may either be a"
    , [Char]
"`mailto:` URL, or an `http://` URL.  In the latter case, the"
    , [Char]
"patch is posted to that URL."
    ]
  , [ [Char]
"If there is no email address associated with the repository, darcs will"
    , [Char]
"prompt you for an email address."
    ]
  , [ [Char]
"Use the `--subject` flag to set the subject of the e-mail to be sent."
    , [Char]
"If you don't provide a subject on the command line, darcs will make one up"
    , [Char]
"based on names of the patches in the patch bundle."
    ]
  , [ [Char]
"Use the `--in-reply-to` flag to set the In-Reply-To and References headers"
    , [Char]
"of the e-mail to be sent. By default no additional headers are included so"
    , [Char]
"e-mail will not be treated as reply by mail readers."
    ]
  , [ [Char]
"If you want to include a description or explanation along with the bundle"
    , [Char]
"of patches, you need to specify the `--edit-description` flag, which"
    , [Char]
"will cause darcs to open up an editor with which you can compose a message"
    , [Char]
"to go along with your patches."
    ]
  , [ [Char]
"If you want to use a command different from the default one for sending"
    , [Char]
"email, you need to specify a command line with the `--sendmail-command`"
    , [Char]
"option. The command line can contain some format specifiers which are"
    , [Char]
"replaced by the actual values. Accepted format specifiers are `%s` for"
    , [Char]
"subject, `%t` for to, `%c` for cc, `%b` for the body of the mail, `%f` for"
    , [Char]
"from, `%a` for the patch bundle and the same specifiers in uppercase for the"
    , [Char]
"URL-encoded values."
    , [Char]
"Additionally you can add `%<` to the end of the command line if the command"
    , [Char]
"expects the complete email message on standard input. E.g. the command lines"
    , [Char]
"for evolution and msmtp look like this:"
    ]
  ]
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
  -- TODO autoformatting for indented paragraphs
  [ [Doc] -> Doc
vcat
    [ Doc
"    evolution \"mailto:%T?subject=%S&attach=%A&cc=%C&body=%B\""
    , Doc
"    msmtp -t %<"
    ]
  ]
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ ([[Char]] -> Doc) -> [[[Char]]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> Doc
formatWords
  [ [ [Char]
"Do not confuse the `--author` options with the return address"
    , [Char]
"that `darcs send` will set for your patch bundle."
    ]
  , [ [Char]
"For example, if you have two email addresses A and B:"
    ]
  ]
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
  -- TODO autoformatting for bullet lists
  [ [Doc] -> Doc
vcat
    [ Doc
"  * If you use `--author A` but your machine is configured to send"
    , Doc
"    mail from address B by default, then the return address on your"
    , Doc
"    message will be B."
    , Doc
"  * If you use `--from A` and your mail client supports setting the"
    , Doc
"    From: address arbitrarily (some non-Unix-like mail clients,"
    , Doc
"    especially, may not support this), then the return address will"
    , Doc
"    be A; if it does not support this, then the return address will"
    , Doc
"    be B."
    , Doc
"  * If you supply neither `--from` nor `--author` then the return"
    , Doc
"    address will be B."
    ]
  ]
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
  [ [[Char]] -> Doc
formatWords
    [ [Char]
"In addition, unless you specify the sendmail command with"
    , [Char]
"`--sendmail-command`, darcs sends email using the default email"
    , [Char]
"command on your computer. This default command is determined by the"
    , [Char]
"`configure` script. Thus, on some non-Unix-like OSes,"
    , [Char]
"`--from` is likely to not work at all."
    ]
  , Doc
otherHelpInheritDefault
  ]

cannotSendToSelf :: String
cannotSendToSelf :: [Char]
cannotSendToSelf = [Char]
"Can't send to current repository! Did you mean send --context?"

creatingPatch :: String -> Doc
creatingPatch :: [Char] -> Doc
creatingPatch [Char]
repodir = Doc
"Creating patch to" Doc -> Doc -> Doc
<+> [Char] -> Doc
quoted [Char]
repodir Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"..."

nothingSendable :: Doc
nothingSendable :: Doc
nothingSendable = Doc
"No recorded local changes to send!"

selectionIs :: [Doc] -> Doc
selectionIs :: [Doc] -> Doc
selectionIs [Doc]
descs = [Char] -> Doc
text [Char]
"We have the following patches to send:" Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat [Doc]
descs

selectionIsNull :: Doc
selectionIsNull :: Doc
selectionIsNull = [Char] -> Doc
text [Char]
"You don't want to send any patches, and that's fine with me!"

emailBackedUp :: String -> Doc
emailBackedUp :: [Char] -> Doc
emailBackedUp [Char]
mf = Doc -> Doc
sentence (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Email body left in" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
mf Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"."

promptCharSetWarning :: String -> String
promptCharSetWarning :: [Char] -> [Char]
promptCharSetWarning [Char]
msg = [Char]
"Warning: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  Send anyway?"

charsetAborted :: Doc
charsetAborted :: Doc
charsetAborted = Doc
"Aborted.  You can specify charset with the --charset option."

charsetCouldNotGuess :: String
charsetCouldNotGuess :: [Char]
charsetCouldNotGuess = [Char]
"darcs could not guess the charset of your mail."

aborted :: Doc
aborted :: Doc
aborted = Doc
"Aborted."

success :: String -> String -> Doc
success :: [Char] -> [Char] -> Doc
success [Char]
to [Char]
cc = Doc -> Doc
sentence (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Doc
"Successfully sent patch bundle to:" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
to Doc -> Doc -> Doc
<+> [Char] -> Doc
copies [Char]
cc
  where
    copies :: [Char] -> Doc
copies [Char]
"" = Doc
""
    copies [Char]
x  = Doc
"and cc'ed" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
x

postingPatch :: String -> Doc
postingPatch :: [Char] -> Doc
postingPatch [Char]
url = Doc
"Posting patch to" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
url

wroteBundle :: FilePathLike a => a -> Doc
wroteBundle :: forall a. FilePathLike a => a -> Doc
wroteBundle a
a = Doc -> Doc
sentence (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Wrote patch to" Doc -> Doc -> Doc
<+> [Char] -> Doc
text (a -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath a
a)

savedButNotSent :: String -> Doc
savedButNotSent :: [Char] -> Doc
savedButNotSent [Char]
to =
        [Char] -> Doc
text ([Char]
"The usual recipent for this bundle is: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
to)
    Doc -> Doc -> Doc
$$  [Char] -> Doc
text [Char]
"To send it automatically, make sure sendmail is working,"
    Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"and add 'send mail' to _darcs/prefs/defaults or"
    Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
" ~/.darcs/defaults"

willSendTo :: DryRun -> [String] -> Doc
willSendTo :: DryRun -> [[Char]] -> Doc
willSendTo DryRun
dr [[Char]]
addresses =
    Doc
"Patch bundle" Doc -> Doc -> Doc
<+> Doc
will Doc -> Doc -> Doc
<+> Doc
" be sent to:" Doc -> Doc -> Doc
<+> [Char] -> Doc
text ([[Char]] -> [Char]
unwords [[Char]]
addresses)
  where
    will :: Doc
will = case DryRun
dr of { DryRun
YesDryRun -> Doc
"would"; DryRun
NoDryRun  -> Doc
"will" }

promptTarget :: String
promptTarget :: [Char]
promptTarget = [Char]
"What is the target email address? "

aboutToEdit :: FilePath -> String
aboutToEdit :: [Char] -> [Char]
aboutToEdit [Char]
file = [Char]
"About to edit file " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file

promptNoDescriptionChange :: String
promptNoDescriptionChange :: [Char]
promptNoDescriptionChange = [Char]
"File content did not change. Continue anyway?"