%  Copyright (C) 2002-2005 David Roundy
%  This program is free software; you can redistribute it and/or modify
%  it under the terms of the GNU General Public License as published by
%  the Free Software Foundation; either version 2, or (at your option)
%  any later version.
%  This program is distributed in the hope that it will be useful,
%  but WITHOUT ANY WARRANTY; without even the implied warranty of
%  GNU General Public License for more details.
%  You should have received a copy of the GNU General Public License
%  along with this program; see the file COPYING.  If not, write to
%  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
%  Boston, MA 02110-1301, USA.

\subsection{darcs trackdown}
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), working_repo_dir,
                         set_scripts_executable )
import Darcs.Hopefully ( hopefully )
import Darcs.Repository ( amInRepository, read_repo, withRepoReadLock, ($-), withRecorded,
                          setScriptsExecutable )
import Darcs.Ordered ( unsafeUnRL, concatRL )
import Darcs.Patch ( RepoPatch, Named, description, apply, invert )
import Printer ( putDocLn )
import Darcs.Test ( get_test )
import Darcs.Lock ( withTempDir )


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


trackdown_help :: String
trackdown_help =
 "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 {command_name = "trackdown",
                          command_help = trackdown_help,
                          command_description = trackdown_description,
                          command_extra_args = -1,
                          command_extra_arg_help = ["[[INITIALIZATION]",
                          command_command = trackdown_cmd,
                          command_prereq = amInRepository,
                          command_get_arg_possibilities = return [],
                          command_argdefaults = nodefaults,
                          command_advanced_options = [set_scripts_executable],
                          command_basic_options = [working_repo_dir]}

trackdown_cmd :: [DarcsFlag] -> [String] -> IO ()
trackdown_cmd 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
    track_next opts test $ map (invert . hopefully) $ unsafeUnRL $ concatRL patches

track_next :: RepoPatch p => [DarcsFlag] -> (IO ExitCode) -> [Named p] -> IO ()
track_next 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
               track_next opts test ps
track_next _ _ [] = putStrLn "Noone passed the test!"

Trackdown is helpful for locating when something was broken.  It creates
a temporary directory with the latest repository content in it and cd to it.
First, and only once, it runs the initialization command if any,
for example
'autoconf; ./configure >/dev/null'
Then it runs the test command, for example
'make && cd tests && sh /tmp/test.sh'
While the test command exits with an error return code, darcs
``unapplies'' one patch from the version controlled files to retrieve
an earlier version, and repeats the test command.  If the test command
finally succeeds, the name of the hunted down patch is found in the
output before the last test run.

FIXME: It is
still rather primitive.  Currently it just goes back over the history in
reverse order trying each version.  I'd like for it to explore different
patch combinations, to try to find the minimum number of patches that you
would need to obliterate in order to make the test succeed.

FIXME: I also would like to add an interface by which you can tell it which
patches it should consider not including.  Without such a feature, the
following command:
% darcs trackdown 'make && false'
would result in compiling every version in the repository--which is a
rather tedious prospect.

\subsubsection{Example usage}
If you want to find the last version of darcs that had a FIXME note in the
file Record.lhs, you could run
% darcs trackdown 'grep FIXME Record.lhs'

To find the latest version that compiles, you can run
% darcs trackdown 'autoconf' './configure && make'

Trackdown can also be used to see how other features of the code changed
with time.  For example
% darcs trackdown 'autoconf; ./configure' \
   "make darcs > /dev/null && cd ~/darcs && time darcs check && false"
would let you see how long `darcs check' takes to run on each previous
version of darcs that will actually compile.  The ``\verb!&& false!''
ensures that trackdown keeps going.