Don't require build plan to upload #400

Author: snoyberg

ChangeLog.md

@@ -9,6 +9,7 @@
 * Display information on why a snapshot was rejected [#381](https://github.com/commercialhaskell/stack/issues/381)
 * Give a reason for unregistering packages [#389](https://github.com/commercialhaskell/stack/issues/389)
 * `stack exec` accepts the `--no-ghc-package-path` parameter
+* Don't require build plan to upload [#400](https://github.com/commercialhaskell/stack/issues/400)
 
 Bug fixes:
 

src/Stack/Upload.hs

@@ -191,9 +191,8 @@ promptPassword = do
 -- | Turn the given settings into an @Uploader@.
 --
 -- Since 0.1.0.0
-mkUploader :: FilePath -- ^ runghc
-           -> Config -> UploadSettings -> IO Uploader
-mkUploader runghc config us = do
+mkUploader :: Config -> UploadSettings -> IO Uploader
+mkUploader config us = do
     manager <- usGetManager us
     (creds, fromFile') <- loadCreds $ usCredsSource us config
     when (not fromFile' && usSaveCreds us) $ saveCreds config creds
@@ -203,7 +202,7 @@ mkUploader runghc config us = do
             , checkStatus = \_ _ _ -> Nothing
             }
     return Uploader
-        { upload_ = \fp0 -> withTarball runghc fp0 $ \fp -> do
+        { upload_ = \fp0 -> withTarball fp0 $ \fp -> do
             let formData = [partFile "package" fp]
             req2 <- formDataBody formData req1
             let req3 = applyBasicAuth
@@ -238,9 +237,8 @@ mkUploader runghc config us = do
 
 -- | Given either a file, return it. Given a directory, run @cabal sdist@ and
 -- get the resulting tarball.
-withTarball :: FilePath -- ^ runghc
-            -> FilePath -> (FilePath -> IO a) -> IO a
-withTarball _runghc fp0 inner = do
+withTarball :: FilePath -> (FilePath -> IO a) -> IO a
+withTarball fp0 inner = do
     isFile <- doesFileExist fp0
     if isFile then inner fp0 else withSystemTempDirectory "stackage-upload-tarball" $ \dir -> do
         isDir <- doesDirectoryExist fp0

src/main/Main.hs

@@ -13,7 +13,7 @@ import           Control.Exception
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger
-import           Control.Monad.Reader (ask,asks)
+import           Control.Monad.Reader (ask)
 import           Data.Char (toLower)
 import           Data.List
 import qualified Data.List as List
@@ -27,7 +27,6 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import           Data.Traversable
 import           Network.HTTP.Client
-import           Network.HTTP.Client.Conduit (getHttpManager)
 import           Options.Applicative.Args
 import           Options.Applicative.Builder.Extra
 import           Options.Applicative.Simple
@@ -491,15 +490,12 @@ updateCmd () go@GlobalOpts{..} = do
 
 -- | Upload to Hackage
 uploadCmd :: [String] -> GlobalOpts -> IO ()
-uploadCmd args0 go = withBuildConfig go ExecStrategy $ do
-    let args = if null args0 then ["."] else args0
-    config <- asks getConfig
-    manager <- asks getHttpManager
-    menv <- getMinimalEnvOverride
-    runghc <- join $ System.Process.Read.findExecutable menv "runghc"
+uploadCmd args0 go = do
+    (manager,lc) <- loadConfigWithOpts go
+    let config = lcConfig lc
+        args = if null args0 then ["."] else args0
     liftIO $ do
         uploader <- Upload.mkUploader
-              (toFilePath runghc)
               config
             $ Upload.setGetManager (return manager)
               Upload.defaultUploadSettings