% 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 Data.Maybe ( isJust )
    import Darcs.Commands ( DarcsCommand(..), nodefaults,
                            commandAlias, commandStub,
                            putWarning
                          )
    import Darcs.Arguments ( DarcsFlag (Recursive), fixSubPaths,
                            listRegisteredFiles,
                            workingRepoDir, umaskOption,
                            recursive
                          )
    import Darcs.RepoPath ( SubPath, sp2fn )
    import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,
                              add_to_pending, readRecordedAndPending, readUnrecorded )
    import Darcs.Diff( treeDiff )
    import Darcs.Patch ( RepoPatch, Prim, adddir, rmdir, addfile, rmfile )
    import Darcs.Patch.FileName( fn2fp )
    import Darcs.Witnesses.Ordered ( FL(..), (+>+) )
    import Darcs.Witnesses.Sealed ( Sealed(..) )
    import Darcs.Repository.Prefs ( filetypeFunction )
    import Storage.Hashed.Tree( TreeItem(..), find, modifyTree, expand, list )
    import Storage.Hashed.AnchoredPath( anchorPath )
    import Storage.Hashed( floatPath )

    import Darcs.Commands.Add( expandDirs )
    import Printer ( text )

    #include "gadts.h"

    removeDescription :: String
    removeDescription = "Remove files from version control."

    removeHelp :: String
    removeHelp =
     "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 {commandName = "remove",
                           commandHelp = removeHelp,
                           commandDescription = removeDescription,
                           commandExtraArgs = -1,
                           commandExtraArgHelp = ["<FILE or DIRECTORY> ..."],
                           commandCommand = removeCmd,
                           commandPrereq = amInRepository,
                           commandGetArgPossibilities = listRegisteredFiles,
                           commandArgdefaults = nodefaults,
                           commandAdvancedOptions = [umaskOption],
                           commandBasicOptions =
                               [workingRepoDir, recursive "recurse into subdirectories"]}

    removeCmd :: [DarcsFlag] -> [String] -> IO ()
    removeCmd opts relargs =
        withRepoLock opts $- \repository -> do
        origfiles <- fixSubPaths opts relargs
        args <- if Recursive `elem` opts
                then reverse `fmap` expandDirs origfiles
                else return origfiles
        when (null args) $
          putStrLn "Nothing specified, nothing removed."
        Sealed p <- makeRemovePatch opts repository args
        add_to_pending repository p

    makeRemovePatch :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t)
                      -> [SubPath] -> IO (Sealed (FL Prim C(u)))
    makeRemovePatch opts repository files =
                              do recorded <- expand =<< readRecordedAndPending repository
                                 unrecorded <- readUnrecorded repository
                                 ftf <- filetypeFunction
                                 mrp ftf recorded unrecorded $ map (floatPath . fn2fp . sp2fn) files
        where mrp ftf recorded unrecorded (f:fs) = do
                let recorded' = modifyTree recorded f Nothing
                    unrecorded' = modifyTree unrecorded f Nothing
                    f_fp = anchorPath "" f
                    skipAndWarn reason =
                        do putWarning opts . text $ "Can't remove " ++ f_fp
                                                    ++ " (" ++ reason ++ ")"
                           return $ Nothing

                local <- case (find recorded f, find unrecorded f) of
                  (Just (SubTree _), Just (SubTree unrecordedChildren)) -> do
                      if not $ null (list unrecordedChildren)
                        then skipAndWarn "it is not empty"
                        else return $ Just (rmdir f_fp :>: NilFL)
                  (Just (File _), Just (File _)) ->
                      Just `fmap` treeDiff ftf unrecorded unrecorded'
                  (Just (File _), _) ->
                      return $ Just (addfile f_fp :>: rmfile f_fp :>: NilFL)
                  (Just (SubTree _), _) ->
                      return  $ Just (adddir f_fp :>: rmdir f_fp :>: NilFL)
                  (_, _) -> skipAndWarn "it is not tracked by darcs"

                  -- we can tell if the remove succeeded by looking if local is
                  -- empty. If the remove succeeded, we should pass on updated
                  -- recorded and unrecorded that reflect the removal
                let nextRecorded | isJust local = recorded'
                                 | otherwise    = recorded
                    nextUnrecorded | isJust local = unrecorded'
                                   | otherwise    = unrecorded

                Sealed rest <- mrp ftf nextRecorded nextUnrecorded fs
                return . Sealed $ case local of
                                    Just localFL -> (localFL +>+ rest)
                                    Nothing      -> rest

              mrp _ _ _ [] = return (Sealed NilFL)

    rmDescription :: String
    rmDescription = "Help newbies find `darcs remove'."

    rmHelp :: String
    rmHelp =
     "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 = commandStub "rm" rmHelp rmDescription remove

    unadd :: DarcsCommand
    unadd = commandAlias "unadd" Nothing remove

\end{code}