module Darcs.Commands.Dist
(
dist
) where
import Prelude hiding ( writeFile )
import Data.ByteString.Lazy ( writeFile )
import Data.Char ( isAlphaNum )
import Control.Monad ( when )
import System.Directory ( setCurrentDirectory )
import System.Cmd ( system )
import System.Exit ( ExitCode(..), exitWith )
import System.FilePath.Posix ( takeFileName, (</>) )
import Workaround ( getCurrentDirectory )
import Codec.Archive.Tar ( pack, write )
import Codec.Archive.Tar.Entry ( entryPath )
import Codec.Compression.GZip ( compress )
import Darcs.Arguments ( DarcsFlag(Verbose, Quiet, DistName, SetScriptsExecutable), distnameOption,
workingRepoDir, matchOne, storeInMemory,
setScriptsExecutableOption )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Lock ( withTempDir )
import Darcs.Match ( getNonrangeMatch, haveNonrangeMatch, firstMatch, getFirstMatch )
import Darcs.Repository ( amInHashedRepository, withRepoReadLock, RepoJob(..),
setScriptsExecutable,
createPartialsPristineDirectoryTree )
import Darcs.Repository.Prefs ( getPrefval )
import Darcs.RepoPath ( AbsolutePath, toFilePath )
import Darcs.Utils ( withCurrentDirectory )
distDescription :: String
distDescription = "Create a distribution tarball."
distHelp :: String
distHelp =
"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
{
commandProgramName = "darcs"
, commandName = "dist"
, commandHelp = distHelp
, commandDescription = distDescription
, commandExtraArgs = 0
, commandExtraArgHelp = []
, commandCommand = distCmd
, commandPrereq = amInHashedRepository
, commandGetArgPossibilities = return []
, commandArgdefaults = nodefaults
, commandAdvancedOptions = []
, commandBasicOptions =
[
distnameOption
, workingRepoDir
, matchOne
, setScriptsExecutableOption
, storeInMemory
]
}
distCmd :: [DarcsFlag]
-> [String]
-> IO ()
distCmd opts _ = withRepoReadLock opts $ RepoJob $ \repository -> do
formerdir <- getCurrentDirectory
let distname = getDistName formerdir [x | DistName x <- opts]
predist <- getPrefval "predist"
let resultfile = formerdir </> distname ++ ".tar.gz"
withTempDir "darcsdist" $ \tempdir -> do
setCurrentDirectory formerdir
withTempDir (toFilePath tempdir </> takeFileName distname) $ \ddir -> do
if haveNonrangeMatch opts
then
if firstMatch opts
then withCurrentDirectory ddir $ getFirstMatch repository opts
else withCurrentDirectory ddir $ getNonrangeMatch repository opts
else createPartialsPristineDirectoryTree repository [""] (toFilePath ddir)
ec <- case predist of Nothing -> return ExitSuccess
Just pd -> system pd
if ec == ExitSuccess
then
do
withCurrentDirectory ddir $
when (SetScriptsExecutable `elem` opts) setScriptsExecutable
doDist opts tempdir ddir resultfile
else
do
putStrLn "Dist aborted due to predist failure"
exitWith ec
doDist :: [DarcsFlag] -> AbsolutePath -> AbsolutePath -> FilePath -> IO ()
doDist opts tempdir ddir resultfile = do
setCurrentDirectory (toFilePath tempdir)
let safeddir = safename $ takeFileName $ toFilePath ddir
entries <- pack "." [safeddir]
when (Verbose `elem` opts) $ putStr $ unlines $ map entryPath entries
writeFile resultfile $ compress $ write entries
when (Quiet `notElem` opts) $ putStrLn $ "Created dist as " ++ resultfile
where
safename n@(c:_) | isAlphaNum c = n
safename n = "./" ++ n
getDistName :: FilePath -> [String] -> FilePath
getDistName _ (dn:_) = dn
getDistName currentDirectory _ = takeFileName currentDirectory