--  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.Util
    ( announceFiles
    , filterExistingPaths
    , testTentativeAndMaybeExit
    , printDryRunMessageAndExit
    , getUniqueRepositoryName
    , getUniqueDPatchName
    , doesDirectoryReallyExist
    , checkUnrelatedRepos
    , preselectPatches
    , getLastPatches
    , matchRange
    , historyEditHelp
    ) where

import Control.Monad ( when, unless )

import Darcs.Prelude

import Data.Char ( isAlpha, toLower, isDigit, isSpace )
import Data.Maybe ( fromMaybe )

import System.Exit ( ExitCode(..), exitWith, exitSuccess )
import System.Posix.Files ( isDirectory )

import Darcs.Patch ( IsRepoType, RepoPatch, xmlSummary )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Depends
    ( areUnrelatedRepos
    , findCommonWithThem
    , patchSetUnion
    )
import Darcs.Patch.Info ( toXml )
import Darcs.Patch.Match
    ( MatchFlag
    , MatchableRP
    , firstMatch
    , matchFirstPatchset
    , matchSecondPatchset
    , matchingHead
    )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, hopefullyM )
import Darcs.Patch.Set ( PatchSet, SealedPatchSet, Origin, emptyPatchSet )
import Darcs.Patch.Witnesses.Ordered ( FL, (:>)(..), mapFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Sealed2(..) )

import Darcs.Repository
    ( ReadingOrWriting(..)
    , Repository
    , identifyRepositoryFor
    , readRecorded
    , readRepo
    , testTentative
    )
import Darcs.Repository.Prefs ( getDefaultRepo, globalPrefsDirDoc )
import Darcs.Repository.State ( readUnrecordedFiltered )

import Darcs.UI.Commands ( putInfo )
import Darcs.UI.Flags ( DarcsFlag )
import Darcs.UI.PrintPatch ( showFriendly )
import Darcs.UI.Options ( (?) )
import Darcs.UI.Options.All
    ( Verbosity(..), SetScriptsExecutable, TestChanges (..)
    , RunTest(..), LeaveTestDir(..), UseIndex, ScanKnown(..)
    , WithSummary(..), DryRun(..), XmlOutput(..), LookForMoves
    )
import qualified Darcs.UI.Options.All as O

import Darcs.Util.English ( anyOfClause, itemizeVertical )
import Darcs.Util.Exception ( clarifyErrors )
import Darcs.Util.File ( getFileStatus )
import Darcs.Util.Path ( AnchoredPath, displayPath, getUniquePathName )
import Darcs.Util.Printer
    ( Doc, formatWords, ($+$), text, (<+>), hsep, ($$), vcat, vsep
    , putDocLn, insertBeforeLastline, prefix
    , putDocLnWith, pathlist
    )
import Darcs.Util.Printer.Color ( fancyPrinters )
import Darcs.Util.Prompt ( PromptConfig(..), promptChar, promptYorn )
import Darcs.Util.Tree.Monad ( virtualTreeIO, exists )
import Darcs.Util.Tree ( Tree )


announceFiles :: Verbosity -> Maybe [AnchoredPath] -> String -> IO ()
announceFiles :: Verbosity -> Maybe [AnchoredPath] -> [Char] -> IO ()
announceFiles Verbosity
Quiet Maybe [AnchoredPath]
_ [Char]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
announceFiles Verbosity
_ (Just [AnchoredPath]
paths) [Char]
message = Doc -> IO ()
putDocLn forall a b. (a -> b) -> a -> b
$
    [Char] -> Doc
text [Char]
message forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
":" Doc -> Doc -> Doc
<+> [[Char]] -> Doc
pathlist (forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> [Char]
displayPath [AnchoredPath]
paths)
announceFiles Verbosity
_ Maybe [AnchoredPath]
_ [Char]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

testTentativeAndMaybeExit :: Repository rt p wR wU wT
                          -> Verbosity
                          -> TestChanges
                          -> SetScriptsExecutable
                          -> Bool
                          -> String
                          -> String -> Maybe String -> IO ()
testTentativeAndMaybeExit :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT
-> Verbosity
-> TestChanges
-> SetScriptsExecutable
-> Bool
-> [Char]
-> [Char]
-> Maybe [Char]
-> IO ()
testTentativeAndMaybeExit Repository rt p wR wU wT
repo Verbosity
verb TestChanges
test SetScriptsExecutable
sse Bool
interactive [Char]
failMessage [Char]
confirmMsg Maybe [Char]
withClarification = do
    let (RunTest
rt,LeaveTestDir
ltd) = case TestChanges
test of
          TestChanges
NoTestChanges    -> (RunTest
NoRunTest, LeaveTestDir
YesLeaveTestDir)
          YesTestChanges LeaveTestDir
x -> (RunTest
YesRunTest, LeaveTestDir
x)
    ExitCode
testResult <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT
-> RunTest
-> LeaveTestDir
-> SetScriptsExecutable
-> Verbosity
-> IO ExitCode
testTentative Repository rt p wR wU wT
repo RunTest
rt LeaveTestDir
ltd SetScriptsExecutable
sse Verbosity
verb
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
testResult forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) forall a b. (a -> b) -> a -> b
$ do
        let doExit :: IO a
doExit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. IO a -> [Char] -> IO a
clarifyErrors) Maybe [Char]
withClarification forall a b. (a -> b) -> a -> b
$
                        forall a. ExitCode -> IO a
exitWith ExitCode
testResult
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
interactive forall {a}. IO a
doExit
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Looks like " forall a. [a] -> [a] -> [a]
++ [Char]
failMessage
        let prompt :: [Char]
prompt = [Char]
"Shall I " forall a. [a] -> [a] -> [a]
++ [Char]
confirmMsg forall a. [a] -> [a] -> [a]
++ [Char]
" anyway?"
        Char
yn <- PromptConfig -> IO Char
promptChar ([Char] -> [Char] -> [Char] -> Maybe Char -> [Char] -> PromptConfig
PromptConfig [Char]
prompt [Char]
"yn" [] (forall a. a -> Maybe a
Just Char
'n') [])
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char
yn forall a. Eq a => a -> a -> Bool
== Char
'y') forall {a}. IO a
doExit

-- | @'printDryRunMessageAndExit' action flags patches@ prints a string
-- representing the action that would be taken if the @--dry-run@ option had
-- not been passed to darcs. Then darcs exits successfully.  @action@ is the
-- name of the action being taken, like @\"push\"@ @flags@ is the list of flags
-- which were sent to darcs @patches@ is the sequence of patches which would be
-- touched by @action@.
printDryRunMessageAndExit :: RepoPatch p
                          => String
                          -> Verbosity -> WithSummary -> DryRun -> XmlOutput
                          -> Bool -- interactive
                          -> FL (PatchInfoAnd rt p) wX wY
                          -> IO ()
printDryRunMessageAndExit :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
[Char]
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wX wY
-> IO ()
printDryRunMessageAndExit [Char]
action Verbosity
v WithSummary
s DryRun
d XmlOutput
x Bool
interactive FL (PatchInfoAnd rt p) wX wY
patches = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DryRun
d forall a. Eq a => a -> a -> Bool
== DryRun
YesDryRun) forall a b. (a -> b) -> a -> b
$ do
        Doc -> IO ()
putInfoX forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [ Doc
"Would", [Char] -> Doc
text [Char]
action, Doc
"the following changes:" ]
        Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters Doc
put_mode
        Doc -> IO ()
putInfoX forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
""
        Doc -> IO ()
putInfoX forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Making no changes: this is a dry run."
        forall {a}. IO a
exitSuccess
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
interactive Bool -> Bool -> Bool
&& WithSummary
s forall a. Eq a => a -> a -> Bool
== WithSummary
YesSummary) forall a b. (a -> b) -> a -> b
$ do
        Doc -> IO ()
putInfoX forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [ Doc
"Will", [Char] -> Doc
text [Char]
action, Doc
"the following changes:" ]
        Doc -> IO ()
putDocLn Doc
put_mode
  where
    put_mode :: Doc
put_mode = if XmlOutput
x forall a. Eq a => a -> a -> Bool
== XmlOutput
YesXml
                   then [Char] -> Doc
text [Char]
"<patches>" Doc -> Doc -> Doc
$$
                        [Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (Doc -> Doc
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {p :: * -> * -> *} {rt :: RepoType} {wA} {wB}.
(Summary p, PrimDetails (PrimOf p)) =>
WithSummary -> PatchInfoAndG rt p wA wB -> Doc
xml_info WithSummary
s) FL (PatchInfoAnd rt p) wX wY
patches) Doc -> Doc -> Doc
$$
                        [Char] -> Doc
text [Char]
"</patches>"
                   else [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (p :: * -> * -> *) wX wY.
ShowPatch p =>
Verbosity -> WithSummary -> p wX wY -> Doc
showFriendly Verbosity
v WithSummary
s) FL (PatchInfoAnd rt p) wX wY
patches

    putInfoX :: Doc -> IO ()
putInfoX = if XmlOutput
x forall a. Eq a => a -> a -> Bool
== XmlOutput
YesXml then forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ()) else Doc -> IO ()
putDocLn

    xml_info :: WithSummary -> PatchInfoAndG rt p wA wB -> Doc
xml_info WithSummary
YesSummary = forall {p :: * -> * -> *} {rt :: RepoType} {wA} {wB}.
(Summary p, PrimDetails (PrimOf p)) =>
PatchInfoAndG rt p wA wB -> Doc
xml_with_summary
    xml_info WithSummary
NoSummary  = PatchInfo -> Doc
toXml forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info

    xml_with_summary :: PatchInfoAndG rt p wA wB -> Doc
xml_with_summary PatchInfoAndG rt p wA wB
hp
        | Just p wA wB
p <- forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> Maybe (p wA wB)
hopefullyM PatchInfoAndG rt p wA wB
hp = Doc -> Doc -> Doc
insertBeforeLastline (PatchInfo -> Doc
toXml forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wA wB
hp)
                                        (Doc -> Doc
indent forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
(Summary p, PrimDetails (PrimOf p)) =>
p wX wY -> Doc
xmlSummary p wA wB
p)
    xml_with_summary PatchInfoAndG rt p wA wB
hp = PatchInfo -> Doc
toXml (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wA wB
hp)

    indent :: Doc -> Doc
indent = [Char] -> Doc -> Doc
prefix [Char]
"    "

-- | Given a repository and two common command options, classify the given list
-- of paths according to whether they exist in the pristine or working tree.
-- Paths which are neither in working nor pristine are reported and dropped.
-- The result is a pair of path lists: those that exist only in the working tree,
-- and those that exist in pristine or working.
filterExistingPaths :: (RepoPatch p, ApplyState p ~ Tree)
                    => Repository rt p wR wU wR
                    -> Verbosity
                    -> UseIndex
                    -> ScanKnown
                    -> LookForMoves
                    -> [AnchoredPath]
                    -> IO ([AnchoredPath],[AnchoredPath])
filterExistingPaths :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> Verbosity
-> UseIndex
-> ScanKnown
-> LookForMoves
-> [AnchoredPath]
-> IO ([AnchoredPath], [AnchoredPath])
filterExistingPaths Repository rt p wR wU wR
repo Verbosity
verb UseIndex
useidx ScanKnown
scan LookForMoves
lfm [AnchoredPath]
paths = do
      Tree IO
pristine <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wR
repo
      Tree IO
working <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> UseIndex
-> ScanKnown
-> LookForMoves
-> Maybe [AnchoredPath]
-> IO (Tree IO)
readUnrecordedFiltered Repository rt p wR wU wR
repo UseIndex
useidx ScanKnown
scan LookForMoves
lfm (forall a. a -> Maybe a
Just [AnchoredPath]
paths)
      let check :: Tree IO -> IO ([Bool], Tree IO)
check = forall a. TreeIO a -> Tree IO -> IO (a, Tree IO)
virtualTreeIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
exists [AnchoredPath]
paths
      ([Bool]
in_pristine, Tree IO
_) <- Tree IO -> IO ([Bool], Tree IO)
check Tree IO
pristine
      ([Bool]
in_working, Tree IO
_) <- Tree IO -> IO ([Bool], Tree IO)
check Tree IO
working
      let paths_with_info :: [(AnchoredPath, Bool, Bool)]
paths_with_info       = forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [AnchoredPath]
paths [Bool]
in_pristine [Bool]
in_working
          paths_in_neither :: [AnchoredPath]
paths_in_neither      = [ AnchoredPath
p | (AnchoredPath
p,Bool
False,Bool
False) <- [(AnchoredPath, Bool, Bool)]
paths_with_info ]
          paths_only_in_working :: [AnchoredPath]
paths_only_in_working = [ AnchoredPath
p | (AnchoredPath
p,Bool
False,Bool
True) <- [(AnchoredPath, Bool, Bool)]
paths_with_info ]
          paths_in_either :: [AnchoredPath]
paths_in_either       = [ AnchoredPath
p | (AnchoredPath
p,Bool
inp,Bool
inw) <- [(AnchoredPath, Bool, Bool)]
paths_with_info, Bool
inp Bool -> Bool -> Bool
|| Bool
inw ]
          or_not_added :: Doc
or_not_added          = if ScanKnown
scan forall a. Eq a => a -> a -> Bool
== ScanKnown
ScanKnown then Doc
" or not added " else Doc
" "
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Verbosity
verb forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
paths_in_neither) forall a b. (a -> b) -> a -> b
$ Doc -> IO ()
putDocLn forall a b. (a -> b) -> a -> b
$
        Doc
"Ignoring non-existing" forall a. Semigroup a => a -> a -> a
<> Doc
or_not_added forall a. Semigroup a => a -> a -> a
<> Doc
"paths:" Doc -> Doc -> Doc
<+>
        [[Char]] -> Doc
pathlist (forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> [Char]
displayPath [AnchoredPath]
paths_in_neither)
      forall (m :: * -> *) a. Monad m => a -> m a
return ([AnchoredPath]
paths_only_in_working, [AnchoredPath]
paths_in_either)

getUniqueRepositoryName :: Bool -> FilePath -> IO FilePath
getUniqueRepositoryName :: Bool -> [Char] -> IO [Char]
getUniqueRepositoryName Bool
talkative [Char]
name = Bool -> ([Char] -> [Char]) -> (Int -> [Char]) -> IO [Char]
getUniquePathName Bool
talkative [Char] -> [Char]
buildMsg forall {a}. (Eq a, Num a, Show a) => a -> [Char]
buildName
  where
    buildName :: a -> [Char]
buildName a
i = if a
i forall a. Eq a => a -> a -> Bool
== -a
1 then [Char]
name else [Char]
nameforall a. [a] -> [a] -> [a]
++[Char]
"_"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show a
i
    buildMsg :: [Char] -> [Char]
buildMsg [Char]
n = [Char]
"Directory or file '"forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++
                 [Char]
"' already exists, creating repository as '"forall a. [a] -> [a] -> [a]
++
                 [Char]
n forall a. [a] -> [a] -> [a]
++[Char]
"'"

getUniqueDPatchName :: FilePath -> IO FilePath
getUniqueDPatchName :: [Char] -> IO [Char]
getUniqueDPatchName [Char]
name = Bool -> ([Char] -> [Char]) -> (Int -> [Char]) -> IO [Char]
getUniquePathName Bool
False (forall a b. a -> b -> a
const [Char]
"") forall {a}. (Eq a, Num a, Show a) => a -> [Char]
buildName
  where
    buildName :: a -> [Char]
buildName a
i =
      if a
i forall a. Eq a => a -> a -> Bool
== -a
1 then [Char] -> [Char]
patchFilename [Char]
name else [Char] -> [Char]
patchFilename forall a b. (a -> b) -> a -> b
$ [Char]
nameforall a. [a] -> [a] -> [a]
++[Char]
"_"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show a
i

-- |patchFilename maps a patch description string to a safe (lowercased, spaces
-- removed and ascii-only characters) patch filename.
patchFilename :: String -> String
patchFilename :: [Char] -> [Char]
patchFilename [Char]
the_summary = [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".dpatch"
  where
    name :: [Char]
name = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
safeFileChar [Char]
the_summary
    safeFileChar :: Char -> Char
safeFileChar Char
c | Char -> Bool
isAlpha Char
c = Char -> Char
toLower Char
c
                   | Char -> Bool
isDigit Char
c = Char
c
                   | Char -> Bool
isSpace Char
c = Char
'-'
    safeFileChar Char
_ = Char
'_'

doesDirectoryReallyExist :: FilePath -> IO Bool
doesDirectoryReallyExist :: [Char] -> IO Bool
doesDirectoryReallyExist [Char]
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False FileStatus -> Bool
isDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO (Maybe FileStatus)
getFileStatus [Char]
f

checkUnrelatedRepos :: RepoPatch p
                    => Bool
                    -> PatchSet rt p Origin wX
                    -> PatchSet rt p Origin wY
                    -> IO ()
checkUnrelatedRepos :: forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
RepoPatch p =>
Bool -> PatchSet rt p Origin wX -> PatchSet rt p Origin wY -> IO ()
checkUnrelatedRepos Bool
allowUnrelatedRepos PatchSet rt p Origin wX
us PatchSet rt p Origin wY
them =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( Bool -> Bool
not Bool
allowUnrelatedRepos Bool -> Bool -> Bool
&& forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Commute p =>
PatchSet rt p Origin wX -> PatchSet rt p Origin wY -> Bool
areUnrelatedRepos PatchSet rt p Origin wX
us PatchSet rt p Origin wY
them ) forall a b. (a -> b) -> a -> b
$
         do Bool
confirmed <- [Char] -> IO Bool
promptYorn [Char]
"Repositories seem to be unrelated. Proceed?"
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Cancelled." forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. IO a
exitSuccess

-- | Get the union of the set of patches in each specified location
remotePatches :: (IsRepoType rt, RepoPatch p)
              => [DarcsFlag]
              -> Repository rt p wX wU wT -> [O.NotInRemote]
              -> IO (SealedPatchSet rt p Origin)
remotePatches :: forall (rt :: RepoType) (p :: * -> * -> *) wX wU wT.
(IsRepoType rt, RepoPatch p) =>
[DarcsFlag]
-> Repository rt p wX wU wT
-> [NotInRemote]
-> IO (SealedPatchSet rt p Origin)
remotePatches [DarcsFlag]
opts Repository rt p wX wU wT
repository [NotInRemote]
nirs = do
    [[Char]]
nirsPaths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM NotInRemote -> IO [Char]
getNotInRemotePath [NotInRemote]
nirs
    [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$
      Doc
"Determining patches not in" Doc -> Doc -> Doc
<+>
      [[Char]] -> Doc
anyOfClause [[Char]]
nirsPaths Doc -> Doc -> Doc
$$ Int -> [[Char]] -> Doc
itemizeVertical Int
2 [[Char]]
nirsPaths
    forall (p :: * -> * -> *) (rt :: RepoType).
(Commute p, Merge p, Eq2 p) =>
[SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin
patchSetUnion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (SealedPatchSet rt p Origin)
readNir [[Char]]
nirsPaths
  where
    readNir :: [Char] -> IO (SealedPatchSet rt p Origin)
readNir [Char]
n = do
        Repository rt p Any Any Any
r <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT vR vU vT.
ReadingOrWriting
-> Repository rt p wR wU wT
-> UseCache
-> [Char]
-> IO (Repository rt p vR vU vT)
identifyRepositoryFor ReadingOrWriting
Reading Repository rt p wX wU wT
repository (PrimDarcsOption UseCache
O.useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) [Char]
n
        PatchSet rt p Origin Any
rps <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p Any Any Any
r
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wX. a wX -> Sealed a
Sealed PatchSet rt p Origin Any
rps)

    getNotInRemotePath :: O.NotInRemote -> IO String
    getNotInRemotePath :: NotInRemote -> IO [Char]
getNotInRemotePath (O.NotInRemotePath [Char]
p) = forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
p
    getNotInRemotePath NotInRemote
O.NotInDefaultRepo = do
        Maybe [Char]
defaultRepo <- IO (Maybe [Char])
getDefaultRepo
        let err :: IO a
err = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"No default push/pull repo configured, please pass a "
                         forall a. [a] -> [a] -> [a]
++ [Char]
"repo name to --" forall a. [a] -> [a] -> [a]
++ [Char]
O.notInRemoteFlagName
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. IO a
err forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
defaultRepo

getLastPatches :: RepoPatch p
               => [O.MatchFlag] -> PatchSet rt p Origin wR
               -> (PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin wR
getLastPatches :: forall (p :: * -> * -> *) (rt :: RepoType) wR.
RepoPatch p =>
[MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
getLastPatches [MatchFlag]
matchFlags PatchSet rt p Origin wR
ps =
  case forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p wStart wX -> Maybe (SealedPatchSet rt p wStart)
matchFirstPatchset [MatchFlag]
matchFlags PatchSet rt p Origin wR
ps of
    Just (Sealed PatchSet rt p Origin wX
p1s) -> forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Commute p =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
findCommonWithThem PatchSet rt p Origin wR
ps PatchSet rt p Origin wX
p1s
    Maybe (SealedPatchSet rt p Origin)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"precondition: getLastPatches requires a firstMatch"

preselectPatches
  :: (IsRepoType rt, RepoPatch p)
  => [DarcsFlag]
  -> Repository rt p wR wU wT
  -> IO ((PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin wR)
preselectPatches :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
[DarcsFlag]
-> Repository rt p wR wU wT
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR)
preselectPatches [DarcsFlag]
opts Repository rt p wR wU wT
repo = do
  PatchSet rt p Origin wR
allpatches <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
repo
  let matchFlags :: [MatchFlag]
matchFlags = MatchOption
O.matchSeveralOrLast forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
  case PrimDarcsOption [NotInRemote]
O.notInRemote forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
    [] -> do
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        if [MatchFlag] -> Bool
firstMatch [MatchFlag]
matchFlags
          then forall (p :: * -> * -> *) (rt :: RepoType) wR.
RepoPatch p =>
[MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
getLastPatches [MatchFlag]
matchFlags PatchSet rt p Origin wR
allpatches
          else forall (rt :: RepoType) (p :: * -> * -> *) wR.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
matchingHead [MatchFlag]
matchFlags PatchSet rt p Origin wR
allpatches
    -- FIXME what about match options when we have --not-in-remote?
    -- It looks like they are simply ignored.
    [NotInRemote]
nirs -> do
      (Sealed PatchSet rt p Origin wX
thems) <-
        forall (rt :: RepoType) (p :: * -> * -> *) wX wU wT.
(IsRepoType rt, RepoPatch p) =>
[DarcsFlag]
-> Repository rt p wX wU wT
-> [NotInRemote]
-> IO (SealedPatchSet rt p Origin)
remotePatches [DarcsFlag]
opts Repository rt p wR wU wT
repo [NotInRemote]
nirs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Commute p =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
findCommonWithThem PatchSet rt p Origin wR
allpatches PatchSet rt p Origin wX
thems

matchRange :: MatchableRP p
           => [MatchFlag]
           -> PatchSet rt p Origin wY
           -> Sealed2 (FL (PatchInfoAnd rt p))
matchRange :: forall (p :: * -> * -> *) (rt :: RepoType) wY.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p Origin wY -> Sealed2 (FL (PatchInfoAnd rt p))
matchRange [MatchFlag]
matchFlags PatchSet rt p Origin wY
ps =
  case (Sealed (PatchSet rt p Origin)
sp1s, Sealed (PatchSet rt p Origin)
sp2s) of
    (Sealed PatchSet rt p Origin wX
p1s, Sealed PatchSet rt p Origin wX
p2s) ->
      case forall (p :: * -> * -> *) (rt :: RepoType) wX wY.
Commute p =>
PatchSet rt p Origin wX
-> PatchSet rt p Origin wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
findCommonWithThem PatchSet rt p Origin wX
p2s PatchSet rt p Origin wX
p1s of
        PatchSet rt p Origin wZ
_ :> FL (PatchInfoAnd rt p) wZ wX
us -> forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 FL (PatchInfoAnd rt p) wZ wX
us
  where
    sp1s :: Sealed (PatchSet rt p Origin)
sp1s = forall a. a -> Maybe a -> a
fromMaybe (forall (a :: * -> *) wX. a wX -> Sealed a
Sealed forall (rt :: RepoType) (p :: * -> * -> *).
PatchSet rt p Origin Origin
emptyPatchSet) forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p wStart wX -> Maybe (SealedPatchSet rt p wStart)
matchFirstPatchset [MatchFlag]
matchFlags PatchSet rt p Origin wY
ps
    sp2s :: Sealed (PatchSet rt p Origin)
sp2s = forall a. a -> Maybe a -> a
fromMaybe (forall (a :: * -> *) wX. a wX -> Sealed a
Sealed PatchSet rt p Origin wY
ps) forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet rt p wStart wX -> Maybe (SealedPatchSet rt p wStart)
matchSecondPatchset [MatchFlag]
matchFlags PatchSet rt p Origin wY
ps

historyEditHelp :: Doc
historyEditHelp :: Doc
historyEditHelp = [[Char]] -> Doc
formatWords
  [ [Char]
"Note that this command edits the history of your repo. It is"
  , [Char]
"primarily intended to be used on patches that you authored yourself"
  , [Char]
"and did not yet publish. Using it for patches that are already"
  , [Char]
"published, or even ones you did not author yourself, may cause"
  , [Char]
"confusion and can disrupt your own and other people's work-flow."
  , [Char]
"This depends a lot on how your project is organized, though, so"
  , [Char]
"there may be valid exceptions to this rule."
  ]
  Doc -> Doc -> Doc
$+$ [[Char]] -> Doc
formatWords
  [ [Char]
"Using the `--not-in-remote` option is a good way to guard against"
  , [Char]
"accidentally editing published patches. Without arguments, this"
  , [Char]
"deselects any patches that are also present in the `defaultrepo`."
  , [Char]
"If you work in a clone of some publically hosted repository,"
  , [Char]
"then your `defaultrepo` will be that public repo. You can also"
  , [Char]
"give the option an argument which is a path or URL of some other"
  , [Char]
"repository; you can use the option multiple times with"
  , [Char]
"different repositories, which has the effect of treating all"
  , [Char]
"of them as \"upstream\", that is, it prevents you from selecting"
  , [Char]
"a patch that is contained in any of these repos."
  ]
  Doc -> Doc -> Doc
$+$ [[Char]] -> Doc
formatWords
  [ [Char]
"You can also guard only against editing another developer's patch"
  , [Char]
"by using an appropriate `--match` option with the `author` keyword."
  , [Char]
"For instance, you could add something like `<cmd> match Your Name`"
  , [Char]
"to your `" forall a. [a] -> [a] -> [a]
++ [Char]
globalPrefsDirDoc forall a. [a] -> [a] -> [a]
++ [Char]
"defaults`."
  ]