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

    {-# OPTIONS_GHC -cpp #-}
    {-# LANGUAGE CPP #-}

    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 ))
                --tentativelyRemovePatches repository opts (mapFL_FL hopefully 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}