% 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. \subsection{darcs check} \begin{code} module Darcs.Commands.Check ( check ) where import Control.Monad ( when, unless ) import System.Exit ( ExitCode(..), exitWith ) import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Arguments ( DarcsFlag( Quiet, NoTest ), partial_check, notest, leave_test_dir, working_repo_dir, ) import Darcs.Repository.Repair( replayRepository, RepositoryConsistency(..) ) import Darcs.Repository ( Repository, amInRepository, withRepository, ($-), slurp_recorded, testTentative ) import Darcs.Patch ( RepoPatch, showPatch ) import Darcs.Ordered ( FL(..) ) import Darcs.Diff ( unsafeDiff ) import Darcs.Repository.Prefs ( filetype_function ) import Printer ( putDocLn, text, ($$), (<+>) ) \end{code} \options{check} \haskell{check_description} \begin{code} check_description :: String check_description = "Check the repository for consistency." \end{code} Check verifies that the patches stored in the repository, when successively applied to an empty tree, properly recreate the stored pristine tree. \begin{options} --complete, --partial \end{options} If you have a checkpoint of the repository (as is the case if you got the repository originally using \verb!darcs get --partial!), by default \verb'darcs check' will only verify the contents since the most recent checkpoint. You can change this behavior using the \verb!--complete! flag. \begin{code} check_help :: String check_help = "Check verifies that the patches stored in the repository, when successively\n"++ "applied to an empty tree, properly recreate the stored pristine tree.\n" \end{code} \begin{code} check :: DarcsCommand check = DarcsCommand {command_name = "check", command_help = check_help, command_description = check_description, command_extra_args = 0, command_extra_arg_help = [], command_command = check_cmd, command_prereq = amInRepository, command_get_arg_possibilities = return [], command_argdefaults = nodefaults, command_advanced_options = [], command_basic_options = [partial_check, notest, leave_test_dir, working_repo_dir ]} \end{code} \begin{code} check_cmd :: [DarcsFlag] -> [String] -> IO () check_cmd opts _ = withRepository opts $- \repo -> check' repo opts check' :: (RepoPatch p) => Repository p -> [DarcsFlag] -> IO () check' repository opts = do res <- replayRepository repository opts $ \ state -> do case state of RepositoryConsistent -> do putInfo $ text "The repository is consistent!" unless (NoTest `elem` opts) $ testTentative repository return ExitSuccess BrokenPristine newpris -> do brokenPristine newpris return $ ExitFailure 1 BrokenPatches newpris _ -> do brokenPristine newpris putInfo $ text "Found broken patches." return $ ExitFailure 1 exitWith res where brokenPristine newpris = do putInfo $ text "Looks like we have a difference..." mc <- slurp_recorded repository ftf <- filetype_function putInfo $ case unsafeDiff opts ftf newpris mc of NilFL -> text "Nothing" patch -> text "Difference: " <+> showPatch patch putInfo $ text "" $$ text "Inconsistent repository!" putInfo s = when (not $ Quiet `elem` opts) $ putDocLn s \end{code} \input{Darcs/Test.lhs} \begin{options} --no-test \end{options} If you just want to check the consistency of your repository without running the test, you can call darcs check with the \verb!--no-test! option.