src/Darcs/Commands/Remove.lhs

   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 \subsection{darcs remove}
  19 \begin{code}
  20 {-# OPTIONS_GHC -cpp #-}
  21 {-# LANGUAGE CPP #-}
  22
  23 module Darcs.Commands.Remove ( remove, rm, unadd ) where
  24
  25 import Darcs.Commands ( DarcsCommand(..), nodefaults,
  26                         command_alias, command_stub,
  27                       )
  28 import Darcs.Arguments ( DarcsFlag, fixSubPaths,
  29                         list_registered_files,
  30                         working_repo_dir, umask_option
  31                       )
  32 import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )
  33 import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,
  34                           slurp_pending, slurp_recorded, get_unrecorded, add_to_pending )
  35 import Darcs.Patch ( RepoPatch, Prim, apply_to_slurpy, adddir, rmdir, addfile, rmfile )
  36 import Darcs.Ordered ( FL(..), (+>+) )
  37 import Darcs.SlurpDirectory ( slurp_removedir, slurp_removefile )
  38 import Darcs.Repository.Prefs ( filetype_function )
  39 import Darcs.Diff ( unsafeDiff )
  40 #include "impossible.h"
  41 \end{code}
  42
  43 \begin{code}
  44 remove_description :: String
  45 remove_description =
  46  "Remove one or more files or directories from the repository."
  47 \end{code}
  48
  49 \options{remove}
  50
  51 \haskell{remove_help}
  52
  53 \begin{code}
  54 remove_help :: String
  55 remove_help =
  56  "Remove should be called when you want to remove a file from your project,\n"++
  57  "but don't actually want to delete the file.  Otherwise just delete the\n"++
  58  "file or directory, and darcs will notice that it has been removed.\n" ++
  59  "Be aware that the file WILL be deleted from any other copy of the\n" ++
  60  "repository to which you later apply the patch.\n"
  61 \end{code}
  62
  63 \begin{code}
  64 remove :: DarcsCommand
  65 remove = DarcsCommand {command_name = "remove",
  66                        command_help = remove_help,
  67                        command_description = remove_description,
  68                        command_extra_args = -1,
  69                        command_extra_arg_help = ["<FILE or DIRECTORY> ..."],
  70                        command_command = remove_cmd,
  71                        command_prereq = amInRepository,
  72                        command_get_arg_possibilities = list_registered_files,
  73                        command_argdefaults = nodefaults,
  74                        command_advanced_options = [umask_option],
  75                        command_basic_options =
  76                            [working_repo_dir]}
  77 \end{code}
  78
  79 \begin{code}
  80 remove_cmd :: [DarcsFlag] -> [String] -> IO ()
  81 remove_cmd opts relargs =
  82     withRepoLock opts $- \repository -> do
  83     args <- fixSubPaths opts relargs
  84     p <- make_remove_patch repository args
  85     add_to_pending repository p
  86
  87 make_remove_patch :: RepoPatch p => Repository p -> [SubPath] -> IO (FL Prim)
  88 make_remove_patch repository files =
  89                           do s <- slurp_pending repository
  90                              srecorded <- slurp_recorded repository
  91                              pend <- get_unrecorded repository
  92                              let sunrec = fromJust $ apply_to_slurpy pend srecorded
  93                              wt <- filetype_function
  94                              mrp wt s sunrec files
  95     where mrp wt s sunrec (f:fs) =
  96               case slurp_removedir fn s of
  97               Just s' ->
  98                   case slurp_removedir fn sunrec of
  99                   Just sunrec' -> do rest <- mrp wt s' sunrec' fs
 100                                      return $ rmdir f_fp :>: rest
 101                   Nothing -> do rest <- mrp wt s' sunrec fs
 102                                 return $ adddir f_fp :>: rmdir f_fp :>: rest
 103               Nothing ->
 104                   case slurp_removefile fn s of
 105                   Nothing -> fail $ "Can't remove "++f_fp
 106                   Just s' ->
 107                       case slurp_removefile fn sunrec of
 108                       Nothing -> do rest <- mrp wt s' sunrec fs
 109                                     return $ addfile f_fp :>: rmfile f_fp :>: rest
 110                       Just sunrec' -> do rest <- mrp wt s' sunrec' fs
 111                                          let newp = unsafeDiff [] wt sunrec sunrec'
 112                                          return $ newp +>+ rest
 113             where fn = sp2fn f
 114                   f_fp = toFilePath f
 115           mrp _ _ _ [] = return NilFL
 116 \end{code}
 117
 118 % rm - Note: not a subsection because not to be documented.
 119
 120 \begin{code}
 121 rm_description :: String
 122 rm_description =
 123  "Does not actually do anything, but offers advice on removing files"
 124
 125 rm_help :: String
 126 rm_help =
 127  "This command does not do anything.\n"++
 128  "If you want to remove a file AND delete it, just delete the file or directory,\n"++
 129  "and darcs will notice that it has been removed.\n" ++
 130  "If you want to remove a file WITHOUT deleting it, use the 'remove' command\n"
 131
 132 rm :: DarcsCommand
 133 rm = command_stub "rm" rm_help rm_description remove
 134 \end{code}
 135
 136 % unadd - Note: not a subsection because not to be documented.
 137
 138 \begin{code}
 139 unadd :: DarcsCommand
 140 unadd = command_alias "unadd" remove
 141 \end{code}
 142
 143