%  Copyright (C) 2002-2005 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 get}
\begin{code}
{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE CPP #-}

module Darcs.Commands.Get ( get ) where

import System.Directory ( setCurrentDirectory, doesDirectoryExist, doesFileExist,
                          createDirectory )
import Workaround ( getCurrentDirectory )
import Data.Maybe ( isJust )
import Control.Monad ( when )

import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( DarcsFlag( WorkDir, Partial, Lazy,
                                    UseFormat2, UseOldFashionedInventory, UseHashedInventory,
                                    SetScriptsExecutable, Quiet, OnePattern ),
                        get_context, pristine_tree, get_inventory_choices, working_repo_dir,
                        partial, reponame,
                        match_one_context, set_default, set_scripts_executable, nolinks,
                        network_options )
import Darcs.Repository ( Repository, withRepository, ($-), withRepoLock, identifyRepositoryFor, read_repo,
                          createPristineDirectoryTree,
                          tentativelyRemovePatches, patchSetToPatches, patchSetToRepository,
                          copyRepository, tentativelyAddToPending,
                          finalizeRepositoryChanges, sync_repo, setScriptsExecutable )
import Darcs.Repository.Format ( identifyRepoFormat, RepoFormat,
                                 RepoProperty ( Darcs2, HashedInventory ), format_has )
import Darcs.Repository.DarcsRepo ( write_inventory )
import qualified Darcs.Repository.DarcsRepo as DR ( read_repo )
import Darcs.Repository ( PatchSet, SealedPatchSet, copy_oldrepo_patches )
import Darcs.Repository.ApplyPatches ( apply_patches )
import Darcs.Repository.Checkpoint ( write_checkpoint_patch, get_checkpoint )
import Darcs.Patch ( RepoPatch, Patch, apply, patch2patchinfo, invert,
                     effect, description )
import Darcs.Ordered ( (:\/:)(..), RL(..), unsafeUnRL, mapRL, concatRL, reverseRL, lengthFL )
import Darcs.External ( copyFileOrUrl, Cachable(..) )
import Darcs.Patch.Depends ( get_common_and_uncommon, get_patches_beyond_tag )
import Darcs.Repository.Prefs ( set_defaultrepo )
import Darcs.Repository.Motd ( show_motd )
import Darcs.Repository.Pristine ( identifyPristine, createPristineFromWorking, )
import Darcs.SignalHandler ( catchInterrupt )
import Darcs.Commands.Init ( initialize )
import Darcs.Match ( have_patchset_match, get_one_patchset )
import Darcs.Utils ( catchall, formatPath, withCurrentDirectory )
import Darcs.Progress ( debugMessage )
import Printer ( text, vcat, errorDoc, ($$), Doc, putDocLn, )
import Darcs.Lock ( writeBinFile )
import Darcs.RepoPath ( toFilePath, toPath, ioAbsoluteOrRemote)
import Darcs.Sealed ( Sealed(..), unsafeUnflippedseal )
import Darcs.Global ( darcsdir )
#include "impossible.h"
\end{code}
\begin{code}
get_description :: String
get_description =
 "Create a local copy of another repository."
\end{code}

\options{get}

If the remote repository and the current directory are in the same filesystem and
that filesystem supports hard links, get will create hard links for the
patch files, which means that the additional storage space needed will be
minimal.  This is \emph{very} good for your disk usage (and for the speed
of running get), so if you want multiple copies of a repository, I strongly
recommend first running \verb!darcs get! to get yourself one copy, and then
running \verb!darcs get! on that copy to make any more you like.  The only
catch is that the first time you run \verb!darcs push! or \verb!darcs pull!
from any of these second copies, by default they will access your first
copy---which may not be what you want.

You may specify the name of the repository created by providing a second
argument to get, which is a directory name.

\begin{code}
get_help :: String
get_help =
 "Get is used to get a local copy of a repository.\n"
\end{code}
\begin{code}
get :: DarcsCommand
get = DarcsCommand {command_name = "get",
                    command_help = get_help,
                    command_description = get_description,
                    command_extra_args = -1,
                    command_extra_arg_help = ["<REPOSITORY>", "[<DIRECTORY>]"],
                    command_command = get_cmd,
                    command_prereq = contextExists,
                    command_get_arg_possibilities = return [],
                    command_argdefaults = nodefaults,
                    command_advanced_options = network_options ++
                                               command_advanced_options initialize,
                    command_basic_options = [reponame,
                                            partial,
                                            match_one_context,
                                            set_default,
                                            set_scripts_executable,
                                            nolinks, pristine_tree,
                                             get_inventory_choices,
                                             working_repo_dir]}
\end{code}
\begin{code}
get_cmd :: [DarcsFlag] -> [String] -> IO ()
get_cmd opts [inrepodir, outname] = get_cmd (WorkDir outname:opts) [inrepodir]
get_cmd opts [inrepodir] = do
  debugMessage "Starting work on get..."
  typed_repodir <- ioAbsoluteOrRemote inrepodir
  let repodir = toPath typed_repodir
  show_motd opts repodir
  when (Partial `elem` opts) $ debugMessage "Reading checkpoint..."
  rfsource_or_e <- identifyRepoFormat repodir
  rfsource <- case rfsource_or_e of Left e -> fail e
                                    Right x -> return x
  debugMessage $ "Found the format of "++repodir++"..."
  mysimplename <- make_repo_name opts repodir
  createDirectory mysimplename
  setCurrentDirectory mysimplename
  when (format_has Darcs2 rfsource && UseOldFashionedInventory `elem` opts) $
    putInfo $ text "Warning: 'old-fashioned-inventory' is ignored with a darcs-2 repository\n"
  let opts' = if format_has Darcs2 rfsource
              then UseFormat2:opts
              else if format_has HashedInventory rfsource &&
                      not (UseOldFashionedInventory `elem` opts)
                   then UseHashedInventory:filter (/= UseFormat2) opts
                   else UseOldFashionedInventory:filter (/= UseFormat2) opts
  (command_command initialize) opts' []
  debugMessage "Finished initializing new directory."
  set_defaultrepo repodir opts

  rf_or_e <- identifyRepoFormat "."
  rf <- case rf_or_e of Left e -> fail e
                        Right x -> return x
  if format_has HashedInventory rf -- refactor this into repository
    then writeBinFile (darcsdir++"/hashed_inventory") ""
    else write_inventory "." (NilRL:<:NilRL :: PatchSet Patch)

  if not (null [p | OnePattern p <- opts]) -- --to-match given
     && not (Partial `elem` opts) && not (Lazy `elem` opts)
    then withRepository opts $- \repository -> do
      debugMessage "Using economical get --to-match handling"
      fromrepo <- identifyRepositoryFor  repository repodir
      Sealed patches_to_get <- get_one_patchset fromrepo opts
      patchSetToRepository fromrepo patches_to_get opts
      debugMessage "Finished converting selected patch set to new repository"
    else copy_repo_and_go_to_chosen_version opts repodir rfsource rf putInfo
        where am_informative = not $ Quiet `elem` opts
              putInfo s = when am_informative $ putDocLn s

get_cmd _ _ = fail "You must provide 'get' with either one or two arguments."

-- called by get_cmd
-- assumes that the target repo of the get is the current directory, and that an inventory in the
-- right format has already been created.
copy_repo_and_go_to_chosen_version :: [DarcsFlag] -> String -> RepoFormat -> RepoFormat -> (Doc -> IO ()) -> IO ()
copy_repo_and_go_to_chosen_version opts repodir rfsource rf putInfo = do
  copy_repo `catchInterrupt` (putInfo $ text "Using lazy repository.")
  withRepository opts $- \repository -> go_to_chosen_version repository putInfo opts
  putInfo $ text "Finished getting."
      where copy_repo =
                withRepository opts $- \repository -> do
                  if format_has HashedInventory rf || format_has HashedInventory rfsource
                     then do debugMessage "Identifying and copying repository..."
                             identifyRepositoryFor repository repodir >>= copyRepository
                             when (SetScriptsExecutable `elem` opts) setScriptsExecutable
                     else copy_repo_old_fashioned repository opts repodir

\end{code}

\begin{code}
make_repo_name :: [DarcsFlag] -> FilePath -> IO String
make_repo_name (WorkDir n:_) _ =
    do exists <- doesDirectoryExist n
       file_exists <- doesFileExist n
       if exists || file_exists
          then fail $ "Directory or file named '" ++ n ++ "' already exists."
          else return n
make_repo_name (_:as) d = make_repo_name as d
make_repo_name [] d =
  case dropWhile (=='.') $ reverse $
       takeWhile (\c -> c /= '/' && c /= ':') $
       dropWhile (=='/') $ reverse d of
  "" -> modify_repo_name "anonymous_repo"
  base -> modify_repo_name base

modify_repo_name :: String -> IO String
modify_repo_name name =
    if head name == '/'
    then mrn name (-1)
    else do cwd <- getCurrentDirectory
            mrn (cwd ++ "/" ++ name) (-1)
 where
  mrn :: String -> Int -> IO String
  mrn n i = do
    exists <- doesDirectoryExist thename
    file_exists <- doesFileExist thename
    if not exists && not file_exists
       then do when (i /= -1) $
                    putStrLn $ "Directory '"++ n ++
                               "' already exists, creating repository as '"++
                               thename ++"'"
               return thename
       else mrn n $ i+1
    where thename = if i == -1 then n else n++"_"++show i
\end{code}

\begin{options}
--context, --tag, --to-patch, --to-match
\end{options}
If you want to get a specific version of a repository, you have a few
options.  You can either use the \verb!--tag!, \verb!--to-patch! or
\verb!--to-match! options, or you can use the \verb!--context=FILENAME!
option, which specifies a file containing a context generated with
\verb!darcs changes --context!.  This allows you (for example) to include in
your compiled program an option to output the precise version of the
repository from which it was generated, and then perhaps ask users to
include this information in bug reports.

Note that when specifying \verb!--to-patch! or \verb!--to-match!, you may
get a version of your code that has never before been seen, if the patches
have gotten themselves reordered.  If you ever want to be able to precisely
reproduce a given version, you need either to tag it or create a context
file.

\begin{code}
contextExists :: [DarcsFlag] -> IO (Either String ())
contextExists opts =
   case get_context opts of
     Nothing -> return $ Right ()
     Just f  -> do exists <- doesFileExist $ toFilePath f
                   if exists
                      then return $ Right ()
                      else return . Left $ "Context file "++toFilePath f++" does not exist"

go_to_chosen_version :: RepoPatch p => Repository p -> (Doc -> IO ())
                     -> [DarcsFlag] -> IO ()
go_to_chosen_version repository putInfo opts =
    when (have_patchset_match opts) $ do
       debugMessage "Going to specified version..."
       patches <- read_repo repository
       Sealed context <- get_one_patchset repository opts
       let (_,us':\/:them') = get_common_and_uncommon (patches, context)
       case them' of
           NilRL:<:NilRL -> return ()
           _ -> errorDoc $ text "Missing these patches from context:"
                        $$ (vcat $ mapRL description $ head $ unsafeUnRL them')
       let ps = patchSetToPatches us'
       putInfo $ text $ "Unapplying " ++ (show $ lengthFL ps) ++ " " ++
                   (patch_or_patches $ lengthFL ps)
       withRepoLock opts $- \_ ->
           do tentativelyRemovePatches repository opts ps
              tentativelyAddToPending repository opts $ invert $ effect ps
              finalizeRepositoryChanges repository
              apply opts (invert $ effect ps) `catch` \e ->
                  fail ("Couldn't undo patch in working dir.\n" ++ show e)
              sync_repo repository

patch_or_patches :: Int -> String
patch_or_patches 1 = "patch."
patch_or_patches _ = "patches."

\end{code}

\begin{options}
--partial
\end{options}
Only get the patches since the last checkpoint. This will save time,
bandwidth and disk space, at the expense of losing the history before
the checkpoint.

\begin{options}
--no-pristine-tree
\end{options}
In order to save disk space, you can use {\tt get} with the
\verb|--no-pristine-tree| flag to create a repository with no pristine
tree.  Please see Section~\ref{disk-usage} for more information.


\begin{code}

copy_repo_old_fashioned :: RepoPatch p => Repository p -> [DarcsFlag] -> String -> IO ()
copy_repo_old_fashioned repository opts repodir = do
  myname <- getCurrentDirectory
  fromrepo <- identifyRepositoryFor repository repodir
  mch <- get_checkpoint fromrepo
  patches <- read_repo fromrepo
  debugMessage "Getting the inventory..."
  write_inventory "." patches
  debugMessage "Copying patches..."
  copy_oldrepo_patches opts fromrepo "."
  debugMessage "Patches copied"
  Sealed local_patches <- DR.read_repo opts "." :: IO (SealedPatchSet Patch)
  debugMessage "Repo read"
  repo_is_local <- doesDirectoryExist repodir
  debugMessage $ "Repo local: " ++ formatPath (show repo_is_local)
  if repo_is_local && not (Partial `elem` opts)
     then do
       debugMessage "Copying prefs"
       copyFileOrUrl opts
          (repodir++"/"++darcsdir++"/prefs/prefs") (darcsdir++"/prefs/prefs") (MaxAge 600)
          `catchall` return ()
       debugMessage "Writing working directory"
       createPristineDirectoryTree fromrepo myname
       withCurrentDirectory myname $ do
           -- note: SetScriptsExecutable is normally checked in PatchApply
           -- but darcs get on local repositories does not apply patches
           if SetScriptsExecutable `elem` opts
              then setScriptsExecutable
              else return ()
     else do
       setCurrentDirectory myname
       if Partial `elem` opts && isJust mch
          then let Sealed p_ch = fromJust mch
                   pi_ch = patch2patchinfo p_ch
                   needed_patches = reverseRL $ concatRL $ unsafeUnflippedseal $
                                    get_patches_beyond_tag pi_ch local_patches
                   in do write_checkpoint_patch p_ch
                         apply opts p_ch `catch`
                             \e -> fail ("Bad checkpoint!\n" ++ show e)
                         apply_patches opts needed_patches
          else apply_patches opts $ reverseRL $ concatRL local_patches
  debugMessage "Writing the pristine"
  pristine <- identifyPristine
  createPristineFromWorking pristine
  setCurrentDirectory myname
  debugMessage "Syncing the repository..."
  sync_repo repository
  debugMessage "Repository synced."

\end{code}