1 %  Copyright (C) 2003-2005 David Roundy
    2 %
    3 %  This program is free software; you can redistribute it and/or modify
    4 %  it under the terms of the GNU General Public License as published by
    5 %  the Free Software Foundation; either version 2, or (at your option)
    6 %  any later version.
    7 %
    8 %  This program is distributed in the hope that it will be useful,
    9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 %  GNU General Public License for more details.
   12 %
   13 %  You should have received a copy of the GNU General Public License
   14 %  along with this program; see the file COPYING.  If not, write to
   15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 %  Boston, MA 02110-1301, USA.
   17 
   18 \darcsCommand{unrevert}
   19 \begin{code}
   20 {-# OPTIONS_GHC -cpp #-}
   21 {-# LANGUAGE CPP #-}
   22 
   23 #include "gadts.h"
   24 
   25 module Darcs.Commands.Unrevert ( unrevert, write_unrevert ) where
   26 import System.Exit ( ExitCode(..), exitWith )
   27 
   28 import Darcs.Commands ( DarcsCommand(..), nodefaults )
   29 import Darcs.Arguments ( DarcsFlag( Unified, MarkConflicts ),
   30                          ignoretimes, working_repo_dir,
   31                         all_interactive, umask_option,
   32                       )
   33 import Darcs.Repository ( SealedPatchSet, Repository, withRepoLock, ($-),
   34                           unrevertUrl, considerMergeToWorking,
   35                           tentativelyAddToPending, finalizeRepositoryChanges,
   36                           sync_repo, get_unrecorded,
   37                           read_repo, amInRepository,
   38                           slurp_recorded,
   39                           applyToWorking )
   40 import Darcs.Patch ( RepoPatch, Prim, commutex, namepatch, fromPrims )
   41 import Darcs.Ordered ( RL(..), FL(..), (:<)(..), (:>)(..), (:\/:)(..), reverseRL,
   42                        (+>+) )
   43 import Darcs.SelectChanges ( with_selected_changes_to_files' )
   44 import Darcs.SlurpDirectory ( Slurpy )
   45 import qualified Data.ByteString as B
   46 import Darcs.Lock ( writeDocBinFile, removeFileMayNotExist )
   47 import Darcs.Patch.Depends ( get_common_and_uncommon )
   48 import Darcs.Utils ( askUser, catchall )
   49 import Darcs.Patch.Bundle ( scan_bundle, make_bundle )
   50 import IsoDate ( getIsoDateTime )
   51 import Darcs.SignalHandler ( withSignalsBlocked )
   52 import Progress ( debugMessage )
   53 import Darcs.Sealed ( Sealed(Sealed) )
   54 #include "impossible.h"
   55 
   56 unrevert_description :: String
   57 unrevert_description =
   58  "Undo the last revert (may fail if changes after the revert)."
   59 
   60 unrevert_help :: String
   61 unrevert_help =
   62  "Unrevert is a rescue command in case you accidentally reverted\n" ++
   63  "something you wanted to keep (for example, typing `darcs rev -a'\n" ++
   64  "instead of `darcs rec -a').\n" ++
   65  "\n" ++
   66  "This command may fail if the repository has changed since the revert\n" ++
   67  "took place.  Darcs will ask for confirmation before executing an\n" ++
   68  "interactive command that will DEFINITELY prevent unreversion.\n"
   69 
   70 unrevert :: DarcsCommand
   71 unrevert = DarcsCommand {command_name = "unrevert",
   72                          command_help = unrevert_help,
   73                          command_description = unrevert_description,
   74                          command_extra_args = 0,
   75                          command_extra_arg_help = [],
   76                          command_command = unrevert_cmd,
   77                          command_prereq = amInRepository,
   78                          command_get_arg_possibilities = return [],
   79                          command_argdefaults = nodefaults,
   80                          command_advanced_options = [umask_option],
   81                          command_basic_options = [ignoretimes,
   82                                                   all_interactive,
   83                                                   working_repo_dir]}
   84 
   85 unrevert_cmd :: [DarcsFlag] -> [String] -> IO ()
   86 unrevert_cmd opts [] = withRepoLock opts $- \repository -> do
   87   us <- read_repo repository
   88   Sealed them <- unrevert_patch_bundle repository
   89   rec <- slurp_recorded repository
   90   unrec <- get_unrecorded repository
   91   case get_common_and_uncommon (us, them) of
   92     (_, (h_us:<:NilRL) :\/: (h_them:<:NilRL)) -> do
   93       Sealed pw <- considerMergeToWorking repository "pull" (MarkConflicts:opts)
   94                    (reverseRL h_us) (reverseRL h_them)
   95       with_selected_changes_to_files' "unrevert" opts [] pw $
   96                             \ (p :> skipped) -> do
   97         tentativelyAddToPending repository opts p
   98         withSignalsBlocked $
   99           do finalizeRepositoryChanges repository
  100              applyToWorking repository opts p `catch` \e ->
  101                  fail ("Error applying unrevert to working directory...\n"
  102                        ++ show e)
  103              debugMessage "I'm about to write_unrevert."
  104              write_unrevert repository skipped rec (unrec+>+p)
  105         sync_repo repository
  106         debugMessage "Finished unreverting."
  107     _ -> impossible                                                                                                            
  108 unrevert_cmd _ _ = impossible                                                                                                            
  109 
  110 write_unrevert :: RepoPatch p => Repository p C(r u t) -> FL Prim C(x y) -> Slurpy -> FL Prim C(r x) -> IO ()
  111 write_unrevert repository NilFL _ _ = removeFileMayNotExist $ unrevertUrl repository
  112 write_unrevert repository ps rec pend = do
  113   case commutex (ps :< pend) of
  114     Nothing -> do really <- askUser "You will not be able to unrevert this operation! Proceed? "
  115                   case really of ('y':_) -> return ()
  116                                  _ -> exitWith $ ExitSuccess
  117                   write_unrevert repository NilFL rec pend
  118     Just (_ :< p') -> do
  119         rep <- read_repo repository
  120         case get_common_and_uncommon (rep,rep) of
  121             (common,_ :\/: _) -> do
  122                 date <- getIsoDateTime
  123                 np <- namepatch date "unrevert" "anon" [] (fromRepoPrims repository p')
  124                 writeDocBinFile (unrevertUrl repository) $
  125                              make_bundle [Unified] rec common (np :>: NilFL)
  126                 where fromRepoPrims :: RepoPatch p => Repository p C(r u t) -> FL Prim C(r y) -> p C(r y)
  127                       fromRepoPrims _ xs = fromPrims xs
  128 
  129 unrevert_patch_bundle :: RepoPatch p => Repository p C(r u t) -> IO (SealedPatchSet p)
  130 unrevert_patch_bundle repository = do
  131   pf <- B.readFile (unrevertUrl repository)
  132         `catchall` fail "There's nothing to unrevert!"
  133   case scan_bundle pf of
  134       Right ps -> return ps
  135       Left err -> fail $ "Couldn't parse unrevert patch:\n" ++ err
  136 \end{code}