src/Darcs/Commands/Repair.lhs

   1 %  Copyright (C) 2003,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 \subsection{darcs repair}
  19 \begin{code}
  20 module Darcs.Commands.Repair ( repair ) where
  21 import System.IO
  22 import System.Exit ( exitWith, ExitCode(..) )
  23
  24 import Darcs.Commands
  25 import Darcs.Arguments ( DarcsFlag(),
  26                         working_repo_dir, umask_option,
  27                       )
  28 import Darcs.Repository ( withRepoLock, ($-), amInRepository,
  29                           replacePristineFromSlurpy )
  30 import Darcs.Repository.Repair( replayRepository, cleanupRepositoryReplay,
  31                                 RepositoryConsistency(..), CanRepair(..) )
  32 \end{code}
  33
  34 \options{repair}
  35 \begin{code}
  36 repair_description :: String
  37 repair_description = "Repair the corrupted repository."
  38 \end{code}
  39 \haskell{repair_help}
  40
  41 \begin{code}
  42 repair_help :: String
  43 repair_help =
  44  "Repair attempts to fix corruption that may have entered your\n"++
  45  "repository.\n"
  46 \end{code}
  47
  48 \begin{code}
  49 repair :: DarcsCommand
  50 repair = DarcsCommand {command_name = "repair",
  51                        command_help = repair_help,
  52                        command_description = repair_description,
  53                        command_extra_args = 0,
  54                        command_extra_arg_help = [],
  55                        command_command = repair_cmd,
  56                        command_prereq = amInRepository,
  57                        command_get_arg_possibilities = return [],
  58                        command_argdefaults = nodefaults,
  59                        command_advanced_options = [umask_option],
  60                        command_basic_options = [working_repo_dir]}
  61 \end{code}
  62
  63 Repair currently will only repair damage to the pristine tree.
  64 Fortunately this is just the sort of corruption that is most
  65 likely to happen.
  66
  67 \begin{code}
  68
  69 repair_cmd :: [DarcsFlag] -> [String] -> IO ()
  70 repair_cmd opts _ = withRepoLock opts $- \repository -> do
  71   state <- replayRepository CanRepair repository opts
  72   case state of
  73       RepositoryConsistent ->
  74           putStrLn "The repository is already consistent, no changes made."
  75       RepositoryInconsistent s -> do
  76                putStrLn "Fixing pristine tree..."
  77                replacePristineFromSlurpy repository s
  78   cleanupRepositoryReplay repository
  79   exitWith ExitSuccess
  80
  81 \end{code}