%  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
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%  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.

\begin{code}
module Test ( run_test, get_test, test_patch, run_posthook ) where
import DarcsUtils ( withCurrentDirectory )
import System ( ExitCode(..), system )
import Monad ( when )
import Directory ( setCurrentDirectory )
import Workaround ( getCurrentDirectory )
import Patch ( Patch, apply )
import PatchCore ( patch2patchinfo )
import PatchInfo ( just_name )
import DarcsRepo ( withRecorded )

import DarcsArguments ( DarcsFlag( Verbose, Quiet, LeaveTestDir,
                                   NoPosthook, RunPosthook ),
                        get_posthook_cmd )
import RepoPrefs ( get_prefval )
import Lock ( withTempDir, withPermDir )
import DarcsUtils ( askUser )
import IO ( hPutStr, stderr )
\end{code}

If you like, you can configure your repository to be able to run a test
suite of some sort.  You can do this by using ``setpref'' to set the
``test'' value to be a command to run, e.g.
\begin{verbatim}
% darcs setpref test "sh configure && make && make test"
\end{verbatim}
Or, if you want to define a test specific to one copy of the repository,
you could do this by editing the file \verb!_darcs/prefs/prefs!.

\begin{options}
--leave-test-directory, --remove-test-directory
\end{options}

Normally darcs deletes the directory in which the test was run afterwards.
Sometimes (especially when the test fails) you'd prefer to be able to be
able to examine the test directory after the test is run.  You can do this
by specifying the \verb!--leave-test-directory! flag.  Alas, there is no
way to make darcs leave the test directory only if the test fails.  The
opposite of \verb!--leave-test-directory! is
\verb!--remove-test-directory!, which could come in handy if you choose to
make \verb!--leave-test-directory! the default (see
section~\ref{defaults}).

\begin{code}
run_test :: [DarcsFlag] -> FilePath -> IO ExitCode
run_test opts testdir = do test <- get_test opts
                           withCurrentDirectory testdir test

get_test :: [DarcsFlag] -> IO (IO ExitCode)
get_test opts =
 let putInfo s = when (not $ Quiet `elem` opts) $ putStr s
 in do
 testline <- get_prefval "test"
 return $
   case testline of
   Nothing -> return ExitSuccess
   Just testcode -> do
     putInfo "Running test...\n"
     ec <- system testcode
     if ec == ExitSuccess
       then putInfo "Test ran successfully.\n"
       else putInfo "Test failed!\n"
     return ec
\end{code}

\begin{code}
test_patch :: [DarcsFlag] -> Patch -> IO ExitCode
test_patch opts p = do
  testline <- get_prefval "test"
  case testline of
    Nothing -> return ExitSuccess
    Just _ -> do
      formerdir <- getCurrentDirectory
      withRecorded (wd "testing") $ \td -> do
        apply opts p
        setCurrentDirectory formerdir
        ec <- run_test opts td
        if ec == ExitSuccess
           then putInfo "Looks like a good patch.\n"
           else putInfo ("Looks like you have a bad patch" ++ name ++ ".\n")
        return ec
   where wd = if LeaveTestDir `elem` opts then withPermDir else withTempDir
         putInfo str = when (not $ Quiet `elem` opts) $ putStr str
         name = case patch2patchinfo p of Just p' -> ": " ++ just_name p'
                                          Nothing -> ""
\end{code}

\begin{code}
run_posthook :: [DarcsFlag] -> FilePath -> IO ExitCode
run_posthook opts repodir
             | NoPosthook `elem` opts = return ExitSuccess
             | otherwise = withCurrentDirectory repodir $ get_posthook opts

get_posthook :: [DarcsFlag] -> IO ExitCode
get_posthook opts =
 let putInfo s = when (Verbose `elem` opts) $ putStr s
     putErr  s = when (Quiet `notElem` opts) $ hPutStr stderr s
 in case get_posthook_cmd opts of
    Nothing -> return ExitSuccess
    Just command -> do
      yorn <- maybeAskUser ("\nThe following command is set to execute.\n"++
                            "Execute the following command now (yes or no)?\n"++
                            command++"\n")
      case yorn of ('y':_) -> do ec <- system command
                                 if ec == ExitSuccess
                                    then putInfo "Posthook ran successfully.\n"
                                    else putErr  "Posthook failed!\n"
                                 return ec
                   _ -> do putInfo "Posthook cancelled..."
                           return ExitSuccess
          where maybeAskUser
                    | RunPosthook `elem` opts = \_ -> return "yes"
                    | otherwise = askUser
\end{code}
