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

\subsection{darcs rollback}
\begin{code}
module Darcs.Commands.Rollback ( rollback ) where

import Control.Monad ( when, filterM )
import System ( exitWith, ExitCode(..) )
import Data.List ( sort )
import Data.Maybe ( isJust )
import System.Directory ( removeFile )

import Darcs.Commands ( DarcsCommand(..), nodefaults, loggers )
import Darcs.Arguments ( DarcsFlag(MarkConflicts), getRepoPaths, get_author,
                         definePatches,
                         working_repo_dir, nocompress,
                         author, patchname_option, ask_long_comment,
                         leave_test_dir, notest, list_registered_files,
                         match_several_or_last, all_interactive, umask_option
                       )
import Darcs.RepoPath ( toFilePath )
import Darcs.Repository ( amInRepository, withRepoLock, ($-), applyToWorking,
                          slurp_recorded_and_unrecorded, read_repo, slurp_recorded,
                          tentativelyMergePatches, withGutsOf,
                          finalizeRepositoryChanges, sync_repo )
import Darcs.Patch ( summary, invert, namepatch, effect, fromPrims )
import Darcs.Patch.Ordered
import Darcs.Hopefully ( n2pia )
import Darcs.Lock ( world_readable_temp )
import Darcs.SlurpDirectory ( empty_slurpy, wait_a_moment )
import Darcs.Match ( first_match )
import Darcs.SelectChanges ( with_selected_last_changes_to_files_reversed,
                             with_selected_last_changes_to_files' )
import Darcs.Commands.Record ( file_exists, get_log )
import Darcs.Commands.Unrecord ( get_last_patches )
import Darcs.Utils ( clarify_errors )
import Darcs.Progress ( debugMessage )
import Darcs.Sealed ( Sealed(..), unsafeUnflippedseal )
import IsoDate ( getIsoDateTime )
#include "impossible.h"
\end{code}

\begin{code}
rollback_description :: String
rollback_description =
 "Record a new patch reversing some recorded changes."
\end{code}

\options{rollback}

\haskell{rollback_help} If you decide you didn't want to roll back a patch
after all, you can reverse its effect by obliterating the rolled-back patch.

Rollback can actually allow you to roll back a subset of the changes made
by the selected patch or patches.  Many of the options available in
rollback behave similarly to the options for unrecord~\ref{unrecord} and
record~\ref{record}.

\begin{code}
rollback_help :: String
rollback_help =
 "Rollback is used to undo the effects of one or more patches without actually\n"++
 "deleting them.  Instead, it creates a new patch reversing selected portions.\n"++
 "of those changes. Unlike obliterate and unrecord (which accomplish a similar\n"++
 "goal) rollback is perfectly safe, since it leaves in the repository a record\n"++
 "of its changes.\n"
\end{code}
\begin{code}
rollback :: DarcsCommand
rollback = DarcsCommand {command_name = "rollback",
                         command_help = rollback_help,
                         command_description = rollback_description,
                         command_extra_args = -1,
                         command_extra_arg_help = ["[FILE or DIRECTORY]..."],
                         command_command = rollback_cmd,
                         command_prereq = amInRepository,
                         command_get_arg_possibilities = list_registered_files,
                         command_argdefaults = nodefaults,
                         command_advanced_options = [nocompress,umask_option],
                         command_basic_options = [match_several_or_last,
                                                  all_interactive,
                                                  author, patchname_option, ask_long_comment,
                                                  notest, leave_test_dir,
                                                  working_repo_dir]}
\end{code}
\begin{code}
rollback_cmd :: [DarcsFlag] -> [String] -> IO ()
rollback_cmd opts args = withRepoLock opts $- \repository -> do
  let (logMessage,_,_) = loggers opts
  rec <- if null args then return empty_slurpy
         else slurp_recorded repository
  files <- sort `fmap` getRepoPaths opts args
  existing_files <- map toFilePath `fmap` filterM (file_exists rec) files
  non_existent_files <- map toFilePath `fmap` filterM (fmap not . file_exists rec) files
  when (not $ null existing_files) $
       logMessage $ "Recording changes in "++unwords existing_files++":\n"
  when (not $ null non_existent_files) $
       logMessage $ "Non existent files or directories: "++unwords non_existent_files++"\n"
  when ((not $ null non_existent_files) && null existing_files) $
       fail "None of the files you specified exist!"
  (recorded, working_dir) <- slurp_recorded_and_unrecorded repository
  Sealed allpatches <- read_repo repository
  let patches = if first_match opts then get_last_patches opts allpatches
                                    else unsafeUnflippedseal $ headRL allpatches
  with_selected_last_changes_to_files_reversed "rollback" opts recorded existing_files
      (reverseRL patches) $
    \ (_ :> ps) ->
    do when (nullFL ps) $ do logMessage "No patches selected!"
                             exitWith ExitSuccess
       definePatches ps
       with_selected_last_changes_to_files' "rollback" opts working_dir
               existing_files (effect ps) $ \ (_:>ps'') ->
         do when (nullFL ps) $ do logMessage "No changes selected!"
                                  exitWith ExitSuccess
            let make_log = world_readable_temp "darcs-rollback"
                newlog = Just ("", "":"rolling back:":"":lines (show $ summary ps ))
            --tentativelyRemovePatches repository opts (mapFL_FL hopefully ps)
            (name, my_log, logf) <- get_log opts newlog make_log $ invert ps''
            date <- getIsoDateTime
            my_author <- get_author opts
            let rbp = n2pia $ namepatch date name my_author my_log $ fromPrims $ invert ps''
            debugMessage "Adding rollback patch to repository."
            pw <- tentativelyMergePatches repository "rollback" (MarkConflicts : opts)
                  NilFL (rbp :>: NilFL)
            debugMessage "Finalizing rollback changes..."
            withGutsOf repository $ do
              finalizeRepositoryChanges repository
              debugMessage "About to apply rolled-back changes to working directory."
              -- so work will be more recent than rec:
              revertable $ do wait_a_moment
                              applyToWorking repository opts pw
            when (isJust logf) $ removeFile (fromJust logf)
            sync_repo repository
            logMessage $ "Finished rolling back."
          where revertable x = x `clarify_errors` unlines
                  ["Error applying patch to the working directory.","",
                   "This may have left your working directory an inconsistent",
                   "but recoverable state. If you had no un-recorded changes",
                   "by using 'darcs revert' you should be able to make your",
                   "working directory consistent again."]
\end{code}

