[commit: Cabal] master: Make the 'upload' command more self explanatory (20a1831)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/20a18311124172c06fd1a941891288e921078c44

>---------------------------------------------------------------

commit 20a18311124172c06fd1a941891288e921078c44
Author: Duncan Coutts <duncan at haskell.org>
Date:   Mon Mar 10 23:33:46 2008 +0000

    Make the 'upload' command more self explanatory
    It tells you what to do if you don't supply any args, rather than doing
    nothing and it check for simple mistakes and gives helpful error messages.

>---------------------------------------------------------------

 cabal-install/Main.hs |   21 ++++++++++++++++++++-
 1 files changed, 20 insertions(+), 1 deletions(-)

diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 6435d41..b308ede 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -21,7 +21,7 @@ import Distribution.Simple.Program (defaultProgramConfiguration)
 import Distribution.Simple.Command
 import Distribution.Simple.SetupWrapper (setupWrapper)
 import Distribution.Simple.Configure (configCompilerAux)
-import Distribution.Simple.Utils (cabalVersion, die)
+import Distribution.Simple.Utils (cabalVersion, die, intercalate)
 import Hackage.Config           (SavedConfig(..), savedConfigToConfigFlags,
                                  defaultConfigFile, loadConfig, configRepos,
                                  configPackageDB)
@@ -40,6 +40,8 @@ import qualified Paths_cabal_install (version)
 
 import System.Environment       (getArgs, getProgName)
 import System.Exit              (exitFailure)
+import System.FilePath          (splitExtension, takeExtension)
+import System.Directory         (doesFileExist)
 import Data.List                (intersperse)
 import Data.Monoid              (Monoid(..))
 import Control.Monad            (unless)
@@ -183,6 +185,7 @@ uploadAction flags extraArgs = do
   config <- loadConfig verbosity configFile
   -- FIXME: check that the .tar.gz files exist and report friendly error message if not
   let tarfiles = extraArgs
+  checkTarFiles tarfiles
   if fromFlag (uploadCheck flags)
     then Upload.check  verbosity tarfiles
     else upload verbosity 
@@ -191,6 +194,22 @@ uploadAction flags extraArgs = do
                 (flagToMaybe $ configUploadPassword config
                      `mappend` uploadPassword flags)
                 tarfiles
+  where
+    checkTarFiles tarfiles
+      | null tarfiles
+      = die "the 'upload' command expects one or more .tar.gz packages."
+      | not (null otherFiles)
+      = die $ "the 'upload' command expects only .tar.gz packages: "
+           ++ intercalate ", " otherFiles
+      | otherwise = sequence_
+                      [ do exists <- doesFileExist tarfile
+                           unless exists $ die $ "file not found: " ++ tarfile
+                      | tarfile <- tarfiles ]
+
+      where otherFiles = filter (not . isTarGzFile) tarfiles
+            isTarGzFile file = case splitExtension file of
+              (file', ".gz") -> takeExtension file' == ".tar"
+              _              -> False
 
 checkAction :: Flag Verbosity -> [String] -> IO ()
 checkAction verbosityFlag extraArgs = do