% 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.
\darcsCommand{check}
\begin{code}

moduleDarcs.Commands.Check(check)whereimportControl.Monad(when)importControl.Applicative((<$>))importSystem.Exit(ExitCode(..),exitWith)importDarcs.Commands(DarcsCommand(..),nodefaults,putInfo)importDarcs.Arguments(DarcsFlag(Quiet),partialCheck,test,leaveTestDir,workingRepoDir,ignoretimes)importDarcs.Flags(willIgnoreTimes)importDarcs.Repository.Repair(replayRepository,checkIndex,RepositoryConsistency(..))importDarcs.Repository(Repository,amInRepository,withRepository,testRecorded,readRecorded)importDarcs.Patch(RepoPatch,showPatch,Prim)importDarcs.Witnesses.Ordered(FL(..))importDarcs.Witnesses.Sealed(Sealed(..),unFreeLeft)importDarcs.Repository.Prefs(filetypeFunction)importDarcs.Diff(treeDiff)importPrinter(text,($$),(<+>))#include "gadts.h"checkDescription::StringcheckDescription="Check the repository for consistency."checkHelp::StringcheckHelp="This command verifies that the patches in the repository, when applied\n"++"successively to an empty tree, result in the pristine tree. If not,\n"++"the differences are printed and Darcs exits unsucessfully (with a\n"++"non-zero exit status).\n"++"\n"++"If the repository is in darcs-1 format and has a checkpoint, you can\n"++"use the --partial option to start checking from the latest checkpoint.\n"++"This is the default for partial darcs-1 repositories; the --complete\n"++"option to forces a full check.\n"++"\n"++"If a regression test is defined (see `darcs setpref') it will be run\n"++"by `darcs check'. Use the --no-test option to disable this.\n"check::DarcsCommandcheck=DarcsCommand{commandName="check",commandHelp=checkHelp,commandDescription=checkDescription,commandExtraArgs=0,commandExtraArgHelp=[],commandCommand=checkCmd,commandPrereq=amInRepository,commandGetArgPossibilities=return[],commandArgdefaults=nodefaults,commandAdvancedOptions=[],commandBasicOptions=[partialCheck,test,leaveTestDir,workingRepoDir,ignoretimes]}checkCmd::[DarcsFlag]->[String]->IO()checkCmdopts_=withRepositoryopts(check'opts)check'::forallpC(rut).(RepoPatchp)=>[DarcsFlag]->RepositorypC(rut)->IO()check'optsrepository=dofailed<-replayRepositoryrepositoryopts$\state->docasestateofRepositoryConsistent->doputInfoopts$text"The repository is consistent!"testRecordedrepositoryreturnFalseBrokenPristinenewpris->dobrokenPristinenewprisreturnTrueBrokenPatchesnewpris_->dobrokenPristinenewprisputInfoopts$text"Found broken patches."returnTruebad_index<-casewillIgnoreTimesoptsofFalse->not<$>checkIndexrepository(Quiet`elem`opts)True->returnFalsewhenbad_index$putInfoopts$text"Bad index."exitWith$iffailed||bad_indexthenExitFailure1elseExitSuccesswherebrokenPristinenewpris=doputInfoopts$text"Looks like we have a difference..."mc<-readRecordedrepositoryftf<-filetypeFunctionSealed(diff::FLPrimC(rr2))<-unFreeLeft`fmap`treeDiffftfnewprismc::IO(Sealed(FLPrimC(r)))putInfoopts$casediffofNilFL->text"Nothing"patch->text"Difference: "<+>showPatchpatchputInfoopts$text""$$text"Inconsistent repository!"

\end{code}
%% FIXME: this should go in "common options" or something, since
%% commands like record and amend-record also run the test command.
\input{Darcs/Test.lhs}