--  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 TypeOperators #-}

module Darcs.UI.Commands.Push ( push ) where

import Prelude ()
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
    , abortRun
    , setEnvDarcsPatches
    , defaultRepo
    , amInHashedRepository
    )
import Darcs.UI.Commands.Util ( printDryRunMessageAndExit, checkUnrelatedRepos )
import Darcs.UI.Completion ( prefArgs )
import Darcs.UI.Flags
    ( DarcsFlag
    , isInteractive, verbosity, withContext
    , xmlOutput, selectDeps, applyAs, remoteDarcs
    , changesReverse, dryRun, useCache, remoteRepos, setDefault, fixUrl )
import Darcs.UI.Options
    ( (^), odesc, ocheck, onormalise
    , defaultFlags, parseFlags, (?) )
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 ( Repository, withRepository, RepoJob(..), identifyRepositoryFor,
                          readRepo )
import Darcs.Patch ( IsRepoType, RepoPatch, description )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Witnesses.Ordered
    ( (:>)(..), RL, FL, nullRL,
    nullFL, reverseFL, mapFL_FL, mapRL )
import Darcs.Repository.Prefs ( 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(..)
    , selectionContext
    , runSelection
    )
import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
import Darcs.Patch.Depends ( findCommonWithThem, countUsThem )
import Darcs.Patch.Bundle ( makeBundleN )
import Darcs.Patch.Show( ShowPatch )
import Darcs.Patch.Set ( PatchSet, Origin )
import Darcs.Util.Printer ( Doc, vcat, empty, text, ($$) )
import Darcs.UI.Email ( makeEmail )
import Darcs.Util.English (englishNum, Noun(..))
import Darcs.Util.Workaround ( getCurrentDirectory )
import Darcs.Util.Text ( quote )
import Darcs.Util.Tree( Tree )


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

pushHelp :: String
pushHelp :: String
pushHelp = [String] -> String
unlines
 [ "Push is the opposite of pull.  Push allows you to copy patches from the"
 , "current repository into another repository."
 , ""
 , "If you give the `--apply-as` flag, darcs will use `sudo` to apply the"
 , "patches as a different user.  This can be useful if you want to set up a"
 , "system where several users can modify the same repository, but you don't"
 , "want to allow them full write access.  This isn't secure against skilled"
 , "malicious attackers, but at least can protect your repository from clumsy,"
 , "inept or lazy users."
 , ""
 , "`darcs push` will compress the patch data before sending it to a remote"
 , "location via ssh. This works as long as the remote darcs is not older"
 , "than version 2.5. If you get errors that indicate a corrupt patch bundle,"
 , "you should try again with the `--no-compress` option."
 ]

push :: DarcsCommand [DarcsFlag]
push :: DarcsCommand [DarcsFlag]
push = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
    { commandProgramName :: String
commandProgramName = "darcs"
    , commandName :: String
commandName = "push"
    , commandHelp :: String
commandHelp = String
pushHelp
    , commandDescription :: String
commandDescription = String
pushDescription
    , commandExtraArgs :: Int
commandExtraArgs = -1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = ["[REPOSITORY]"]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
pushCmd
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = String
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
prefArgs "repos"
    , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
defaultRepo
    , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Maybe String
   -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  (Maybe String
   -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String
   -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
pushAdvancedOpts
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
pushBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
pushOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> Any)
forall a.
DarcsOption
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
pushOpts
    , commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
pushOpts
    }
  where
    pushBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
pushBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
  [MatchFlag]
MatchOption
O.matchSeveral
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
  [MatchFlag]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
     (SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
  (SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
PrimDarcsOption SelectDeps
O.selectDeps
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
     (Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
  (Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
PrimDarcsOption (Maybe Bool)
O.interactive
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput -> Summary -> Maybe String -> Maybe Bool -> Bool -> a)
     (Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (DryRun
      -> XmlOutput -> Summary -> Maybe String -> Maybe Bool -> Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput -> Summary -> Maybe String -> Maybe Bool -> Bool -> a)
  (Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
PrimDarcsOption Sign
O.sign
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (DryRun
   -> XmlOutput -> Summary -> Maybe String -> Maybe Bool -> Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Summary -> Maybe String -> Maybe Bool -> Bool -> a)
     (DryRun
      -> XmlOutput -> Summary -> Maybe String -> Maybe Bool -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Summary -> Maybe String -> Maybe Bool -> Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Summary -> Maybe String -> Maybe Bool -> Bool -> a)
  (DryRun
   -> XmlOutput -> Summary -> Maybe String -> Maybe Bool -> Bool -> a)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Summary -> Maybe String -> Maybe Bool -> Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe Bool -> Bool -> a)
     (Summary -> Maybe String -> Maybe Bool -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Maybe Bool -> Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Maybe Bool -> Bool -> a)
  (Summary -> Maybe String -> Maybe Bool -> Bool -> a)
PrimDarcsOption Summary
O.summary
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Maybe Bool -> Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> Bool -> a)
     (Maybe String -> Maybe Bool -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool -> Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> Bool -> a)
  (Maybe String -> Maybe Bool -> Bool -> a)
PrimDarcsOption (Maybe String)
O.repoDir
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool -> Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
-> OptSpec
     DarcsOptDescr DarcsFlag (Bool -> a) (Maybe Bool -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> a)
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
  DarcsOptDescr DarcsFlag (Bool -> a) (Maybe Bool -> Bool -> a)
PrimDarcsOption (Maybe Bool)
O.setDefault
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
PrimDarcsOption Bool
O.allowUnrelatedRepos
    pushAdvancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String
   -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
pushAdvancedOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
  (Maybe String)
PrimDarcsOption (Maybe String)
O.applyAs
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
  (Maybe String)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Compression -> NetworkOptions -> a)
     (RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> Compression -> NetworkOptions -> a)
     (Maybe String
      -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> 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 -> Compression -> NetworkOptions -> a)
  (RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
PrimDarcsOption RemoteRepos
O.remoteRepos
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Bool -> Compression -> NetworkOptions -> a)
  (Maybe String
   -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Compression -> NetworkOptions -> a)
     (Bool -> Compression -> NetworkOptions -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Compression -> NetworkOptions -> a)
     (Maybe String
      -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> 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 -> NetworkOptions -> a)
  (Bool -> Compression -> NetworkOptions -> a)
PrimDarcsOption Bool
O.changesReverse
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Compression -> NetworkOptions -> a)
  (Maybe String
   -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (NetworkOptions -> a)
     (Compression -> NetworkOptions -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (NetworkOptions -> a)
     (Maybe String
      -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> 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
  (NetworkOptions -> a)
  (Compression -> NetworkOptions -> a)
PrimDarcsOption Compression
O.compress
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (NetworkOptions -> a)
  (Maybe String
   -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (NetworkOptions -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe String
      -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> 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 (NetworkOptions -> a)
PrimDarcsOption NetworkOptions
O.network
    pushOpts :: DarcsOption
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
pushOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> a)
pushBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
  ([MatchFlag]
   -> SelectDeps
   -> Maybe Bool
   -> Sign
   -> DryRun
   -> XmlOutput
   -> Summary
   -> Maybe String
   -> Maybe Bool
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> a)
     (Maybe String
      -> RemoteRepos
      -> Bool
      -> Compression
      -> NetworkOptions
      -> UseCache
      -> HooksConfig
      -> a)
-> DarcsOption
     a
     ([MatchFlag]
      -> SelectDeps
      -> Maybe Bool
      -> Sign
      -> DryRun
      -> XmlOutput
      -> Summary
      -> Maybe String
      -> Maybe Bool
      -> Bool
      -> Maybe StdCmdAction
      -> Bool
      -> Bool
      -> Verbosity
      -> Bool
      -> Maybe String
      -> RemoteRepos
      -> Bool
      -> Compression
      -> NetworkOptions
      -> UseCache
      -> HooksConfig
      -> a)
forall b c a.
DarcsOption
  (Maybe StdCmdAction -> Bool -> Bool -> Verbosity -> Bool -> b) c
-> DarcsOption (UseCache -> HooksConfig -> a) b -> DarcsOption a c
`withStdOpts` DarcsOption
  (UseCache -> HooksConfig -> a)
  (Maybe String
   -> RemoteRepos
   -> Bool
   -> Compression
   -> NetworkOptions
   -> UseCache
   -> HooksConfig
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String
   -> RemoteRepos -> Bool -> Compression -> NetworkOptions -> a)
pushAdvancedOpts

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

prepareBundle :: forall rt p wR wU wT. (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
              => [DarcsFlag] -> String -> Repository rt p wR wU wT -> IO Doc
prepareBundle :: [DarcsFlag] -> String -> Repository rt p wR wU wT -> IO Doc
prepareBundle opts :: [DarcsFlag]
opts repodir :: String
repodir repository :: Repository rt p wR wU wT
repository = do
  [String]
old_default <- String -> IO [String]
getPreflist "defaultrepo"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
old_default [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
repodir]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       let pushing :: String
pushing = if 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 "Would push" else "Pushing"
       in  [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
pushingString -> String -> String
forall a. [a] -> [a] -> [a]
++" to "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
quote String
repodirString -> String -> String
forall a. [a] -> [a] -> [a]
++"..."
  PatchSet rt p Origin Any
them <- Repository rt p wR wU wT
-> UseCache -> String -> IO (Repository rt p Any Any Any)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT vR vU vT.
Repository rt p wR wU wT
-> UseCache -> String -> IO (Repository rt p vR vU vT)
identifyRepositoryFor Repository rt p wR wU wT
repository (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
repodir IO (Repository rt p Any Any Any)
-> (Repository rt p Any Any Any -> IO (PatchSet rt p Origin Any))
-> IO (PatchSet rt p Origin Any)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Repository rt p Any Any Any -> IO (PatchSet rt p Origin Any)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo
  String -> DryRun -> RemoteRepos -> SetDefault -> IO ()
addRepoSource String
repodir (PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption RemoteRepos
remoteRepos PrimDarcsOption RemoteRepos -> [DarcsFlag] -> RemoteRepos
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (Bool -> [DarcsFlag] -> SetDefault
setDefault Bool
False [DarcsFlag]
opts)
  PatchSet rt p Origin wR
us <- Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
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
repository
  common :: PatchSet rt p Origin wZ
common :> us' :: FL (PatchInfoAnd rt p) wZ wR
us' <- (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
 -> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR))
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR
-> PatchSet rt p Origin Any
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
Commute p =>
PatchSet rt p wStart wX
-> PatchSet rt p wStart wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart wX
findCommonWithThem PatchSet rt p Origin wR
us PatchSet rt p Origin Any
them
  [DarcsFlag]
-> PatchSet rt p Origin wR
-> RL (PatchInfoAnd rt p) wZ wR
-> PatchSet rt p Origin Any
-> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) (a :: * -> * -> *) wX wY
       wT.
(RepoPatch p, ShowPatch a) =>
[DarcsFlag]
-> PatchSet rt p Origin wX
-> RL a wT wX
-> PatchSet rt p Origin wY
-> IO ()
prePushChatter [DarcsFlag]
opts PatchSet rt p Origin wR
us (FL (PatchInfoAnd rt p) wZ wR -> RL (PatchInfoAnd rt p) wZ wR
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wZ wR
us') PatchSet rt p Origin Any
them
  let direction :: WhichChanges
direction = if 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
      context :: PatchSelectionContext (PatchInfoAnd rt p)
context = WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [String]
-> PatchSelectionContext (PatchInfoAnd rt p)
forall (rt :: RepoType) (p :: * -> * -> *).
(IsRepoType rt, RepoPatch p) =>
WhichChanges
-> String
-> PatchSelectionOptions
-> Maybe (Splitter (PatchInfoAnd rt p))
-> Maybe [String]
-> PatchSelectionContext (PatchInfoAnd rt p)
selectionContext WhichChanges
direction "push" ([DarcsFlag] -> PatchSelectionOptions
pushPatchSelOpts [DarcsFlag]
opts) Maybe (Splitter (PatchInfoAnd rt p))
forall a. Maybe a
Nothing Maybe [String]
forall a. Maybe a
Nothing
  FL (PatchInfoAnd rt p) wZ wR
-> PatchSelectionContext (PatchInfoAnd rt p)
-> IO
     ((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wR)
forall (p :: * -> * -> *) wX wY.
(Invert p, Commute p, Apply p, PatchInspect p, ShowPatch p,
 ShowContextPatch p, ApplyState p ~ Tree) =>
FL p wX wY
-> PatchSelectionContext p -> IO ((:>) (FL p) (FL p) wX wY)
runSelection FL (PatchInfoAnd rt p) wZ wR
us' PatchSelectionContext (PatchInfoAnd rt p)
context
                   IO ((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wR)
-> ((:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wR
    -> IO Doc)
-> IO Doc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [DarcsFlag]
-> PatchSet rt p Origin wZ
-> (:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wZ wR
-> IO Doc
forall (t :: * -> * -> *) (rt :: RepoType) (p :: * -> * -> *) wZ wW
       wA.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> PatchSet rt p wA wZ
-> (:>) (FL (PatchInfoAnd rt p)) t wZ wW
-> IO Doc
bundlePatches [DarcsFlag]
opts PatchSet rt p Origin wZ
common

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

bundlePatches :: forall t rt p wZ wW wA. (RepoPatch p, ApplyState p ~ Tree)
              => [DarcsFlag] -> PatchSet rt p wA wZ
              -> (FL (PatchInfoAnd rt p) :> t) wZ wW
              -> IO Doc
bundlePatches :: [DarcsFlag]
-> PatchSet rt p wA wZ
-> (:>) (FL (PatchInfoAnd rt p)) t wZ wW
-> IO Doc
bundlePatches opts :: [DarcsFlag]
opts common :: PatchSet rt p wA wZ
common (to_be_pushed :: FL (PatchInfoAnd rt p) wZ wZ
to_be_pushed :> _) =
    do
      FL (PatchInfoAnd rt p) wZ wZ -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
FL (PatchInfoAnd rt p) wX wY -> IO ()
setEnvDarcsPatches FL (PatchInfoAnd rt p) wZ wZ
to_be_pushed
      String
-> Verbosity
-> Summary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wZ wZ
-> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
String
-> Verbosity
-> Summary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wX wY
-> IO ()
printDryRunMessageAndExit "push"
        (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
        (PrimDarcsOption Summary
O.summary PrimDarcsOption Summary -> [DarcsFlag] -> Summary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
        (PrimDarcsOption DryRun
dryRun PrimDarcsOption DryRun -> [DarcsFlag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
        (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 rt p) wZ wZ
to_be_pushed
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FL (PatchInfoAnd rt p) wZ wZ -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PatchInfoAnd rt 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
$
            String -> Doc
text "You don't want to push any patches, and that's fine with me!"
          IO ()
forall a. IO a
exitSuccess
      Maybe (Tree IO)
-> PatchSet rt p wA wZ -> FL (WrappedNamed rt p) wZ wZ -> IO Doc
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX
-> FL (WrappedNamed rt p) wX wY
-> IO Doc
makeBundleN Maybe (Tree IO)
forall a. Maybe a
Nothing PatchSet rt p wA wZ
common ((forall wW wY. PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY)
-> FL (PatchInfoAnd rt p) wZ wZ -> FL (WrappedNamed rt 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 forall wW wY. PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully FL (PatchInfoAnd rt p) wZ wZ
to_be_pushed)

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


pushPatchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
pushPatchSelOpts :: [DarcsFlag] -> PatchSelectionOptions
pushPatchSelOpts flags :: [DarcsFlag]
flags = PatchSelectionOptions :: Verbosity
-> [MatchFlag]
-> Bool
-> SelectDeps
-> Summary
-> WithContext
-> PatchSelectionOptions
S.PatchSelectionOptions
    { verbosity :: Verbosity
S.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 = MatchOption -> [DarcsFlag] -> [MatchFlag]
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 PrimDarcsOption SelectDeps -> [DarcsFlag] -> SelectDeps
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , summary :: Summary
S.summary = PrimDarcsOption Summary
O.summary PrimDarcsOption Summary -> [DarcsFlag] -> Summary
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    , withContext :: WithContext
S.withContext = PrimDarcsOption WithContext
withContext PrimDarcsOption WithContext -> [DarcsFlag] -> WithContext
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
flags
    }

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

applyViaSudo :: String -> String -> Doc -> IO ExitCode
applyViaSudo :: String -> String -> Doc -> IO ExitCode
applyViaSudo user :: String
user repo :: String
repo bundle :: Doc
bundle =
    IO String
darcsProgram IO String -> (String -> IO ExitCode) -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \darcs :: String
darcs ->
    String -> [String] -> Doc -> IO ExitCode
pipeDoc "sudo" ["-u",String
user,String
darcs,"apply","--all","--repodir",String
repo] Doc
bundle

applyViaLocal :: [DarcsFlag] -> String -> Doc -> IO ExitCode
applyViaLocal :: [DarcsFlag] -> String -> Doc -> IO ExitCode
applyViaLocal opts :: [DarcsFlag]
opts repo :: String
repo bundle :: Doc
bundle =
    IO String
darcsProgram IO String -> (String -> IO ExitCode) -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \darcs :: String
darcs ->
    String -> [String] -> Doc -> IO ExitCode
pipeDoc String
darcs ("apply"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:"--all"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:"--repodir"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
repoString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[DarcsFlag] -> [String]
applyopts [DarcsFlag]
opts) Doc
bundle

applyViaSsh :: [DarcsFlag] -> SshFilePath -> Doc -> IO ExitCode
applyViaSsh :: [DarcsFlag] -> SshFilePath -> Doc -> IO ExitCode
applyViaSsh opts :: [DarcsFlag]
opts repo :: SshFilePath
repo =
    Compression -> SshFilePath -> [String] -> Doc -> IO ExitCode
pipeDocSSH (PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Compression
O.compress [DarcsFlag]
opts) SshFilePath
repo
           [RemoteDarcs -> String
R.remoteDarcs ([DarcsFlag] -> RemoteDarcs
remoteDarcs [DarcsFlag]
opts) String -> String -> String
forall a. [a] -> [a] -> [a]
++" apply --all "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords ([DarcsFlag] -> [String]
applyopts [DarcsFlag]
opts)String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     " --repodir '"String -> String -> String
forall a. [a] -> [a] -> [a]
++SshFilePath -> String
sshRepo SshFilePath
repoString -> String -> String
forall a. [a] -> [a] -> [a]
++"'"]

applyViaSshAndSudo :: [DarcsFlag] -> SshFilePath -> String -> Doc -> IO ExitCode
applyViaSshAndSudo :: [DarcsFlag] -> SshFilePath -> String -> Doc -> IO ExitCode
applyViaSshAndSudo opts :: [DarcsFlag]
opts repo :: SshFilePath
repo username :: String
username =
    Compression -> SshFilePath -> [String] -> Doc -> IO ExitCode
pipeDocSSH (PrimDarcsOption Compression -> [DarcsFlag] -> Compression
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Compression
O.compress [DarcsFlag]
opts) SshFilePath
repo
           ["sudo -u "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
usernameString -> String -> String
forall a. [a] -> [a] -> [a]
++" "String -> String -> String
forall a. [a] -> [a] -> [a]
++RemoteDarcs -> String
R.remoteDarcs ([DarcsFlag] -> RemoteDarcs
remoteDarcs [DarcsFlag]
opts)String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     " apply --all --repodir '"String -> String -> String
forall a. [a] -> [a] -> [a]
++SshFilePath -> String
sshRepo SshFilePath
repoString -> String -> String
forall a. [a] -> [a] -> [a]
++"'"]

applyopts :: [DarcsFlag] -> [String]
applyopts :: [DarcsFlag] -> [String]
applyopts opts :: [DarcsFlag]
opts = if PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption Bool
O.debug [DarcsFlag]
opts then ["--debug"] else []