% 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.
\darcsCommand{rollback}
\begin{code}
module Darcs.Commands.Rollback ( rollback ) where
import Control.Monad ( when, filterM )
import System.Exit ( exitWith, ExitCode(..) )
import Data.List ( sort )
import Data.Maybe ( isJust )
import System.Directory ( removeFile )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( DarcsFlag(MarkConflicts), fixSubPaths, getAuthor,
definePatches,
workingRepoDir, nocompress,
author, patchnameOption, askLongComment,
leaveTestDir, notest, listRegisteredFiles,
matchSeveralOrLast, allInteractive, umaskOption
)
import Darcs.RepoPath ( toFilePath )
import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),
applyToWorking,
read_repo, slurp_recorded,
tentativelyMergePatches, withGutsOf,
finalizeRepositoryChanges, invalidateIndex )
import Darcs.Patch ( RepoPatch, summary, invert, namepatch, effect, fromPrims,
sortCoalesceFL, canonize )
import Darcs.Patch.Prim ( Prim )
import Darcs.Witnesses.Ordered
import Darcs.Hopefully ( PatchInfoAnd, n2pia )
import Darcs.Lock ( world_readable_temp )
import Darcs.SlurpDirectory ( empty_slurpy )
import Darcs.Match ( firstMatch )
import Darcs.SelectChanges ( with_selected_last_changes_to_files_reversed,
with_selected_last_changes_to_files' )
import Darcs.Commands.Record ( fileExists, getLog )
import Darcs.Commands.Unrecord ( getLastPatches )
import Darcs.Utils ( clarifyErrors )
import Printer ( renderString )
import Progress ( debugMessage )
import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..) )
import IsoDate ( getIsoDateTime )
#include "impossible.h"
rollbackDescription :: String
rollbackDescription =
"Record a new patch reversing some recorded changes."
rollbackHelp :: String
rollbackHelp =
"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"
rollback :: DarcsCommand
rollback = DarcsCommand {commandName = "rollback",
commandHelp = rollbackHelp,
commandDescription = rollbackDescription,
commandExtraArgs = 1,
commandExtraArgHelp = ["[FILE or DIRECTORY]..."],
commandCommand = rollbackCmd,
commandPrereq = amInRepository,
commandGetArgPossibilities = listRegisteredFiles,
commandArgdefaults = nodefaults,
commandAdvancedOptions = [nocompress,umaskOption],
commandBasicOptions = [matchSeveralOrLast,
allInteractive,
author, patchnameOption, askLongComment,
notest, leaveTestDir,
workingRepoDir]}
rollbackCmd :: [DarcsFlag] -> [String] -> IO ()
rollbackCmd opts args = withRepoLock opts $- \repository -> do
rec <- if null args then return empty_slurpy
else slurp_recorded repository
files <- sort `fmap` fixSubPaths opts args
existing_files <- map toFilePath `fmap` filterM (fileExists rec) files
non_existent_files <- map toFilePath `fmap` filterM (fmap not . fileExists rec) files
when (not $ null existing_files) $
putStrLn $ "Recording changes in "++unwords existing_files++":\n"
when (not $ null non_existent_files) $
putStrLn $ "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!"
allpatches <- read_repo repository
FlippedSeal patches <- return $ if firstMatch opts
then getLastPatches opts allpatches
else FlippedSeal $ concatRL allpatches
with_selected_last_changes_to_files_reversed "rollback" opts Nothing existing_files
(reverseRL patches) $ \ (_ :> ps) ->
do when (nullFL ps) $ do putStrLn "No patches selected!"
exitWith ExitSuccess
definePatches ps
with_selected_last_changes_to_files' "rollback" opts Nothing
existing_files (concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect ps)
(rollItBackNow opts repository ps)
rollItBackNow :: (RepoPatch p1, RepoPatch p) =>
[DarcsFlag] -> Repository p1 -> FL (PatchInfoAnd p)
-> (t :> FL Prim) -> IO ()
rollItBackNow opts repository ps (_ :> ps'') =
do when (nullFL ps'') $ do putStrLn "No changes selected!"
exitWith ExitSuccess
let make_log = world_readable_temp "darcs-rollback"
newlog = Just ("", "":"rolling back:":"":lines (renderString $ summary ps ))
(name, my_log, logf) <- getLog opts newlog make_log $ invert ps''
date <- getIsoDateTime
my_author <- getAuthor opts
rbp <- n2pia `fmap` namepatch date name my_author my_log
(fromPrims $ invert ps'')
debugMessage "Adding rollback patch to repository."
Sealed pw <- tentativelyMergePatches repository "rollback" (MarkConflicts : opts)
NilFL (rbp :>: NilFL)
debugMessage "Finalizing rollback changes..."
invalidateIndex repository
withGutsOf repository $ do
finalizeRepositoryChanges repository
debugMessage "About to apply rolled-back changes to working directory."
revertable $ applyToWorking repository opts pw
when (isJust logf) $ removeFile (fromJust logf)
putStrLn "Finished rolling back."
where revertable x = x `clarifyErrors` 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}