9678b3e · elk · git.iko.soy

111 verifyVersion env pkg vsn docs maybeKnownVersions

112 commitHash <- verifyTag manager pkg vsn

113 verifyNoChanges commitHash vsn

114− zipHash <- verifyZip manager pkg vsn

114+ zipHash <- verifyZip env pkg vsn

115

116+ Task.io $ putStrLn ""

116− register manager pkg vsn commitHash zipHash

117+ register manager pkg vsn docs commitHash zipHash

117−

118− putStrLn "Success!"

118+ Task.io $ putStrLn "Success!"

119

120

121

143

144verifyReadme :: FilePath -> Task.Task Exit.Publish ()

145verifyReadme root =

146− reportReadmePhase $

146+ reportReadmeCheck $

147 do let readmePath = root </> "README.md"

148 exists <- File.exists readmePath

149 case exists of

163

164verifyLicense :: FilePath -> Task.Task Exit.Publish ()

165verifyLicense root =

166− reportLicensePhase $

166+ reportLicenseCheck $

167 do let licensePath = root </> "LICENSE"

168 exists <- File.exists licensePath

169 if exists

177

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

179verifyTag manager pkg vsn =

180− reportTagPhase vsn $

180+ reportTagCheck vsn $

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

182 case D.fromByteString commitHashDecoder body of

183 Right hash ->

204

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

206verifyNoChanges commitHash vsn =

207− reportChangesPhase $

207+ reportLocalChangesCheck $

208 do maybeGit <- Dir.findExecutable "git"

209 case maybeGit of

210 Nothing ->

222-- VERIFY THAT ZIP BUILDS / COMPUTE HASH

223

224

225−verifyZip :: Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha

225+verifyZip :: Env -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha

226−verifyZip manager pkg vsn =

226+verifyZip (Env root _ manager _ _) pkg vsn =

227− withTempDir $ \prepublishDir ->

227+ withTempDir root $ \prepublishDir ->

228 do (sha, archive) <-

229− reportDownloadPhase $

229+ reportDownloadCheck $

230 Http.getArchive manager (toZipUrl pkg vsn)

231 Exit.PublishCannotGetZip

232 Exit.PublishCannotDecodeZip

234

235 Task.io $ File.writePackage prepublishDir archive

236

237− reportBuildPhase $

237+ reportZipBuildCheck $

238 Dir.withCurrentDirectory prepublishDir $

239− do error "TODO Build.generateDocs"

239+ error "TODO Build.generateDocs"

240− return ()

241

240

242 return sha

241 return sha

243

242

244

243

245−withTempDir :: FilePath -> (FilePath -> IO a) -> IO a

244+withTempDir :: FilePath -> (FilePath -> Task.Task x a) -> Task.Task x a

246withTempDir root callback =

245withTempDir root callback =

247 let

246 let

248 dir = Stuff.prepublishDir root

247 dir = Stuff.prepublishDir root

249 in

248 in

249+ Task.eio id $

250− bracket_

250+ bracket_

251− (Dir.createDirectoryIfMissing True dir)

251+ (Dir.createDirectoryIfMissing True dir)

252− (Dir.removeDirectoryRecursive dir)

252+ (Dir.removeDirectoryRecursive dir)

253− (callback dir)

253+ (Task.run (callback dir))

254

255

256toZipUrl :: Pkg.Name -> V.Version -> String

269

270verifyVersion :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Maybe Registry.KnownVersions -> Task.Task Exit.Publish ()

271verifyVersion env pkg vsn newDocs publishedVersions =

272− reportVersionPhase vsn $

272+ reportSemverCheck vsn $

273 case publishedVersions of

274 Nothing ->

275 if vsn == V.one

311-- REGISTER PACKAGES

312

313

314−register :: Http.Manager -> Pkg.Name -> V.Version -> String -> Http.Sha -> Task.Task Exit.Publish ()

314+register :: Http.Manager -> Pkg.Name -> V.Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish ()

315−register manager pkg vsn commitHash sha =

315+register manager pkg vsn docs commitHash sha =

316 let

317 url =

318 Website.route "/register"

324 Task.eio Exit.PublishCannotRegister $

325 Http.upload manager url

326 [ Http.filePart "elm.json" "elm.json"

327− , Http.filePart "docs.json" (error "TODO generate docs, maybe in memory only?")

327+ , Http.jsonPart "docs.json" "docs.json" (Docs.encode docs)

328 , Http.filePart "README.md" "README.md"

329 , Http.stringPart "github-hash" (Http.shaToChars sha)

330 ]

334-- REPORTING

335

336

337−reportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> IO ()

337+reportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> Task.Task x ()

338reportPublishStart pkg vsn maybeKnownVersions =

339+ Task.io $

339 case maybeKnownVersions of

340 case maybeKnownVersions of

340 Nothing ->

341 Nothing ->

341 putStrLn $ Exit.newPackageOverview ++ "\nI will now verify that everything is in order...\n"

342 putStrLn $ Exit.newPackageOverview ++ "\nI will now verify that everything is in order...\n"

348-- REPORTING PHASES

349-- REPORTING PHASES

349

350

351

351−reportReadmePhase :: IO (Either x a) -> Task.Task x a

352+reportReadmeCheck :: IO (Either x a) -> Task.Task x a

352−reportReadmePhase =

353+reportReadmeCheck =

353− reportPhase

354+ reportCheck

354 "Looking for README.md"

355 "Looking for README.md"

355 "Found README.md"

356 "Found README.md"

356 "Problem with your README.md"

357 "Problem with your README.md"

357

358

359

359−reportLicensePhase :: IO (Either x a) -> Task.Task x a

360+reportLicenseCheck :: IO (Either x a) -> Task.Task x a

360−reportLicensePhase =

361+reportLicenseCheck =

361− reportPhase

362+ reportCheck

362 "Looking for LICENSE"

363 "Looking for LICENSE"

363 "Found LICENSE"

364 "Found LICENSE"

364 "Problem with your LICENSE"

365 "Problem with your LICENSE"

365

366

367

368+reportBuildCheck :: IO (Either x a) -> Task.Task x a

369+reportBuildCheck =

370+ reportCheck

371+ "Verifying package documentation..."

372+ "Verified package documentation"

373+ "Problem with package documentation"

374+

375+

367−reportVersionPhase :: V.Version -> IO (Either x GoodVersion) -> Task.Task x ()

376+reportSemverCheck :: V.Version -> IO (Either x GoodVersion) -> Task.Task x ()

368−reportVersionPhase version work =

377+reportSemverCheck version work =

369 let

378 let

370 vsn = V.toChars version

379 vsn = V.toChars version

371

380

381 ++ M.toChars magnitude ++ " change, "

390 ++ M.toChars magnitude ++ " change, "

382 ++ V.toChars oldVersion ++ " => " ++ vsn ++ ")"

391 ++ V.toChars oldVersion ++ " => " ++ vsn ++ ")"

383 in

392 in

384− void $ reportCustomPhase waiting success failure work

393+ void $ reportCustomCheck waiting success failure work

385

394

386

395

387−reportTagPhase :: V.Version -> IO (Either x a) -> Task.Task x a

396+reportTagCheck :: V.Version -> IO (Either x a) -> Task.Task x a

388−reportTagPhase vsn =

397+reportTagCheck vsn =

389− reportPhase

398+ reportCheck

390 ("Is version " ++ V.toChars vsn ++ " tagged on GitHub?")

399 ("Is version " ++ V.toChars vsn ++ " tagged on GitHub?")

391 ("Version " ++ V.toChars vsn ++ " is tagged on GitHub")

400 ("Version " ++ V.toChars vsn ++ " is tagged on GitHub")

392 ("Version " ++ V.toChars vsn ++ " is not tagged on GitHub!")

401 ("Version " ++ V.toChars vsn ++ " is not tagged on GitHub!")

393

402

394

403

395−reportDownloadPhase :: IO (Either x a) -> Task.Task x a

404+reportDownloadCheck :: IO (Either x a) -> Task.Task x a

396−reportDownloadPhase =

405+reportDownloadCheck =

397− reportPhase

406+ reportCheck

398 "Downloading code from GitHub..."

407 "Downloading code from GitHub..."

399 "Code downloaded successfully from GitHub"

408 "Code downloaded successfully from GitHub"

400 "Could not download code from GitHub!"

409 "Could not download code from GitHub!"

401

410

402

411

403−reportBuildPhase :: IO (Either x a) -> Task.Task x a

412+reportLocalChangesCheck :: IO (Either x a) -> Task.Task x a

404−reportBuildPhase =

413+reportLocalChangesCheck =

405− reportPhase

414+ reportCheck

406− "Building downloaded code and generated docs..."

407− "Downloaded code compiles successfully / docs generated\n"

408− "Cannot compile downloaded code!"

409−

410−

411−reportChangesPhase :: IO (Either x a) -> Task.Task x a

412−reportChangesPhase =

413− reportPhase

414 "Checking for uncommitted changes..."

415 "Checking for uncommitted changes..."

415 "No uncommitted changes in local code"

416 "No uncommitted changes in local code"

416 "Your local code is different than the code tagged on GitHub"

417 "Your local code is different than the code tagged on GitHub"

417

418

419

420+reportZipBuildCheck :: IO (Either x a) -> Task.Task x a

421+reportZipBuildCheck =

422+ reportCheck

423+ "Verifying downloaded code..."

424+ "Downloaded code compiles successfully"

425+ "Cannot compile downloaded code!"

426+

427+

419−reportPhase :: String -> String -> String -> IO (Either x a) -> Task.Task x a

428+reportCheck :: String -> String -> String -> IO (Either x a) -> Task.Task x a

420−reportPhase waiting success failure work =

429+reportCheck waiting success failure work =

421− reportCustomPhase waiting (\_ -> success) failure work

430+ reportCustomCheck waiting (\_ -> success) failure work

422

431

423

432

424−reportCustomPhase :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a

433+reportCustomCheck :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a

425−reportCustomPhase waiting success failure work =

434+reportCustomCheck waiting success failure work =

426 let

435 let

427 putFlush doc =

436 putFlush doc =

428 Help.toStdout doc >> IO.hFlush IO.stdout

437 Help.toStdout doc >> IO.hFlush IO.stdout