src/Darcs/Commands/MarkConflicts.lhs

   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 \subsection{darcs 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 \end{code}
  41 \begin{code}
  42 markconflicts_description :: String
  43 markconflicts_description =
  44  "Mark any conflicts to the working copy for manual resolution."
  45 \end{code}
  46
  47 \options{mark-conflicts}
  48
  49 \haskell{mark-conflicts_help}
  50
  51 \begin{code}
  52 markconflicts_help :: String
  53 markconflicts_help =
  54  "Mark-conflicts is used to mark and resolve any conflicts that may exist in a\n"++
  55  "repository.  Note that this trashes any unrecorded changes in the working\n"++
  56  "copy.\n"
  57 \end{code}
  58 \begin{code}
  59 markconflicts :: DarcsCommand
  60 markconflicts = DarcsCommand {command_name = "mark-conflicts",
  61                               command_help = markconflicts_help,
  62                               command_description = markconflicts_description,
  63                               command_extra_args = 0,
  64                               command_extra_arg_help = [],
  65                               command_command = markconflicts_cmd,
  66                               command_prereq = amInRepository,
  67                               command_get_arg_possibilities = return [],
  68                               command_argdefaults = nodefaults,
  69                               command_advanced_options = [umask_option],
  70                               command_basic_options = [ignoretimes,
  71                                                       working_repo_dir]}
  72 \end{code}
  73
  74 \begin{code}
  75 markconflicts_cmd :: [DarcsFlag] -> [String] -> IO ()
  76 markconflicts_cmd opts [] = withRepoLock opts $- \repository -> do
  77   pend <- get_unrecorded_unsorted repository
  78   r <- read_repo repository
  79   Sealed res <- return $ patchset_conflict_resolutions r
  80   case res of NilFL -> do putStrLn "No conflicts to mark."
  81                           exitWith ExitSuccess
  82               _ -> return ()
  83   case pend of
  84     NilFL -> return ()
  85     _ ->      do yorn <- promptYorn
  86                          ("This will trash any unrecorded changes"++
  87                           " in the working directory.\nAre you sure? ")
  88                  when (yorn /= 'y') $ exitWith ExitSuccess
  89                  applyToWorking repository opts (invert pend) `catch` \e ->
  90                     bug ("Can't undo pending changes!" ++ show e)
  91                  sync_repo repository
  92   withSignalsBlocked $
  93     do add_to_pending repository res
  94        applyToWorking repository opts res `catch` \e ->
  95            bug ("Problem marking conflicts in mark-conflicts!" ++ show e)
  96   putStrLn "Finished marking conflicts."
  97 markconflicts_cmd _ _ = impossible
  98 \end{code}
  99
 100 % resolve - not documented because hidden
 101
 102 \begin{code}
 103 resolve :: DarcsCommand
 104 resolve = command_alias "resolve" markconflicts
 105 \end{code}