1 %  Copyright (C) 2002-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{trackdown}
   19 \begin{code}
   20 module Darcs.Commands.TrackDown ( trackdown ) where
   21 import Prelude hiding ( init )
   22 import System.Exit ( ExitCode(..) )
   23 import System.Cmd ( system )
   24 import System.IO ( hFlush, stdout )
   25 import Control.Monad( when )
   26 
   27 import Darcs.Commands ( DarcsCommand(..), nodefaults )
   28 import Darcs.Arguments ( DarcsFlag(SetScriptsExecutable), working_repo_dir,
   29                          set_scripts_executable )
   30 import Darcs.Hopefully ( hopefully )
   31 import Darcs.Repository ( amInRepository, read_repo, withRepoReadLock, ($-), withRecorded,
   32                           setScriptsExecutable )
   33 import Darcs.Ordered ( unsafeUnRL, concatRL )
   34 import Darcs.Patch ( RepoPatch, Named, description, apply, invert )
   35 import Printer ( putDocLn )
   36 import Darcs.Test ( get_test )
   37 import Darcs.Lock ( withTempDir )
   38 
   39 trackdown_description :: String
   40 trackdown_description = "Locate the most recent version lacking an error."
   41 
   42 trackdown_help :: String
   43 trackdown_help =
   44  "Trackdown tries to find the most recent version in the repository which\n"++
   45  "passes a test.  Given no arguments, it uses the default repository test.\n"++
   46  "Given one argument, it treats it as a test command.  Given two arguments,\n"++
   47  "the first is an initialization command with is run only once, and the\n"++
   48  "second is the test command.\n"
   49 
   50 trackdown :: DarcsCommand
   51 trackdown = DarcsCommand {command_name = "trackdown",
   52                           command_help = trackdown_help,
   53                           command_description = trackdown_description,
   54                           command_extra_args = -1,
   55                           command_extra_arg_help = ["[[INITIALIZATION]",
   56                                                     "COMMAND]"],
   57                           command_command = trackdown_cmd,
   58                           command_prereq = amInRepository,
   59                           command_get_arg_possibilities = return [],
   60                           command_argdefaults = nodefaults,
   61                           command_advanced_options = [set_scripts_executable],
   62                           command_basic_options = [working_repo_dir]}
   63 
   64 trackdown_cmd :: [DarcsFlag] -> [String] -> IO ()
   65 trackdown_cmd opts args = withRepoReadLock opts $- \repository -> do
   66   patches <- read_repo repository
   67   (init,test) <- case args of
   68           [] ->
   69               do t <- get_test opts
   70                  return (return ExitSuccess, t)
   71           [cmd] ->
   72               do putStrLn $ "Tracking down command:\n"++cmd
   73                  return $ (return ExitSuccess, system cmd)
   74           [init,cmd] ->
   75               do putStrLn $ "Initializing with command:\n"++init
   76                  putStrLn $ "Tracking down command:\n"++cmd
   77                  return $ (system init, system cmd)
   78           _ -> fail "Trackdown expects zero to two arguments."
   79   withRecorded repository (withTempDir "trackingdown") $ \_ -> do
   80     when (SetScriptsExecutable `elem` opts) setScriptsExecutable
   81     init
   82     track_next opts test $ map (invert . hopefully) $ unsafeUnRL $ concatRL patches
   83 
   84 track_next :: RepoPatch p => [DarcsFlag] -> (IO ExitCode) -> [Named p] -> IO ()
   85 track_next opts test (p:ps) = do
   86     test_result <- test
   87     if test_result == ExitSuccess
   88        then putStrLn "Success!"
   89        else do apply opts p `catch` \e -> fail ("Bad patch:\n" ++ show e)
   90                putStrLn "Trying without the patch:"
   91                putDocLn $ description $ invert p
   92                hFlush stdout
   93                track_next opts test ps
   94 track_next _ _ [] = putStrLn "Noone passed the test!"
   95 \end{code}
   96 
   97 Trackdown is helpful for locating when something was broken.  It creates
   98 a temporary directory with the latest repository content in it and cd to it.
   99 First, and only once, it runs the initialization command if any,
  100 for example
  101 \begin{verbatim}
  102 'autoconf; ./configure >/dev/null'
  103 \end{verbatim}
  104 Then it runs the test command, for example
  105 \begin{verbatim}
  106 'make && cd tests && sh /tmp/test.sh'
  107 \end{verbatim}
  108 While the test command exits with an error return code, darcs
  109 ``unapplies'' one patch from the version controlled files to retrieve
  110 an earlier version, and repeats the test command.  If the test command
  111 finally succeeds, the name of the hunted down patch is found in the
  112 output before the last test run.
  113 
  114 FIXME: It is
  115 still rather primitive.  Currently it just goes back over the history in
  116 reverse order trying each version.  I'd like for it to explore different
  117 patch combinations, to try to find the minimum number of patches that you
  118 would need to obliterate in order to make the test succeed.
  119 
  120 FIXME: I also would like to add an interface by which you can tell it which
  121 patches it should consider not including.  Without such a feature, the
  122 following command:
  123 \begin{verbatim}
  124 % darcs trackdown 'make && false'
  125 \end{verbatim}
  126 would result in compiling every version in the repository--which is a
  127 rather tedious prospect.
  128 
  129 \subsubsection{Example usage}
  130 If you want to find the last version of darcs that had a FIXME note in the
  131 file Record.lhs, you could run
  132 \begin{verbatim}
  133 % darcs trackdown 'grep FIXME Record.lhs'
  134 \end{verbatim}
  135 
  136 To find the latest version that compiles, you can run
  137 \begin{verbatim}
  138 % darcs trackdown 'autoconf' './configure && make'
  139 \end{verbatim}
  140 
  141 Trackdown can also be used to see how other features of the code changed
  142 with time.  For example
  143 \begin{verbatim}
  144 % darcs trackdown 'autoconf; ./configure' \
  145    "make darcs > /dev/null && cd ~/darcs && time darcs check && false"
  146 \end{verbatim}
  147 would let you see how long `darcs check' takes to run on each previous
  148 version of darcs that will actually compile.  The ``\verb!&& false!''
  149 ensures that trackdown keeps going.