--  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, getDiffDoc ) where

import Prelude ()
import Darcs.Prelude hiding ( all )

import Data.Maybe ( fromJust )
import System.FilePath.Posix ( takeFileName, (</>) )

import Darcs.Util.Workaround ( getCurrentDirectory )
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.Prompt ( askEnter )
import Control.Monad ( when )
import Data.List ( (\\) )
import Darcs.Util.Tree.Plain( writePlainTree )
import Darcs.Util.Tree.Hashed( hashedTreeIO )
import Data.Maybe ( isJust )
import System.Directory ( findExecutable )
                          
import Darcs.Util.CommandLine ( parseCmd )
import Darcs.UI.External
    ( diffProgram
    , execPipeIgnoreError
    )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Completion ( knownFileArgs )
import Darcs.UI.Flags ( DarcsFlag, wantGuiPause, useCache, fixSubPaths )
import Darcs.UI.Options ( (^), odesc, ocheck, onormalise, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Repository.Flags ( WantGuiPause (..), DiffAlgorithm(MyersDiff) )
import Darcs.Patch.PatchInfoAnd ( info, n2pia )
import Darcs.Util.Path ( toFilePath, SubPath, simpleSubPath, isSubPathOf, AbsolutePath )
import Darcs.Util.Global ( darcsdir )
import Darcs.Patch.Match
    ( firstMatch
    , secondMatch
    , matchFirstPatchset
    , matchSecondPatchset
    )
import Darcs.Repository ( withRepository, RepoJob(..), readRepo )
import Darcs.Repository.State
    ( readUnrecorded, restrictSubpaths
    , readRecorded, unrecordedChanges
    , UseIndex(..), ScanKnown(..), applyTreeFilter
    )
import Darcs.Patch.Witnesses.Ordered ( mapRL, (:>)(..), (+>+), RL(..) )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePEnd )
import Darcs.Patch.Witnesses.Sealed ( unseal, Sealed(..), seal )
import Darcs.Patch ( RepoPatch, IsRepoType, apply, listTouchedFiles, invert, fromPrims )
import Darcs.Patch.Depends ( findCommonWithThem )
import Darcs.Patch.Named.Wrapped ( anonymous )
import Darcs.Patch.Set ( PatchSet(..), patchSet2RL )
import Darcs.Patch.Info ( PatchInfo, displayPatchInfo )
import Darcs.Util.Lock ( withTempDir )
import Darcs.Util.Printer ( Doc, putDoc, vcat, empty, ($$) )

diffDescription :: String
diffDescription :: String
diffDescription = "Create a diff between two versions of the repository."

diffHelp :: String
diffHelp :: String
diffHelp =
 "The `darcs diff` command compares two versions of the working tree of\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "the current repository.  Without options, the pristine (recorded) and\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "unrecorded working trees are compared.  This is lower-level than\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "the `darcs whatsnew` command, since it outputs a line-by-line diff,\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "and it is also slower.  As with `darcs whatsnew`, if you specify\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "files or directories, changes to other files are not listed.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "The command always uses an external diff utility.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "With the `--patch` option, the comparison will be made between working\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "trees with and without that patch.  Patches *after* the selected patch\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "are not present in either of the compared working trees.  The\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "`--from-patch` and `--to-patch` options allow the set of patches in the\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "`old' and `new' working trees to be specified separately.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "The associated tag and match options are also understood, e.g. `darcs\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "diff --from-tag 1.0 --to-tag 1.1`.  All these options assume an\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "ordering of the patch set, so results may be affected by operations\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "such as `darcs optimize reorder`.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "diff(1) is called with the arguments `-rN`.  The `--unified` option causes\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "`-u` to be passed to diff(1).  An additional argument can be passed\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "using `--diff-opts`, such as `--diff-opts=-ud` or `--diff-opts=-wU9`.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "The `--diff-command` option can be used to specify an alternative\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "utility. Arguments may be included, separated by whitespace.  The value\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "is not interpreted by a shell, so shell constructs cannot be used.  The\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "arguments %1 and %2 MUST be included, these are substituted for the two\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "working trees being compared. For instance:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "    darcs diff -p . --diff-command \"meld %1 %2\"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
 "If this option is used, `--diff-opts` is ignored.\n"

diffCommand :: DarcsCommand [DarcsFlag]
diffCommand :: DarcsCommand [DarcsFlag]
diffCommand = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
    -> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
    -> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
    { commandProgramName :: String
commandProgramName = "darcs"
    , commandName :: String
commandName = "diff"
    , commandHelp :: String
commandHelp = String
diffHelp
    , commandDescription :: String
commandDescription = String
diffDescription
    , commandExtraArgs :: Int
commandExtraArgs = -1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = ["[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
    , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = OptSpec DarcsOptDescr DarcsFlag Any (WantGuiPause -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec DarcsOptDescr DarcsFlag Any (WantGuiPause -> Any)
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WantGuiPause
diffAdvancedOpts
    , commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag] -> ExternalDiff -> Maybe String -> Bool -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag] -> ExternalDiff -> Maybe String -> Bool -> Any)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag] -> ExternalDiff -> Maybe String -> Bool -> a)
diffBasicOpts
    , commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> a)
diffOpts
    , commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
  DarcsOptDescr
  DarcsFlag
  Any
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> Any)
forall a.
DarcsOption
  a
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> a)
diffOpts
    , commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
  DarcsOptDescr
  DarcsFlag
  [DarcsFlag]
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> [DarcsFlag])
forall a.
DarcsOption
  a
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> a)
diffOpts
    }
  where
    diffBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag] -> ExternalDiff -> Maybe String -> Bool -> a)
diffBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (ExternalDiff -> Maybe String -> Bool -> a)
  [MatchFlag]
MatchOption
O.matchRange
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (ExternalDiff -> Maybe String -> Bool -> a)
  [MatchFlag]
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Bool -> a)
     (ExternalDiff -> Maybe String -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe String -> Bool -> a)
     ([MatchFlag] -> ExternalDiff -> 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)
  (ExternalDiff -> Maybe String -> Bool -> a)
PrimDarcsOption ExternalDiff
O.extDiff
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe String -> Bool -> a)
  ([MatchFlag] -> ExternalDiff -> Maybe String -> Bool -> a)
-> OptSpec
     DarcsOptDescr DarcsFlag (Bool -> a) (Maybe String -> Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Bool -> a)
     ([MatchFlag] -> ExternalDiff -> 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 -> Maybe String -> Bool -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Bool -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     ([MatchFlag] -> ExternalDiff -> 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
    diffOpts :: DarcsOption
  a
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> a)
diffOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> a)
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> a)
forall a.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  ([MatchFlag] -> ExternalDiff -> Maybe String -> Bool -> a)
diffBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> a)
  ([MatchFlag]
   -> ExternalDiff
   -> Maybe String
   -> Bool
   -> Maybe StdCmdAction
   -> Bool
   -> Bool
   -> Verbosity
   -> Bool
   -> WantGuiPause
   -> UseCache
   -> HooksConfig
   -> a)
-> DarcsOption
     (UseCache -> HooksConfig -> a)
     (WantGuiPause -> UseCache -> HooksConfig -> a)
-> DarcsOption
     a
     ([MatchFlag]
      -> ExternalDiff
      -> Maybe String
      -> Bool
      -> Maybe StdCmdAction
      -> Bool
      -> Bool
      -> Verbosity
      -> Bool
      -> WantGuiPause
      -> UseCache
      -> HooksConfig
      -> a)
forall b c a.
DarcsOption
  (Maybe StdCmdAction -> Bool -> Bool -> Verbosity -> Bool -> b) c
-> DarcsOption (UseCache -> HooksConfig -> a) b -> DarcsOption a c
`withStdOpts` DarcsOption
  (UseCache -> HooksConfig -> a)
  (WantGuiPause -> UseCache -> HooksConfig -> a)
forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WantGuiPause
diffAdvancedOpts

getDiffOpts :: O.ExternalDiff -> [String]
getDiffOpts :: ExternalDiff -> [String]
getDiffOpts O.ExternalDiff {diffOpts :: ExternalDiff -> [String]
O.diffOpts=[String]
os,diffUnified :: ExternalDiff -> Bool
O.diffUnified=Bool
u} = [String] -> [String]
addUnified [String]
os where
  addUnified :: [String] -> [String]
addUnified = if Bool
u then ("-u"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall a. a -> a
id

-- | 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 with an exception.
getDiffCmdAndArgs :: String -> [DarcsFlag] -> String -> String
                      -> Either String (String, [String])
getDiffCmdAndArgs :: String
-> [DarcsFlag]
-> String
-> String
-> Either String (String, [String])
getDiffCmdAndArgs cmd :: String
cmd opts :: [DarcsFlag]
opts f1 :: String
f1 f2 :: String
f2 = ExternalDiff -> Either String (String, [String])
helper (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 extDiff :: ExternalDiff
extDiff =
    case ExternalDiff -> Maybe String
O.diffCmd ExternalDiff
extDiff of
      Just c :: String
c ->
        case FTable -> String -> Either ParseError ([String], Bool)
parseCmd [ ('1', String
f1) , ('2', String
f2) ] String
c of
          Left err :: 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 ([],_)  -> String -> Either String (String, [String])
forall a. String -> a
bug "parseCmd should never return empty list"
          Right (h :: String
h:t :: [String]
t,_) -> (String, [String]) -> Either String (String, [String])
forall a b. b -> Either a b
Right (String
h,[String]
t)
      Nothing -> -- if no command specified, use 'diff'
        (String, [String]) -> Either String (String, [String])
forall a b. b -> Either a b
Right (String
cmd, "-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])

diffCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
diffCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
diffCmd fps :: (AbsolutePath, AbsolutePath)
fps opts :: [DarcsFlag]
opts args :: [String]
args
  | Bool -> Bool
not ([MatchFlag] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (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 (t :: * -> *) a. Foldable t => t a -> Bool
null (MatchOption
O.matchFrom MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)) =
        String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "using --patch and --last at the same time with the 'diff'" String -> String -> String
forall a. [a] -> [a] -> [a]
++
          " command doesn't make sense. Use --from-patch to create a diff" String -> String -> String
forall a. [a] -> [a] -> [a]
++
          " from this patch to the present, or use just '--patch' to view" String -> String -> String
forall a. [a] -> [a] -> [a]
++
          " this specific patch."
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args = [DarcsFlag] -> Maybe [SubPath] -> IO ()
doDiff [DarcsFlag]
opts Maybe [SubPath]
forall a. Maybe a
Nothing
  | Bool
otherwise = [DarcsFlag] -> Maybe [SubPath] -> IO ()
doDiff [DarcsFlag]
opts (Maybe [SubPath] -> IO ())
-> ([SubPath] -> Maybe [SubPath]) -> [SubPath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SubPath] -> Maybe [SubPath]
forall a. a -> Maybe a
Just ([SubPath] -> IO ()) -> IO [SubPath] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (AbsolutePath, AbsolutePath) -> [String] -> IO [SubPath]
fixSubPaths (AbsolutePath, AbsolutePath)
fps [String]
args

doDiff :: [DarcsFlag] -> Maybe [SubPath] ->  IO ()
doDiff :: [DarcsFlag] -> Maybe [SubPath] -> IO ()
doDiff opts :: [DarcsFlag]
opts msubpaths :: Maybe [SubPath]
msubpaths = [DarcsFlag] -> Maybe [SubPath] -> IO Doc
getDiffDoc [DarcsFlag]
opts Maybe [SubPath]
msubpaths IO Doc -> (Doc -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> IO ()
putDoc

getDiffDoc :: [DarcsFlag] -> Maybe [SubPath] ->  IO Doc
getDiffDoc :: [DarcsFlag] -> Maybe [SubPath] -> IO Doc
getDiffDoc opts :: [DarcsFlag]
opts msubpaths :: Maybe [SubPath]
msubpaths = UseCache -> RepoJob Doc -> IO Doc
forall a. UseCache -> RepoJob a -> IO a
withRepository (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob Doc -> IO Doc) -> RepoJob Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO Doc)
-> RepoJob Doc
forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob ((forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
  (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
  Repository rt p wR wU wR -> IO Doc)
 -> RepoJob Doc)
-> (forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
    (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
    Repository rt p wR wU wR -> IO Doc)
-> RepoJob Doc
forall a b. (a -> b) -> a -> b
$ \repository :: Repository rt p wR wU wR
repository -> do
  String
formerdir <- IO String
getCurrentDirectory

  let thename :: String
thename = String -> String
takeFileName String
formerdir

  PatchSet rt p Origin wR
patchset <- Repository rt p wR wU wR -> 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 wR
repository

  FL p wR wU
unrecorded <- FL (PrimOf p) wR wU -> FL p wR wU
forall (p :: * -> * -> *) wX wY.
FromPrims p =>
FL (PrimOf p) wX wY -> p wX wY
fromPrims (FL (PrimOf p) wR wU -> FL p wR wU)
-> IO (FL (PrimOf p) wR wU) -> IO (FL p wR wU)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [SubPath]
-> IO (FL (PrimOf p) wR wU)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wT
-> Maybe [SubPath]
-> IO (FL (PrimOf p) wT wU)
unrecordedChanges (UseIndex
UseIndex, ScanKnown
ScanKnown, DiffAlgorithm
MyersDiff)
    LookForMoves
O.NoLookForMoves LookForReplaces
O.NoLookForReplaces
    Repository rt p wR wU wR
repository Maybe [SubPath]
msubpaths
  PatchInfoAnd rt p wR wU
unrecorded' <- WrappedNamed rt p wR wU -> PatchInfoAnd rt p wR wU
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
WrappedNamed rt p wX wY -> PatchInfoAnd rt p wX wY
n2pia (WrappedNamed rt p wR wU -> PatchInfoAnd rt p wR wU)
-> IO (WrappedNamed rt p wR wU) -> IO (PatchInfoAnd rt p wR wU)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FL p wR wU -> IO (WrappedNamed rt p wR wU)
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
FL p wX wY -> IO (WrappedNamed rt p wX wY)
anonymous FL 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 MatchOption
O.matchRange [DarcsFlag]
opts
  Sealed all :: PatchSet rt p Origin wX
all <- Sealed (PatchSet rt p Origin) -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet rt p Origin)
 -> IO (Sealed (PatchSet rt p Origin)))
-> Sealed (PatchSet rt p Origin)
-> IO (Sealed (PatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ case ([MatchFlag] -> Bool
secondMatch [MatchFlag]
matchFlags, PatchSet rt p Origin wR
patchset) of
    (True, _) -> PatchSet rt p Origin wR -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet rt p Origin wR
patchset
    (False, PatchSet tagged :: RL (Tagged rt p) Origin wX
tagged untagged :: RL (PatchInfoAnd rt p) wX wR
untagged) -> PatchSet rt p Origin wU -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (PatchSet rt p Origin wU -> Sealed (PatchSet rt p Origin))
-> PatchSet rt p Origin wU -> Sealed (PatchSet rt p Origin)
forall a b. (a -> b) -> a -> b
$ RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wU -> PatchSet rt p Origin wU
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin wX
tagged (RL (PatchInfoAnd rt p) wX wR
untagged RL (PatchInfoAnd rt p) wX wR
-> PatchInfoAnd rt p wR wU -> RL (PatchInfoAnd rt p) wX wU
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: PatchInfoAnd rt p wR wU
unrecorded')

  Sealed ctx :: PatchSet rt p Origin wX
ctx <- Sealed (PatchSet rt p Origin) -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet rt p Origin)
 -> IO (Sealed (PatchSet rt p Origin)))
-> Sealed (PatchSet rt p Origin)
-> IO (Sealed (PatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ if [MatchFlag] -> Bool
firstMatch [MatchFlag]
matchFlags
                            then [MatchFlag]
-> PatchSet rt p Origin wR -> Sealed (PatchSet rt p Origin)
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
(IsRepoType rt, Matchable p) =>
[MatchFlag]
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchFirstPatchset [MatchFlag]
matchFlags PatchSet rt p Origin wR
patchset
                            else PatchSet rt p Origin wR -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet rt p Origin wR
patchset

  Sealed match :: PatchSet rt p Origin wX
match <- Sealed (PatchSet rt p Origin) -> IO (Sealed (PatchSet rt p Origin))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (PatchSet rt p Origin)
 -> IO (Sealed (PatchSet rt p Origin)))
-> Sealed (PatchSet rt p Origin)
-> IO (Sealed (PatchSet rt p Origin))
forall a b. (a -> b) -> a -> b
$ if [MatchFlag] -> Bool
secondMatch [MatchFlag]
matchFlags
                             then [MatchFlag]
-> PatchSet rt p Origin wR -> Sealed (PatchSet rt p Origin)
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
(IsRepoType rt, Matchable p) =>
[MatchFlag]
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchSecondPatchset [MatchFlag]
matchFlags PatchSet rt p Origin wR
patchset
                             else PatchSet rt p Origin wX -> Sealed (PatchSet rt p Origin)
forall (a :: * -> *) wX. a wX -> Sealed a
seal PatchSet rt p Origin wX
all

  (_ :> todiff :: FL (PatchInfoAnd rt p) wZ wX
todiff) <- (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
 -> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX))
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX
-> PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
Commute p =>
PatchSet rt p wStart wX
-> PatchSet rt p wStart wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart wX
findCommonWithThem PatchSet rt p Origin wX
match PatchSet rt p Origin wX
ctx
  (_ :> tounapply :: FL (PatchInfoAnd rt p) wZ wX
tounapply) <- (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
 -> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX))
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
-> IO ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wX
-> PatchSet rt p Origin wX
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) Origin wX
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
Commute p =>
PatchSet rt p wStart wX
-> PatchSet rt p wStart wY
-> (:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart wX
findCommonWithThem PatchSet rt p Origin wX
all PatchSet rt p Origin wX
match

  Tree IO
base <- if [MatchFlag] -> Bool
secondMatch [MatchFlag]
matchFlags
           then 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
repository
           else Repository rt p wR wU wR -> Maybe [SubPath] -> IO (Tree IO)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> Maybe [SubPath] -> IO (Tree IO)
readUnrecorded Repository rt p wR wU wR
repository Maybe [SubPath]
forall a. Maybe a
Nothing

  let touched :: [SubPath]
touched = (String -> SubPath) -> [String] -> [SubPath]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe SubPath -> SubPath
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SubPath -> SubPath)
-> (String -> Maybe SubPath) -> String -> SubPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe SubPath
simpleSubPath) ([String] -> [SubPath]) -> [String] -> [SubPath]
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wZ wX -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles FL (PatchInfoAnd rt p) wZ wX
todiff
      files :: [SubPath]
files = case Maybe [SubPath]
msubpaths of
               Nothing -> [SubPath]
touched
               Just subpaths :: [SubPath]
subpaths -> (SubPath -> [SubPath]) -> [SubPath] -> [SubPath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\s :: SubPath
s -> (SubPath -> Bool) -> [SubPath] -> [SubPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (SubPath -> SubPath -> Bool
isSubPathOf SubPath
s) [SubPath]
touched) [SubPath]
subpaths
  TreeFilter IO
relevant <- Repository rt p wR wU wR -> [SubPath] -> IO (TreeFilter IO)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT (m :: * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> [SubPath] -> IO (TreeFilter m)
restrictSubpaths Repository rt p wR wU wR
repository [SubPath]
files
  let filt :: (a, Tree IO) -> Tree IO
filt = 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 -> Tree IO)
-> ((a, Tree IO) -> Tree IO) -> (a, Tree IO) -> Tree IO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Tree IO) -> Tree IO
forall a b. (a, b) -> b
snd
      ppath :: String
ppath = String
darcsdir String -> String -> String
</> "pristine.hashed"

  Tree IO
oldtree <- ((), Tree IO) -> Tree IO
forall a. (a, Tree IO) -> Tree IO
filt (((), Tree IO) -> Tree IO) -> IO ((), Tree IO) -> IO (Tree IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TreeIO () -> Tree IO -> String -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> String -> IO (a, Tree IO)
hashedTreeIO
                (FL (PatchInfoAnd rt p) wX wZ -> TreeIO ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply (FL (PatchInfoAnd rt p) wX wZ -> TreeIO ())
-> (FL (PatchInfoAnd rt p) wZ wX -> FL (PatchInfoAnd rt p) wX wZ)
-> FL (PatchInfoAnd rt p) wZ wX
-> TreeIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL (PatchInfoAnd rt p) wZ wX -> FL (PatchInfoAnd rt p) wX wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (FL (PatchInfoAnd rt p) wZ wX -> TreeIO ())
-> FL (PatchInfoAnd rt p) wZ wX -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wZ wX -> FL (PatchInfoAnd rt p) wZ wZ
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd FL (PatchInfoAnd rt p) wZ wX
todiff FL (PatchInfoAnd rt p) wZ wZ
-> FL (PatchInfoAnd rt p) wZ wX -> FL (PatchInfoAnd rt p) wZ wX
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (PatchInfoAnd rt p) wZ wX
tounapply) Tree IO
base String
ppath
  Tree IO
newtree <- ((), Tree IO) -> Tree IO
forall a. (a, Tree IO) -> Tree IO
filt (((), Tree IO) -> Tree IO) -> IO ((), Tree IO) -> IO (Tree IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TreeIO () -> Tree IO -> String -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> String -> IO (a, Tree IO)
hashedTreeIO
                (FL (PatchInfoAnd rt p) wX wZ -> TreeIO ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply (FL (PatchInfoAnd rt p) wX wZ -> TreeIO ())
-> (FL (PatchInfoAnd rt p) wZ wX -> FL (PatchInfoAnd rt p) wX wZ)
-> FL (PatchInfoAnd rt p) wZ wX
-> TreeIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL (PatchInfoAnd rt p) wZ wX -> FL (PatchInfoAnd rt p) wX wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (FL (PatchInfoAnd rt p) wZ wX -> TreeIO ())
-> FL (PatchInfoAnd rt p) wZ wX -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) wZ wX
tounapply) Tree IO
base String
ppath

  String -> (AbsolutePath -> IO Doc) -> IO Doc
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir ("old-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
thename) ((AbsolutePath -> IO Doc) -> IO Doc)
-> (AbsolutePath -> IO Doc) -> IO Doc
forall a b. (a -> b) -> a -> b
$ \odir :: AbsolutePath
odir ->
    String -> (AbsolutePath -> IO Doc) -> IO Doc
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir ("new-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
thename) ((AbsolutePath -> IO Doc) -> IO Doc)
-> (AbsolutePath -> IO Doc) -> IO Doc
forall a b. (a -> b) -> a -> b
$ \ndir :: AbsolutePath
ndir ->
      String -> IO Doc -> IO Doc
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory String
formerdir (IO Doc -> IO Doc) -> IO Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ do
        Tree IO -> String -> IO ()
writePlainTree Tree IO
oldtree (AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
odir)
        Tree IO -> String -> IO ()
writePlainTree Tree IO
newtree (AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
ndir)
        Doc
thediff <- String -> IO Doc -> IO Doc
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory (AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
odir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/..") (IO Doc -> IO Doc) -> IO Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$
                       String -> String -> IO Doc
rundiff (String -> String
takeFileName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
odir) (String -> String
takeFileName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
ndir)
        PatchSet rt p Origin wR
morepatches <- Repository rt p wR wU wR -> 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 wR
repository
        Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> IO Doc) -> Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ [PatchInfo] -> Doc
changelog ([DarcsFlag] -> PatchSet rt p Origin wR -> [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
(IsRepoType rt, RepoPatch p) =>
[DarcsFlag] -> PatchSet rt p wStart wX -> [PatchInfo]
getDiffInfo [DarcsFlag]
opts PatchSet rt p Origin wR
morepatches) Doc -> Doc -> Doc
$$ Doc
thediff
    where rundiff :: String -> String -> IO Doc
          rundiff :: String -> String -> IO Doc
rundiff f1 :: String
f1 f2 :: String
f2 = do
            String
cmd <- IO String
diffProgram
            case String
-> [DarcsFlag]
-> String
-> String
-> Either String (String, [String])
getDiffCmdAndArgs String
cmd [DarcsFlag]
opts String
f1 String
f2 of
              Left err :: String
err -> String -> IO Doc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
              Right (d_cmd :: String
d_cmd, d_args :: [String]
d_args) -> do
                if [String] -> 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]
d_args) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1 Bool -> Bool -> Bool
|| [String] -> 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]
d_args) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1
                    then String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Invalid argument (%1 or %2) in --diff-command"
                    else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe String
cmdExists <- String -> IO (Maybe String)
findExecutable String
d_cmd
                if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
cmdExists
                    then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    else String -> IO ()
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]
++ " 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
YesWantGuiPause) in
                  do 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
$
                       "Running command '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (String
d_cmdString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
d_args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"
                     Doc
output <- String -> [String] -> Doc -> IO Doc
execPipeIgnoreError String
d_cmd [String]
d_args Doc
empty
                     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 "Hit return to move on..."
                     Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
output

getDiffInfo :: (IsRepoType rt, RepoPatch p) => [DarcsFlag] -> PatchSet rt p wStart wX -> [PatchInfo]
getDiffInfo :: [DarcsFlag] -> PatchSet rt p wStart wX -> [PatchInfo]
getDiffInfo opts :: [DarcsFlag]
opts ps :: PatchSet rt p wStart wX
ps =
    let matchFlags :: [MatchFlag]
matchFlags = MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags MatchOption
O.matchRange [DarcsFlag]
opts
        infos :: PatchSet rt p wX wY -> [PatchInfo]
infos = (forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd rt p) wX wY -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info (RL (PatchInfoAnd rt p) wX wY -> [PatchInfo])
-> (PatchSet rt p wX wY -> RL (PatchInfoAnd rt p) wX wY)
-> PatchSet rt p wX wY
-> [PatchInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p wX wY -> RL (PatchInfoAnd rt p) wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL
        handle :: ([MatchFlag] -> Bool,
 [MatchFlag]
 -> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wX))
-> [PatchInfo]
handle (match_cond :: [MatchFlag] -> Bool
match_cond, do_match :: [MatchFlag] -> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wX)
do_match)
          | [MatchFlag] -> Bool
match_cond [MatchFlag]
matchFlags = (forall wX. PatchSet rt p wX wX -> [PatchInfo])
-> Sealed (PatchSet rt p wX) -> [PatchInfo]
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. PatchSet rt p wX wX -> [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchSet rt p wX wY -> [PatchInfo]
infos ([MatchFlag] -> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wX)
do_match [MatchFlag]
matchFlags PatchSet rt p wStart wX
ps)
          | Bool
otherwise = PatchSet rt p wStart wX -> [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchSet rt p wX wY -> [PatchInfo]
infos PatchSet rt p wStart wX
ps
    in ([MatchFlag] -> Bool,
 [MatchFlag]
 -> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wStart))
-> [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wX.
([MatchFlag] -> Bool,
 [MatchFlag]
 -> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wX))
-> [PatchInfo]
handle ([MatchFlag] -> Bool
secondMatch, [MatchFlag]
-> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wStart)
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
(IsRepoType rt, Matchable p) =>
[MatchFlag]
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchSecondPatchset)
         [PatchInfo] -> [PatchInfo] -> [PatchInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([MatchFlag] -> Bool,
 [MatchFlag]
 -> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wStart))
-> [PatchInfo]
forall (rt :: RepoType) (p :: * -> * -> *) wX.
([MatchFlag] -> Bool,
 [MatchFlag]
 -> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wX))
-> [PatchInfo]
handle ([MatchFlag] -> Bool
firstMatch, [MatchFlag]
-> PatchSet rt p wStart wX -> Sealed (PatchSet rt p wStart)
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
(IsRepoType rt, Matchable p) =>
[MatchFlag]
-> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchFirstPatchset)

changelog :: [PatchInfo] -> Doc
changelog :: [PatchInfo] -> Doc
changelog pis :: [PatchInfo]
pis = [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]
pis