%  Copyright (C) 2003-2005 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 unrevert}\label{unrevert}
\begin{code}
module Unrevert ( unrevert, remove_from_unrevert_context, write_unrevert ) where
import System ( ExitCode(..), exitWith )
import Monad ( liftM )
import List ( (\\) )

import DarcsCommands ( DarcsCommand(..), nodefaults )
import DarcsArguments ( DarcsFlag( Unified ),
                        verbose, ignoretimes, working_repo_dir,
                        all_gui_interactive, umask_option,
                      )
import Directory ( removeFile )
import Repository ( PatchSet, identifyRepository, withRepoLock,
                    slurp_recorded, unrevertUrl,
                    read_pending, with_new_pending,
                    sync_repo,
                    read_repo, amInRepository,
                    slurp_recorded_and_unrecorded,
                    applyToWorking,
                  )
import Patch ( Patch, join_patches,
               patch2patchinfo, commute, namepatch, flatten_to_primitives,
             )
import SelectChanges ( with_selected_changes_to_files )
import SlurpDirectory ( Slurpy )
import FastPackedString ( readFilePS )
import Lock ( writeDocBinFile )
import Pull ( merge_with_us_and_pending )
import Depends ( get_common_and_uncommon )
import Resolution ( standard_resolution )
import DarcsUtils ( askUser, catchall )
import PatchBundle ( scan_bundle, make_bundle )
import SelectChanges ( promptChar )
import IsoDate ( getIsoDateTime )
import SignalHandler ( withSignalsBlocked )
#include "impossible.h"
\end{code}
\begin{code}
unrevert_description :: String
unrevert_description =
 "Undo the last revert (may fail if changes after the revert)."
\end{code}

\options{unrevert}

\haskell{unrevert_help}
\begin{code}
unrevert_help :: String
unrevert_help =
 "Unrevert is used to undo the results of a revert command. It is only\n"++
 "guaranteed to work properly if you haven't made any changes since the\n"++
 "revert was performed.\n"
\end{code}
The command makes a best effort to merge the unreversion with any changes
you have since made.  In fact, unrevert should even work if you've recorded
changes since reverting.
\begin{code}
unrevert :: DarcsCommand
unrevert = DarcsCommand {command_name = "unrevert",
                         command_help = unrevert_help,
                         command_description = unrevert_description,
                         command_extra_args = 0,
                         command_extra_arg_help = [],
                         command_command = unrevert_cmd,
                         command_prereq = amInRepository,
                         command_get_arg_possibilities = return [],
                         command_argdefaults = nodefaults,
                         command_darcsoptions = [verbose, ignoretimes,
                                                 all_gui_interactive,
                                                 working_repo_dir,
                                                 umask_option]}
\end{code}
\begin{code}
unrevert_cmd :: [DarcsFlag] -> [String] -> IO ()
unrevert_cmd opts [] = withRepoLock opts $ \repository -> do
  us <- read_repo repository
  them <- unrevert_patch_bundle
  (rec, working) <- slurp_recorded_and_unrecorded repository
  case get_common_and_uncommon (us, them) of
    (_, us', them') -> do
      (_, work_patch) <- merge_with_us_and_pending opts
                         (map (fromJust.snd) $ reverse $ head us',
                          map (fromJust.snd) $ reverse $ head them')
      pw_resolved <- join_patches `liftM` standard_resolution work_patch
      with_selected_changes_to_files "unrevert" opts working
                            [] (flatten_to_primitives pw_resolved) Nothing $
                            \ (skipped, p) -> do
        pend <- read_pending repository
        let pend_and_p = case pend of
                         Nothing -> join_patches p
                         Just pending -> join_patches (pending : p)
        withSignalsBlocked $ with_new_pending repository pend_and_p $
          do applyToWorking repository opts (join_patches p) `catch` \e ->
                 fail ("Error applying unrevert to working directory...\n"
                    ++ show e)
             write_unrevert pend_and_p skipped rec
        sync_repo repository
        putStrLn "Finished unreverting."
unrevert_cmd _ _ = impossible
\end{code}

\begin{code}
write_unrevert :: Patch -> [Patch] -> Slurpy -> IO ()
write_unrevert _ [] _ =
    do repository <- identifyRepository "."
       removeFile (unrevertUrl repository) `catchall` return ()
write_unrevert pend ps rec =
    case commute (join_patches ps, pend) of
    Nothing -> do really <- askUser "You will not be able to unrevert this operation! Proceed? "
                  case really of ('y':_) -> return ()
                                 _ -> exitWith $ ExitSuccess
                  write_unrevert pend [] rec
    Just (_, p') -> do
        repository <- identifyRepository "."
        rep <- read_repo repository
        case get_common_and_uncommon (rep,rep) of
            (common,_,_) -> do
                date <- getIsoDateTime
                writeDocBinFile (unrevertUrl repository) $
                             make_bundle [Unified] rec common
                            [namepatch date "unrevert" "anonymous" [] p']
\end{code}

\begin{code}
unrevert_patch_bundle :: IO PatchSet
unrevert_patch_bundle = do
  repository <- identifyRepository "."
  pf <- readFilePS (unrevertUrl repository)
        `catchall` fail "There's nothing to unrevert!"
  case scan_bundle pf of
      Right ps -> return ps
      Left err -> fail $ "Couldn't parse unrevert patch:\n" ++ err
\end{code}

\begin{code}
remove_from_unrevert_context :: [Patch] -> IO ()
remove_from_unrevert_context ps = do
  bundle <- unrevert_patch_bundle `catchall` return [[]]
  case bundle of
    [[]] -> return ()
    _ -> do
    repository <- identifyRepository "."
    let unrevert_loc = unrevertUrl repository
    ref <- read_repo repository
    case get_common_and_uncommon (bundle, ref) of
        (common,[[(_, Just us)]],[[]]) ->
            case commute (us, join_patches ps) of
            Nothing -> unrevert_impossible unrevert_loc
            Just (_, us') -> do
                s <- slurp_recorded repository
                writeDocBinFile unrevert_loc $
                             make_bundle [] s
                             (common \\ pis) [us']
        (common,[[(_, Just _)]],_)
            | any (`elem` common) pis -> unrevert_impossible unrevert_loc
            | otherwise -> return ()
        _ -> unrevert_impossible unrevert_loc
    where unrevert_impossible unrevert_loc =
              do yorn <- promptChar
                         "This operation will make unrevert impossible!\nProceed?"
                         "yn"
                 case yorn of
                     'n' -> fail "Cancelled to avoid unrevert catastrophe!"
                     'y' -> removeFile unrevert_loc `catchall` return ()
                     _ -> impossible
          pis = map (fromJust . patch2patchinfo) ps
\end{code}