%  Copyright (C) 2002-2003 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.

\subsection{darcs mv}
\begin{code}
module Mv ( mv ) where
import Monad ( when, unless )
import SignalHandler ( withSignalsBlocked )

import DarcsCommands ( DarcsCommand(..), nodefaults )
import DarcsArguments ( DarcsFlag( AllowCaseOnly ), verbose,
                        fix_filepaths_wrt, working_repo_dir,
                        list_files, allow_caseonly, umask_option,
                      )
import FilePathUtils ( (///) )
import Directory ( renameDirectory )
import Workaround ( renameFile )
import Repository ( identifyRepository, withRepoLock, amInRepository,
                    slurp_pending, add_to_pending,
                  )
import Patch ( join_patches, move )
import SlurpDirectory ( Slurpy, slurp, slurp_has, slurp_has_anycase,
                        slurp_remove, slurp_hasdir, slurp_hasfile )
import FileName ( fp2fn, fn2fp, super_name )
#include "impossible.h"
\end{code}

\begin{code}
mv_description :: String
mv_description =
 "Move/rename one or more files or directories."
\end{code}

\options{mv}

\haskell{mv_help} This is why ``mv'' isn't called ``move'', since it is
really almost equivalent to the unix command ``mv''.  I could add an
equivalent command named ``move'' for those who like vowels.

\begin{options}
--case-ok
\end{options}

Darcs mv will by default refuse to rename a file if there already exists a
file having the same name apart from case.  This is because doing so could
create a repository that could not be used on file systems that are case
insensitive (such as Apple's HFS+).  You can override this by with the flag
\verb!--case-ok!.

\begin{code}
mv_help :: String
mv_help =
 "Darcs mv needs to be called whenever you want to move files or\n"++
 "directories. Unlike remove, mv actually performs the move itself in your\n"++
 "working copy.\n"
\end{code}

\begin{code}
mv :: DarcsCommand
mv = DarcsCommand {command_name = "mv",
                   command_help = mv_help,
                   command_description = mv_description,
                   command_extra_args = -1,
                   command_extra_arg_help = ["[FILE or DIRECTORY]..."],
                   command_command = mv_cmd,
                   command_prereq = amInRepository,
                   command_get_arg_possibilities = list_files,
                   command_argdefaults = nodefaults,
                   command_darcsoptions = [allow_caseonly,
                                           verbose, working_repo_dir,
                                           umask_option]}
mv_cmd :: [DarcsFlag] -> [String] -> IO ()
mv_cmd _ [] = fail "You must specify at least two arguments for mv"
mv_cmd _ [_] = fail "You must specify at least two arguments for mv"
\end{code}

\begin{code}
mv_cmd opts args@[_,_] = withRepoLock opts $ \repository -> do
  (old:new:_) <- fix_filepaths_wrt "." opts args
  work <- slurp "."
  if slurp_hasdir (fp2fn new) work && slurp_has old work
   then move_to_dir opts [old] new
   else do
    cur <- slurp_pending repository
    check_new_and_old_filenames opts cur work (old,new)
    withSignalsBlocked $ do
      move_file_or_dir work old new
      add_to_pending repository (move old new)
\end{code}

\begin{code}
mv_cmd opts args =
   withRepoLock opts $ \_ -> do
     relpaths <- fix_filepaths_wrt "." opts args
     let moved = init relpaths
         finaldir = last relpaths
     move_to_dir opts moved finaldir

move_to_dir :: [DarcsFlag] -> [FilePath] -> FilePath -> IO ()
move_to_dir opts moved finaldir =
  let movefns = map (reverse.takeWhile (/='/').reverse) moved
      movetargets = map (finaldir///) movefns
      movepatches = map2 move moved movetargets
  in do
    repository <- identifyRepository "."
    cur <- slurp_pending repository
    work <- slurp "."
    mapM_ (check_new_and_old_filenames opts cur work) $ zip moved movetargets
    withSignalsBlocked $ do
      sequence_ $ map2 (move_file_or_dir work) moved movetargets
      add_to_pending repository (join_patches movepatches)

check_new_and_old_filenames
    :: [DarcsFlag] -> Slurpy -> Slurpy -> (FilePath, FilePath) -> IO ()
check_new_and_old_filenames opts cur work (old,new) = do
  if slurp_has old work -- We need to move the object
     then do unless (slurp_hasdir (super_name $ fp2fn new) work) $
                    fail $ "The target directory " ++
                             (fn2fp $ super_name $ fp2fn new)++
                             " isn't known in working directory, did you forget to add it?"
             when (it_has new work) $ fail $ already_exists "working directory"
     else unless (slurp_has new work) $ fail $ doesnt_exist "working directory"
  if slurp_has old cur
     then do unless (slurp_hasdir (super_name $ fp2fn new) cur) $
                    fail $ "The target directory " ++
                             (fn2fp $ super_name $ fp2fn new)++
                             " isn't known in working directory, did you forget to add it?"
             when (it_has new cur) $ fail $ already_exists "repository"
     else fail $ doesnt_exist "repository"
    where it_has f s = 
            let ms2 = slurp_remove (fp2fn old) s
            in case ms2 of
               Nothing -> False
               Just s2 -> if AllowCaseOnly `elem` opts 
                          then slurp_has f s2
                          else slurp_has_anycase f s2
          already_exists what_slurpy =
              if AllowCaseOnly `elem` opts
              then "A file or dir named "++new++" already exists in "
                       ++ what_slurpy ++ "."
              else "A file or dir named "++new++" (or perhaps differing"++
                       " only in case)\nalready exists in "++
                       what_slurpy ++ ".\n"++
                   "Use --case-ok to allow files differing only in case."
          doesnt_exist what_slurpy =
              "There is no file or dir named " ++ old ++
              " in the "++ what_slurpy ++ "."

move_file_or_dir :: Slurpy -> FilePath -> FilePath -> IO ()
move_file_or_dir work old new =
    if slurp_hasfile (fp2fn old) work
       then renameFile old new
       else if slurp_hasdir (fp2fn old) work
            then renameDirectory old new
            else return ()

map2 :: (a -> b -> c) -> [a] -> [b] -> [c]
map2 _ [] [] = []
map2 f (a:as) (b:bs) = f a b : map2 f as bs
map2 _ _ _ = bug "map2 in mv given lists of differing lengths!"
\end{code}

