--  Copyright (C) 2003-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.

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 <- 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
  debugMessage "After readPatches"
  -- We pass @mpaths@ here which means we get only the changes that affect the
  -- given paths (if any).
  unrecorded <- unrecordedChanges (diffingOpts opts) repository mpaths
  debugMessage "After getting the unrecorded changes"
  -- Use of 'anonymous' is unproblematic here as we don't store any patches.
  -- But we must take care not to show its fake patch info to the user.
  unrecorded' <- n2pia `fmap` anonymous unrecorded

  let 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

  -- If no secondMatch (--to-xxx) is specified, include unrecorded changes
  Sealed all <- return $
    if secondMatch matchFlags
      then seal patchset
      else seal $ patchSetSnoc patchset unrecorded'
  -- Note how this differs from how firstMatch defaults for log command
  Sealed ctx <- return $
    fromMaybe (seal patchset) $ matchFirstPatchset matchFlags patchset
  Sealed match <- return $
    fromMaybe (seal all) $ matchSecondPatchset matchFlags patchset

  _ :> todiff <- return $ findCommonWithThem match ctx
  _ :> tounapply <- return $ findCommonWithThem all match

  Sealed logmatch <- return $
    if secondMatch matchFlags
      then seal match
      else seal patchset
  -- Same as @todiff@ but without trailing @unrecorded'@ changes
  _ :> tolog <- return $ findCommonWithThem logmatch ctx

  let 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 = 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
  relevant <- restrictSubpaths repository files

  formerdir <- getCurrentDirectory
  let thename = String -> String
takeFileName String
formerdir
  withTempDir "darcs-diff" $ \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

      -- Prepare the (plain) trees we want to compare. Since we need to access
      -- our repository, we have to restore the working directory.
      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
        -- Make sure we have at least one writable cache entry
        -- to serve as our storage for hashed 'Tree' items
        -- during the 'apply' and 'unapply' operations below.
        let cache :: Cache
cache = String -> Cache
mkDirCache String
tdir
        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
        -- fill our temporary cache
        _ <- writeDarcsHashed pristine cache

        -- @base@ will be like our working tree, /except/ that it contains only
        -- the unrecorded changes that affect the given file paths, see comment
        -- above when we called 'unrecordedChanges'.
        base <- if secondMatch matchFlags
                 then return pristine
                 else snd <$> hashedTreeIO (apply unrecorded') pristine cache

        newtree <- snd <$> hashedTreeIO (unapply tounapply) base cache
        -- @todiff@ may have our @unrecorded'@ changes as its last element. If
        -- we used our full working tree as @base@, then we would now unapply
        -- filtered changes from an unfiltered 'Tree', so the result would be
        -- the pristine Tree with the filtered-out unrecorded changes /still
        -- applied/. Unapplying the (unfiltered) recorded changes that touch
        -- paths that we filtered out would then fail (issue2639).
        -- We cannot use 'readUnrecorded' and pass it @mpaths@ because that
        -- would filter the whole Tree, so again unapplying recorded changes
        -- that touch irrelevant paths would fail.
        -- A valid alternative solution would be to not pre-filter unrecorded
        -- changes at all, since we filter the resulting Trees anyway (see
        -- below). But that may be less efficient if there are many unrecorded
        -- changes but we are interested in just a small subset of the affected
        -- paths.
        oldtree <- snd <$> hashedTreeIO (unapply todiff) newtree cache

        writePlainTree (applyTreeFilter relevant oldtree) (toFilePath odir)
        writePlainTree (applyTreeFilter relevant newtree) (toFilePath ndir)
        -- Display patch info for (only) the recorded patches that we diff
        putDocLn $ vcat $ map displayPatchInfo $ reverse $ mapFL info tolog
        hFlush stdout

      -- Call the external diff program. Note we are now back in our
      -- temporary directory.
      cmd <- IO String
diffProgram
      let 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 -> 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 getDiffCmdAndArgs cmd opts old 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
          cmdExists <- String -> IO (Maybe String)
findExecutable String
d_cmd
          unless (isJust cmdExists) $
            fail $ d_cmd ++ " is not an executable in --diff-command"
          let pausingForGui = ([DarcsFlag] -> WantGuiPause
wantGuiPause [DarcsFlag]
opts WantGuiPause -> WantGuiPause -> Bool
forall a. Eq a => a -> a -> Bool
== WantGuiPause
O.YesWantGuiPause)
              cmdline = [String] -> String
unwords (String
d_cmd String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
d_args)
          when pausingForGui $ putStrLn $ "Running command '" ++ cmdline ++ "'"
          _ <- execInteractive cmdline Nothing
          when pausingForGui $ askEnter "Hit return to move on..."

-- | Returns the command we should use for diff as a tuple (command, arguments).
-- This will either be whatever the user specified via --diff-command  or the
-- default 'diffProgram'.  Note that this potentially involves parsing the
-- user's diff-command, hence the possibility for failure.
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 -> -- if no command specified, use 'diff'
        (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