on master help sign in
change some names / hook up docs.json upload
commit9678b3ee114ae7b219afa3df3032d10b098c1227 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 11 Jun 2019, 12:28 (7 years ago) parent4101a0b
1 file changed+65−56
terminal/src/Publish.hs+65−56
terminal/src/Publish.hs+65−56
@@ -111,11 +111,11 @@ publish env@(Env root cache manager registry outline) =
111111 verifyVersion env pkg vsn docs maybeKnownVersions
112112 commitHash <- verifyTag manager pkg vsn
113113 verifyNoChanges commitHash vsn
114− zipHash <- verifyZip manager pkg vsn
114+ zipHash <- verifyZip env pkg vsn
115115
116− register manager pkg vsn commitHash zipHash
117−
118− putStrLn "Success!"
116+ Task.io $ putStrLn ""
117+ register manager pkg vsn docs commitHash zipHash
118+ Task.io $ putStrLn "Success!"
119119
120120
121121
@@ -143,7 +143,7 @@ noExposed exposed =
143143
144144verifyReadme :: FilePath -> Task.Task Exit.Publish ()
145145verifyReadme root =
146− reportReadmePhase $
146+ reportReadmeCheck $
147147 do let readmePath = root </> "README.md"
148148 exists <- File.exists readmePath
149149 case exists of
@@ -163,7 +163,7 @@ verifyReadme root =
163163
164164verifyLicense :: FilePath -> Task.Task Exit.Publish ()
165165verifyLicense root =
166− reportLicensePhase $
166+ reportLicenseCheck $
167167 do let licensePath = root </> "LICENSE"
168168 exists <- File.exists licensePath
169169 if exists
@@ -177,7 +177,7 @@ verifyLicense root =
177177
178178verifyTag :: Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish String
179179verifyTag manager pkg vsn =
180− reportTagPhase vsn $
180+ reportTagCheck vsn $
181181 Http.post manager (toTagUrl pkg vsn) [Http.accept "application/json"] Exit.PublishCannotGetTag $ \body ->
182182 case D.fromByteString commitHashDecoder body of
183183 Right hash ->
@@ -204,7 +204,7 @@ commitHashDecoder =
204204
205205verifyNoChanges :: String -> V.Version -> Task.Task Exit.Publish ()
206206verifyNoChanges commitHash vsn =
207− reportChangesPhase $
207+ reportLocalChangesCheck $
208208 do maybeGit <- Dir.findExecutable "git"
209209 case maybeGit of
210210 Nothing ->
@@ -222,11 +222,11 @@ verifyNoChanges commitHash vsn =
222222-- VERIFY THAT ZIP BUILDS / COMPUTE HASH
223223
224224
225−verifyZip :: Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha
226−verifyZip manager pkg vsn =
227− withTempDir $ \prepublishDir ->
225+verifyZip :: Env -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha
226+verifyZip (Env root _ manager _ _) pkg vsn =
227+ withTempDir root $ \prepublishDir ->
228228 do (sha, archive) <-
229− reportDownloadPhase $
229+ reportDownloadCheck $
230230 Http.getArchive manager (toZipUrl pkg vsn)
231231 Exit.PublishCannotGetZip
232232 Exit.PublishCannotDecodeZip
@@ -234,23 +234,23 @@ verifyZip manager pkg vsn =
234234
235235 Task.io $ File.writePackage prepublishDir archive
236236
237− reportBuildPhase $
237+ reportZipBuildCheck $
238238 Dir.withCurrentDirectory prepublishDir $
239− do error "TODO Build.generateDocs"
240− return ()
239+ error "TODO Build.generateDocs"
241240
242241 return sha
243242
244243
245−withTempDir :: FilePath -> (FilePath -> IO a) -> IO a
244+withTempDir :: FilePath -> (FilePath -> Task.Task x a) -> Task.Task x a
246245withTempDir root callback =
247246 let
248247 dir = Stuff.prepublishDir root
249248 in
250− bracket_
251− (Dir.createDirectoryIfMissing True dir)
252− (Dir.removeDirectoryRecursive dir)
253− (callback dir)
249+ Task.eio id $
250+ bracket_
251+ (Dir.createDirectoryIfMissing True dir)
252+ (Dir.removeDirectoryRecursive dir)
253+ (Task.run (callback dir))
254254
255255
256256toZipUrl :: Pkg.Name -> V.Version -> String
@@ -269,7 +269,7 @@ data GoodVersion
269269
270270verifyVersion :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Maybe Registry.KnownVersions -> Task.Task Exit.Publish ()
271271verifyVersion env pkg vsn newDocs publishedVersions =
272− reportVersionPhase vsn $
272+ reportSemverCheck vsn $
273273 case publishedVersions of
274274 Nothing ->
275275 if vsn == V.one
@@ -311,8 +311,8 @@ verifyBump (Env _ cache manager _ _) pkg vsn newDocs knownVersions@(Registry.Kno
311311-- REGISTER PACKAGES
312312
313313
314−register :: Http.Manager -> Pkg.Name -> V.Version -> String -> Http.Sha -> Task.Task Exit.Publish ()
315−register manager pkg vsn commitHash sha =
314+register :: Http.Manager -> Pkg.Name -> V.Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish ()
315+register manager pkg vsn docs commitHash sha =
316316 let
317317 url =
318318 Website.route "/register"
@@ -324,7 +324,7 @@ register manager pkg vsn commitHash sha =
324324 Task.eio Exit.PublishCannotRegister $
325325 Http.upload manager url
326326 [ 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)
328328 , Http.filePart "README.md" "README.md"
329329 , Http.stringPart "github-hash" (Http.shaToChars sha)
330330 ]
@@ -334,8 +334,9 @@ register manager pkg vsn commitHash sha =
334334-- REPORTING
335335
336336
337−reportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> IO ()
337+reportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> Task.Task x ()
338338reportPublishStart pkg vsn maybeKnownVersions =
339+ Task.io $
339340 case maybeKnownVersions of
340341 Nothing ->
341342 putStrLn $ Exit.newPackageOverview ++ "\nI will now verify that everything is in order...\n"
@@ -348,24 +349,32 @@ reportPublishStart pkg vsn maybeKnownVersions =
348349-- REPORTING PHASES
349350
350351
351−reportReadmePhase :: IO (Either x a) -> Task.Task x a
352−reportReadmePhase =
353− reportPhase
352+reportReadmeCheck :: IO (Either x a) -> Task.Task x a
353+reportReadmeCheck =
354+ reportCheck
354355 "Looking for README.md"
355356 "Found README.md"
356357 "Problem with your README.md"
357358
358359
359−reportLicensePhase :: IO (Either x a) -> Task.Task x a
360−reportLicensePhase =
361− reportPhase
360+reportLicenseCheck :: IO (Either x a) -> Task.Task x a
361+reportLicenseCheck =
362+ reportCheck
362363 "Looking for LICENSE"
363364 "Found LICENSE"
364365 "Problem with your LICENSE"
365366
366367
367−reportVersionPhase :: V.Version -> IO (Either x GoodVersion) -> Task.Task x ()
368−reportVersionPhase version work =
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+
376+reportSemverCheck :: V.Version -> IO (Either x GoodVersion) -> Task.Task x ()
377+reportSemverCheck version work =
369378 let
370379 vsn = V.toChars version
371380
@@ -381,48 +390,48 @@ reportVersionPhase version work =
381390 ++ M.toChars magnitude ++ " change, "
382391 ++ V.toChars oldVersion ++ " => " ++ vsn ++ ")"
383392 in
384− void $ reportCustomPhase waiting success failure work
393+ void $ reportCustomCheck waiting success failure work
385394
386395
387−reportTagPhase :: V.Version -> IO (Either x a) -> Task.Task x a
388−reportTagPhase vsn =
389− reportPhase
396+reportTagCheck :: V.Version -> IO (Either x a) -> Task.Task x a
397+reportTagCheck vsn =
398+ reportCheck
390399 ("Is version " ++ V.toChars vsn ++ " tagged on GitHub?")
391400 ("Version " ++ V.toChars vsn ++ " is tagged on GitHub")
392401 ("Version " ++ V.toChars vsn ++ " is not tagged on GitHub!")
393402
394403
395−reportDownloadPhase :: IO (Either x a) -> Task.Task x a
396−reportDownloadPhase =
397− reportPhase
404+reportDownloadCheck :: IO (Either x a) -> Task.Task x a
405+reportDownloadCheck =
406+ reportCheck
398407 "Downloading code from GitHub..."
399408 "Code downloaded successfully from GitHub"
400409 "Could not download code from GitHub!"
401410
402411
403−reportBuildPhase :: IO (Either x a) -> Task.Task x a
404−reportBuildPhase =
405− reportPhase
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
412+reportLocalChangesCheck :: IO (Either x a) -> Task.Task x a
413+reportLocalChangesCheck =
414+ reportCheck
414415 "Checking for uncommitted changes..."
415416 "No uncommitted changes in local code"
416417 "Your local code is different than the code tagged on GitHub"
417418
418419
419−reportPhase :: String -> String -> String -> IO (Either x a) -> Task.Task x a
420−reportPhase waiting success failure work =
421− reportCustomPhase waiting (\_ -> success) failure work
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+
428+reportCheck :: String -> String -> String -> IO (Either x a) -> Task.Task x a
429+reportCheck waiting success failure work =
430+ reportCustomCheck waiting (\_ -> success) failure work
422431
423432
424−reportCustomPhase :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a
425−reportCustomPhase waiting success failure work =
433+reportCustomCheck :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a
434+reportCustomCheck waiting success failure work =
426435 let
427436 putFlush doc =
428437 Help.toStdout doc >> IO.hFlush IO.stdout