%  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; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\section{darcs add}
\begin{code}
module Add ( add ) where

import List ( (\\) )

import DarcsCommands
import DarcsArguments (noskip_boring, allow_caseonly,
                       any_verbosity,
                       recursive, working_repo_dir,
                       list_files, fix_filepath, list_unregistered_files,
                       DarcsFlag (AllowCaseOnly, Boring, Recursive,
                                  Verbose, Quiet),
                      )
import DarcsUtils ( withCurrentDirectory )

import Repository ( write_pending, am_in_repo, read_pending, slurp_pending )
import Patch ( Patch, apply_to_slurpy, addfile, adddir,
               join_patches, flatten,
             )
import SlurpDirectory ( Slurpy, slurp_has_anycase, slurp_has,
                        doesDirectoryReallyExist, doesFileReallyExist,
                        slurp_hasdir,
                      )
import FileName ( fp2fn )
import Monad ( liftM, unless )
import RepoPrefs ( darcsdir_filter, boring_file_filter )
import Lock ( withLock )
\end{code}

\begin{code}
add_description :: String
add_description =
 "Add one or more new files or directories."
\end{code}

\options{add}

\haskell{add_help}

\begin{code}
add_help :: String
add_help =
 "Add needs to be called whenever you add a new file or directory to\n"++
 "your project.  Of course, it also needs to be called when you first\n"++
 "create the project, to let darcs know which files should be kept\n"++
 "track of.\n"
\end{code}

\begin{code}
add :: DarcsCommand
add = DarcsCommand {command_name = "add",
                    command_help = add_help,
                    command_description = add_description,
                    command_extra_args = -1,
                    command_extra_arg_help = ["<FILE or DIRECTORY> ..."],
                    command_command = add_cmd,
                    command_prereq = am_in_repo,
                    command_get_arg_possibilities = list_unregistered_files,
                    command_argdefaults = nodefaults,
                    command_darcsoptions =
                    [noskip_boring, allow_caseonly,
                     recursive "add contents of subdirectories",
                     any_verbosity,
                     working_repo_dir]}
\end{code}

Darcs will refuse to add a file or directory that differs from an existing
one only in case.  This is because the HFS+ file system used on under MacOS
treats such files as being one and the same.

\begin{code}
add_cmd :: [DarcsFlag] -> [String] -> IO ()
add_cmd opts args = withLock "./_darcs/lock" $
 let putVerbose = if Verbose `elem` opts then putStr else \_ -> return ()
     putInfo = if Quiet `elem` opts then \_ -> return () else putStr
     putInfoLn = if Quiet `elem` opts then \_ -> return () else putStrLn
 in
 do cur <- slurp_pending "."
    flist <- if Recursive `elem` opts
             then expand_dirs $ map (fix_filepath opts) args
             else return $ map (fix_filepath opts) args
    -- refuse to add boring files recursively:
    nboring <- if Boring `elem` opts
               then return $ darcsdir_filter
               else boring_file_filter
    sequence_ $ map (putInfoLn . ("Skipping boring file "++)) $ flist \\ nboring flist
    ps <- addp putVerbose putInfo (AllowCaseOnly `elem` opts) cur $ nboring flist
    pend <- read_pending
    case pend of
        Nothing -> write_pending $ join_patches $ filter (/= join_patches []) ps
        Just op -> write_pending $ join_patches $
                   flatten $ join_patches [op,join_patches ps]

addp :: (String -> IO ()) -> (String -> IO ())
     -> Bool -> Slurpy -> [FilePath] -> IO [Patch]
addp _ _ _ _ [] = return []
addp putVerbose putInfo allowcaseonly cur (f:fs) =
  if (if allowcaseonly
      then slurp_has f cur
      else slurp_has_anycase f cur)
  then do putInfo $ "A file named "++f++" is already in the repository!\n"
          unless allowcaseonly $ do
            putInfo $ "Note that to ensure portability we don't allow files"
            putInfo $ " that differ\nonly in case.\n"
          addp putVerbose putInfo allowcaseonly cur fs
  else do
    isdir <- doesDirectoryReallyExist f
    if isdir
       then trypatch $ adddir f
       else do isfile <- doesFileReallyExist f
               if isfile
                  then trypatch $ addfile f
                  else do putInfo $ "File "++ f ++" does not exist!\n"
                          addp putVerbose putInfo allowcaseonly cur fs
    where trypatch p =
              case apply_to_slurpy p cur of
              Nothing -> do putInfo $ "Skipping '" ++ f ++ "' ... "
                            parent_error
                            addp putVerbose putInfo allowcaseonly cur fs
              Just s' -> do putVerbose $ "Adding '"++f++"'\n"
                            (p:) `liftM` addp putVerbose putInfo allowcaseonly s' fs
          parentdir = reverse $ dropWhile (/='/') $ reverse f
          have_parentdir = slurp_hasdir (fp2fn parentdir) cur
          parent_error = if have_parentdir
                         then putInfo "\n"
                         else putInfo $ "parent directory '"++parentdir++
                                  "' isn't in the repo.\n"
\end{code}

\begin{code}
expand_dirs :: [FilePath] -> IO [FilePath]
expand_dirs fs = liftM concat $ mapM expand_one fs
expand_one :: FilePath -> IO [FilePath]
expand_one f = do
  isdir <- doesDirectoryReallyExist f
  if not isdir then return [f]
     else do fs <- withCurrentDirectory f list_files
             return $ f: map (\f'->f++"/"++f') fs
\end{code}