Add status colour to stopped jobs

TODO

@@ -1,6 +1,4 @@
-TODO: Show more information on overview page
-  - Colour stopped jobs by success/failure
-  - Show time of last output (or time since last update) for running jobs?
+TODO: Show time of last output (or time since last update) for running jobs?
 
 TODO: Make server stop jobs that have been running too long
   This could be done as part of the refresh action.

apiLib.sml

@@ -189,4 +189,18 @@ fun read_job_type inp =
     else "master"
   end
 
+datatype status = Pending | Success | Failure | Errored
+
+fun read_status inp =
+  let
+    fun loop () =
+      case TextIO.inputLine inp of NONE => Errored
+      | SOME line =>
+        if String.isSubstring "FAILED" line
+          then Failure
+        else if String.isSubstring "SUCCESS" line
+          then Success
+        else loop ()
+  in loop () end
+
 end

server.sml

@@ -76,7 +76,7 @@ fun claim id name =
               handle Option => cgi_die ["job ",f," has invalid file format"]
     val () = TextIO.closeIn inp
   in
-    GitHub.set_status f sha GitHub.pending_status
+    GitHub.set_status f sha Pending
   end
 
 fun append id line =
@@ -114,7 +114,7 @@ fun stop id =
     val () = TextIO.closeIn inp
     val () = GitHub.set_status f sha status
   in
-    send_email (String.concat["Job ",f,": ",#2 status])
+    send_email (String.concat["Job ",f,": ",#2 (GitHub.status status)])
                (String.concat["See ",server,"/job/",f,"\n"])
   end
 

serverLib.sml

@@ -306,16 +306,17 @@ structure GitHub = struct
     "--data",data,
     String.concat[rest_endpoint,endpoint]])
 
-  val pending_status = ("pending","regression test in progress")
-  val success_status = ("success","regression test succeeded")
-  val failure_status = ("failure","regression test failed")
-  val unknown_status = ("error","regression test aborted")
-  fun set_status id sha sd =
+  fun status Pending = ("pending","regression test in progress")
+    | status Success = ("success","regression test succeeded")
+    | status Failure = ("failure","regression test failed")
+    | status Errored = ("error","regression test aborted")
+
+  fun set_status id sha st =
     let
       val cmd =
         rest_curl_cmd
           (cakeml_status_endpoint sha)
-          (status_json id sd)
+          (status_json id (status st))
       val response = system_output cgi_die cmd
     in
       cgi_assert
@@ -324,18 +325,6 @@ structure GitHub = struct
     end
 end
 
-fun read_status inp =
-  let
-    fun loop () =
-      case TextIO.inputLine inp of NONE => GitHub.unknown_status
-      | SOME line =>
-        if String.isSubstring "FAILED" line
-          then GitHub.failure_status
-        else if String.isSubstring "SUCCESS" line
-          then GitHub.success_status
-        else loop ()
-  in loop () end
-
 val cakeml_query = String.concat [
   "{repository(name: \\\"cakeml\\\", owner: \\\"CakeML\\\"){",
   "defaultBranchRef { target { ... on Commit {",
@@ -556,7 +545,10 @@ structure HTML = struct
   val pre = elt "pre"
   fun time d = element "time" [("datetime",machine_date d)] [pretty_date d]
   fun a href body = element "a" [("href",href)] [body]
-  val span = elt "span"
+  fun span attrs strs = element "span" attrs strs
+  fun status_attrs Success = [("class","success")]
+    | status_attrs Failure = [("class","failure")]
+    | status_attrs _ = []
   val li = elt "li"
   fun ul ls = element "ul" [] (List.map li ls)
 end
@@ -575,10 +567,11 @@ in
       val typ = read_job_type inp
                 handle IO.Io _ => cgi_die ["cannot open ",f]
                      | Option => cgi_die [f," has invalid file format"]
+      val attrs = if q = "stopped" then status_attrs (read_status inp) else []
       val () = TextIO.closeIn inp
     in
       String.concat[a (String.concat["job/",jid]) jid, " ",
-                    span (String.concat ["(", typ, ")"])]
+                    span attrs ["(", typ, ")"]]
     end
 
   fun html_job_list (q,ids) =

style.css

@@ -7,5 +7,7 @@ pre time { font-size: 18px; }
 ul { list-style-type: none; font-size: 24px; }
 li { display: inline; padding: 1em; }
 li span { font-size: 18px; }
+li span.success { color: #0d0 }
+li span.failure { color: #d00 }
 a { color: #337ab7; text-decoration: none; }
 a:hover { text-decoration: underline; }