Unrevert.lhs

%  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}
{-# OPTIONS_GHC -cpp #-}
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 ( PatchSet, 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.Patch.Ordered ( RL(..), FL(..), (:<)(..), (:>)(..), (:\/:)(..), reverseRL )
import Darcs.SelectChanges ( with_selected_changes_to_files' )
import Darcs.SlurpDirectory ( Slurpy )
import FastPackedString ( readFilePS )
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 Darcs.Progress ( debugMessage )
import Darcs.Sealed ( Sealed(Sealed) )
#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_advanced_options = [umask_option],
                         command_basic_options = [ignoretimes,
                                                  all_interactive,
                                                  working_repo_dir]}
\end{code}
\begin{code}
unrevert_cmd :: [DarcsFlag] -> [String] -> IO ()
unrevert_cmd opts [] = withRepoLock opts $- \repository -> do
  Sealed us <- read_repo repository
  them <- unrevert_patch_bundle repository
  (rec, working) <- slurp_recorded_and_unrecorded repository
  unrec <- get_unrecorded repository
  case get_common_and_uncommon (us, them) of
    (_, us' :\/: them') -> do
      pw <- considerMergeToWorking repository "pull" (MarkConflicts:opts)
                 (reverseRL $ headRL us') (reverseRL $ headRL 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
        sync_repo repository
        debugMessage "Finished unreverting."
      where headRL (x:<:_) = x
            headRL NilRL = impossible
unrevert_cmd _ _ = impossible
\end{code}

\begin{code}
write_unrevert :: RepoPatch p => Repository p -> FL Prim -> Slurpy -> FL Prim -> 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
        Sealed 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" []
                                           (fromRepoPrims repository p') :>: NilFL)
                where fromRepoPrims :: RepoPatch p => Repository p -> FL Prim -> p
                      fromRepoPrims _ xs = fromPrims xs
\end{code}

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