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

\darcsCommand{unrevert}
\begin{code}
{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE CPP #-}

#include "gadts.h"

module Darcs.Commands.Unrevert ( unrevert, write_unrevert ) where
import System.Exit ( ExitCode(..), exitWith )

import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( DarcsFlag( Unified, MarkConflicts ),
                         ignoretimes, working_repo_dir,
                        all_interactive, umask_option,
                      )
import Darcs.Repository ( SealedPatchSet, Repository, withRepoLock, ($-),
                          unrevertUrl, considerMergeToWorking,
                          tentativelyAddToPending, finalizeRepositoryChanges,
                          sync_repo, get_unrecorded,
                          read_repo, amInRepository,
                          slurp_recorded,
                          applyToWorking )
import Darcs.Patch ( RepoPatch, Prim, commutex, namepatch, fromPrims )
import Darcs.Ordered ( RL(..), FL(..), (:<)(..), (:>)(..), (:\/:)(..), reverseRL,
                       (+>+) )
import Darcs.SelectChanges ( with_selected_changes_to_files' )
import Darcs.SlurpDirectory ( Slurpy )
import qualified Data.ByteString as B
import Darcs.Lock ( writeDocBinFile, removeFileMayNotExist )
import Darcs.Patch.Depends ( get_common_and_uncommon )
import Darcs.Utils ( askUser, catchall )
import Darcs.Patch.Bundle ( scan_bundle, make_bundle )
import IsoDate ( getIsoDateTime )
import Darcs.SignalHandler ( withSignalsBlocked )
import Progress ( debugMessage )
import Darcs.Sealed ( Sealed(Sealed) )
#include "impossible.h"

unrevert_description :: String
unrevert_description =
 "Undo the last revert (may fail if changes after the revert)."

unrevert_help :: String
unrevert_help =
 "Unrevert is a rescue command in case you accidentally reverted\n" ++
 "something you wanted to keep (for example, typing `darcs rev -a'\n" ++
 "instead of `darcs rec -a').\n" ++
 "\n" ++
 "This command may fail if the repository has changed since the revert\n" ++
 "took place.  Darcs will ask for confirmation before executing an\n" ++
 "interactive command that will DEFINITELY prevent unreversion.\n"

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_advanced_options = [umask_option],
                         command_basic_options = [ignoretimes,
                                                  all_interactive,
                                                  working_repo_dir]}

unrevert_cmd :: [DarcsFlag] -> [String] -> IO ()
unrevert_cmd opts [] = withRepoLock opts $- \repository -> do
  us <- read_repo repository
  Sealed them <- unrevert_patch_bundle repository
  rec <- slurp_recorded repository
  unrec <- get_unrecorded repository
  case get_common_and_uncommon (us, them) of
    (_, (h_us:<:NilRL) :\/: (h_them:<:NilRL)) -> do
      Sealed pw <- considerMergeToWorking repository "pull" (MarkConflicts:opts)
                   (reverseRL h_us) (reverseRL h_them)
      with_selected_changes_to_files' "unrevert" opts [] pw $
                            \ (p :> skipped) -> do
        tentativelyAddToPending repository opts p
        withSignalsBlocked $
          do finalizeRepositoryChanges repository
             applyToWorking repository opts p `catch` \e ->
                 fail ("Error applying unrevert to working directory...\n"
                       ++ show e)
             debugMessage "I'm about to write_unrevert."
             write_unrevert repository skipped rec (unrec+>+p)
        sync_repo repository
        debugMessage "Finished unreverting."
    _ -> impossible
unrevert_cmd _ _ = impossible

write_unrevert :: RepoPatch p => Repository p C(r u t) -> FL Prim C(x y) -> Slurpy -> FL Prim C(r x) -> IO ()
write_unrevert repository NilFL _ _ = removeFileMayNotExist $ unrevertUrl repository
write_unrevert repository ps rec pend = do
  case commutex (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 repository NilFL rec pend
    Just (_ :< p') -> do
        rep <- read_repo repository
        case get_common_and_uncommon (rep,rep) of
            (common,_ :\/: _) -> do
                date <- getIsoDateTime
                np <- namepatch date "unrevert" "anon" [] (fromRepoPrims repository p')
                writeDocBinFile (unrevertUrl repository) $
                             make_bundle [Unified] rec common (np :>: NilFL)
                where fromRepoPrims :: RepoPatch p => Repository p C(r u t) -> FL Prim C(r y) -> p C(r y)
                      fromRepoPrims _ xs = fromPrims xs

unrevert_patch_bundle :: RepoPatch p => Repository p C(r u t) -> IO (SealedPatchSet p)
unrevert_patch_bundle repository = do
  pf <- B.readFile (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}