% Copyright (C) 20032005 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 021101301, USA.
\subsection{darcs unrevert}\label{unrevert}
\begin{code}
#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_and_unrecorded,
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)."
\end{code}
\options{unrevert}
\haskell{unrevert_help}
\begin{code}
unrevert_help :: String
unrevert_help =
"Unrevert is a rescue command in case you accidentally reverted\n" ++
"something you wanted to keep (for example, accidentally typing `darcs\n" ++
"rev -a' 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, working) <- slurp_recorded_and_unrecorded 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 working [] 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}