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.

\darcsCommand{dist}
\begin{code}
module Darcs.Commands.Dist ( dist ) where
import System.Directory ( setCurrentDirectory )
import Workaround ( getCurrentDirectory )
import System.Exit ( ExitCode(..), exitWith )
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 ( AbsolutePath, toFilePath )
import Darcs.Utils ( withCurrentDirectory )
import Exec ( exec, Redirect(..) )

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"

 -- FIXME: this is tedious and ugly.
 {-
 ++ "\n" ++
 "Suppose you use a version numbering scheme `major.minor.patch', and\n" ++
 "you tag each release `major.minor'.  You can then calculate the\n" ++
 "version number by taking the newest tag and appending a dot and the\n" ++
 "number of patches since that tag.  If you use the directory name as\n" ++
 "the project name, you can make tarballs of the form name-version.tgz\n" ++
 "using the following shell script:\n" ++
 "\n" ++
 "  major_minor=$(darcs show tags | head -1) &&\n" ++
 "  patch_level=$(($(darcs changes --count --from-tag .) - 1)) &&\n" ++
 "  version=$major_minor.$patch_level &&\n" ++
 "  project=${PWD##*/} &&\n" ++
 "  darcs dist --dist-name \"$project\"-\"$version\".tar.gz\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)
        ec <- case predist of Nothing -> return ExitSuccess
                              Just pd -> system pd
        if (ec == ExitSuccess) then do_dist verb tarfile tempdir ddir resultfile
            else
                do
                putStrLn "Dist aborted due to predist failure"
                exitWith ec

-- | This function performs the actual distribution action itself.
-- NB - it does /not/ perform the pre-dist, that should already
-- have completed successfully before this is invoked.
do_dist :: Bool -> FilePath -> AbsolutePath -> AbsolutePath -> FilePath -> IO ()
do_dist verb tarfile tempdir ddir resultfile = do
  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}