9ea07f8 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

make error messages more specific when cannot find tag during publish

9ea07f8Evan Czaplicki7 years ago

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

compare with master

unifiedsplit

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

316 | PublishShortReadme

317 | PublishNoLicense

318 | PublishBuildProblem BuildProblem

319+ | PublishMissingTag V.Version

319− | PublishCannotGetTag Http.Error

320+ | PublishCannotGetTag V.Version Http.Error

321+ | PublishCannotGetTagData V.Version String BS.ByteString

320 | PublishCannotGetZip Http.Error

322 | PublishCannotGetZip Http.Error

321 | PublishCannotDecodeZip

323 | PublishCannotDecodeZip

322 | PublishCannotGetDocs V.Version V.Version DocsProblem

324 | PublishCannotGetDocs V.Version V.Version DocsProblem

323 | PublishCannotRegister Http.Error

325 | PublishCannotRegister Http.Error

324− | PublishMissingTag V.Version

325 | PublishNoGit

326 | PublishNoGit

326 | PublishLocalChanges V.Version

327 | PublishLocalChanges V.Version

327 --

328 --

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

484 PublishBuildProblem buildProblem ->

485 PublishBuildProblem buildProblem ->

485 error "TODO PublishBuildProblem" buildProblem

486 error "TODO PublishBuildProblem" buildProblem

486

487

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−

504 PublishMissingTag version ->

488 PublishMissingTag version ->

505 let vsn = V.toChars version in

489 let vsn = V.toChars version in

506 Help.docReport "NO TAG" Nothing

490 Help.docReport "NO TAG" Nothing

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

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

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

521 ]

505 ]

522

506

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+

523 PublishNoGit ->

560 PublishNoGit ->

524 Help.report "NO GIT" Nothing

561 Help.report "NO GIT" Nothing

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

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

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

599toDocsProblemReport problem context =

636toDocsProblemReport problem context =

600 case problem of

637 case problem of

601 DP_Http httpError ->

638 DP_Http httpError ->

602− toHttpErrorReport "PROBLEM FETCHING DOCS" httpError context

639+ toHttpErrorReport "PROBLEM LOADING DOCS" httpError context

603

640

604 DP_Data url body ->

641 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:")

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

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

607 , D.reflow $

644 , D.reflow $

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

645 "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) =

111 verifyLicense root

112 docs <- verifyBuild root

113 verifyVersion env pkg vsn docs maybeKnownVersions

114+ git <- getGit

114− commitHash <- verifyTag manager pkg vsn

115+ commitHash <- verifyTag git manager pkg vsn

115− verifyNoChanges commitHash vsn

116+ verifyNoChanges git commitHash vsn

116 zipHash <- verifyZip env pkg vsn

117 zipHash <- verifyZip env pkg vsn

117

118

118 Task.io $ putStrLn ""

119 Task.io $ putStrLn ""

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

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

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

195

196

197

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+

197

213

198-- VERIFY GITHUB TAG

214-- VERIFY GITHUB TAG

199

215

200

216

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

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

202−verifyTag manager pkg vsn =

218+verifyTag git manager pkg vsn =

203 reportTagCheck vsn $

219 reportTagCheck vsn $

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

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

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

205− case D.fromByteString commitHashDecoder body of

229+ case D.fromByteString commitHashDecoder body of

206− Right hash ->

230+ Right hash ->

207− return $ Right hash

231+ return $ Right hash

208

232

209− Left _ ->

233+ Left _ ->

210− return $ Left (Exit.PublishMissingTag vsn)

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

211

235

212

236

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

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

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

225-- VERIFY NO LOCAL CHANGES SINCE TAG

249-- VERIFY NO LOCAL CHANGES SINCE TAG

226

250

227

251

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

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

229−verifyNoChanges commitHash vsn =

253+verifyNoChanges git commitHash vsn =

230 reportLocalChangesCheck $

254 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

255+ 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, "--" ]

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

239− case exitCode of

257+ case exitCode of

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

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

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

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

242

260

243

261

244

262