% Copyright (C) 2002-2004 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{remove} \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} module Darcs.Commands.Remove ( remove, rm, unadd ) where import Control.Monad ( when ) import Darcs.Commands ( DarcsCommand(..), nodefaults, command_alias, command_stub, ) import Darcs.Arguments ( DarcsFlag, fixSubPaths, list_registered_files, working_repo_dir, umask_option ) import Darcs.RepoPath ( SubPath, toFilePath, sp2fn ) import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository, slurp_pending, slurp_recorded, get_unrecorded_in_files, add_to_pending ) import Darcs.Patch ( RepoPatch, Prim, apply_to_slurpy, adddir, rmdir, addfile, rmfile ) import Darcs.Ordered ( FL(..), (+>+) ) import Darcs.SlurpDirectory ( slurp_removedir, slurp_removefile ) import Darcs.Repository.Prefs ( filetype_function ) import Darcs.Diff ( unsafeDiff ) import Darcs.Gorsvet( invalidateIndex ) #include "impossible.h" remove_description :: String remove_description = "Remove files from version control." remove_help :: String remove_help = "The `darcs remove' command exists primarily for symmetry with `darcs\n" ++ "add', as the normal way to remove a file from version control is\n" ++ "simply to delete it from the working tree. This command is only\n" ++ "useful in the unusual case where one wants to record a removal patch\n" ++ "WITHOUT deleting the copy in the working tree (which can be re-added).\n" ++ "\n" ++ "Note that applying a removal patch to a repository (e.g. by pulling\n" ++ "the patch) will ALWAYS affect the working tree of that repository.\n" remove :: DarcsCommand remove = DarcsCommand {command_name = "remove", command_help = remove_help, command_description = remove_description, command_extra_args = -1, command_extra_arg_help = [" ..."], command_command = remove_cmd, command_prereq = amInRepository, command_get_arg_possibilities = list_registered_files, command_argdefaults = nodefaults, command_advanced_options = [umask_option], command_basic_options = [working_repo_dir]} remove_cmd :: [DarcsFlag] -> [String] -> IO () remove_cmd opts relargs = withRepoLock opts $- \repository -> do args <- fixSubPaths opts relargs when (null args) $ putStrLn "Nothing specified, nothing removed." p <- make_remove_patch repository args invalidateIndex repository add_to_pending repository p make_remove_patch :: RepoPatch p => Repository p -> [SubPath] -> IO (FL Prim) make_remove_patch repository files = do s <- slurp_pending repository srecorded <- slurp_recorded repository pend <- get_unrecorded_in_files repository (map sp2fn files) let sunrec = fromJust $ apply_to_slurpy pend srecorded wt <- filetype_function mrp wt s sunrec files where mrp wt s sunrec (f:fs) = case slurp_removedir fn s of Just s' -> case slurp_removedir fn sunrec of Just sunrec' -> do rest <- mrp wt s' sunrec' fs return $ rmdir f_fp :>: rest Nothing -> do rest <- mrp wt s' sunrec fs return $ adddir f_fp :>: rmdir f_fp :>: rest Nothing -> case slurp_removefile fn s of Nothing -> fail $ "Can't remove "++f_fp Just s' -> case slurp_removefile fn sunrec of Nothing -> do rest <- mrp wt s' sunrec fs return $ addfile f_fp :>: rmfile f_fp :>: rest Just sunrec' -> do rest <- mrp wt s' sunrec' fs let newp = unsafeDiff [] wt sunrec sunrec' return $ newp +>+ rest where fn = sp2fn f f_fp = toFilePath f mrp _ _ _ [] = return NilFL rm_description :: String rm_description = "Help newbies find `darcs remove'." rm_help :: String rm_help = "The `darcs rm' command does nothing.\n" ++ "\n" ++ "The normal way to remove a file from version control is simply to\n" ++ "delete it from the working tree. To remove a file from version\n" ++ "control WITHOUT affecting the working tree, see `darcs remove'.\n" rm :: DarcsCommand rm = command_stub "rm" rm_help rm_description remove unadd :: DarcsCommand unadd = command_alias "unadd" remove \end{code}