module Darcs.Commands.TrackDown ( trackdown ) where
import Prelude hiding ( init )
import System.Exit ( ExitCode(..) )
import System.Cmd ( system )
import System.IO ( hFlush, stdout )
import Control.Monad( when )

import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( DarcsFlag(SetScriptsExecutable), workingRepoDir,
                         setScriptsExecutableOption )
import Darcs.Hopefully ( hopefully )
import Darcs.Repository ( amInRepository, read_repo, withRepoReadLock, ($-), withRecorded,
                          setScriptsExecutable )
import Darcs.Witnesses.Ordered ( FL(..), mapRL_RL, concatRL )
import Darcs.Patch ( RepoPatch, Named, description, apply, invert, invertRL )
import Printer ( putDocLn )
import Darcs.Test ( get_test )
import Darcs.Lock ( withTempDir )

#include "gadts.h"

trackdownDescription :: String
trackdownDescription = "Locate the most recent version lacking an error."

trackdownHelp :: String
trackdownHelp =
 "Trackdown tries to find the most recent version in the repository which\n"++
 "passes a test.  Given no arguments, it uses the default repository test.\n"++
 "Given one argument, it treats it as a test command.  Given two arguments,\n"++
 "the first is an initialization command with is run only once, and the\n"++
 "second is the test command.\n"

trackdown :: DarcsCommand
trackdown = DarcsCommand {commandName = "trackdown",
                          commandHelp = trackdownHelp,
                          commandDescription = trackdownDescription,
                          commandExtraArgs = -1,
                          commandExtraArgHelp = ["[[INITIALIZATION]",
                                                    "COMMAND]"],
                          commandCommand = trackdownCmd,
                          commandPrereq = amInRepository,
                          commandGetArgPossibilities = return [],
                          commandArgdefaults = nodefaults,
                          commandAdvancedOptions = [setScriptsExecutableOption],
                          commandBasicOptions = [workingRepoDir]}

trackdownCmd :: [DarcsFlag] -> [String] -> IO ()
trackdownCmd opts args = withRepoReadLock opts $- \repository -> do
  patches <- read_repo repository
  (init,test) <- case args of
          [] ->
              do t <- get_test opts
                 return (return ExitSuccess, t)
          [cmd] ->
              do putStrLn $ "Tracking down command:\n"++cmd
                 return $ (return ExitSuccess, system cmd)
          [init,cmd] ->
              do putStrLn $ "Initializing with command:\n"++init
                 putStrLn $ "Tracking down command:\n"++cmd
                 return $ (system init, system cmd)
          _ -> fail "Trackdown expects zero to two arguments."
  withRecorded repository (withTempDir "trackingdown") $ \_ -> do
    when (SetScriptsExecutable `elem` opts) setScriptsExecutable
    init
    trackNext opts test . invertRL . mapRL_RL hopefully . concatRL $ patches

trackNext :: RepoPatch p => [DarcsFlag] -> (IO ExitCode) -> FL (Named p) C(x y) -> IO ()
trackNext opts test (p:>:ps) = do
    test_result <- test
    if test_result == ExitSuccess
       then putStrLn "Success!"
       else do apply opts p `catch` \e -> fail ("Bad patch:\n" ++ show e)
               putStrLn "Trying without the patch:"
               putDocLn $ description $ invert p
               hFlush stdout
               trackNext opts test ps
trackNext _ _ NilFL = putStrLn "Noone passed the test!"