src/Darcs/Commands/Dist.lhs

   1 %  Copyright (C) 2003 David Roundy
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18 \subsection{darcs dist}
  19 \begin{code}
  20 module Darcs.Commands.Dist ( dist ) where
  21 import System.Directory ( setCurrentDirectory )
  22 import Workaround ( getCurrentDirectory )
  23 import System.Exit ( ExitCode(..) )
  24 import System.Cmd ( system )
  25 import Data.Char ( isAlphaNum )
  26 import Control.Monad ( when )
  27
  28 import Darcs.Commands
  29 import Darcs.Arguments
  30 import Darcs.Match ( get_nonrange_match, have_nonrange_match )
  31 import Darcs.Repository ( amInRepository, withRepoReadLock, ($-), --withRecorded,
  32                           createPartialsPristineDirectoryTree )
  33 import Darcs.Repository.Prefs ( get_prefval )
  34 import Darcs.Lock ( withTemp, withTempDir, readBinFile )
  35 import Darcs.RepoPath ( toFilePath )
  36 import Darcs.Utils ( withCurrentDirectory )
  37 import UglyFileName ( own_name, fn2fp, fp2fn )
  38 import Exec ( exec, Redirect(..) )
  39
  40 \end{code}
  41
  42 \options{dist}
  43
  44 \haskell{dist_description}
  45
  46 \begin{code}
  47 dist_description :: String
  48 dist_description =
  49  "Create a distribution tarball."
  50 \end{code}
  51
  52 \haskell{dist_help} Basically, you will typically use it in a makefile
  53 rule such as
  54 \begin{verbatim}
  55 dist:
  56     darcs dist --dist-name darcs-`./darcs --version`
  57 \end{verbatim}
  58 \verb!darcs dist! then simply creates a clean copy of the source tree,
  59 which it then tars and gzips.  If you use programs such as autoconf or
  60 automake, you really should run them on the clean tree before tarring it up
  61 and distributing it.  You can do this using the pref value ``predist'',
  62 which is a shell command that is run prior to tarring up the distribution:
  63 \begin{verbatim}
  64 % darcs setpref predist "autoconf && automake"
  65 \end{verbatim}
  66
  67 \begin{code}
  68 dist_help :: String
  69 dist_help =
  70  "Dist creates a tarball from a clean copy of the recorded edition of\n"++
  71  "your tree, eventually augmented by running the shell command specified\n"++
  72  "with the \"predist\" preference.\n"
  73 \end{code}
  74
  75 \begin{code}
  76 dist :: DarcsCommand
  77 dist = DarcsCommand {command_name = "dist",
  78                      command_help = dist_help,
  79                      command_description = dist_description,
  80                      command_extra_args = 0,
  81                      command_extra_arg_help = [],
  82                      command_command = dist_cmd,
  83                      command_prereq = amInRepository,
  84                      command_get_arg_possibilities = return [],
  85                      command_argdefaults = nodefaults,
  86                      command_advanced_options = [],
  87                      command_basic_options = [distname_option,
  88                                               working_repo_dir,
  89                                               match_one,
  90                                               store_in_memory]}
  91 \end{code}
  92
  93 \begin{code}
  94 dist_cmd :: [DarcsFlag] -> [String] -> IO ()
  95 dist_cmd opts args = withRepoReadLock opts $- \repository -> do
  96   distname <- get_dist_name opts
  97   verb <- return $ Verbose `elem` opts
  98   predist <- get_prefval "predist"
  99   formerdir <- getCurrentDirectory
 100   path_list <- if null args
 101                then return [""]
 102                else map toFilePath `fmap` fixSubPaths opts args
 103   resultfile <- return (formerdir++"/"++distname++".tar.gz")
 104   withTemp $ \tarfile ->
 105     withTempDir "darcsdist" $ \tempdir -> do
 106       setCurrentDirectory (formerdir)
 107       withTempDir (toFilePath tempdir++"/"++(basename distname)) $ \ddir -> do
 108         if have_nonrange_match opts
 109           then withCurrentDirectory ddir $ get_nonrange_match repository opts
 110           else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)
 111         case predist of Nothing -> return ExitSuccess
 112                         Just pd -> system pd
 113         setCurrentDirectory (toFilePath tempdir)
 114         exec "tar" ["-cf", "-", safename $ basename $ toFilePath ddir]
 115                    (Null, File tarfile, AsIs)
 116         when verb $ withTemp $ \tar_listing -> do
 117                       exec "tar" ["-tf", "-"]
 118                            (File tarfile, File tar_listing, Stdout)
 119                       to <- readBinFile tar_listing
 120                       putStr to
 121         exec "gzip" ["-c"]
 122              (File tarfile, File resultfile, AsIs)
 123         putStrLn $ "Created dist as "++resultfile
 124   where
 125     basename = fn2fp . own_name . fp2fn
 126     safename n@(c:_) | isAlphaNum c  = n
 127     safename n = "./" ++ n
 128
 129 guess_repo_name :: IO String
 130 guess_repo_name = do
 131   pwd <- getCurrentDirectory
 132   if '/' `elem` pwd
 133      then return $ reverse $ takeWhile (/='/') $ reverse pwd
 134      else return "cantguessreponame"
 135
 136 get_dist_name :: [DarcsFlag] -> IO String
 137 get_dist_name (DistName dn:_) = return dn
 138 get_dist_name (_:fs) = get_dist_name fs
 139 get_dist_name _ = guess_repo_name
 140 \end{code}
 141