Remove 'upload --check'.

Fixes haskell#1823.
23Skidoo · May 11, 2016 · 5ddd497 · 5ddd497
1 parent fe0a4aa
commit 5ddd497
Show file tree

Hide file tree

Showing 4 changed files with 3 additions and 28 deletions.
diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs
@@ -351,7 +351,6 @@ instance Semigroup SavedConfig where
 
       combinedSavedUploadFlags = UploadFlags {
         uploadCandidate   = combine uploadCandidate,
-        uploadCheck       = combine uploadCheck,
         uploadDoc         = combine uploadDoc,
         uploadUsername    = combine uploadUsername,
         uploadPassword    = combine uploadPassword,

diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
@@ -1428,7 +1428,6 @@ instance Semigroup InstallFlags where
 
 data UploadFlags = UploadFlags {
     uploadCandidate   :: Flag Bool,
-    uploadCheck       :: Flag Bool,
     uploadDoc         :: Flag Bool,
     uploadUsername    :: Flag Username,
     uploadPassword    :: Flag Password,
@@ -1439,7 +1438,6 @@ data UploadFlags = UploadFlags {
 defaultUploadFlags :: UploadFlags
 defaultUploadFlags = UploadFlags {
     uploadCandidate   = toFlag True,
-    uploadCheck       = toFlag False,
     uploadDoc         = toFlag False,
     uploadUsername    = mempty,
     uploadPassword    = mempty,
@@ -1466,11 +1464,6 @@ uploadCommand = CommandUI {
         uploadCandidate (\v flags -> flags { uploadCandidate = v })
         falseArg
 
-      ,option ['c'] ["check"]
-         "Do not upload, just do QA checks."
-        uploadCheck (\v flags -> flags { uploadCheck = v })
-        trueArg
-
       ,option ['d'] ["documentation"]
         "Upload documentation instead of a source package. Cannot be used together with --check. \
         \By default, this uploads documentation for a package candidate. To upload documentation for \

diff --git a/cabal-install/Distribution/Client/Upload.hs b/cabal-install/Distribution/Client/Upload.hs
@@ -1,4 +1,4 @@
-module Distribution.Client.Upload (check, upload, uploadDoc, report) where
+module Distribution.Client.Upload (upload, uploadDoc, report) where
 
 import Distribution.Client.Types ( Username(..), Password(..)
                                  , RemoteRepo(..), maybeRepoRemote )
@@ -15,7 +15,7 @@ import Distribution.Client.Config
 import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
 import qualified Distribution.Client.BuildReports.Upload as BuildReport
 
-import Network.URI (URI(uriPath), parseURI)
+import Network.URI (URI(uriPath))
 import Network.HTTP (Header(..), HeaderName(..))
 
 import System.IO        (hFlush, stdin, stdout, hGetEcho, hSetEcho)
@@ -30,10 +30,6 @@ import Data.Char (isSpace)
 
 type Auth = Maybe (String, String)
 
-checkURI :: URI
-Just checkURI = parseURI $ "http://hackage.haskell.org/cgi-bin/"
-                           ++ "hackage-scripts/check-pkg"
-
 stripExtensions :: [String] -> FilePath -> Maybe String
 stripExtensions exts path = foldM f path (reverse exts)
  where
@@ -170,13 +166,6 @@ report verbosity repoCtxt mUsername mPassword = do
                          (remoteRepoURI remoteRepo) [(report', Just buildLog)]
                        return ()
 
-check :: Verbosity -> RepoContext -> [FilePath] -> IO ()
-check verbosity repoCtxt paths = do
-    transport <- repoContextGetTransport repoCtxt
-    forM_ paths $ \path -> do
-      notice verbosity $ "Checking " ++ path ++ "... "
-      handlePackage transport verbosity checkURI checkURI Nothing False path
-
 handlePackage :: HttpTransport -> Verbosity -> URI -> URI -> Auth
               -> Bool -> FilePath -> IO ()
 handlePackage transport verbosity uri packageUri auth candidate path =

diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
@@ -1054,9 +1054,6 @@ uploadAction uploadFlags extraArgs globalFlags = do
       tarfiles     = extraArgs
   when (null tarfiles && not (fromFlag (uploadDoc uploadFlags'))) $
     die "the 'upload' command expects at least one .tar.gz archive."
-  when (fromFlag (uploadCheck uploadFlags')
-        && fromFlag (uploadDoc uploadFlags')) $
-    die "--check and --doc cannot be used together."
   checkTarFiles extraArgs
   maybe_password <-
     case uploadPasswordCmd uploadFlags'
@@ -1065,10 +1062,7 @@ uploadAction uploadFlags extraArgs globalFlags = do
                         (simpleProgramInvocation xs xss)
        _             -> pure $ flagToMaybe $ uploadPassword uploadFlags'
   withRepoContext verbosity globalFlags' $ \repoContext -> do
-    if fromFlag (uploadCheck uploadFlags')
-    then do
-      Upload.check verbosity repoContext tarfiles
-    else if fromFlag (uploadDoc uploadFlags')
+    if fromFlag (uploadDoc uploadFlags')
     then do
       when (length tarfiles > 1) $
        die $ "the 'upload' command can only upload documentation "