--  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.

{-# LANGUAGE CPP #-}

module Darcs.Commands.Diff ( diffCommand ) where

import System.FilePath.Posix ( takeFileName )
import Workaround ( getCurrentDirectory )
import Darcs.Utils ( askEnter, withCurrentDirectory )
import Control.Monad ( when )
import Data.List ( (\\) )

import Storage.Hashed.Plain( writePlainTree )

import Darcs.External( diffProgram )
import CommandLine ( parseCmd )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments
    ( DarcsFlag(AfterPatch, DiffCmd, DiffFlags, LastN)
    , diffCmdFlag
    , diffflags
    , fixSubPaths
    , matchRange
    , pauseForGui
    , storeInMemory
    , unidiff
    , workingRepoDir
    )
import Darcs.Flags ( isNotUnified, wantGuiPause )
import Darcs.Patch.PatchInfoAnd ( info )
import Darcs.RepoPath ( AbsolutePath, SubPath, toFilePath, sp2fn )
import Darcs.Match ( getPartialFirstMatch, getPartialSecondMatch,
                     firstMatch, secondMatch,
                     matchFirstPatchset, matchSecondPatchset )
import Darcs.Repository ( withRepository, RepoJob(..), readRepo,
                          amInHashedRepository,
                          createPristineDirectoryTree,
                          createPartialsPristineDirectoryTree )
import Darcs.Patch.Set ( PatchSet, newset2RL )
import Darcs.Repository.State ( readUnrecorded )
import Darcs.Patch ( RepoPatch )
import Darcs.Witnesses.Ordered ( mapRL )
import Darcs.Patch.Info ( PatchInfo, humanFriendly )
import Darcs.External ( execPipeIgnoreError )
import Darcs.Lock ( withTempDir )
import Darcs.Witnesses.Sealed ( unseal )
import Printer ( Doc, putDoc, vcat, empty, ($$) )
#include "impossible.h"

#include "gadts.h"

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

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

diffCommand :: DarcsCommand
diffCommand = DarcsCommand {commandProgramName = "darcs",
                             commandName = "diff",
                             commandHelp = diffHelp,
                             commandDescription = diffDescription,
                             commandExtraArgs = -1,
                             commandExtraArgHelp
                                 = ["[FILE or DIRECTORY]..."],
                             commandCommand = diffCmd,
                             commandPrereq = amInHashedRepository,
                             commandGetArgPossibilities = return [],
                             commandArgdefaults = nodefaults,
                             commandAdvancedOptions =
                                [ pauseForGui
                                ],
                             commandBasicOptions =
                                [ matchRange
                                , diffCmdFlag
                                , diffflags
                                , unidiff
                                , workingRepoDir
                                , storeInMemory
                                ]
                           }

getDiffOpts :: [DarcsFlag] -> [String]
getDiffOpts opts | isNotUnified opts = get_nonU_diff_opts opts
                 | otherwise         = "-u" : get_nonU_diff_opts opts
    where get_nonU_diff_opts (DiffFlags f:fs) = f : get_nonU_diff_opts fs
          get_nonU_diff_opts (_:fs) = get_nonU_diff_opts fs
          get_nonU_diff_opts [] = []

-- | 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 cmd opts f1 f2 = helper opts where
  helper (DiffCmd c:_) =
    case parseCmd [ ('1', f1) , ('2', f2) ] c of
    Left err        -> Left $ show err
    Right ([],_)    -> bug $ "parseCmd should never return empty list"
    Right ((h:t),_) -> Right (h,t)
  helper [] = -- if no command specified, use 'diff'
    Right (cmd, ("-rN":getDiffOpts opts++[f1,f2]))
  helper (_:t) = helper t

diffCmd :: [DarcsFlag] -> [String] -> IO ()
diffCmd opts args
  | not (null [i | LastN i <- opts]) &&
      not (null [p | AfterPatch p <- opts]) =
        fail $ "using --patch and --last at the same time with the 'diff'" ++
          " command doesn't make sense. Use --from-patch to create a diff" ++
          " from this patch to the present, or use just '--patch' to view" ++
          " this specific patch."
  | null args = doDiff opts Nothing
  | otherwise = doDiff opts . Just =<< fixSubPaths opts args

doDiff :: [DarcsFlag] -> Maybe [SubPath] ->  IO ()
doDiff opts sps = withRepository opts $ RepoJob $ \repository -> do
  let pathList = map sp2fn `fmap` sps
  formerdir <- getCurrentDirectory
  withTempDirs (takeFileName formerdir) $ \odir ndir -> do
    if firstMatch opts
      then withCurrentDirectory odir $ getPartialFirstMatch repository opts pathList
      else case pathList of
        Nothing -> createPristineDirectoryTree repository $ toFilePath odir
        Just pl -> createPartialsPristineDirectoryTree repository pl $ toFilePath odir
    if secondMatch opts
       then withCurrentDirectory ndir $ getPartialSecondMatch repository opts pathList
       else withCurrentDirectory formerdir $
               readUnrecorded repository sps >>= (flip writePlainTree (toFilePath ndir))
    thediff <- withCurrentDirectory (toFilePath odir ++ "/..") $
                   case pathList of
                   Nothing -> rundiff (takeFileName $ toFilePath odir) (takeFileName $ toFilePath ndir)
                   Just fs -> vcat `fmap`
                         mapM (\f -> rundiff
                               (takeFileName (toFilePath odir) ++ "/" ++ toFilePath f)
                               (takeFileName (toFilePath ndir) ++ "/" ++ toFilePath f)) fs
    morepatches <- readRepo repository
    putDoc $ changelog (getDiffInfo opts morepatches)
            $$ thediff
    where rundiff :: String -> String -> IO Doc
          rundiff f1 f2 = do
            cmd <- diffProgram
            case getDiffCmdAndArgs cmd opts f1 f2 of
             Left err -> fail err
             Right (d_cmd, d_args) ->
              let pausingForGui = wantGuiPause opts in
              do when pausingForGui $ putStrLn $
                   "Running command '" ++ unwords (d_cmd:d_args) ++ "'"
                 output <- execPipeIgnoreError d_cmd d_args empty
                 when pausingForGui $
                    askEnter "Hit return to move on..."
                 return output

          withTempDirs :: String -> (AbsolutePath -> AbsolutePath -> IO a) -> IO a
          withTempDirs x f = withTempDir ("old-" ++ x) $ \odir ->
            withTempDir ("new-" ++ x) $ \ndir -> f odir ndir

getDiffInfo :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x) -> [PatchInfo]
getDiffInfo opts ps =
    let infos = mapRL info . newset2RL
        handle (match_cond, do_match)
          | match_cond opts = unseal infos (do_match opts ps)
          | otherwise = infos ps
    in handle (secondMatch, matchSecondPatchset)
         \\ handle (firstMatch, matchFirstPatchset)

changelog :: [PatchInfo] -> Doc
changelog pis = vcat $ map humanFriendly pis