{-# 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, remoteRepos, setDefault
, fixUrl
, getCc
, getAuthor
, getSubject
, getInReplyTo
, getSendmailCmd
, getOutput
, charset
, verbosity
, isInteractive
, author
, hasLogfile
, selectDeps
, minimize
, editDescription
)
import Darcs.UI.Options
( (^), odesc, ocheck
, defaultFlags, parseFlags, (?)
)
import qualified Darcs.UI.Options.All as O
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, patchDesc )
import Darcs.Repository
( Repository
, repoLocation
, PatchSet
, identifyRepositoryFor
, ReadingOrWriting(..)
, withRepository
, RepoJob(..)
, readRepo
, readRecorded
, prefsUrl )
import Darcs.Patch.Set ( Origin )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch ( IsRepoType, 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 ( addRepoSource, getPreflist )
import Darcs.Repository.Flags ( DryRun(..) )
import Darcs.Util.External ( 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.Lock
( withOpenTemp
, 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 = PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, matchFlags :: [MatchFlag]
S.matchFlags = forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchSeveral [DarcsFlag]
flags
, interactive :: Bool
S.interactive = Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
flags
, selectDeps :: SelectDeps
S.selectDeps = PrimDarcsOption SelectDeps
selectDeps forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, withSummary :: WithSummary
S.withSummary = PrimDarcsOption WithSummary
O.withSummary forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
, withContext :: WithContext
S.withContext = WithContext
O.NoContext
}
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 = [Char]
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [[Char]]
-> IO [[Char]]
prefArgs [Char]
"repos"
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
defaultRepo
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Logfile
-> RemoteRepos
-> Maybe AbsolutePath
-> Bool
-> NetworkOptions
-> a)
sendAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc 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
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
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
-> Maybe StdCmdAction
-> Verbosity
-> Logfile
-> RemoteRepos
-> Maybe AbsolutePath
-> Bool
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
sendOpts
, commandCheckOptions :: [DarcsFlag] -> [[Char]]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [[Char]]
ocheck forall {a}.
DarcsOption
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
-> Maybe StdCmdAction
-> Verbosity
-> Logfile
-> RemoteRepos
-> Maybe AbsolutePath
-> Bool
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
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
= MatchOption
O.matchSeveral
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SelectDeps
O.selectDeps
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Bool)
O.interactive
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption HeaderFields
O.headerFields
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe [Char])
O.author
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe [Char])
O.charset
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.mail
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe [Char])
O.sendmailCmd
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Output)
O.output
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Sign
O.sign
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithSummary
O.withSummary
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.editDescription
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe Bool)
O.setDefault
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption InheritDefault
O.inheritDefault
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe [Char])
O.repoDir
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.minimize
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.allowUnrelatedRepos
sendAdvancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Logfile
-> RemoteRepos
-> Maybe AbsolutePath
-> Bool
-> NetworkOptions
-> a)
sendAdvancedOpts
= PrimDarcsOption Logfile
O.logfile
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption RemoteRepos
O.remoteRepos
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe AbsolutePath)
O.sendToContext
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption Bool
O.changesReverse
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption NetworkOptions
O.network
sendOpts :: DarcsOption
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
-> Maybe StdCmdAction
-> Verbosity
-> Logfile
-> RemoteRepos
-> Maybe AbsolutePath
-> Bool
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
sendOpts = 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 forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Logfile
-> RemoteRepos
-> Maybe AbsolutePath
-> Bool
-> NetworkOptions
-> 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] =
forall a. UseCache -> RepoJob a -> IO a
withRepository (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob forall a b. (a -> b) -> a -> b
$
\(Repository rt p wR wU wR
repository :: Repository rt p wR wU wR) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimDarcsOption Bool
O.mail forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts Bool -> Bool -> Bool
&& PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts forall a. Eq a => a -> a -> Bool
== DryRun
O.NoDryRun) forall a b. (a -> b) -> a -> b
$ do
Maybe [Char]
sm_cmd <- [DarcsFlag] -> IO (Maybe [Char])
getSendmailCmd [DarcsFlag]
opts
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe [Char]
sm_cmd) IO ()
checkDefaultSendmail
case PrimDarcsOption (Maybe AbsolutePath)
O.sendToContext forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
Just AbsolutePath
contextfile -> do
[WhatToDo]
wtds <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
[DarcsFlag] -> Maybe (Repository rt p wR wU wT) -> IO [WhatToDo]
decideOnBehavior [DarcsFlag]
opts (forall a. Maybe a
Nothing :: Maybe (Repository rt p wR wU wR))
PatchSet rt p Origin wR
ref <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
Sealed PatchSet rt p Origin wX
them <- forall (p :: * -> * -> *) (rt :: RepoType) wX.
Commute p =>
PatchSet rt p Origin wX
-> [Char] -> IO (SealedPatchSet rt p Origin)
readContextFile PatchSet rt p Origin wR
ref (forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
contextfile)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> [DarcsFlag]
-> [WhatToDo]
-> [Char]
-> PatchSet rt p Origin wX
-> IO ()
sendToThem Repository rt p wR wU wR
repository [DarcsFlag]
opts [WhatToDo]
wtds [Char]
"CONTEXT" PatchSet rt p Origin wX
them
Maybe AbsolutePath
Nothing -> do
[Char]
repodir <- AbsolutePath -> [Char] -> IO [Char]
fixUrl AbsolutePath
o [Char]
unfixedrepodir
AbsolutePath
here <- IO AbsolutePath
getCurrentDirectory
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
repodir forall a. Eq a => a -> a -> Bool
== forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
here) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
cannotSendToSelf
[[Char]]
old_default <- [Char] -> IO [[Char]]
getPreflist [Char]
"defaultrepo"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([[Char]]
old_default forall a. Eq a => a -> a -> Bool
== [[Char]
repodir]) forall a b. (a -> b) -> a -> b
$
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts ([Char] -> Doc
creatingPatch [Char]
repodir)
Repository rt p Any Any Any
repo <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT vR vU vT.
ReadingOrWriting
-> Repository rt p wR wU wT
-> UseCache
-> [Char]
-> IO (Repository rt p vR vU vT)
identifyRepositoryFor ReadingOrWriting
Reading Repository rt p wR wU wR
repository (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) [Char]
repodir
PatchSet rt p Origin Any
them <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p Any Any Any
repo
[Char]
-> DryRun
-> RemoteRepos
-> SetDefault
-> InheritDefault
-> Bool
-> IO ()
addRepoSource [Char]
repodir (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption RemoteRepos
remoteRepos forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(Bool -> [DarcsFlag] -> SetDefault
setDefault Bool
False [DarcsFlag]
opts) (PrimDarcsOption InheritDefault
O.inheritDefault forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
opts)
[WhatToDo]
wtds <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
[DarcsFlag] -> Maybe (Repository rt p wR wU wT) -> IO [WhatToDo]
decideOnBehavior [DarcsFlag]
opts (forall a. a -> Maybe a
Just Repository rt p Any Any Any
repo)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> [DarcsFlag]
-> [WhatToDo]
-> [Char]
-> PatchSet rt p Origin wX
-> IO ()
sendToThem Repository rt p wR wU wR
repository [DarcsFlag]
opts [WhatToDo]
wtds [Char]
repodir PatchSet rt p Origin Any
them
sendCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [[Char]]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
sendToThem :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT -> [DarcsFlag] -> [WhatToDo] -> String
-> PatchSet rt p Origin wX -> IO ()
sendToThem :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wX.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> [DarcsFlag]
-> [WhatToDo]
-> [Char]
-> PatchSet rt p Origin wX
-> IO ()
sendToThem Repository rt p wR wU wT
repo [DarcsFlag]
opts [WhatToDo]
wtds [Char]
their_name PatchSet rt p Origin wX
them = do
PatchSet rt p Origin wR
us <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
repo
PatchSet rt p Origin wZ
common :> FL (PatchInfoAnd rt p) wZ wR
us' <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Commute p =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
findCommonWithThem PatchSet rt p Origin wR
us PatchSet rt p Origin wX
them
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Bool -> PatchSet rt p Origin wX -> PatchSet rt p Origin wY -> IO ()
checkUnrelatedRepos (PrimDarcsOption Bool
O.allowUnrelatedRepos forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) PatchSet rt p Origin wR
us PatchSet rt p Origin wX
them
case FL (PatchInfoAnd rt p) wZ wR
us' of
FL (PatchInfoAnd rt p) wZ wR
NilFL -> do [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
nothingSendable
forall a. IO a
exitSuccess
FL (PatchInfoAnd rt p) wZ wR
_ -> [DarcsFlag] -> Doc -> IO ()
putVerbose [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
selectionIs (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description FL (PatchInfoAnd rt p) wZ wR
us')
Tree IO
pristine <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wT
repo
let direction :: WhichChanges
direction = if PrimDarcsOption Bool
changesReverse 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 rt p)
selection_config = forall (p :: * -> * -> *).
Matchable p =>
WhichChanges
-> [Char]
-> PatchSelectionOptions
-> Maybe (Splitter p)
-> Maybe [AnchoredPath]
-> SelectionConfig p
selectionConfig WhichChanges
direction [Char]
"send" ([DarcsFlag] -> PatchSelectionOptions
patchSelOpts [DarcsFlag]
opts) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
(FL (PatchInfoAnd rt p) wZ wZ
to_be_sent :> FL (PatchInfoAnd rt 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 rt p) wZ wR
us' SelectionConfig (PatchInfoAnd rt p)
selection_config
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
[Char]
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wX wY
-> IO ()
printDryRunMessageAndExit [Char]
"send"
(PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption WithSummary
O.withSummary forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption DryRun
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 rt p) wZ wZ
to_be_sent
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd rt p) wZ wZ
to_be_sent) forall a b. (a -> b) -> a -> b
$ do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
selectionIsNull
forall a. IO a
exitSuccess
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
FL (PatchInfoAnd rt p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd rt p) wZ wZ
to_be_sent
let genFullBundle :: IO Doc
genFullBundle = forall (rt :: RepoType) (p :: * -> * -> *) wX wY wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet rt p Origin wZ
-> Either
(FL (PatchInfoAnd rt p) wX wY)
(Tree IO,
(:\/:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY)
-> IO Doc
prepareBundle [DarcsFlag]
opts PatchSet rt p Origin wZ
common (forall a b. b -> Either a b
Right (Tree IO
pristine, FL (PatchInfoAnd rt p) wZ wR
us'forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/:FL (PatchInfoAnd rt p) wZ wZ
to_be_sent))
Doc
bundle <- if Bool -> Bool
not (PrimDarcsOption Bool
minimize 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 forall (p :: * -> * -> *) (rt :: RepoType) wStart wB wC.
RepoPatch p =>
PatchSet rt p wStart wB
-> FL (PatchInfoAnd rt p) wB wC
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart)
minContext PatchSet rt p Origin wZ
common FL (PatchInfoAnd rt p) wZ wZ
to_be_sent of
Sealed (PatchSet rt p Origin wZ
common' :> FL (PatchInfoAnd rt p) wZ wX
to_be_sent') -> forall (rt :: RepoType) (p :: * -> * -> *) wX wY wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet rt p Origin wZ
-> Either
(FL (PatchInfoAnd rt p) wX wY)
(Tree IO,
(:\/:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY)
-> IO Doc
prepareBundle [DarcsFlag]
opts PatchSet rt p Origin wZ
common' (forall a b. a -> Either a b
Left FL (PatchInfoAnd rt p) wZ wX
to_be_sent') )
forall a. IO a -> IO a -> IO a
`catchInterrupt` IO Doc
genFullBundle
AbsolutePath
here <- IO AbsolutePath
getCurrentDirectory
let make_fname :: FL (PatchInfoAndG rt (Named p)) wX wZ -> IO [Char]
make_fname (PatchInfoAndG rt (Named p) wX wY
tb:>:FL (PatchInfoAndG rt (Named p)) wY wZ
_) = [Char] -> IO [Char]
getUniqueDPatchName forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfoAnd rt p wX wY -> [Char]
patchDesc PatchInfoAndG rt (Named p) wX wY
tb
make_fname FL (PatchInfoAndG rt (Named p)) wX wZ
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
[Char]
fname <- forall {rt :: RepoType} {p :: * -> * -> *} {wX} {wZ}.
FL (PatchInfoAndG rt (Named p)) wX wZ -> IO [Char]
make_fname FL (PatchInfoAnd rt p) wZ wZ
to_be_sent
let outname :: Maybe AbsolutePathOrStd
outname = case [DarcsFlag] -> [Char] -> Maybe AbsolutePathOrStd
getOutput [DarcsFlag]
opts [Char]
fname of
Just AbsolutePathOrStd
f -> forall a. a -> Maybe a
Just AbsolutePathOrStd
f
Maybe AbsolutePathOrStd
Nothing | PrimDarcsOption Bool
O.mail forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts -> forall a. Maybe a
Nothing
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ [Char]
p | Post [Char]
p <- [WhatToDo]
wtds] -> forall a. Maybe a
Nothing
| Bool
otherwise -> forall a. a -> Maybe a
Just (AbsolutePath -> [Char] -> AbsolutePathOrStd
makeAbsoluteOrStd AbsolutePath
here [Char]
fname)
case Maybe AbsolutePathOrStd
outname of
Just AbsolutePathOrStd
fname' -> forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd rt p) wX wY
-> Doc
-> AbsolutePathOrStd
-> [WhatToDo]
-> [Char]
-> IO ()
writeBundleToFile [DarcsFlag]
opts FL (PatchInfoAnd rt p) wZ wZ
to_be_sent Doc
bundle AbsolutePathOrStd
fname' [WhatToDo]
wtds [Char]
their_name
Maybe AbsolutePathOrStd
Nothing -> forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd rt p) wX wY
-> Doc
-> [Char]
-> [WhatToDo]
-> [Char]
-> IO ()
sendBundle [DarcsFlag]
opts FL (PatchInfoAnd rt p) wZ wZ
to_be_sent Doc
bundle [Char]
fname [WhatToDo]
wtds [Char]
their_name
prepareBundle :: forall rt p wX wY wZ. (RepoPatch p, ApplyState p ~ Tree)
=> [DarcsFlag] -> PatchSet rt p Origin wZ
-> Either (FL (PatchInfoAnd rt p) wX wY)
(Tree IO, (FL (PatchInfoAnd rt p) :\/: FL (PatchInfoAnd rt p)) wX wY)
-> IO Doc
prepareBundle :: forall (rt :: RepoType) (p :: * -> * -> *) wX wY wZ.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet rt p Origin wZ
-> Either
(FL (PatchInfoAnd rt p) wX wY)
(Tree IO,
(:\/:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY)
-> IO Doc
prepareBundle [DarcsFlag]
opts PatchSet rt p Origin wZ
common Either
(FL (PatchInfoAnd rt p) wX wY)
(Tree IO,
(:\/:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY)
e = do
Doc
unsig_bundle <-
case Either
(FL (PatchInfoAnd rt p) wX wY)
(Tree IO,
(:\/:) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY)
e of
(Right (Tree IO
pristine, FL (PatchInfoAnd rt p) wZ wX
us' :\/: FL (PatchInfoAnd rt p) wZ wY
to_be_sent)) -> do
Tree IO
pristine' <- forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (PatchInfoAnd rt p) wZ wX
us') Tree IO
pristine
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle (forall a. a -> Maybe a
Just Tree IO
pristine')
(forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet rt p Origin wZ
common)
(forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully FL (PatchInfoAnd rt p) wZ wY
to_be_sent)
Left FL (PatchInfoAnd rt p) wX wY
to_be_sent -> forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle forall a. Maybe a
Nothing
(forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP PatchSet rt p Origin wZ
common)
(forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully FL (PatchInfoAnd rt p) wX wY
to_be_sent)
Sign -> Doc -> IO Doc
signString (forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Sign
O.sign [DarcsFlag]
opts) Doc
unsig_bundle
sendBundle :: forall rt p wX wY . (RepoPatch p, ApplyState p ~ Tree)
=> [DarcsFlag] -> FL (PatchInfoAnd rt p) wX wY
-> Doc -> String -> [WhatToDo] -> String -> IO ()
sendBundle :: forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd rt p) wX wY
-> Doc
-> [Char]
-> [WhatToDo]
-> [Char]
-> IO ()
sendBundle [DarcsFlag]
opts FL (PatchInfoAnd rt p) wX wY
to_be_sent Doc
bundle [Char]
fname [WhatToDo]
wtds [Char]
their_name=
let
auto_subject :: forall pp wA wB . FL (PatchInfoAnd rt pp) wA wB -> String
auto_subject :: forall (pp :: * -> * -> *) wA wB.
FL (PatchInfoAnd rt pp) wA wB -> [Char]
auto_subject (PatchInfoAnd rt pp wA wY
p:>:FL (PatchInfoAnd rt pp) wY wB
NilFL) = [Char]
"darcs patch: " forall a. [a] -> [a] -> [a]
++ [Char] -> Int -> [Char]
trim (forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfoAnd rt p wX wY -> [Char]
patchDesc PatchInfoAnd rt pp wA wY
p) Int
57
auto_subject (PatchInfoAnd rt pp wA wY
p:>:FL (PatchInfoAnd rt pp) wY wB
ps) = [Char]
"darcs patch: " forall a. [a] -> [a] -> [a]
++ [Char] -> Int -> [Char]
trim (forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchInfoAnd rt p wX wY -> [Char]
patchDesc PatchInfoAnd rt pp wA wY
p) Int
43 forall a. [a] -> [a] -> [a]
++
[Char]
" (and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd rt pp) wY wB
ps) forall a. [a] -> [a] -> [a]
++ [Char]
" more)"
auto_subject FL (PatchInfoAnd rt pp) wA wB
_ = 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 forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
st forall a. Ord a => a -> a -> Bool
<= Int
n then [Char]
st
else forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
-Int
3) [Char]
st forall a. [a] -> [a] -> [a]
++ [Char]
"..."
in do
[WhatToDo]
thetargets <- [WhatToDo] -> IO [WhatToDo]
getTargets [WhatToDo]
wtds
[Char]
from <- Maybe [Char] -> Bool -> IO [Char]
getAuthor (PrimDarcsOption (Maybe [Char])
author forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) Bool
False
let thesubject :: [Char]
thesubject = forall a. a -> Maybe a -> a
fromMaybe (forall (pp :: * -> * -> *) wA wB.
FL (PatchInfoAnd rt pp) wA wB -> [Char]
auto_subject FL (PatchInfoAnd rt p) wX wY
to_be_sent) forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Maybe [Char]
getSubject [DarcsFlag]
opts
(Doc
mailcontents, Maybe [Char]
mailfile, Maybe [Char]
mailcharset) <- forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
[DarcsFlag]
-> [Char]
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Doc, Maybe [Char], Maybe [Char])
getDescription [DarcsFlag]
opts [Char]
their_name FL (PatchInfoAnd rt p) wX wY
to_be_sent
let warnMailBody :: IO ()
warnMailBody = case Maybe [Char]
mailfile of
Just [Char]
mf -> Doc -> IO ()
putDocLn forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
emailBackedUp [Char]
mf
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
warnCharset :: [Char] -> IO ()
warnCharset [Char]
msg = do
Bool
confirmed <- [Char] -> IO Bool
promptYorn forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
promptCharSetWarning [Char]
msg
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed forall a b. (a -> b) -> a -> b
$ do
Doc -> IO ()
putDocLn Doc
charsetAborted
IO ()
warnMailBody
forall a. IO a
exitSuccess
Maybe [Char]
thecharset <- case PrimDarcsOption (Maybe [Char])
charset forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
providedCset :: Maybe [Char]
providedCset@(Just [Char]
_) -> 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
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
mailcharset
Just [Char]
"utf-8" -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
mailcharset
Just [Char]
_ -> 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
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[Char]
x -> [([Char]
"In-Reply-To", [Char]
x), ([Char]
"References", [Char]
x)]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DarcsFlag] -> Maybe [Char]
getInReplyTo forall a b. (a -> b) -> a -> b
$ [DarcsFlag]
opts)
(forall a. a -> Maybe a
Just Doc
mailcontents)
Maybe [Char]
thecharset
Doc
bundle
(forall a. a -> Maybe a
Just [Char]
fname)
contentAndBundle :: Maybe (Doc, Doc)
contentAndBundle = 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)))
forall a b. IO a -> IO b -> IO a
`onException` IO ()
warnMailBody
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ [Char]
p | Post [Char]
p <- [WhatToDo]
thetargets]) IO ()
sendmail
ByteString
nbody <- forall a. ((Handle, [Char]) -> IO a) -> IO a
withOpenTemp 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
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ [Char]
p | Post [Char]
p <- [WhatToDo]
thetargets]
(\[Char]
url -> do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
postingPatch [Char]
url
[Char] -> ByteString -> [Char] -> IO ()
postUrl [Char]
url ByteString
nbody [Char]
"message/rfc822")
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_ :: IOException) -> IO ()
sendmail)
forall t. FilePathLike t => [DarcsFlag] -> Maybe t -> IO ()
cleanup [DarcsFlag]
opts Maybe [Char]
mailfile
generateEmailToString :: [WhatToDo] -> String
generateEmailToString :: [WhatToDo] -> [Char]
generateEmailToString = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" , " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= [Char]
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing ([DarcsFlag] -> Maybe AbsolutePath
hasLogfile [DarcsFlag]
opts) Bool -> Bool -> Bool
|| [DarcsFlag] -> Bool
willRemoveLogFile [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall p. FilePathLike p => p -> IO ()
removeFileMayNotExist t
mailfile
cleanup [DarcsFlag]
_ Maybe t
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeBundleToFile :: forall rt p wX wY . (RepoPatch p, ApplyState p ~ Tree)
=> [DarcsFlag] -> FL (PatchInfoAnd rt p) wX wY -> Doc ->
AbsolutePathOrStd -> [WhatToDo] -> String -> IO ()
writeBundleToFile :: forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> FL (PatchInfoAnd rt p) wX wY
-> Doc
-> AbsolutePathOrStd
-> [WhatToDo]
-> [Char]
-> IO ()
writeBundleToFile [DarcsFlag]
opts FL (PatchInfoAnd rt p) wX wY
to_be_sent Doc
bundle AbsolutePathOrStd
fname [WhatToDo]
wtds [Char]
their_name =
do (Doc
d,Maybe [Char]
f,Maybe [Char]
_) <- forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
[DarcsFlag]
-> [Char]
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Doc, Maybe [Char], Maybe [Char])
getDescription [DarcsFlag]
opts [Char]
their_name FL (PatchInfoAnd rt p) wX wY
to_be_sent
let putabs :: a -> IO ()
putabs a
a = do forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile a
a (Doc
d Doc -> Doc -> Doc
$$ Doc
bundle)
Doc -> IO ()
putDocLn (forall a. FilePathLike a => a -> Doc
wroteBundle a
a)
putstd :: IO ()
putstd = Doc -> IO ()
putDoc (Doc
d Doc -> Doc -> Doc
$$ Doc
bundle)
forall a. (AbsolutePath -> a) -> a -> AbsolutePathOrStd -> a
useAbsoluteOrStd forall p. FilePathLike p => p -> IO ()
putabs IO ()
putstd AbsolutePathOrStd
fname
let to :: [Char]
to = [WhatToDo] -> [Char]
generateEmailToString [WhatToDo]
wtds
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
to) forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
savedButNotSent [Char]
to
forall t. FilePathLike t => [DarcsFlag] -> Maybe t -> IO ()
cleanup [DarcsFlag]
opts Maybe [Char]
f
data WhatToDo
= Post String
| SendMail String
decideOnBehavior :: [DarcsFlag] -> Maybe (Repository rt p wR wU wT) -> IO [WhatToDo]
decideOnBehavior :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
[DarcsFlag] -> Maybe (Repository rt p wR wU wT) -> IO [WhatToDo]
decideOnBehavior [DarcsFlag]
opts Maybe (Repository rt p wR wU wT)
remote_repo =
case [WhatToDo]
the_targets of
[] -> do [WhatToDo]
wtds <- case Maybe (Repository rt p wR wU wT)
remote_repo of
Maybe (Repository rt p wR wU wT)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Repository rt p wR wU wT
r -> forall {rt :: RepoType} {p :: * -> * -> *} {wR} {wU} {wT}.
Repository rt p wR wU wT -> IO [WhatToDo]
check_post Repository rt p wR wU wT
r
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WhatToDo]
wtds) forall a b. (a -> b) -> a -> b
$ [WhatToDo] -> IO ()
announce_recipients [WhatToDo]
wtds
forall (m :: * -> *) a. Monad m => a -> m a
return [WhatToDo]
wtds
[WhatToDo]
ts -> do [WhatToDo] -> IO ()
announce_recipients [WhatToDo]
ts
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 wR wU wT -> IO [WhatToDo]
check_post Repository rt p wR wU wT
the_remote_repo =
do [WhatToDo]
p <- (([Char] -> [WhatToDo]
readPost forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BC.unpack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
[Char] -> Cachable -> IO ByteString
fetchFilePS ([Char] -> [Char]
prefsUrl (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation Repository rt p wR wU wT
the_remote_repo) forall a. [a] -> [a] -> [a]
++ [Char]
"/post")
(CInt -> Cachable
MaxAge CInt
600)) forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return []
[WhatToDo]
emails <- forall {rt :: RepoType} {p :: * -> * -> *} {wR} {wU} {wT}.
Repository rt p wR wU wT -> IO [WhatToDo]
who_to_email Repository rt p wR wU wT
the_remote_repo
forall (m :: * -> *) a. Monad m => a -> m a
return ([WhatToDo]
pforall a. [a] -> [a] -> [a]
++[WhatToDo]
emails)
readPost :: [Char] -> [WhatToDo]
readPost = forall a b. (a -> b) -> [a] -> [b]
map [Char] -> WhatToDo
parseLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines where
parseLine :: [Char] -> WhatToDo
parseLine [Char]
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> WhatToDo
Post [Char]
t) [Char] -> WhatToDo
SendMail forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"mailto:" [Char]
t
who_to_email :: Repository rt p wR wU wT -> IO [WhatToDo]
who_to_email Repository rt p wR wU wT
repo =
do [Char]
email <- (ByteString -> [Char]
BC.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
[Char] -> Cachable -> IO ByteString
fetchFilePS ([Char] -> [Char]
prefsUrl (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> [Char]
repoLocation Repository rt p wR wU wT
repo) forall a. [a] -> [a] -> [a]
++ [Char]
"/email")
(CInt -> Cachable
MaxAge CInt
600))
forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
if Char
'@' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
email then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> WhatToDo
SendMail forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
email
else 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 (Post [Char]
p) = [Char]
p
msg :: Doc
msg = DryRun -> [[Char]] -> Doc
willSendTo (PrimDarcsOption DryRun
dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (forall a b. (a -> b) -> [a] -> [b]
map WhatToDo -> [Char]
pn [WhatToDo]
emails)
in case PrimDarcsOption DryRun
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 -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WhatToDo]
the_targets Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing ([DarcsFlag] -> [Char] -> Maybe AbsolutePathOrStd
getOutput [DarcsFlag]
opts [Char]
"")) forall a b. (a -> b) -> a -> b
$
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
msg
getTargets :: [WhatToDo] -> IO [WhatToDo]
getTargets :: [WhatToDo] -> IO [WhatToDo]
getTargets [] = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> WhatToDo
SendMail) forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
askUser [Char]
promptTarget
getTargets [WhatToDo]
wtds = 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 (PrimDarcsOption HeaderFields
O.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:" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
url = [Char] -> WhatToDo
Post [Char]
url
f [Char]
em = [Char] -> WhatToDo
SendMail [Char]
em
getDescription :: RepoPatch p
=> [DarcsFlag] -> String -> FL (PatchInfoAnd rt p) wX wY -> IO (Doc, Maybe String, Maybe String)
getDescription :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
[DarcsFlag]
-> [Char]
-> FL (PatchInfoAnd rt p) wX wY
-> IO (Doc, Maybe [Char], Maybe [Char])
getDescription [DarcsFlag]
opts [Char]
their_name FL (PatchInfoAnd rt p) wX wY
patches =
case Maybe [Char]
get_filename of
Just [Char]
file -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimDarcsOption Bool
editDescription forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Maybe AbsolutePath
hasLogfile [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile [Char]
file Doc
patchdesc
[Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
aboutToEdit [Char]
file
(ExitCode
_, Bool
changed) <- forall p. FilePathLike p => p -> IO (ExitCode, Bool)
editFile [Char]
file
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
changed forall a b. (a -> b) -> a -> b
$ do
Bool
confirmed <- [Char] -> IO Bool
promptYorn [Char]
promptNoDescriptionChange
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed forall a b. (a -> b) -> a -> b
$ do Doc -> IO ()
putDocLn Doc
aborted
forall a. IO a
exitSuccess
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Char]
updatedFile <- [Char] -> IO [Char]
updateFilename [Char]
file
Doc
doc <- forall p. FilePathLike p => p -> IO Doc
readDocBinFile [Char]
updatedFile
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
doc, forall a. a -> Maybe a
Just [Char]
updatedFile, forall {a}. IsString a => Doc -> Maybe a
tryGetCharset Doc
doc)
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Doc
patchdesc, forall a. Maybe a
Nothing, forall {a}. IsString a => Doc -> Maybe a
tryGetCharset Doc
patchdesc)
where patchdesc :: Doc
patchdesc = [Char] -> Doc
text (forall a. Show a => a -> [Char]
show Int
len)
Doc -> Doc -> Doc
<+> [Char] -> Doc
text (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 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 (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description FL (PatchInfoAnd rt p) wX wY
patches)
where
len :: Int
len = forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd rt p) wX wY
patches
updateFilename :: [Char] -> IO [Char]
updateFilename [Char]
file =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> [Char] -> IO ()
renameFile [Char]
file [Char]
darcsSendMessageFinal forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
darcsSendMessageFinal) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FilePathLike a => a -> [Char]
toFilePath) 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
f
Maybe AbsolutePath
Nothing -> if PrimDarcsOption Bool
editDescription forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
then forall a. a -> Maybe a
Just [Char]
darcsSendMessage
else 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 forall a. a -> Maybe a
Just a
"us-ascii"
else forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$
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:"
]
]
forall a. [a] -> [a] -> [a]
++
[ [Doc] -> Doc
vcat
[ Doc
" evolution \"mailto:%T?subject=%S&attach=%A&cc=%C&body=%B\""
, Doc
" msmtp -t %<"
]
]
forall a. [a] -> [a] -> [a]
++ 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:"
]
]
forall a. [a] -> [a] -> [a]
++
[ [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."
]
]
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 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 forall a b. (a -> b) -> a -> b
$ Doc
"Email body left in" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
mf forall a. Semigroup a => a -> a -> a
<> Doc
"."
promptCharSetWarning :: String -> String
promptCharSetWarning :: [Char] -> [Char]
promptCharSetWarning [Char]
msg = [Char]
"Warning: " forall a. [a] -> [a] -> [a]
++ [Char]
msg 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 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 forall a b. (a -> b) -> a -> b
$ Doc
"Wrote patch to" Doc -> Doc -> Doc
<+> [Char] -> Doc
text (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: " 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 " forall a. [a] -> [a] -> [a]
++ [Char]
file
promptNoDescriptionChange :: String
promptNoDescriptionChange :: [Char]
promptNoDescriptionChange = [Char]
"File content did not change. Continue anyway?"