%  Copyright (C) 2004,2007 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.

\darcsCommand{amend-record}
\begin{code}
module Darcs.Commands.AmendRecord ( amendrecord ) where
import Data.List ( sort )
import Data.Maybe ( isJust )
import System.Directory ( removeFile )
import System.Exit ( ExitCode(..), exitWith )
import Control.Monad ( when )

import Darcs.Flags ( DarcsFlag(Author, LogFile, PatchName,
                               EditLongComment, PromptLongComment) )
import Darcs.Lock ( world_readable_temp )
import Darcs.RepoPath ( toFilePath )
import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully, info )
import Darcs.Repository ( Repository, withRepoLock, ($-), withGutsOf,
                    tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,
                    amInRepository
                        , invalidateIndex, unrecordedChanges
                  )
import Darcs.Patch ( RepoPatch, description, Prim, fromPrims,
                     infopatch, getdeps, adddeps, effect,
                   )
import Darcs.Patch.Prim ( canonizeFL )
import Darcs.Patch.Info ( pi_author, pi_name, pi_log,
                          PatchInfo, patchinfo, is_inverted, invert_name,
                        )
import Darcs.Patch.Split ( primSplitter )
import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (+>+), nullFL )
import Darcs.SelectChanges ( with_selected_changes_to_files',
                             with_selected_patch_from_repo )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Commands.Record ( getDate, getLog )
import Darcs.Arguments ( DarcsFlag ( All ),
                         areFileArgs, fixSubPaths, defineChanges,
                        allInteractive, ignoretimes,
                        askLongComment, author, patchnameOption,
                        leaveTestDir, nocompress, lookforadds,
                         workingRepoDir,
                        matchOneNontag, umaskOption,
                        notest, testByDefault, listRegisteredFiles,
                        getEasyAuthor, setScriptsExecutableOption
                      )
import Darcs.Utils ( askUser, clarifyErrors )
import Printer ( putDocLn )

amendrecordDescription :: String
amendrecordDescription =
 "Improve a patch before it leaves your repository."

amendrecordHelp :: String
amendrecordHelp =
 "Amend-record updates a `draft' patch with additions or improvements,\n" ++
 "resulting in a single `finished' patch.  This is better than recording\n" ++
 "the additions and improvements as separate patches, because then\n" ++
 "whenever the `draft' patch is copied between repositories, you would\n" ++
 "need to make sure all the extra patches are copied, too.\n" ++
 "\n" ++
 "Do not copy draft patches between repositories, because a finished\n" ++
 "patch cannot be copied into a repository that contains a draft of the\n" ++
 "same patch.  If this has already happened, `darcs obliterate' can be\n" ++
 "used to remove the draft patch.\n" ++
 "\n" ++
 -- FIXME: is the following still true in Darcs 2.1? --twb
 "Do not run amend-record in repository that other developers can pull\n" ++
 "from, because if they pull while an amend-record is in progress, their\n" ++
 "repository may be corrupted.\n" ++
 "\n" ++
 "When recording a draft patch, it is a good idea to start the name with\n" ++
 "`DRAFT:' so that other developers know it is not finished.  When\n" ++
 "finished, remove it with `darcs amend-record --edit-long-comment'.\n" ++
 "To change the patch name without starting an editor, use --patch-name.\n" ++
 "\n" ++
 "Like `darcs record', if you call amend-record with files as arguments,\n" ++
 "you will only be asked about changes to those files.  So to amend a\n" ++
 "patch to foo.c with improvements in bar.c, you would run:\n" ++
 "\n" ++
 "    darcs amend-record --match 'touch foo.c' bar.c\n" ++
 "\n" ++
 "It is usually a bad idea to amend another developer's patch.  To make\n" ++
 "amend-record only ask about your own patches by default, you can add\n" ++
 "something like `amend-record match David Roundy' to ~/.darcs/defaults, \n" ++
 "where `David Roundy' is your name. " ++ 
 "On Windows use C:/Documents And Settings/user/Application Data/darcs/defaults\n"

amendrecord :: DarcsCommand
amendrecord = DarcsCommand {commandName = "amend-record",
                            commandHelp = amendrecordHelp,
                            commandDescription = amendrecordDescription,
                            commandExtraArgs = -1,
                            commandExtraArgHelp = ["[FILE or DIRECTORY]..."],
                            commandCommand = amendrecordCmd,
                            commandPrereq = amInRepository,
                            commandGetArgPossibilities = listRegisteredFiles,
                            commandArgdefaults = nodefaults,
                            commandAdvancedOptions = [nocompress, ignoretimes, umaskOption,
                                                        setScriptsExecutableOption],
                            commandBasicOptions = [matchOneNontag,
                                                     notest,
                                                    leaveTestDir,
                                                    allInteractive,
                                                    author, patchnameOption, askLongComment,
                                                    lookforadds,
                                                    workingRepoDir]}

amendrecordCmd :: [DarcsFlag] -> [String] -> IO ()
amendrecordCmd opts args =
    withRepoLock (testByDefault opts) $- \repository -> do
    files  <- sort `fmap` fixSubPaths opts args
    when (areFileArgs files) $
         putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
    with_selected_patch_from_repo "amend" repository opts $ \ (_ :> oldp) -> do
        ch <- unrecordedChanges opts repository files
        case ch of
          NilFL | not (hasEditMetadata opts) -> putStrLn "No changes!"
          _ ->
               with_selected_changes_to_files' "add" (filter (==All) opts) (Just primSplitter)
                (map toFilePath files) ch $ addChangesToPatch opts repository oldp

addChangesToPatch :: forall t p . (RepoPatch p) => [DarcsFlag] -> Repository p -> PatchInfoAnd p
                  -> (FL Prim :> t) -> IO ()
addChangesToPatch opts repository oldp (chs:>_) =    
                  if (nullFL chs && not (hasEditMetadata opts))
                  then putStrLn "You don't want to record anything!"
                  else do
                       (mlogf, newp) <- updatePatchHeader opts oldp chs
                       defineChanges newp
                       invalidateIndex repository
                       withGutsOf repository $ do
                         tentativelyRemovePatches repository opts (hopefully oldp :>: NilFL)
                         tentativelyAddPatch repository opts newp
                         let failmsg = maybe "" (\lf -> "\nLogfile left in "++lf++".") mlogf
                         finalizeRepositoryChanges repository `clarifyErrors` failmsg
                       maybe (return ()) removeFile mlogf
                       putStrLn "Finished amending patch:"
                       putDocLn $ description newp

updatePatchHeader :: forall p. (RepoPatch p) => [DarcsFlag] -> PatchInfoAnd p -> FL Prim
                  -> IO (Maybe String, PatchInfoAnd p)
updatePatchHeader opts oldp chs = do
                       let old_pinf = info oldp
                           prior    = (pi_name old_pinf, pi_log old_pinf)
                           make_log = world_readable_temp "darcs-amend-record"
                           old_author = pi_author old_pinf
                       date <- getDate opts
                       warnIfHijacking opts old_author
                       (new_name, new_log, mlogf) <- getLog opts (Just prior) make_log chs
                       let new_author = case getAuthor opts of
                                        Just a  -> a
                                        Nothing -> pi_author old_pinf
                           maybe_invert = if is_inverted old_pinf then invert_name else id
                       new_pinf <- maybe_invert `fmap` patchinfo date new_name
                                                                 new_author new_log
                       return $ (mlogf, fixp oldp chs new_pinf)

warnIfHijacking :: [DarcsFlag] -> String -> IO ()
warnIfHijacking opts old_author = do
  author_here <- getEasyAuthor
  case author_here of
    Nothing -> return ()
    Just ah -> let edit_author = isJust (getAuthor opts)
              in if (edit_author || ah == old_author)
                 then return ()
                 else do yorn <- askUser $ 
                                "You're not "++old_author ++"! Amend anyway? "
                         case yorn of ('y':_) -> return ()
                                      _ -> exitWith $ ExitSuccess

hasEditMetadata :: [DarcsFlag] -> Bool
hasEditMetadata (Author _:_) = True
hasEditMetadata (LogFile _:_) = True
hasEditMetadata (PatchName _:_) = True
hasEditMetadata (EditLongComment:_) = True
hasEditMetadata (PromptLongComment:_) = True
hasEditMetadata (_:fs) = hasEditMetadata fs
hasEditMetadata [] = False

getAuthor :: [DarcsFlag] -> Maybe String
getAuthor (Author a:_) = Just a
getAuthor (_:as) = getAuthor as
getAuthor []     = Nothing

fixp :: RepoPatch p => PatchInfoAnd p -> FL Prim -> PatchInfo -> PatchInfoAnd p
fixp oldp chs new_pinf =
    let pdeps = getdeps $ hopefully oldp
        oldchs = effect oldp
        infodepspatch pinfo deps p = adddeps (infopatch pinfo p) deps
    in n2pia $ infodepspatch new_pinf pdeps $ fromPrims $ canonizeFL
             $ oldchs +>+ chs
\end{code}