% Copyright (C) 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 021101301, USA.
\subsection{darcs dist}
\begin{code}
module Darcs.Commands.Dist ( dist ) where
import System.Directory ( setCurrentDirectory )
import Workaround ( getCurrentDirectory )
import System.Exit ( ExitCode(..) )
import System.Cmd ( system )
import System.FilePath.Posix ( takeFileName, (</>) )
import Data.Char ( isAlphaNum )
import Control.Monad ( when )
import Darcs.Commands ( DarcsCommand(DarcsCommand, command_name, command_help,
command_description, command_extra_args,
command_extra_arg_help, command_command,
command_prereq, command_get_arg_possibilities,
command_argdefaults,
command_advanced_options, command_basic_options),
nodefaults )
import Darcs.Arguments ( DarcsFlag(Verbose, DistName), distname_option,
working_repo_dir, match_one, store_in_memory,
fixSubPaths )
import Darcs.Match ( get_nonrange_match, have_nonrange_match )
import Darcs.Repository ( amInRepository, withRepoReadLock, ($-), --withRecorded,
createPartialsPristineDirectoryTree )
import Darcs.Repository.Prefs ( get_prefval )
import Darcs.Lock ( withTemp, withTempDir, readBinFile )
import Darcs.RepoPath ( toFilePath )
import Darcs.Utils ( withCurrentDirectory )
import Exec ( exec, Redirect(..) )
\end{code}
\options{dist}
\haskell{dist_help}
\begin{code}
dist_description :: String
dist_description = "Create a distribution tarball."
dist_help :: String
dist_help =
"The `darcs dist' command creates a compressed archive (a `tarball') in\n" ++
"the repository's root directory, containing the recorded state of the\n" ++
"working tree (unrecorded changes and the \\_darcs directory are\n" ++
"excluded).\n" ++
"\n" ++
"If a predist command is set (see `darcs setpref'), that command will\n" ++
"be run on the tarball contents prior to archiving. For example,\n" ++
"autotools projects would set it to `autoconf \\&\\& automake'.\n" ++
"\n" ++
"By default, the tarball (and the top-level directory within the\n" ++
"tarball) has the same name as the repository, but this can be\n" ++
"overridden with the --dist-name option.\n"
dist :: DarcsCommand
dist = DarcsCommand {command_name = "dist",
command_help = dist_help,
command_description = dist_description,
command_extra_args = 0,
command_extra_arg_help = [],
command_command = dist_cmd,
command_prereq = amInRepository,
command_get_arg_possibilities = return [],
command_argdefaults = nodefaults,
command_advanced_options = [],
command_basic_options = [distname_option,
working_repo_dir,
match_one,
store_in_memory]}
dist_cmd :: [DarcsFlag] -> [String] -> IO ()
dist_cmd opts args = withRepoReadLock opts $- \repository -> do
distname <- get_dist_name opts
verb <- return $ Verbose `elem` opts
predist <- get_prefval "predist"
formerdir <- getCurrentDirectory
path_list <- if null args
then return [""]
else map toFilePath `fmap` fixSubPaths opts args
resultfile <- return (formerdir</>distname++".tar.gz")
withTemp $ \tarfile ->
withTempDir "darcsdist" $ \tempdir -> do
setCurrentDirectory (formerdir)
withTempDir (toFilePath tempdir </> takeFileName distname) $ \ddir -> do
if have_nonrange_match opts
then withCurrentDirectory ddir $ get_nonrange_match repository opts
else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)
case predist of Nothing -> return ExitSuccess
Just pd -> system pd
setCurrentDirectory (toFilePath tempdir)
exec "tar" ["-cf", "-", safename $ takeFileName $ toFilePath ddir]
(Null, File tarfile, AsIs)
when verb $ withTemp $ \tar_listing -> do
exec "tar" ["-tf", "-"]
(File tarfile, File tar_listing, Stdout)
to <- readBinFile tar_listing
putStr to
exec "gzip" ["-c"]
(File tarfile, File resultfile, AsIs)
putStrLn $ "Created dist as "++resultfile
where
safename n@(c:_) | isAlphaNum c = n
safename n = "./" ++ n
guess_repo_name :: IO String
guess_repo_name = do
pwd <- getCurrentDirectory
if '/' `elem` pwd
then return $ reverse $ takeWhile (/='/') $ reverse pwd
else return "cantguessreponame"
get_dist_name :: [DarcsFlag] -> IO String
get_dist_name (DistName dn:_) = return dn
get_dist_name (_:fs) = get_dist_name fs
get_dist_name _ = guess_repo_name
\end{code}