--  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.Push ( push ) where

import Darcs.Prelude

import System.Exit ( exitWith, ExitCode( ExitSuccess, ExitFailure ), exitSuccess )
import Control.Monad ( when, unless )
import Data.Maybe ( isJust )
import Darcs.UI.Commands
    ( DarcsCommand(..), withStdOpts
    , putVerbose
    , putInfo
    , putFinished
    , abortRun
    , setEnvDarcsPatches
    , defaultRepo
    , amInHashedRepository
    )
import Darcs.UI.Commands.Clone ( otherHelpInheritDefault )
import Darcs.UI.Commands.Util ( printDryRunMessageAndExit, checkUnrelatedRepos )
import Darcs.UI.Completion ( prefArgs )
import Darcs.UI.Flags
    ( DarcsFlag
    , isInteractive, verbosity
    , xmlOutput, selectDeps, applyAs
    , changesReverse, dryRun, useCache, setDefault, fixUrl )
import Darcs.UI.Options ( (?), (^) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( DryRun (..) )
import qualified Darcs.Repository.Flags as R ( remoteDarcs )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully )
import Darcs.Repository
    ( RepoJob(..)
    , Repository
    , identifyRepositoryFor
    , ReadingOrWriting(..)
    , readPatches
    , withRepository
    )
import Darcs.Patch ( RepoPatch, description )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Witnesses.Ordered
    ( (:>)(..), RL, FL, nullRL,
    nullFL, reverseFL, mapFL_FL, mapRL )
import Darcs.Repository.Prefs
    ( Pref(Defaultrepo, Repos)
    , addRepoSource
    , getPreflist
    )
import Darcs.UI.External ( signString, darcsProgram
                         , pipeDoc, pipeDocSSH )
import Darcs.Util.Exception ( die )
import Darcs.Util.URL ( isHttpUrl, isValidLocalPath
                      , isSshUrl, splitSshUrl, SshFilePath(..) )
import Darcs.Util.Path ( AbsolutePath )
import Darcs.UI.SelectChanges
    ( WhichChanges(..)
    , selectionConfig
    , runSelection
    )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import Darcs.Patch.Depends ( findCommonWithThem, countUsThem )
import Darcs.Patch.Bundle ( makeBundle )
import Darcs.Patch.Show( ShowPatch )
import Darcs.Patch.Set ( PatchSet, Origin )
import Darcs.Util.Printer.Color ( ePutDocLn )
import Darcs.Util.Printer
    ( Doc
    , ($$)
    , ($+$)
    , (<+>)
    , empty
    , formatWords
    , quoted
    , text
    , vcat
    )
import Darcs.UI.Email ( makeEmail )
import Darcs.Util.English (englishNum, Noun(..))
import Darcs.Util.Workaround ( getCurrentDirectory )
import Darcs.Util.Tree( Tree )


pushDescription :: String
pushDescription :: [Char]
pushDescription =
 [Char]
"Copy and apply patches from this repository to another one."

pushHelp :: Doc
pushHelp :: Doc
pushHelp =
  [[Char]] -> Doc
formatWords
    [ [Char]
"Push is the opposite of pull.  Push allows you to copy patches from the"
    , [Char]
"current repository into another repository."
    ]
  Doc -> Doc -> Doc
$+$ [[Char]] -> Doc
formatWords
    [ [Char]
"The --reorder-patches option works in the same way as it does for pull"
    , [Char]
"and apply: instead of placing the new patches (coming from your local"
    , [Char]
"repository) on top of (i.e. after) the existing (remote) ones, it puts"
    , [Char]
"the remote-only patches on top of the ones that you are pushing. This"
    , [Char]
"can be useful, for instance, if you have recorded a tag locally and want"
    , [Char]
"this tag to be clean in the remote repository after pushing."
    ]
  Doc -> Doc -> Doc
$+$ [[Char]] -> Doc
formatWords
    [ [Char]
"If you give the `--apply-as` flag, darcs will use `sudo` to apply the"
    , [Char]
"patches as a different user.  This can be useful if you want to set up a"
    , [Char]
"system where several users can modify the same repository, but you don't"
    , [Char]
"want to allow them full write access.  This isn't secure against skilled"
    , [Char]
"malicious attackers, but at least can protect your repository from clumsy,"
    , [Char]
"inept or lazy users."
    ]
  Doc -> Doc -> Doc
$+$ [[Char]] -> Doc
formatWords
    [ [Char]
"`darcs push` will compress the patch data before sending it to a remote"
    , [Char]
"location via ssh. This works as long as the remote darcs is not older"
    , [Char]
"than version 2.5. If you get errors that indicate a corrupt patch bundle,"
    , [Char]
"you should try again with the `--no-compress` option."
    ]
  Doc -> Doc -> Doc
$+$
  Doc
otherHelpInheritDefault

push :: DarcsCommand
push :: DarcsCommand
push = DarcsCommand
    { commandProgramName :: [Char]
commandProgramName = [Char]
"darcs"
    , commandName :: [Char]
commandName = [Char]
"push"
    , commandHelp :: Doc
commandHelp = Doc
pushHelp
    , commandDescription :: [Char]
commandDescription = [Char]
pushDescription
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [[Char]]
commandExtraArgHelp = [[Char]
"[REPOSITORY]"]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
pushCmd
    , 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
pushOpts
    }
  where
    pushBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
pushBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  [MatchFlag]
MatchOption
O.matchSeveral
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  [MatchFlag]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
     (SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  (SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
PrimDarcsOption SelectDeps
O.selectDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
     (Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  (Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
     (Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  (Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
PrimDarcsOption Sign
O.sign
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
     (DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  (DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char]
      -> Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
     (WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char]
      -> Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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 Bool -> InheritDefault -> Bool -> Reorder -> a)
  (WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
PrimDarcsOption WithSummary
O.withSummary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char]
   -> Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
     (Maybe [Char]
      -> Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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 -> Bool -> Reorder -> a)
  (Maybe [Char]
   -> Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
PrimDarcsOption (Maybe [Char])
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (InheritDefault -> Bool -> Reorder -> a)
     (Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (InheritDefault -> Bool -> Reorder -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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 -> Bool -> Reorder -> a)
  (Maybe Bool -> InheritDefault -> Bool -> Reorder -> a)
PrimDarcsOption (Maybe Bool)
O.setDefault
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (InheritDefault -> Bool -> Reorder -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Reorder -> a)
     (InheritDefault -> Bool -> Reorder -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Reorder -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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 -> Reorder -> a)
  (InheritDefault -> Bool -> Reorder -> a)
PrimDarcsOption InheritDefault
O.inheritDefault
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Reorder -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec
     DarcsOptDescr DarcsFlag (Reorder -> a) (Bool -> Reorder -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Reorder -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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 (Reorder -> a) (Bool -> Reorder -> a)
PrimDarcsOption Bool
O.allowUnrelatedRepos
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Reorder -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Reorder -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> WithSummary
      -> Maybe [Char]
      -> Maybe Bool
      -> InheritDefault
      -> Bool
      -> Reorder
      -> 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 (Reorder -> a)
PrimDarcsOption Reorder
O.reorderPush
    pushAdvancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe [Char] -> Bool -> Compression -> RemoteDarcs -> a)
pushAdvancedOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Compression -> RemoteDarcs -> a)
  (Maybe [Char])
PrimDarcsOption (Maybe [Char])
O.applyAs
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Compression -> RemoteDarcs -> a)
  (Maybe [Char])
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Compression -> RemoteDarcs -> a)
     (Bool -> Compression -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Compression -> RemoteDarcs -> a)
     (Maybe [Char] -> Bool -> Compression -> 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
  (Compression -> RemoteDarcs -> a)
  (Bool -> Compression -> RemoteDarcs -> a)
PrimDarcsOption Bool
O.changesReverse
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Compression -> RemoteDarcs -> a)
  (Maybe [Char] -> Bool -> Compression -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (RemoteDarcs -> a)
     (Compression -> RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (RemoteDarcs -> a)
     (Maybe [Char] -> Bool -> Compression -> 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)
  (Compression -> RemoteDarcs -> a)
PrimDarcsOption Compression
O.compress
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (RemoteDarcs -> a)
  (Maybe [Char] -> Bool -> Compression -> RemoteDarcs -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (RemoteDarcs -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe [Char] -> Bool -> Compression -> 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
    pushOpts :: CommandOptions
pushOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Maybe [Char]
   -> Bool
   -> Compression
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> Maybe StdCmdAction
   -> Verbosity
   -> Maybe [Char]
   -> Bool
   -> Compression
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> a)
pushBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Maybe [Char]
   -> Bool
   -> Compression
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> WithSummary
   -> Maybe [Char]
   -> Maybe Bool
   -> InheritDefault
   -> Bool
   -> Reorder
   -> Maybe StdCmdAction
   -> Verbosity
   -> Maybe [Char]
   -> Bool
   -> Compression
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (Maybe [Char]
      -> Bool
      -> Compression
      -> 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])
  (Maybe [Char]
   -> Bool
   -> Compression
   -> RemoteDarcs
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe [Char] -> Bool -> Compression -> RemoteDarcs -> a)
pushAdvancedOpts

pushCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
pushCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
pushCmd (AbsolutePath
_, AbsolutePath
o) [DarcsFlag]
opts [[Char]
unfixedrepodir] = do
  [Char]
repodir <- AbsolutePath -> [Char] -> IO [Char]
fixUrl AbsolutePath
o [Char]
unfixedrepodir
  [Char]
here <- IO [Char]
getCurrentDirectory
  [DarcsFlag] -> [Char] -> IO ()
checkOptionsSanity [DarcsFlag]
opts [Char]
repodir
  -- make sure we aren't trying to push to the current repo
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
repodir [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
here) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
die [Char]
"Cannot push from repository to itself."
  Doc
bundle <-
    UseCache -> RepoJob 'RO Doc -> IO Doc
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 Doc -> IO Doc) -> RepoJob 'RO Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO Doc -> RepoJob 'RO Doc
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO Doc -> RepoJob 'RO Doc)
-> TreePatchJob 'RO Doc -> RepoJob 'RO Doc
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> [Char] -> Repository 'RO p wU wR -> IO Doc
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag] -> [Char] -> Repository rt p wU wR -> IO Doc
prepareBundle [DarcsFlag]
opts [Char]
repodir
  Doc
sbundle <- 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
bundle
  let body :: Doc
body =
        if [Char] -> Bool
isValidLocalPath [Char]
repodir
          then Doc
sbundle
          else [Char]
-> [([Char], [Char])]
-> Maybe Doc
-> Maybe [Char]
-> Doc
-> Maybe [Char]
-> Doc
makeEmail [Char]
repodir [] Maybe Doc
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing Doc
sbundle Maybe [Char]
forall a. Maybe a
Nothing
  ExitCode
rval <- [DarcsFlag] -> [Char] -> Doc -> IO ExitCode
remoteApply [DarcsFlag]
opts [Char]
repodir Doc
body
  case ExitCode
rval of
    ExitFailure Int
ec -> do
      Doc -> IO ()
ePutDocLn ([Char] -> Doc
text [Char]
"Apply failed!")
      ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
ec)
    ExitCode
ExitSuccess -> [DarcsFlag] -> [Char] -> IO ()
putFinished [DarcsFlag]
opts [Char]
"pushing"
pushCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [] = [Char] -> IO ()
forall a. [Char] -> IO a
die [Char]
"No default repository to push to, please specify one."
pushCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [[Char]]
_ = [Char] -> IO ()
forall a. [Char] -> IO a
die [Char]
"Cannot push to more than one repo."

prepareBundle :: (RepoPatch p, ApplyState p ~ Tree)
              => [DarcsFlag] -> String -> Repository rt p wU wR -> IO Doc
prepareBundle :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag] -> [Char] -> Repository rt p wU wR -> IO Doc
prepareBundle [DarcsFlag]
opts [Char]
repodir Repository rt p wU wR
repository = do
  [[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
$
       let pushing :: [Char]
pushing = if 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
YesDryRun then [Char]
"Would push" else [Char]
"Pushing"
       in  [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
pushing Doc -> Doc -> Doc
<+> Doc
"to" Doc -> Doc -> Doc
<+> [Char] -> Doc
quoted [Char]
repodir Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"..."
  PatchSet p Origin Any
them <- ReadingOrWriting
-> Repository rt 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
Writing Repository rt 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 IO (Repository 'RO p Any Any)
-> (Repository 'RO p Any Any -> IO (PatchSet p Origin Any))
-> IO (PatchSet p Origin Any)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
  [Char] -> DryRun -> SetDefault -> InheritDefault -> Bool -> 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) (Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
opts)
  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
repository
  PatchSet p Origin wZ
common :> FL (PatchInfoAnd p) wZ wR
only_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 Any
-> (:>) (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 Any
them
  [DarcsFlag]
-> PatchSet p Origin wR
-> RL (PatchInfoAnd p) wZ wR
-> PatchSet p Origin Any
-> IO ()
forall (p :: * -> * -> *) (a :: * -> * -> *) wX wC wY.
(RepoPatch p, ShowPatch a) =>
[DarcsFlag]
-> PatchSet p Origin wX
-> RL a wC wX
-> PatchSet p Origin wY
-> IO ()
prePushChatter [DarcsFlag]
opts PatchSet p Origin wR
us (FL (PatchInfoAnd p) wZ wR -> RL (PatchInfoAnd p) wZ wR
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd p) wZ wR
only_us) PatchSet p Origin Any
them
  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]
"push" ([DarcsFlag] -> PatchSelectionOptions
pushPatchSelOpts [DarcsFlag]
opts) Maybe (Splitter (PatchInfoAnd p))
forall a. Maybe a
Nothing Maybe [AnchoredPath]
forall a. Maybe a
Nothing
  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
only_us SelectionConfig (PatchInfoAnd p)
selection_config
                   IO ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wR)
-> ((:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wR
    -> IO Doc)
-> IO Doc
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [DarcsFlag]
-> PatchSet p Origin wZ
-> (:>) (FL (PatchInfoAnd p)) (FL (PatchInfoAnd p)) wZ wR
-> IO Doc
forall (p :: * -> * -> *) wA wZ (t :: * -> * -> *) wW.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet p wA wZ -> (:>) (FL (PatchInfoAnd p)) t wZ wW -> IO Doc
bundlePatches [DarcsFlag]
opts PatchSet p Origin wZ
common

prePushChatter :: (RepoPatch p, ShowPatch a)
               => [DarcsFlag] -> PatchSet p Origin wX
               -> RL a wC wX -> PatchSet p Origin wY -> IO ()
prePushChatter :: forall (p :: * -> * -> *) (a :: * -> * -> *) wX wC wY.
(RepoPatch p, ShowPatch a) =>
[DarcsFlag]
-> PatchSet p Origin wX
-> RL a wC wX
-> PatchSet p Origin wY
-> IO ()
prePushChatter [DarcsFlag]
opts PatchSet p Origin wX
us RL a wC wX
only_us PatchSet p Origin wY
them = do
  Bool -> PatchSet p Origin wX -> PatchSet p Origin wY -> 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 wX
us PatchSet p Origin wY
them
  let num_to_pull :: Int
num_to_pull = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX -> PatchSet p Origin wY -> (Int, Int)
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX -> PatchSet p Origin wY -> (Int, Int)
countUsThem PatchSet p Origin wX
us PatchSet p Origin wY
them
      pull_reminder :: Doc
pull_reminder = if Int
num_to_pull Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                      then [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"The remote repository has " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num_to_pull
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Noun -> [Char] -> [Char]
forall n. Countable n => Int -> n -> [Char] -> [Char]
englishNum Int
num_to_pull ([Char] -> Noun
Noun [Char]
"patch") [Char]
" to pull."
                      else Doc
empty
  [DarcsFlag] -> Doc -> IO ()
putVerbose [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"We have the following patches to push:" Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((forall wW wZ. a wW wZ -> Doc) -> RL a wC wX -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL a wW wZ -> Doc
forall wW wZ. a wW wZ -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description RL a wC wX
only_us)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RL a wC wX -> Bool
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> Bool
nullRL RL a wC wX
only_us) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts Doc
pull_reminder
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RL a wC wX -> Bool
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> Bool
nullRL RL a wC wX
only_us) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"No recorded local patches to push!"
      IO ()
forall a. IO a
exitSuccess

bundlePatches :: (RepoPatch p, ApplyState p ~ Tree)
              => [DarcsFlag] -> PatchSet p wA wZ
              -> (FL (PatchInfoAnd p) :> t) wZ wW
              -> IO Doc
bundlePatches :: forall (p :: * -> * -> *) wA wZ (t :: * -> * -> *) wW.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet p wA wZ -> (:>) (FL (PatchInfoAnd p)) t wZ wW -> IO Doc
bundlePatches [DarcsFlag]
opts PatchSet p wA wZ
common (FL (PatchInfoAnd p) wZ wZ
to_be_pushed :> t wZ wW
_) =
    do
      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_pushed
      [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]
"push"
        (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)
        (PrimOptSpec DarcsOptDescr DarcsFlag a XmlOutput
PrimDarcsOption XmlOutput
xmlOutput PrimDarcsOption XmlOutput -> [DarcsFlag] -> XmlOutput
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
        (Bool -> [DarcsFlag] -> Bool
isInteractive Bool
True [DarcsFlag]
opts)
        FL (PatchInfoAnd p) wZ wZ
to_be_pushed
      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_pushed) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> Doc
text [Char]
"You don't want to push any patches, and that's fine with me!"
          IO ()
forall a. IO a
exitSuccess
      Maybe (ApplyState p IO)
-> PatchSet p wA wZ -> FL (Named p) wZ wZ -> 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 wA wZ
common ((forall wW wY. PatchInfoAnd p wW wY -> Named p wW wY)
-> FL (PatchInfoAnd p) wZ wZ -> FL (Named p) wZ wZ
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 wZ
to_be_pushed)

checkOptionsSanity :: [DarcsFlag] -> String -> IO ()
checkOptionsSanity :: [DarcsFlag] -> [Char] -> IO ()
checkOptionsSanity [DarcsFlag]
opts [Char]
repodir =
  if [Char] -> Bool
isHttpUrl [Char]
repodir then do
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Char] -> Bool) -> Maybe [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe [Char])
PrimDarcsOption (Maybe [Char])
applyAs PrimDarcsOption (Maybe [Char]) -> [DarcsFlag] -> Maybe [Char]
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
$
           [DarcsFlag] -> Doc -> IO ()
abortRun [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Cannot --apply-as when pushing to URLs"
       let lprot :: [Char]
lprot = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') [Char]
repodir
           msg :: Doc
msg = [Char] -> Doc
text ([Char]
"Pushing to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
lprot[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" URLs is not supported.")
       [DarcsFlag] -> Doc -> IO ()
abortRun [DarcsFlag]
opts Doc
msg
   else Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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 Sign -> Sign -> Bool
forall a. Eq a => a -> a -> Bool
/= Sign
O.NoSign) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [DarcsFlag] -> Doc -> IO ()
abortRun [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Signing doesn't make sense for local repositories or when pushing over ssh."


pushPatchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
pushPatchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
pushPatchSelOpts [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
    }

remoteApply :: [DarcsFlag] -> String -> Doc -> IO ExitCode
remoteApply :: [DarcsFlag] -> [Char] -> Doc -> IO ExitCode
remoteApply [DarcsFlag]
opts [Char]
repodir Doc
bundle
    = case PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe [Char])
PrimDarcsOption (Maybe [Char])
applyAs PrimDarcsOption (Maybe [Char]) -> [DarcsFlag] -> Maybe [Char]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
        Maybe [Char]
Nothing
            | [Char] -> Bool
isSshUrl [Char]
repodir -> [DarcsFlag] -> SshFilePath -> Doc -> IO ExitCode
applyViaSsh [DarcsFlag]
opts ([Char] -> SshFilePath
splitSshUrl [Char]
repodir) Doc
bundle
            | Bool
otherwise -> [DarcsFlag] -> [Char] -> Doc -> IO ExitCode
applyViaLocal [DarcsFlag]
opts [Char]
repodir Doc
bundle
        Just [Char]
un
            | [Char] -> Bool
isSshUrl [Char]
repodir -> [DarcsFlag] -> SshFilePath -> [Char] -> Doc -> IO ExitCode
applyViaSshAndSudo [DarcsFlag]
opts ([Char] -> SshFilePath
splitSshUrl [Char]
repodir) [Char]
un Doc
bundle
            | Bool
otherwise -> [DarcsFlag] -> [Char] -> [Char] -> Doc -> IO ExitCode
applyViaSudo [DarcsFlag]
opts [Char]
un [Char]
repodir Doc
bundle

applyViaSudo :: [DarcsFlag] -> String -> String -> Doc -> IO ExitCode
applyViaSudo :: [DarcsFlag] -> [Char] -> [Char] -> Doc -> IO ExitCode
applyViaSudo [DarcsFlag]
opts [Char]
user [Char]
repo Doc
bundle =
  IO [Char]
darcsProgram IO [Char] -> ([Char] -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
darcs ->
    [Char] -> [[Char]] -> Doc -> IO ExitCode
pipeDoc [Char]
"sudo" ([Char]
"-u" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
user [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
darcs [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [DarcsFlag] -> [Char] -> [[Char]]
darcsArgs [DarcsFlag]
opts [Char]
repo) Doc
bundle

applyViaLocal :: [DarcsFlag] -> String -> Doc -> IO ExitCode
applyViaLocal :: [DarcsFlag] -> [Char] -> Doc -> IO ExitCode
applyViaLocal [DarcsFlag]
opts [Char]
repo Doc
bundle =
  IO [Char]
darcsProgram IO [Char] -> ([Char] -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
darcs -> [Char] -> [[Char]] -> Doc -> IO ExitCode
pipeDoc [Char]
darcs ([DarcsFlag] -> [Char] -> [[Char]]
darcsArgs [DarcsFlag]
opts [Char]
repo) Doc
bundle

applyViaSsh :: [DarcsFlag] -> SshFilePath -> Doc -> IO ExitCode
applyViaSsh :: [DarcsFlag] -> SshFilePath -> Doc -> IO ExitCode
applyViaSsh [DarcsFlag]
opts SshFilePath
repo =
  Compression -> SshFilePath -> [[Char]] -> Doc -> IO ExitCode
pipeDocSSH
    (PrimOptSpec DarcsOptDescr DarcsFlag a Compression
PrimDarcsOption Compression
O.compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
    SshFilePath
repo
    [ [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
        RemoteDarcs -> [Char]
R.remoteDarcs (PrimOptSpec DarcsOptDescr DarcsFlag a RemoteDarcs
PrimDarcsOption RemoteDarcs
O.remoteDarcs PrimDarcsOption RemoteDarcs -> [DarcsFlag] -> RemoteDarcs
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
        [DarcsFlag] -> [Char] -> [[Char]]
darcsArgs [DarcsFlag]
opts ([Char] -> [Char]
shellQuote (SshFilePath -> [Char]
sshRepo SshFilePath
repo))
    ]

applyViaSshAndSudo :: [DarcsFlag] -> SshFilePath -> String -> Doc -> IO ExitCode
applyViaSshAndSudo :: [DarcsFlag] -> SshFilePath -> [Char] -> Doc -> IO ExitCode
applyViaSshAndSudo [DarcsFlag]
opts SshFilePath
repo [Char]
username =
  Compression -> SshFilePath -> [[Char]] -> Doc -> IO ExitCode
pipeDocSSH
    (PrimOptSpec DarcsOptDescr DarcsFlag a Compression
PrimDarcsOption Compression
O.compress PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
    SshFilePath
repo
    [ [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
        [Char]
"sudo" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"-u" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
username [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
        RemoteDarcs -> [Char]
R.remoteDarcs (PrimOptSpec DarcsOptDescr DarcsFlag a RemoteDarcs
PrimDarcsOption RemoteDarcs
O.remoteDarcs PrimDarcsOption RemoteDarcs -> [DarcsFlag] -> RemoteDarcs
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
        [DarcsFlag] -> [Char] -> [[Char]]
darcsArgs [DarcsFlag]
opts ([Char] -> [Char]
shellQuote (SshFilePath -> [Char]
sshRepo SshFilePath
repo))
    ]

darcsArgs :: [DarcsFlag] -> String -> [String]
darcsArgs :: [DarcsFlag] -> [Char] -> [[Char]]
darcsArgs [DarcsFlag]
opts [Char]
repodir = [Char]
"apply" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
standardFlags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
reorderFlags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
debugFlags
  where
    standardFlags :: [[Char]]
standardFlags = [[Char]
"--all", [Char]
"--repodir", [Char]
repodir]
    reorderFlags :: [[Char]]
reorderFlags = if Reorder -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr DarcsFlag a Reorder
PrimDarcsOption Reorder
O.reorderPush PrimDarcsOption Reorder -> [DarcsFlag] -> Reorder
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) then [[Char]
"--reorder-patches"] else []
    debugFlags :: [[Char]]
debugFlags = if PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
O.debug PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts then [[Char]
"--debug"] else []

shellQuote :: String -> String
shellQuote :: [Char] -> [Char]
shellQuote [Char]
s = [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escapeQuote [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
  where
    escapeQuote :: [Char] -> [Char]
escapeQuote [] = []
    escapeQuote cs :: [Char]
cs@(Char
'\'':[Char]
_) = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escapeQuote [Char]
cs
    escapeQuote (Char
c:[Char]
cs) = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escapeQuote [Char]
cs