{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE CPP #-}

module Darcs.Commands.Remove ( remove, rm, unadd ) where

import Control.Monad ( when )
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 )
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
            Sealed rest <- mrp ftf recorded' unrecorded' fs
            let f_fp = anchorPath "" f

            case (find recorded f, find unrecorded f) of
              (Just (SubTree _), Just (SubTree _)) ->
                  return . Sealed $ rmdir f_fp :>: rest
              (Just (File _), Just (File _)) ->
                  do diff <- treeDiff ftf unrecorded unrecorded'
                     return . Sealed $ diff +>+ rest
              (Just (File _), _) ->
                  return . Sealed $ addfile f_fp :>: rmfile f_fp :>: rest
              (Just (SubTree _), _) ->
                  return . Sealed $ adddir f_fp :>: rmdir f_fp :>: rest
              (_, _) -> do putWarning opts . text $ "Can't remove " ++ f_fp
                           return $ Sealed 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" remove