Commit aefbd609 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺 Committed by GitHub
Browse files

Merge pull request #4779 from hvr/pr/issue-4777

Improve success message when `cabal upload`ing documentation
parents d5f1d21c ff38108c
...@@ -102,6 +102,15 @@ uploadDoc verbosity repoCtxt mUsername mPassword isCandidate path = do ...@@ -102,6 +102,15 @@ uploadDoc verbosity repoCtxt mUsername mPassword isCandidate path = do
, "/docs" , "/docs"
] ]
} }
packageUri = targetRepoURI {
uriPath = rootIfEmpty (uriPath targetRepoURI)
FilePath.Posix.</> concat
[ "package/", pkgid
, case isCandidate of
IsCandidate -> "/candidate"
IsPublished -> ""
]
}
(reverseSuffix, reversePkgid) = break (== '-') (reverseSuffix, reversePkgid) = break (== '-')
(reverse (takeFileName path)) (reverse (takeFileName path))
pkgid = reverse $ tail reversePkgid pkgid = reverse $ tail reversePkgid
...@@ -122,13 +131,23 @@ uploadDoc verbosity repoCtxt mUsername mPassword isCandidate path = do ...@@ -122,13 +131,23 @@ uploadDoc verbosity repoCtxt mUsername mPassword isCandidate path = do
-- Hackage responds with 204 No Content when docs are uploaded -- Hackage responds with 204 No Content when docs are uploaded
-- successfully. -- successfully.
(code,_) | code `elem` [200,204] -> do (code,_) | code `elem` [200,204] -> do
notice verbosity "Ok" notice verbosity $ okMessage packageUri
(code,err) -> do (code,err) -> do
notice verbosity $ "Error uploading documentation " notice verbosity $ "Error uploading documentation "
++ path ++ ": " ++ path ++ ": "
++ "http code " ++ show code ++ "\n" ++ "http code " ++ show code ++ "\n"
++ err ++ err
exitFailure exitFailure
where
okMessage packageUri = case isCandidate of
IsCandidate ->
"Documentation successfully uploaded for package candidate. "
++ "You can now preview the result at '" ++ show packageUri
++ "'. To upload non-candidate documentation, use 'cabal upload --publish'."
IsPublished ->
"Package documentation successfully published. You can now view it at '"
++ show packageUri ++ "'."
promptUsername :: IO Username promptUsername :: IO Username
promptUsername = do promptUsername = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment