--  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] -> String -> IO ()
announceFiles Verbosity
Quiet Maybe [AnchoredPath]
_ String
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
announceFiles Verbosity
_ (Just [AnchoredPath]
paths) String
message = Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> Doc
text String
message Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> [String] -> Doc
pathlist ((AnchoredPath -> String) -> [AnchoredPath] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> String
displayPath [AnchoredPath]
paths)
announceFiles Verbosity
_ Maybe [AnchoredPath]
_ String
_ = () -> IO ()
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 :: Repository rt p wR wU wT
-> Verbosity
-> TestChanges
-> SetScriptsExecutable
-> Bool
-> String
-> String
-> Maybe String
-> IO ()
testTentativeAndMaybeExit Repository rt p wR wU wT
repo Verbosity
verb TestChanges
test SetScriptsExecutable
sse Bool
interactive String
failMessage String
confirmMsg Maybe String
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 <- Repository rt p wR wU wT
-> RunTest
-> LeaveTestDir
-> SetScriptsExecutable
-> Verbosity
-> IO ExitCode
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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
testResult ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let doExit :: IO a
doExit = (IO a -> IO a)
-> (String -> IO a -> IO a) -> Maybe String -> IO a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO a -> IO a
forall a. a -> a
id ((IO a -> String -> IO a) -> String -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO a -> String -> IO a
forall a. IO a -> String -> IO a
clarifyErrors) Maybe String
withClarification (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
                        ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
testResult
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
interactive IO ()
forall a. IO a
doExit
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Looks like " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
failMessage
        let prompt :: String
prompt = String
"Shall I " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
confirmMsg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" anyway?"
        Char
yn <- PromptConfig -> IO Char
promptChar (String -> String -> String -> Maybe Char -> String -> PromptConfig
PromptConfig String
prompt String
"yn" [] (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'n') [])
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char
yn Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'y') IO ()
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 :: String
-> Verbosity
-> WithSummary
-> DryRun
-> XmlOutput
-> Bool
-> FL (PatchInfoAnd rt p) wX wY
-> IO ()
printDryRunMessageAndExit String
action Verbosity
v WithSummary
s DryRun
d XmlOutput
x Bool
interactive FL (PatchInfoAnd rt p) wX wY
patches = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DryRun
d DryRun -> DryRun -> Bool
forall a. Eq a => a -> a -> Bool
== DryRun
YesDryRun) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Doc -> IO ()
putInfoX (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [ Doc
"Would", String -> Doc
text String
action, Doc
"the following changes:" ]
        Printers -> Doc -> IO ()
putDocLnWith Printers
fancyPrinters Doc
put_mode
        Doc -> IO ()
putInfoX (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
""
        Doc -> IO ()
putInfoX (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Making no changes: this is a dry run."
        IO ()
forall a. IO a
exitSuccess
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
interactive Bool -> Bool -> Bool
&& WithSummary
s WithSummary -> WithSummary -> Bool
forall a. Eq a => a -> a -> Bool
== WithSummary
YesSummary) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Doc -> IO ()
putInfoX (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [ Doc
"Will", String -> Doc
text String
action, Doc
"the following changes:" ]
        Doc -> IO ()
putDocLn Doc
put_mode
  where
    put_mode :: Doc
put_mode = if XmlOutput
x XmlOutput -> XmlOutput -> Bool
forall a. Eq a => a -> a -> Bool
== XmlOutput
YesXml
                   then String -> Doc
text String
"<patches>" Doc -> Doc -> Doc
$$
                        [Doc] -> Doc
vcat ((forall wW wZ. PatchInfoAnd rt p wW wZ -> Doc)
-> FL (PatchInfoAnd rt p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (Doc -> Doc
indent (Doc -> Doc)
-> (PatchInfoAndG rt (Named p) wW wZ -> Doc)
-> PatchInfoAndG rt (Named p) wW wZ
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithSummary -> PatchInfoAndG rt (Named p) wW wZ -> Doc
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
$$
                        String -> Doc
text String
"</patches>"
                   else [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. PatchInfoAnd rt p wW wZ -> Doc)
-> FL (PatchInfoAnd rt p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (Verbosity -> WithSummary -> PatchInfoAnd rt p wW wZ -> Doc
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 XmlOutput -> XmlOutput -> Bool
forall a. Eq a => a -> a -> Bool
== XmlOutput
YesXml then IO () -> Doc -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
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 = PatchInfoAndG rt p wA wB -> Doc
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 (PatchInfo -> Doc)
-> (PatchInfoAndG rt p wA wB -> PatchInfo)
-> PatchInfoAndG rt p wA wB
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG rt p wA wB -> PatchInfo
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 <- PatchInfoAndG rt p wA wB -> Maybe (p wA wB)
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 (PatchInfo -> Doc) -> PatchInfo -> Doc
forall a b. (a -> b) -> a -> b
$ PatchInfoAndG rt p wA wB -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wA wB
hp)
                                        (Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ p wA wB -> Doc
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 (PatchInfoAndG rt p wA wB -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wA wB
hp)

    indent :: Doc -> Doc
indent = String -> Doc -> Doc
prefix String
"    "

-- | 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 :: 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 <- Repository rt p wR wU wR -> IO (Tree IO)
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 <- Repository rt p wR wU wR
-> UseIndex
-> ScanKnown
-> LookForMoves
-> Maybe [AnchoredPath]
-> IO (Tree IO)
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 ([AnchoredPath] -> Maybe [AnchoredPath]
forall a. a -> Maybe a
Just [AnchoredPath]
paths)
      let check :: Tree IO -> IO ([Bool], Tree IO)
check = TreeIO [Bool] -> Tree IO -> IO ([Bool], Tree IO)
forall a. TreeIO a -> Tree IO -> IO (a, Tree IO)
virtualTreeIO (TreeIO [Bool] -> Tree IO -> IO ([Bool], Tree IO))
-> TreeIO [Bool] -> Tree IO -> IO ([Bool], Tree IO)
forall a b. (a -> b) -> a -> b
$ (AnchoredPath -> RWST (TreeEnv IO) () (TreeState IO) IO Bool)
-> [AnchoredPath] -> TreeIO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnchoredPath -> RWST (TreeEnv IO) () (TreeState IO) IO Bool
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       = [AnchoredPath] -> [Bool] -> [Bool] -> [(AnchoredPath, Bool, Bool)]
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 ScanKnown -> ScanKnown -> Bool
forall a. Eq a => a -> a -> Bool
== ScanKnown
ScanKnown then Doc
" or not added " else Doc
" "
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet Bool -> Bool -> Bool
|| [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
paths_in_neither) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
        Doc
"Ignoring non-existing" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
or_not_added Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"paths:" Doc -> Doc -> Doc
<+>
        [String] -> Doc
pathlist ((AnchoredPath -> String) -> [AnchoredPath] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AnchoredPath -> String
displayPath [AnchoredPath]
paths_in_neither)
      ([AnchoredPath], [AnchoredPath])
-> IO ([AnchoredPath], [AnchoredPath])
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 -> String -> IO String
getUniqueRepositoryName Bool
talkative String
name = Bool -> (String -> String) -> (Int -> String) -> IO String
getUniquePathName Bool
talkative String -> String
buildMsg Int -> String
forall a. (Eq a, Num a, Show a) => a -> String
buildName
  where
    buildName :: a -> String
buildName a
i = if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1 then String
name else String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"_"String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
show a
i
    buildMsg :: String -> String
buildMsg String
n = String
"Directory or file '"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 String
"' already exists, creating repository as '"String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"

getUniqueDPatchName :: FilePath -> IO FilePath
getUniqueDPatchName :: String -> IO String
getUniqueDPatchName String
name = Bool -> (String -> String) -> (Int -> String) -> IO String
getUniquePathName Bool
False (String -> String -> String
forall a b. a -> b -> a
const String
"") Int -> String
forall a. (Eq a, Num a, Show a) => a -> String
buildName
  where
    buildName :: a -> String
buildName a
i =
      if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1 then String -> String
patchFilename String
name else String -> String
patchFilename (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"_"String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
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 :: String -> String
patchFilename String
the_summary = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".dpatch"
  where
    name :: String
name = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
safeFileChar String
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 :: String -> IO Bool
doesDirectoryReallyExist String
f = Bool -> (FileStatus -> Bool) -> Maybe FileStatus -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False FileStatus -> Bool
isDirectory (Maybe FileStatus -> Bool) -> IO (Maybe FileStatus) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO (Maybe FileStatus)
getFileStatus String
f

checkUnrelatedRepos :: RepoPatch p
                    => Bool
                    -> PatchSet rt p Origin wX
                    -> PatchSet rt p Origin wY
                    -> IO ()
checkUnrelatedRepos :: 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 =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( Bool -> Bool
not Bool
allowUnrelatedRepos Bool -> Bool -> Bool
&& PatchSet rt p Origin wX -> PatchSet rt p Origin wY -> 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 ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         do Bool
confirmed <- String -> IO Bool
promptYorn String
"Repositories seem to be unrelated. Proceed?"
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
confirmed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Cancelled." IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
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 :: [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
    [String]
nirsPaths <- (NotInRemote -> IO String) -> [NotInRemote] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM NotInRemote -> IO String
getNotInRemotePath [NotInRemote]
nirs
    [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
      Doc
"Determining patches not in" Doc -> Doc -> Doc
<+>
      [String] -> Doc
anyOfClause [String]
nirsPaths Doc -> Doc -> Doc
$$ Int -> [String] -> Doc
itemizeVertical Int
2 [String]
nirsPaths
    [SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin
forall (p :: * -> * -> *) (rt :: RepoType).
(Commute p, Merge p, Eq2 p) =>
[SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin
patchSetUnion ([SealedPatchSet rt p Origin] -> SealedPatchSet rt p Origin)
-> IO [SealedPatchSet rt p Origin]
-> IO (SealedPatchSet rt p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> IO (SealedPatchSet rt p Origin))
-> [String] -> IO [SealedPatchSet rt p Origin]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (SealedPatchSet rt p Origin)
readNir [String]
nirsPaths
  where
    readNir :: String -> IO (SealedPatchSet rt p Origin)
readNir String
n = do
        Repository rt p Any Any Any
r <- ReadingOrWriting
-> Repository rt p wX wU wT
-> UseCache
-> String
-> IO (Repository rt p Any Any Any)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT vR vU vT.
ReadingOrWriting
-> Repository rt p wR wU wT
-> UseCache
-> String
-> IO (Repository rt p vR vU vT)
identifyRepositoryFor ReadingOrWriting
Reading Repository rt p wX wU wT
repository (PrimDarcsOption UseCache
O.useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
n
        PatchSet rt p Origin Any
rps <- 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 Repository rt p Any Any Any
r
        SealedPatchSet rt p Origin -> IO (SealedPatchSet rt p Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchSet rt p Origin Any -> SealedPatchSet rt p Origin
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed PatchSet rt p Origin Any
rps)

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

getLastPatches :: RepoPatch p
               => [O.MatchFlag] -> PatchSet rt p Origin wR
               -> (PatchSet rt p :> FL (PatchInfoAnd rt p)) Origin wR
getLastPatches :: [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 [MatchFlag]
-> PatchSet rt p Origin wR -> Maybe (SealedPatchSet rt p Origin)
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) -> PatchSet rt p Origin wR
-> PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
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 -> String -> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
forall a. HasCallStack => String -> a
error String
"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 :: [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 <- 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
repo
  let matchFlags :: [MatchFlag]
matchFlags = MatchOption
O.matchSeveralOrLast MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts
  case PrimDarcsOption [NotInRemote]
O.notInRemote PrimDarcsOption [NotInRemote] -> [DarcsFlag] -> [NotInRemote]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
    [] -> do
      (:>) (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
$
        if [MatchFlag] -> Bool
firstMatch [MatchFlag]
matchFlags
          then [MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
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 [MatchFlag]
-> PatchSet rt p Origin wR
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
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) <-
        [DarcsFlag]
-> Repository rt p wR wU wT
-> [NotInRemote]
-> IO (Sealed (PatchSet rt p Origin))
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
      (:>) (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 wX
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wR
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 :: [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 PatchSet rt p Origin wX
-> PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
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 -> FL (PatchInfoAnd rt p) wZ wX -> Sealed2 (FL (PatchInfoAnd rt p))
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 = Sealed (PatchSet rt p Origin)
-> Maybe (Sealed (PatchSet rt p Origin))
-> Sealed (PatchSet rt p Origin)
forall a. a -> Maybe a -> a
fromMaybe (PatchSet rt p Origin Origin -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed PatchSet rt p Origin Origin
forall (rt :: RepoType) (p :: * -> * -> *).
PatchSet rt p Origin Origin
emptyPatchSet) (Maybe (Sealed (PatchSet rt p Origin))
 -> Sealed (PatchSet rt p Origin))
-> Maybe (Sealed (PatchSet rt p Origin))
-> Sealed (PatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ [MatchFlag]
-> PatchSet rt p Origin wY -> Maybe (Sealed (PatchSet rt p Origin))
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 = Sealed (PatchSet rt p Origin)
-> Maybe (Sealed (PatchSet rt p Origin))
-> Sealed (PatchSet rt p Origin)
forall a. a -> Maybe a -> a
fromMaybe (PatchSet rt p Origin wY -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed PatchSet rt p Origin wY
ps) (Maybe (Sealed (PatchSet rt p Origin))
 -> Sealed (PatchSet rt p Origin))
-> Maybe (Sealed (PatchSet rt p Origin))
-> Sealed (PatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ [MatchFlag]
-> PatchSet rt p Origin wY -> Maybe (Sealed (PatchSet rt p Origin))
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 = [String] -> Doc
formatWords
  [ String
"Note that this command edits the history of your repo. It is"
  , String
"primarily intended to be used on patches that you authored yourself"
  , String
"and did not yet publish. Using it for patches that are already"
  , String
"published, or even ones you did not author yourself, may cause"
  , String
"confusion and can disrupt your own and other people's work-flow."
  , String
"This depends a lot on how your project is organized, though, so"
  , String
"there may be valid exceptions to this rule."
  ]
  Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"Using the `--not-in-remote` option is a good way to guard against"
  , String
"accidentally editing published patches. Without arguments, this"
  , String
"deselects any patches that are also present in the `defaultrepo`."
  , String
"If you work in a clone of some publically hosted repository,"
  , String
"then your `defaultrepo` will be that public repo. You can also"
  , String
"give the option an argument which is a path or URL of some other"
  , String
"repository; you can use the option multiple times with"
  , String
"different repositories, which has the effect of treating all"
  , String
"of them as \"upstream\", that is, it prevents you from selecting"
  , String
"a patch that is contained in any of these repos."
  ]
  Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"You can also guard only against editing another developer's patch"
  , String
"by using an appropriate `--match` option with the `author` keyword."
  , String
"For instance, you could add something like `<cmd> match Your Name`"
  , String
"to your `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"defaults`."
  ]