9ea07f8 · elk · git.iko.soy

git.iko.soy/elk

make error messages more specific when cannot find tag during publish

commit9ea07f861f29165bb6a6a8d7d88de0a3968f6a7f authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 14 Jun 2019, 12:54 (7 years ago) parent075be13

2 files changed+99−44

compare with master

unifiedsplit

builder/src/Reporting/Exit.hs+58−21 terminal/src/Publish.hs+41−23

builder/src/Reporting/Exit.hs+58−21

@@ -316,12 +316,13 @@ data Publish

316316 | PublishShortReadme

317317 | PublishNoLicense

318318 | PublishBuildProblem BuildProblem

319− | PublishCannotGetTag Http.Error

319+ | PublishMissingTag V.Version

320+ | PublishCannotGetTag V.Version Http.Error

321+ | PublishCannotGetTagData V.Version String BS.ByteString

320322 | PublishCannotGetZip Http.Error

321323 | PublishCannotDecodeZip

322324 | PublishCannotGetDocs V.Version V.Version DocsProblem

323325 | PublishCannotRegister Http.Error

324− | PublishMissingTag V.Version

325326 | PublishNoGit

326327 | PublishLocalChanges V.Version

327328 --

@@ -484,23 +485,6 @@ publishToReport publish =

484485 PublishBuildProblem buildProblem ->

485486 error "TODO PublishBuildProblem" buildProblem

486487

487− PublishCannotGetTag httpError ->

488− error "TODO PublishCannotGetTag" httpError

489−

490− PublishCannotGetZip httpError ->

491− error "TODO PublishCannotGetZip" httpError

492−

493− PublishCannotDecodeZip ->

494− error "TODO PublishCannotDecodeZip"

495−

496− PublishCannotGetDocs old new docsProblem ->

497− toDocsProblemReport docsProblem $

498− "I need the docs for " ++ V.toChars old ++ " to verify that "

499− ++ V.toChars new ++ " really does come next"

500−

501− PublishCannotRegister httpError ->

502− error "TODO PublishCannotRegister" httpError

503−

504488 PublishMissingTag version ->

505489 let vsn = V.toChars version in

506490 Help.docReport "NO TAG" Nothing

@@ -520,6 +504,59 @@ publishToReport publish =

520504 , "The -m flag is for a helpful message. Try to make it more informative!"

521505 ]

522506

507+ PublishCannotGetTag version httpError ->

508+ case httpError of

509+ Http.BadHttp _ (HTTP.StatusCodeException response _)

510+ | HTTP.statusCode (HTTP.responseStatus response) == 404 ->

511+ let vsn = V.toChars version in

512+ Help.report "NO TAG ON GITHUB" Nothing

513+ ("You have version " ++ vsn ++ " tagged locally, but not on GitHub.")

514+ [ D.reflow

515+ "Run the following command to make this tag available on GitHub:"

516+ , D.indent 4 $ D.dullyellow $ D.fromChars $

517+ "git push origin " ++ vsn

518+ , D.reflow

519+ "This will make it possible to find your code online based on the version number."

520+ ]

521+

522+ _ ->

523+ toHttpErrorReport "PROBLEM VERIFYING TAG" httpError

524+ "I need to check that the version tag is registered on GitHub"

525+

526+ PublishCannotGetTagData version url body ->

527+ Help.report "PROBLEM VERIFYING TAG" Nothing

528+ ("I need to check that version " ++ V.toChars version ++ " is tagged on GitHub, so I fetched:")

529+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

530+ , D.reflow $

531+ "I got the data back, but it was not what I was expecting. The response\

532+ \ body contains " ++ show (BS.length body) ++ " bytes. Here is the "

533+ ++ if BS.length body <= 76 then "whole thing:" else "beginning:"

534+ , D.indent 4 $ D.dullyellow $ D.fromChars $

535+ if BS.length body <= 76

536+ then BS_UTF8.toString body

537+ else take 73 (BS_UTF8.toString body) ++ "..."

538+ , D.reflow $

539+ "Does this error keep showing up? Maybe there is something weird with your\

540+ \ internet connection. We have gotten reports that schools, businesses,\

541+ \ airports, etc. sometimes intercept requests and add things to the body\

542+ \ or change its contents entirely. Could that be the problem?"

543+ ]

544+

545+ PublishCannotGetZip httpError ->

546+ toHttpErrorReport "PROBLEM DOWNLOADING CODE" httpError $

547+ "I need to check that folks can download and build the source code when they install this package"

548+

549+ PublishCannotDecodeZip ->

550+ error "TODO PublishCannotDecodeZip"

551+

552+ PublishCannotGetDocs old new docsProblem ->

553+ toDocsProblemReport docsProblem $

554+ "I need the docs for " ++ V.toChars old ++ " to verify that "

555+ ++ V.toChars new ++ " really does come next"

556+

557+ PublishCannotRegister httpError ->

558+ error "TODO PublishCannotRegister" httpError

559+

523560 PublishNoGit ->

524561 Help.report "NO GIT" Nothing

525562 "I searched your PATH environment variable for `git` and could not\

@@ -599,10 +636,10 @@ toDocsProblemReport :: DocsProblem -> String -> Help.Report

599636toDocsProblemReport problem context =

600637 case problem of

601638 DP_Http httpError ->

602− toHttpErrorReport "PROBLEM FETCHING DOCS" httpError context

639+ toHttpErrorReport "PROBLEM LOADING DOCS" httpError context

603640

604641 DP_Data url body ->

605− Help.report "PROBLEM FETCHING DOCS" Nothing (context ++ ", so I fetched:")

642+ Help.report "PROBLEM LOADING DOCS" Nothing (context ++ ", so I fetched:")

606643 [ D.indent 4 $ D.dullyellow $ D.fromChars url

607644 , D.reflow $

608645 "I got the data back, but it was not what I was expecting. The response\

terminal/src/Publish.hs+41−23

@@ -111,8 +111,9 @@ publish env@(Env root _ manager registry outline) =

111111 verifyLicense root

112112 docs <- verifyBuild root

113113 verifyVersion env pkg vsn docs maybeKnownVersions

114− commitHash <- verifyTag manager pkg vsn

115− verifyNoChanges commitHash vsn

114+ git <- getGit

115+ commitHash <- verifyTag git manager pkg vsn

116+ verifyNoChanges git commitHash vsn

116117 zipHash <- verifyZip env pkg vsn

117118

118119 Task.io $ putStrLn ""

@@ -194,20 +195,43 @@ verifyBuild root =

194195 Build.fromExposed Reporting.silent root details Build.KeepDocs exposed

195196

196197

198+-- GET GIT

199+

200+

201+newtype Git =

202+ Git { _run :: [String] -> IO Exit.ExitCode }

203+

204+

205+getGit :: Task.Task Exit.Publish Git

206+getGit =

207+ do maybeGit <- Task.io $ Dir.findExecutable "git"

208+ case maybeGit of

209+ Just git -> return (Git (Process.rawSystem git))

210+ Nothing -> Task.throw Exit.PublishNoGit

211+

212+

197213

198214-- VERIFY GITHUB TAG

199215

200216

201−verifyTag :: Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish String

202−verifyTag manager pkg vsn =

217+verifyTag :: Git -> Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish String

218+verifyTag git manager pkg vsn =

203219 reportTagCheck vsn $

204− Http.post manager (toTagUrl pkg vsn) [Http.accept "application/json"] Exit.PublishCannotGetTag $ \body ->

205− case D.fromByteString commitHashDecoder body of

206− Right hash ->

207− return $ Right hash

220+ do -- https://stackoverflow.com/questions/1064499/how-to-list-all-git-tags

221+ exitCode <- _run git [ "show", "--name-only", V.toChars vsn, "--" ]

222+ case exitCode of

223+ Exit.ExitFailure _ ->

224+ return $ Left (Exit.PublishMissingTag vsn)

225+

226+ Exit.ExitSuccess ->

227+ let url = toTagUrl pkg vsn in

228+ Http.post manager url [Http.accept "application/json"] (Exit.PublishCannotGetTag vsn) $ \body ->

229+ case D.fromByteString commitHashDecoder body of

230+ Right hash ->

231+ return $ Right hash

208232

209− Left _ ->

210− return $ Left (Exit.PublishMissingTag vsn)

233+ Left _ ->

234+ return $ Left (Exit.PublishCannotGetTagData vsn url body)

211235

212236

213237toTagUrl :: Pkg.Name -> V.Version -> String

@@ -225,20 +249,14 @@ commitHashDecoder =

225249-- VERIFY NO LOCAL CHANGES SINCE TAG

226250

227251

228−verifyNoChanges :: String -> V.Version -> Task.Task Exit.Publish ()

229−verifyNoChanges commitHash vsn =

252+verifyNoChanges :: Git -> String -> V.Version -> Task.Task Exit.Publish ()

253+verifyNoChanges git commitHash vsn =

230254 reportLocalChangesCheck $

231− do maybeGit <- Dir.findExecutable "git"

232− case maybeGit of

233− Nothing ->

234− return $ Left Exit.PublishNoGit

235−

236− Just git ->

237− do -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes

238− exitCode <- Process.rawSystem git [ "diff-index", "--quiet", commitHash, "--" ]

239− case exitCode of

240− Exit.ExitSuccess -> return $ Right ()

241− Exit.ExitFailure _ -> return $ Left (Exit.PublishLocalChanges vsn)

255+ do -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes

256+ exitCode <- _run git [ "diff-index", "--quiet", commitHash, "--" ]

257+ case exitCode of

258+ Exit.ExitSuccess -> return $ Right ()

259+ Exit.ExitFailure _ -> return $ Left (Exit.PublishLocalChanges vsn)

242260

243261

244262