module Darcs.UI.Commands.Diff ( diffCommand ) where
import Darcs.Prelude hiding ( all )
import Control.Monad ( unless, when )
import Data.Maybe ( fromMaybe )
import Data.Maybe ( isJust )
import System.Directory ( createDirectory, findExecutable, withCurrentDirectory )
import System.FilePath.Posix ( takeFileName, (</>) )
import System.IO ( hFlush, stdout )
import Darcs.Patch ( listTouchedFiles )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Depends ( findCommonWithThem )
import Darcs.Patch.Info ( displayPatchInfo )
import Darcs.Patch.Match ( matchFirstPatchset, matchSecondPatchset, secondMatch )
import Darcs.Patch.Named ( anonymous )
import Darcs.Patch.PatchInfoAnd ( info, n2pia )
import Darcs.Patch.Set ( patchSetSnoc )
import Darcs.Patch.Witnesses.Ordered ( (:>)(..), mapFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal )
import Darcs.Repository ( RepoJob(..), readPatches, withRepository )
import Darcs.Repository.State
( applyTreeFilter
, readPristine
, restrictSubpaths
, unrecordedChanges
)
import Darcs.UI.Commands
( DarcsCommand(..)
, amInHashedRepository
, nodefaults
, withStdOpts
)
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.External ( diffProgram )
import Darcs.UI.Flags ( DarcsFlag, diffingOpts, pathSetFromArgs, useCache, wantGuiPause )
import Darcs.UI.Options ( parseFlags, (?), (^) )
import qualified Darcs.UI.Options.All as O
import Darcs.Util.Cache ( mkDirCache )
import Darcs.Util.CommandLine ( parseCmd )
import Darcs.Util.Exec ( execInteractive )
import Darcs.Util.Global ( debugMessage )
import Darcs.Util.Lock ( withTempDir )
import Darcs.Util.Path ( AbsolutePath, AnchoredPath, isPrefix, toFilePath )
import Darcs.Util.Printer ( Doc, putDocLn, text, vcat )
import Darcs.Util.Prompt ( askEnter )
import Darcs.Util.Tree.Hashed ( hashedTreeIO, writeDarcsHashed )
import Darcs.Util.Tree.Plain ( writePlainTree )
import Darcs.Util.Workaround ( getCurrentDirectory )
diffDescription :: String
diffDescription :: String
diffDescription = String
"Create a diff between two versions of the repository."
diffHelp :: Doc
diffHelp :: Doc
diffHelp = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
String
"The `darcs diff` command compares two versions of the working tree of\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"the current repository. Without options, the pristine (recorded) and\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"unrecorded working trees are compared. This is lower-level than\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"the `darcs whatsnew` command, since it outputs a line-by-line diff,\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"and it is also slower. As with `darcs whatsnew`, if you specify\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"files or directories, changes to other files are not listed.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"The command always uses an external diff utility.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"With the `--patch` option, the comparison will be made between working\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"trees with and without that patch. Patches *after* the selected patch\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"are not present in either of the compared working trees. The\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"`--from-patch` and `--to-patch` options allow the set of patches in the\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"`old' and `new' working trees to be specified separately.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"The associated tag and match options are also understood, e.g. `darcs\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"diff --from-tag 1.0 --to-tag 1.1`. All these options assume an\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"ordering of the patch set, so results may be affected by operations\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"such as `darcs optimize reorder`.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"diff(1) is always called with the arguments `-rN` and by default also\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"with `-u` to show the differences in unified format. This can be turned\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"off by passing `--no-unified`. An additional argument can be passed\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"using `--diff-opts`, such as `--diff-opts=-ud` or `--diff-opts=-wU9`.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"The `--diff-command` option can be used to specify an alternative\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"utility. Arguments may be included, separated by whitespace. The value\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"is not interpreted by a shell, so shell constructs cannot be used. The\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"arguments %1 and %2 MUST be included, these are substituted for the two\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"working trees being compared. For instance:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" darcs diff -p . --diff-command \"meld %1 %2\"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"If this option is used, `--diff-opts` is ignored.\n"
diffCommand :: DarcsCommand
diffCommand :: DarcsCommand
diffCommand = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"diff"
, commandHelp :: Doc
commandHelp = Doc
diffHelp
, commandDescription :: String
commandDescription = String
diffDescription
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"[FILE or DIRECTORY]..."]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
diffCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
amInHashedRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandOptions :: CommandOptions
commandOptions = DarcsOption
(Maybe StdCmdAction
-> Verbosity
-> WantGuiPause
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> Bool
-> Maybe StdCmdAction
-> Verbosity
-> WantGuiPause
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
-> DarcsOption
(UseCache
-> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
(WantGuiPause
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache
-> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
b
-> CommandOptions
withStdOpts DarcsOption
(Maybe StdCmdAction
-> Verbosity
-> WantGuiPause
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> Bool
-> Maybe StdCmdAction
-> Verbosity
-> WantGuiPause
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> Bool
-> a)
diffBasicOpts DarcsOption
(UseCache
-> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
(WantGuiPause
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a WantGuiPause
diffAdvancedOpts
}
where
diffBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> Bool
-> a)
diffBasicOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
(ExternalDiff
-> LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
[MatchFlag]
MatchOption
O.matchOneOrRange
PrimOptSpec
DarcsOptDescr
DarcsFlag
(ExternalDiff
-> LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
[MatchFlag]
-> OptSpec
DarcsOptDescr
DarcsFlag
(LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
(ExternalDiff
-> LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> 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
(LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
(ExternalDiff
-> LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
PrimDarcsOption ExternalDiff
O.extDiff
OptSpec
DarcsOptDescr
DarcsFlag
(LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> Bool
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(LookForMoves -> Maybe String -> Bool -> a)
(LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(LookForMoves -> Maybe String -> Bool -> a)
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> 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
(LookForMoves -> Maybe String -> Bool -> a)
(LookForAdds -> LookForMoves -> Maybe String -> Bool -> a)
PrimDarcsOption LookForAdds
O.lookforadds
OptSpec
DarcsOptDescr
DarcsFlag
(LookForMoves -> Maybe String -> Bool -> a)
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> Bool
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> Bool -> a)
(LookForMoves -> Maybe String -> Bool -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> Bool -> a)
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> 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 -> Bool -> a)
(LookForMoves -> Maybe String -> Bool -> a)
PrimDarcsOption LookForMoves
O.lookformoves
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> Bool -> a)
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> Bool
-> a)
-> OptSpec
DarcsOptDescr DarcsFlag (Bool -> a) (Maybe String -> Bool -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> a)
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> 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 String -> Bool -> a)
PrimDarcsOption (Maybe String)
O.repoDir
OptSpec
DarcsOptDescr
DarcsFlag
(Bool -> a)
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> Bool
-> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
([MatchFlag]
-> ExternalDiff
-> LookForAdds
-> LookForMoves
-> Maybe String
-> 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.storeInMemory
diffAdvancedOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a WantGuiPause
diffAdvancedOpts = PrimOptSpec DarcsOptDescr DarcsFlag a WantGuiPause
forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a WantGuiPause
O.pauseForGui
diffCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
diffCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
diffCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [String]
args
| Bool -> Bool
not ([MatchFlag] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchLast MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)) Bool -> Bool -> Bool
&&
Bool -> Bool
not ([MatchFlag] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchFrom MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)) =
String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"using --patch and --last at the same time with the 'diff'" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" command doesn't make sense. Use --from-patch to create a diff" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" from this patch to the present, or use just '--patch' to view" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" this specific patch."
| Bool
otherwise = [DarcsFlag] -> Maybe [AnchoredPath] -> IO ()
doDiff [DarcsFlag]
opts (Maybe [AnchoredPath] -> IO ())
-> IO (Maybe [AnchoredPath]) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (AbsolutePath, AbsolutePath)
-> [String] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [String]
args
doDiff :: [DarcsFlag] -> Maybe [AnchoredPath] -> IO ()
doDiff :: [DarcsFlag] -> Maybe [AnchoredPath] -> IO ()
doDiff [DarcsFlag]
opts Maybe [AnchoredPath]
mpaths = UseCache -> RepoJob 'RO () -> IO ()
forall a. UseCache -> RepoJob 'RO a -> IO a
withRepository (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RO () -> IO ()) -> RepoJob 'RO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO () -> RepoJob 'RO ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO () -> RepoJob 'RO ())
-> TreePatchJob 'RO () -> RepoJob 'RO ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RO p wU wR
repository -> do
PatchSet p Origin wR
patchset <- Repository 'RO p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository 'RO p wU wR
repository
String -> IO ()
debugMessage String
"After readPatches"
FL (PrimOf p) wR wU
unrecorded <- DiffOpts
-> Repository 'RO p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffOpts
-> Repository rt p wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges ([DarcsFlag] -> DiffOpts
diffingOpts [DarcsFlag]
opts) Repository 'RO p wU wR
repository Maybe [AnchoredPath]
mpaths
String -> IO ()
debugMessage String
"After getting the unrecorded changes"
PatchInfoAndG (Named p) wR wU
unrecorded' <- Named p wR wU -> PatchInfoAndG (Named p) wR wU
forall (p :: * -> * -> *) wX wY.
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG p wX wY
n2pia (Named p wR wU -> PatchInfoAndG (Named p) wR wU)
-> IO (Named p wR wU) -> IO (PatchInfoAndG (Named p) wR wU)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FL (PrimOf p) wR wU -> IO (Named p wR wU)
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
FL (PrimOf p) wX wY -> IO (Named p wX wY)
anonymous FL (PrimOf p) wR wU
unrecorded
let matchFlags :: [MatchFlag]
matchFlags = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchOneOrRange [DarcsFlag]
opts
Sealed PatchSet p Origin wX
all <- Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin)))
-> Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a b. (a -> b) -> a -> b
$
if [MatchFlag] -> Bool
secondMatch [MatchFlag]
matchFlags
then PatchSet p Origin wR -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet p Origin wR
patchset
else PatchSet p Origin wU -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet p Origin wU -> Sealed (PatchSet p Origin))
-> PatchSet p Origin wU -> Sealed (PatchSet p Origin)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wR
-> PatchInfoAndG (Named p) wR wU -> PatchSet p Origin wU
forall (p :: * -> * -> *) wX wY wZ.
PatchSet p wX wY -> PatchInfoAnd p wY wZ -> PatchSet p wX wZ
patchSetSnoc PatchSet p Origin wR
patchset PatchInfoAndG (Named p) wR wU
unrecorded'
Sealed PatchSet p Origin wX
ctx <- Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin)))
-> Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a b. (a -> b) -> a -> b
$
Sealed (PatchSet p Origin)
-> Maybe (Sealed (PatchSet p Origin)) -> Sealed (PatchSet p Origin)
forall a. a -> Maybe a -> a
fromMaybe (PatchSet p Origin wR -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet p Origin wR
patchset) (Maybe (Sealed (PatchSet p Origin)) -> Sealed (PatchSet p Origin))
-> Maybe (Sealed (PatchSet p Origin)) -> Sealed (PatchSet p Origin)
forall a b. (a -> b) -> a -> b
$ [MatchFlag]
-> PatchSet p Origin wR -> Maybe (Sealed (PatchSet p Origin))
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet p wStart wX -> Maybe (SealedPatchSet p wStart)
matchFirstPatchset [MatchFlag]
matchFlags PatchSet p Origin wR
patchset
Sealed PatchSet p Origin wX
match <- Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin)))
-> Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a b. (a -> b) -> a -> b
$
Sealed (PatchSet p Origin)
-> Maybe (Sealed (PatchSet p Origin)) -> Sealed (PatchSet p Origin)
forall a. a -> Maybe a -> a
fromMaybe (PatchSet p Origin wX -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet p Origin wX
all) (Maybe (Sealed (PatchSet p Origin)) -> Sealed (PatchSet p Origin))
-> Maybe (Sealed (PatchSet p Origin)) -> Sealed (PatchSet p Origin)
forall a b. (a -> b) -> a -> b
$ [MatchFlag]
-> PatchSet p Origin wR -> Maybe (Sealed (PatchSet p Origin))
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
[MatchFlag]
-> PatchSet p wStart wX -> Maybe (SealedPatchSet p wStart)
matchSecondPatchset [MatchFlag]
matchFlags PatchSet p Origin wR
patchset
PatchSet p Origin wZ
_ :> FL (PatchInfoAnd p) wZ wX
todiff <- (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX))
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX
-> PatchSet p Origin wX
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
findCommonWithThem PatchSet p Origin wX
match PatchSet p Origin wX
ctx
PatchSet p Origin wZ
_ :> FL (PatchInfoAnd p) wZ wX
tounapply <- (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX))
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX
-> PatchSet p Origin wX
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
findCommonWithThem PatchSet p Origin wX
all PatchSet p Origin wX
match
Sealed PatchSet p Origin wX
logmatch <- Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin)))
-> Sealed (PatchSet p Origin) -> IO (Sealed (PatchSet p Origin))
forall a b. (a -> b) -> a -> b
$
if [MatchFlag] -> Bool
secondMatch [MatchFlag]
matchFlags
then PatchSet p Origin wX -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet p Origin wX
match
else PatchSet p Origin wR -> Sealed (PatchSet p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet p Origin wR
patchset
PatchSet p Origin wZ
_ :> FL (PatchInfoAnd p) wZ wX
tolog <- (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX))
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
-> IO ((:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX)
forall a b. (a -> b) -> a -> b
$ PatchSet p Origin wX
-> PatchSet p Origin wX
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchSet p Origin wX
-> PatchSet p Origin wY
-> (:>) (PatchSet p) (FL (PatchInfoAnd p)) Origin wX
findCommonWithThem PatchSet p Origin wX
logmatch PatchSet p Origin wX
ctx
let touched :: [AnchoredPath]
touched = FL (PatchInfoAnd p) wZ wX -> [AnchoredPath]
forall wX wY. FL (PatchInfoAnd p) wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (PatchInfoAnd p) wZ wX
todiff
files :: [AnchoredPath]
files = case Maybe [AnchoredPath]
mpaths of
Maybe [AnchoredPath]
Nothing -> [AnchoredPath]
touched
Just [AnchoredPath]
paths ->
(AnchoredPath -> [AnchoredPath])
-> [AnchoredPath] -> [AnchoredPath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\AnchoredPath
path -> (AnchoredPath -> Bool) -> [AnchoredPath] -> [AnchoredPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (AnchoredPath -> AnchoredPath -> Bool
isPrefix AnchoredPath
path) [AnchoredPath]
touched) [AnchoredPath]
paths
TreeFilter IO
relevant <- Repository 'RO p wU wR -> [AnchoredPath] -> IO (TreeFilter IO)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR (m :: * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> [AnchoredPath] -> IO (TreeFilter m)
restrictSubpaths Repository 'RO p wU wR
repository [AnchoredPath]
files
String
formerdir <- IO String
getCurrentDirectory
let thename :: String
thename = String -> String
takeFileName String
formerdir
String -> (AbsolutePath -> IO ()) -> IO ()
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir String
"darcs-diff" ((AbsolutePath -> IO ()) -> IO ())
-> (AbsolutePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
tmpdir -> do
IO String
getCurrentDirectory IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
debugMessage (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"doDiff: I am now in "String -> String -> String
forall a. [a] -> [a] -> [a]
++)
let tdir :: String
tdir = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
tmpdir
let odir :: String
odir = String
tdir String -> String -> String
</> (String
"old-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
thename)
String -> IO ()
createDirectory String
odir
let ndir :: String
ndir = String
tdir String -> String -> String
</> (String
"new-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
thename)
String -> IO ()
createDirectory String
ndir
String -> IO () -> IO ()
forall a. String -> IO a -> IO a
withCurrentDirectory String
formerdir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let cache :: Cache
cache = String -> Cache
mkDirCache String
tdir
Tree IO
pristine <- Repository 'RO p wU wR -> IO (Tree IO)
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO (Tree IO)
readPristine Repository 'RO p wU wR
repository
PristineHash
_ <- Tree IO -> Cache -> IO PristineHash
writeDarcsHashed Tree IO
pristine Cache
cache
Tree IO
base <- if [MatchFlag] -> Bool
secondMatch [MatchFlag]
matchFlags
then Tree IO -> IO (Tree IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Tree IO
pristine
else ((), Tree IO) -> Tree IO
forall a b. (a, b) -> b
snd (((), Tree IO) -> Tree IO) -> IO ((), Tree IO) -> IO (Tree IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeIO () -> Tree IO -> Cache -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> Cache -> IO (a, Tree IO)
hashedTreeIO (PatchInfoAndG (Named p) wR wU -> TreeIO ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PatchInfoAnd p)) m =>
PatchInfoAndG (Named p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply PatchInfoAndG (Named p) wR wU
unrecorded') Tree IO
pristine Cache
cache
Tree IO
newtree <- ((), Tree IO) -> Tree IO
forall a b. (a, b) -> b
snd (((), Tree IO) -> Tree IO) -> IO ((), Tree IO) -> IO (Tree IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeIO () -> Tree IO -> Cache -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> Cache -> IO (a, Tree IO)
hashedTreeIO (FL (PatchInfoAnd p) wZ wX -> TreeIO ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL (PatchInfoAnd p))) m =>
FL (PatchInfoAnd p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply FL (PatchInfoAnd p) wZ wX
tounapply) Tree IO
base Cache
cache
Tree IO
oldtree <- ((), Tree IO) -> Tree IO
forall a b. (a, b) -> b
snd (((), Tree IO) -> Tree IO) -> IO ((), Tree IO) -> IO (Tree IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeIO () -> Tree IO -> Cache -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> Cache -> IO (a, Tree IO)
hashedTreeIO (FL (PatchInfoAnd p) wZ wX -> TreeIO ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL (PatchInfoAnd p))) m =>
FL (PatchInfoAnd p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply FL (PatchInfoAnd p) wZ wX
todiff) Tree IO
newtree Cache
cache
Tree IO -> String -> IO ()
writePlainTree (TreeFilter IO
-> forall (tr :: (* -> *) -> *). FilterTree tr IO => tr IO -> tr IO
forall (m :: * -> *).
TreeFilter m
-> forall (tr :: (* -> *) -> *). FilterTree tr m => tr m -> tr m
applyTreeFilter TreeFilter IO
relevant Tree IO
oldtree) (String -> String
forall a. FilePathLike a => a -> String
toFilePath String
odir)
Tree IO -> String -> IO ()
writePlainTree (TreeFilter IO
-> forall (tr :: (* -> *) -> *). FilterTree tr IO => tr IO -> tr IO
forall (m :: * -> *).
TreeFilter m
-> forall (tr :: (* -> *) -> *). FilterTree tr m => tr m -> tr m
applyTreeFilter TreeFilter IO
relevant Tree IO
newtree) (String -> String
forall a. FilePathLike a => a -> String
toFilePath String
ndir)
Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (PatchInfo -> Doc) -> [PatchInfo] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map PatchInfo -> Doc
displayPatchInfo ([PatchInfo] -> [Doc]) -> [PatchInfo] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [PatchInfo] -> [PatchInfo]
forall a. [a] -> [a]
reverse ([PatchInfo] -> [PatchInfo]) -> [PatchInfo] -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo)
-> FL (PatchInfoAnd p) wZ wX -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL PatchInfoAndG (Named p) wW wZ -> PatchInfo
forall wW wZ. PatchInfoAnd p wW wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info FL (PatchInfoAnd p) wZ wX
tolog
Handle -> IO ()
hFlush Handle
stdout
String
cmd <- IO String
diffProgram
let old :: String
old = String -> String
takeFileName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. FilePathLike a => a -> String
toFilePath String
odir
new :: String
new = String -> String
takeFileName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. FilePathLike a => a -> String
toFilePath String
ndir
case String
-> [DarcsFlag]
-> String
-> String
-> Either String (String, [String])
getDiffCmdAndArgs String
cmd [DarcsFlag]
opts String
old String
new of
Left String
err -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
Right (String
d_cmd, [String]
d_args) -> do
Maybe String
cmdExists <- String -> IO (Maybe String)
findExecutable String
d_cmd
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
cmdExists) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
d_cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not an executable in --diff-command"
let pausingForGui :: Bool
pausingForGui = ([DarcsFlag] -> WantGuiPause
wantGuiPause [DarcsFlag]
opts WantGuiPause -> WantGuiPause -> Bool
forall a. Eq a => a -> a -> Bool
== WantGuiPause
O.YesWantGuiPause)
cmdline :: String
cmdline = [String] -> String
unwords (String
d_cmd String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
d_args)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pausingForGui (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Running command '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdline String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
ExitCode
_ <- String -> Maybe String -> IO ExitCode
execInteractive String
cmdline Maybe String
forall a. Maybe a
Nothing
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pausingForGui (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
askEnter String
"Hit return to move on..."
getDiffCmdAndArgs :: String -> [DarcsFlag] -> String -> String
-> Either String (String, [String])
getDiffCmdAndArgs :: String
-> [DarcsFlag]
-> String
-> String
-> Either String (String, [String])
getDiffCmdAndArgs String
cmd [DarcsFlag]
opts String
f1 String
f2 = ExternalDiff -> Either String (String, [String])
helper (PrimOptSpec DarcsOptDescr DarcsFlag a ExternalDiff
PrimDarcsOption ExternalDiff
O.extDiff PrimDarcsOption ExternalDiff -> [DarcsFlag] -> ExternalDiff
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) where
helper :: ExternalDiff -> Either String (String, [String])
helper ExternalDiff
extDiff =
case ExternalDiff -> Maybe String
O.diffCmd ExternalDiff
extDiff of
Just String
c ->
case FTable -> String -> Either ParseError ([String], Bool)
parseCmd [ (Char
'1', String
f1) , (Char
'2', String
f2) ] String
c of
Left ParseError
err -> String -> Either String (String, [String])
forall a b. a -> Either a b
Left (String -> Either String (String, [String]))
-> String -> Either String (String, [String])
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
Right ([],Bool
_) -> String -> Either String (String, [String])
forall a. HasCallStack => String -> a
error String
"parseCmd should never return empty list"
Right (String
cmd':[String]
args,Bool
_)
| [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
f1) [String]
args) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
, [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
f2) [String]
args) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> (String, [String]) -> Either String (String, [String])
forall a b. b -> Either a b
Right (String
cmd',[String]
args)
| Bool
otherwise -> String -> Either String (String, [String])
forall a b. a -> Either a b
Left (String -> Either String (String, [String]))
-> String -> Either String (String, [String])
forall a b. (a -> b) -> a -> b
$ String
"Invalid argument (%1 or %2) in --diff-command"
Maybe String
Nothing ->
(String, [String]) -> Either String (String, [String])
forall a b. b -> Either a b
Right (String
cmd, String
"-rN"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:ExternalDiff -> [String]
getDiffOpts ExternalDiff
extDiff[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
f1,String
f2])
getDiffOpts :: O.ExternalDiff -> [String]
getDiffOpts :: ExternalDiff -> [String]
getDiffOpts O.ExternalDiff {diffOptions :: ExternalDiff -> [String]
O.diffOptions=[String]
os,diffUnified :: ExternalDiff -> Bool
O.diffUnified=Bool
u} = [String] -> [String]
addUnified [String]
os where
addUnified :: [String] -> [String]
addUnified = if Bool
u then (String
"-u"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall a. a -> a
id