1 %  Copyright (C) 2002-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{mark-conflicts}
   19 \begin{code}
   20 {-# OPTIONS_GHC -cpp #-}
   21 {-# LANGUAGE CPP #-}
   22 
   23 module Darcs.Commands.MarkConflicts ( markconflicts, resolve ) where
   24 import System.Exit ( ExitCode(..), exitWith )
   25 import Darcs.SignalHandler ( withSignalsBlocked )
   26 import Control.Monad ( when )
   27 
   28 import Darcs.Commands ( DarcsCommand(..), nodefaults, command_alias )
   29 import Darcs.Arguments ( DarcsFlag, ignoretimes, working_repo_dir, umask_option )
   30 import Darcs.Repository ( withRepoLock, ($-), amInRepository, add_to_pending,
   31                     applyToWorking,
   32                     read_repo, sync_repo, get_unrecorded_unsorted,
   33                     )
   34 import Darcs.Patch ( invert )
   35 import Darcs.Ordered ( FL(..) )
   36 import Darcs.Sealed ( Sealed(Sealed) )
   37 import Darcs.Resolution ( patchset_conflict_resolutions )
   38 import Darcs.Utils ( promptYorn )
   39 #include "impossible.h"
   40 
   41 markconflicts_description :: String
   42 markconflicts_description =
   43  "Mark unresolved conflicts in working tree, for manual resolution."
   44 
   45 markconflicts_help :: String
   46 markconflicts_help =
   47  "Darcs requires human guidance to unify changes to the same part of a\n" ++
   48  "source file.  When a conflict first occurs, darcs will add both\n" ++
   49  "choices to the working tree, delimited by the markers `v v v',\n" ++
   50  "`* * *' and `^ ^ ^'.\n" ++
   51  "\n" ++
   52  "However, you might revert or manually delete these markers without\n" ++
   53  "actually resolving the conflict.  In this case, `darcs mark-conflicts'\n" ++
   54  "is useful to show where any unresolved conflicts.  It is also useful\n" ++
   55  "if `darcs apply' is called with --apply-conflicts, where conflicts\n" ++
   56  "aren't marked initially.\n" ++
   57  "\n" ++
   58  "Any unrecorded changes to the working tree WILL be lost forever when\n" ++
   59  "you run this command!  You will be prompted for confirmation before\n" ++
   60  "this takes place.\n" ++
   61  "\n" ++
   62  "This command was historically called `resolve', and this deprecated\n" ++
   63  "alias still exists for backwards-compatibility.\n"
   64 
   65 markconflicts :: DarcsCommand
   66 markconflicts = DarcsCommand {command_name = "mark-conflicts",
   67                               command_help = markconflicts_help,
   68                               command_description = markconflicts_description,
   69                               command_extra_args = 0,
   70                               command_extra_arg_help = [],
   71                               command_command = markconflicts_cmd,
   72                               command_prereq = amInRepository,
   73                               command_get_arg_possibilities = return [],
   74                               command_argdefaults = nodefaults,
   75                               command_advanced_options = [umask_option],
   76                               command_basic_options = [ignoretimes,
   77                                                       working_repo_dir]}
   78 
   79 markconflicts_cmd :: [DarcsFlag] -> [String] -> IO ()
   80 markconflicts_cmd opts [] = withRepoLock opts $- \repository -> do
   81   pend <- get_unrecorded_unsorted repository
   82   r <- read_repo repository
   83   Sealed res <- return $ patchset_conflict_resolutions r
   84   case res of NilFL -> do putStrLn "No conflicts to mark."
   85                           exitWith ExitSuccess
   86               _ -> return ()
   87   case pend of
   88     NilFL -> return ()
   89     _ ->      do yorn <- promptYorn
   90                          ("This will trash any unrecorded changes"++
   91                           " in the working directory.\nAre you sure? ")
   92                  when (yorn /= 'y') $ exitWith ExitSuccess
   93                  applyToWorking repository opts (invert pend) `catch` \e ->
   94                     bug ("Can't undo pending changes!" ++ show e)                                                                                                                
   95                  sync_repo repository
   96   withSignalsBlocked $
   97     do add_to_pending repository res
   98        applyToWorking repository opts res `catch` \e ->
   99            bug ("Problem marking conflicts in mark-conflicts!" ++ show e)                                                                                                                
  100   putStrLn "Finished marking conflicts."
  101 markconflicts_cmd _ _ = impossible                                                                                                                 
  102 
  103 -- |resolve is an alias for mark-conflicts.
  104 resolve :: DarcsCommand
  105 resolve = command_alias "resolve" markconflicts
  106 \end{code}