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

module Darcs.Commands.MarkConflicts ( markconflicts, resolve ) where
import System.Exit ( ExitCode(..), exitWith )
import Darcs.SignalHandler ( withSignalsBlocked )
import Control.Monad ( when )

import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )
import Darcs.Arguments ( DarcsFlag, ignoretimes, workingRepoDir, umaskOption )
import Darcs.Repository ( withRepoLock, ($-), amInRepository, add_to_pending,
                    applyToWorking,
                    read_repo, unrecordedChanges
                    )
import Darcs.Patch ( invert )
import Darcs.Witnesses.Ordered ( FL(..) )
import Darcs.Witnesses.Sealed ( Sealed(Sealed) )
import Darcs.Resolution ( patchset_conflict_resolutions )
import Darcs.Utils ( promptYorn )
#include "impossible.h"

markconflictsDescription :: String
markconflictsDescription =
 "Mark unresolved conflicts in working tree, for manual resolution."

markconflictsHelp :: String
markconflictsHelp =
 "Darcs requires human guidance to unify changes to the same part of a\n" ++
 "source file.  When a conflict first occurs, darcs will add both\n" ++
 "choices to the working tree, delimited by the markers `v v v',\n" ++
 "`* * *' and `^ ^ ^'.\n" ++
 "\n" ++
 "However, you might revert or manually delete these markers without\n" ++
 "actually resolving the conflict.  In this case, `darcs mark-conflicts'\n" ++
 "is useful to show where any unresolved conflicts.  It is also useful\n" ++
 "if `darcs apply' is called with --apply-conflicts, where conflicts\n" ++
 "aren't marked initially.\n" ++
 "\n" ++
 "Any unrecorded changes to the working tree WILL be lost forever when\n" ++
 "you run this command!  You will be prompted for confirmation before\n" ++
 "this takes place.\n" ++
 "\n" ++
 "This command was historically called `resolve', and this deprecated\n" ++
 "alias still exists for backwards-compatibility.\n"

markconflicts :: DarcsCommand
markconflicts = DarcsCommand {commandName = "mark-conflicts",
                              commandHelp = markconflictsHelp,
                              commandDescription = markconflictsDescription,
                              commandExtraArgs = 0,
                              commandExtraArgHelp = [],
                              commandCommand = markconflictsCmd,
                              commandPrereq = amInRepository,
                              commandGetArgPossibilities = return [],
                              commandArgdefaults = nodefaults,
                              commandAdvancedOptions = [umaskOption],
                              commandBasicOptions = [ignoretimes,
                                                      workingRepoDir]}

markconflictsCmd :: [DarcsFlag] -> [String] -> IO ()
markconflictsCmd opts [] = withRepoLock opts $- \repository -> do
  pend <- unrecordedChanges opts repository []
  r <- read_repo repository
  Sealed res <- return $ patchset_conflict_resolutions r
  case res of NilFL -> do putStrLn "No conflicts to mark."
                          exitWith ExitSuccess
              _ -> return ()
  case pend of
    NilFL -> return ()
    _ ->      do putStrLn ("This will trash any unrecorded changes"++
                          " in the working directory.")
                 yorn <- promptYorn "Are you sure? "
                 when (yorn /= 'y') $ exitWith ExitSuccess
                 applyToWorking repository opts (invert pend) `catch` \e ->
                    bug ("Can't undo pending changes!" ++ show e)
  withSignalsBlocked $
    do add_to_pending repository res
       applyToWorking repository opts res `catch` \e ->
           bug ("Problem marking conflicts in mark-conflicts!" ++ show e)
  putStrLn "Finished marking conflicts."
markconflictsCmd _ _ = impossible

-- |resolve is an alias for mark-conflicts.
resolve :: DarcsCommand
resolve = commandAlias "resolve" markconflicts