1 %  Copyright (C) 2002-2004 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 \darcsCommand{remove}
   19 \begin{code}
   20 {-# OPTIONS_GHC -cpp #-}
   21 {-# LANGUAGE CPP #-}
   22 
   23 module Darcs.Commands.Remove ( remove, rm, unadd ) where
   24 
   25 import Control.Monad ( when )
   26 import Darcs.Commands ( DarcsCommand(..), nodefaults,
   27                         command_alias, command_stub,
   28                       )
   29 import Darcs.Arguments ( DarcsFlag, fixSubPaths,
   30                         list_registered_files,
   31                         working_repo_dir, umask_option
   32                       )
   33 import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )
   34 import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,
   35                           slurp_pending, slurp_recorded,
   36                           get_unrecorded_in_files, add_to_pending )
   37 import Darcs.Patch ( RepoPatch, Prim, apply_to_slurpy, adddir, rmdir, addfile, rmfile )
   38 import Darcs.Ordered ( FL(..), (+>+) )
   39 import Darcs.SlurpDirectory ( slurp_removedir, slurp_removefile )
   40 import Darcs.Repository.Prefs ( filetype_function )
   41 import Darcs.Diff ( unsafeDiff )
   42 import Darcs.Gorsvet( invalidateIndex )
   43 #include "impossible.h"
   44 
   45 remove_description :: String
   46 remove_description = "Remove files from version control."
   47 
   48 remove_help :: String
   49 remove_help =
   50  "The `darcs remove' command exists primarily for symmetry with `darcs\n" ++
   51  "add', as the normal way to remove a file from version control is\n" ++
   52  "simply to delete it from the working tree.  This command is only\n" ++
   53  "useful in the unusual case where one wants to record a removal patch\n" ++
   54  "WITHOUT deleting the copy in the working tree (which can be re-added).\n" ++
   55  "\n" ++
   56  "Note that applying a removal patch to a repository (e.g. by pulling\n" ++
   57  "the patch) will ALWAYS affect the working tree of that repository.\n"
   58 
   59 remove :: DarcsCommand
   60 remove = DarcsCommand {command_name = "remove",
   61                        command_help = remove_help,
   62                        command_description = remove_description,
   63                        command_extra_args = -1,
   64                        command_extra_arg_help = ["<FILE or DIRECTORY> ..."],
   65                        command_command = remove_cmd,
   66                        command_prereq = amInRepository,
   67                        command_get_arg_possibilities = list_registered_files,
   68                        command_argdefaults = nodefaults,
   69                        command_advanced_options = [umask_option],
   70                        command_basic_options =
   71                            [working_repo_dir]}
   72 
   73 remove_cmd :: [DarcsFlag] -> [String] -> IO ()
   74 remove_cmd opts relargs =
   75     withRepoLock opts $- \repository -> do
   76     args <- fixSubPaths opts relargs
   77     when (null args) $
   78       putStrLn "Nothing specified, nothing removed."
   79     p <- make_remove_patch repository args
   80     invalidateIndex repository
   81     add_to_pending repository p
   82 
   83 make_remove_patch :: RepoPatch p => Repository p -> [SubPath] -> IO (FL Prim)
   84 make_remove_patch repository files =
   85                           do s <- slurp_pending repository
   86                              srecorded <- slurp_recorded repository
   87                              pend <- get_unrecorded_in_files repository (map sp2fn files)
   88                              let sunrec = fromJust $ apply_to_slurpy pend srecorded                                                       
   89                              wt <- filetype_function
   90                              mrp wt s sunrec files
   91     where mrp wt s sunrec (f:fs) =
   92               case slurp_removedir fn s of
   93               Just s' ->
   94                   case slurp_removedir fn sunrec of
   95                   Just sunrec' -> do rest <- mrp wt s' sunrec' fs
   96                                      return $ rmdir f_fp :>: rest
   97                   Nothing -> do rest <- mrp wt s' sunrec fs
   98                                 return $ adddir f_fp :>: rmdir f_fp :>: rest
   99               Nothing ->
  100                   case slurp_removefile fn s of
  101                   Nothing -> fail $ "Can't remove "++f_fp
  102                   Just s' ->
  103                       case slurp_removefile fn sunrec of
  104                       Nothing -> do rest <- mrp wt s' sunrec fs
  105                                     return $ addfile f_fp :>: rmfile f_fp :>: rest
  106                       Just sunrec' -> do rest <- mrp wt s' sunrec' fs
  107                                          let newp = unsafeDiff [] wt sunrec sunrec'
  108                                          return $ newp +>+ rest
  109             where fn = sp2fn f
  110                   f_fp = toFilePath f
  111           mrp _ _ _ [] = return NilFL
  112 
  113 rm_description :: String
  114 rm_description = "Help newbies find `darcs remove'."
  115 
  116 rm_help :: String
  117 rm_help =
  118  "The `darcs rm' command does nothing.\n" ++
  119  "\n" ++
  120  "The normal way to remove a file from version control is simply to\n" ++
  121  "delete it from the working tree.  To remove a file from version\n" ++
  122  "control WITHOUT affecting the working tree, see `darcs remove'.\n"
  123 
  124 rm :: DarcsCommand
  125 rm = command_stub "rm" rm_help rm_description remove
  126 
  127 unadd :: DarcsCommand
  128 unadd = command_alias "unadd" remove
  129 \end{code}
  130 
  131