Dist.lhs

%  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 02110-1301, 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_description}

\begin{code}
dist_description :: String
dist_description =
 "Create a distribution tarball."
\end{code}

\haskell{dist_help} Basically, you will typically use it in a makefile
rule such as
\begin{verbatim}
dist:
    darcs dist --dist-name darcs-`./darcs --version`
\end{verbatim}
\verb!darcs dist! then simply creates a clean copy of the source tree,
which it then tars and gzips.  If you use programs such as autoconf or
automake, you really should run them on the clean tree before tarring it up
and distributing it.  You can do this using the pref value ``predist'',
which is a shell command that is run prior to tarring up the distribution:
\begin{verbatim}
% darcs setpref predist "autoconf && automake"
\end{verbatim}

\begin{code}
dist_help :: String
dist_help =
 "Dist creates a tarball from a clean copy of the recorded edition of\n"++
 "your tree, eventually augmented by running the shell command specified\n"++
 "with the \"predist\" preference.\n"
\end{code}

\begin{code}
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]}
\end{code}

\begin{code}
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}