% Copyright (C) 20022005 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 021101301, USA.
\subsection{darcs get}
\begin{code}
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( NewRepo, Partial, Lazy,
UseFormat2, UseOldFashionedInventory, UseHashedInventory,
SetScriptsExecutable, Quiet, OnePattern ),
get_context, get_inventory_choices,
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,
createRepository)
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 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"
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
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"
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,
get_inventory_choices]}
get_cmd :: [DarcsFlag] -> [String] -> IO ()
get_cmd opts [inrepodir, outname] = get_cmd (NewRepo 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
createRepository 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
then writeBinFile (darcsdir++"/hashed_inventory") ""
else write_inventory "." (NilRL:<:NilRL :: PatchSet Patch)
if not (null [p | OnePattern p <- opts])
&& 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."
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
make_repo_name :: [DarcsFlag] -> FilePath -> IO String
make_repo_name (NewRepo 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}
\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!--topatch! or
\verb!--tomatch! options, or you can use the \verb!--context=FILENAME!
option, which specifies a file containing a context generated with
\verb!darcs changes
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!--topatch! or \verb!--tomatch!, 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{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
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}