Move SSD session JSON writer to typed Kotlin

ober

31889e8aa88d634e7b614520b0facaeda7fd1ccc

diff --git a/.build.yml b/.build.yml
index 89b2965..377d7b8 100644
--- a/.build.yml
+++ b/.build.yml
@@ -5,7 +5,7 @@ packages:
   - make=4.4.1-r4
 sources:
   # Build dependency: full immutable commit, mirrored in dependencies.lock.json.
-  - "https://git.sr.ht/~lisp/jerboa#3a359bfff280c0eee5fc85c4c6a24fc9fc669d58"
+  - "https://git.sr.ht/~lisp/jerboa#79546b9d6d7f3fa15555c3b4193c2080b1ad4aed"
   # The second source is the build subject selected by the SourceHut submitter.
   - https://git.sr.ht/~lisp/jerboa-android
 tasks:
@@ -14,6 +14,6 @@ tasks:
       test "$(apk info -v chez-scheme)" = chez-scheme-10.3.0-r2
       test "$(apk info -v git)" = git-2.54.0-r0
       test "$(apk info -v make)" = make-4.4.1-r4
-      test "$(git -C ../jerboa rev-parse HEAD)" = 3a359bfff280c0eee5fc85c4c6a24fc9fc669d58
-      test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = a7ab43d1351a122fa69915cba29dc6cfdc4da9fd
+      test "$(git -C ../jerboa rev-parse HEAD)" = 79546b9d6d7f3fa15555c3b4193c2080b1ad4aed
+      test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = ff5aa378868436fe9ef1f906f52a27aa27b9502e
       JERBOA="chez --libdirs .:../jerboa/lib --script" make test
diff --git a/dependencies.lock.json b/dependencies.lock.json
index 9f9bb25..d8120b3 100644
--- a/dependencies.lock.json
+++ b/dependencies.lock.json
@@ -11,8 +11,8 @@
   "generator_runtime": {
     "name": "jerboa",
     "repository": "https://git.sr.ht/~lisp/jerboa",
-    "commit": "3a359bfff280c0eee5fc85c4c6a24fc9fc669d58",
-    "tree": "a7ab43d1351a122fa69915cba29dc6cfdc4da9fd"
+    "commit": "79546b9d6d7f3fa15555c3b4193c2080b1ad4aed",
+    "tree": "ff5aa378868436fe9ef1f906f52a27aa27b9502e"
   },
   "assurance_tools": {
     "osv_scanner": {
diff --git a/scripts/verify-supply-chain.sh b/scripts/verify-supply-chain.sh
index 8a2f641..14880ed 100755
--- a/scripts/verify-supply-chain.sh
+++ b/scripts/verify-supply-chain.sh
@@ -3,8 +3,8 @@ set -eu
 
 repo=$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd -P)
 lock="$repo/dependencies.lock.json"
-jerboa_commit=3a359bfff280c0eee5fc85c4c6a24fc9fc669d58 # gitsafe:ignore
-jerboa_tree=a7ab43d1351a122fa69915cba29dc6cfdc4da9fd # gitsafe:ignore
+jerboa_commit=79546b9d6d7f3fa15555c3b4193c2080b1ad4aed # gitsafe:ignore
+jerboa_tree=ff5aa378868436fe9ef1f906f52a27aa27b9502e # gitsafe:ignore
 gradle_sha=20f1b1176237254a6fc204d8434196fa11a4cfb387567519c61556e8710aed78
 jdk_macos_sha=8fa1eff40bb637a33613b2ccb8b12c70dc3661cc22cf8e784943715769a05336
 jdk_linux_sha=d8afc263758141a66e0e3aafc321e783f7016696f4eaea067d340a269037d331
diff --git a/templates/ssd-review.ss b/templates/ssd-review.ss
index c8dae6a..eeed387 100644
--- a/templates/ssd-review.ss
+++ b/templates/ssd-review.ss
@@ -899,6 +899,132 @@
                                 (json-object-opt-string json "notes"))))
                         (pair group cells)))))))))))
 
+    (typed-kotlin-file "com/sfb/ssdreview/SsdSessionJson.kt"
+      (kotlin-imports (org json JSONArray) (org json JSONObject))
+      (typed-library (com sfb ssdreview)
+        (export ssdSessionToTruthJson)
+        (type JSONObject)
+        (type JSONArray)
+        (type SsdCell)
+        (type SsdGroup)
+        (type SsdSession)
+        (type Int32)
+        (def (ssdSessionHasRustCell? (session : SsdSession)) : Bool
+          (for/fold ((found #f))
+                    ((i (in-range (int32 0) (list-size (SsdSession-cells session)))))
+            (if found
+                #t
+                (string-starts-with?
+                  (SsdCell-detector (list-ref (SsdSession-cells session) i))
+                  "rust"))))
+        (def (ssdSessionCellDetectionJson (session : SsdSession)) : JSONArray
+          (let ((items (json-array-empty)))
+            (begin
+              (if (ssdSessionHasRustCell? session)
+                  (begin
+                    (json-array-put-string! items "jerboa-vision-rust")
+                    (int32 0))
+                  (int32 0))
+              (json-array-put-string! items "android-threshold-components")
+              items)))
+        (def (ssdSessionReviewedGroup? (group : SsdGroup)) : Bool
+          (or (equal? (SsdGroup-status group) "approved")
+              (equal? (SsdGroup-status group) "reviewed")))
+        (def (ssdGroupToTruthJsonFromSession (session : SsdSession)
+                                             (group : SsdGroup)) : JSONObject
+          (let ((ids (json-array-empty)))
+            (let ((cells (json-array-empty)))
+              (let ((json (json-object-empty)))
+                (begin
+                  (for/fold ((ignored (int32 0)))
+                            ((i (in-range (int32 0) (list-size (SsdGroup-cellIds group)))))
+                    (let ((cellId (list-ref (SsdGroup-cellIds group) i)))
+                      (begin
+                        (json-array-put-string! ids cellId)
+                        (let ((cell (ssdSessionFindCellById session cellId)))
+                          (if (nullable-null? cell)
+                              ignored
+                              (begin
+                                (json-array-put-json-object! cells
+                                  (ssdCellToJson (nullable-get cell)))
+                                ignored))))))
+                  (json-object-put-string! json "source_group_id" (SsdGroup-id group))
+                  (json-object-put-string! json "label" (SsdGroup-label group))
+                  (json-object-put-string! json "box_type_id" (SsdGroup-boxTypeId group))
+                  (json-object-put-string! json "status" (SsdGroup-status group))
+                  (json-object-put-int32! json "count"
+                    (if (> (SsdGroup-count group) (int32 0))
+                        (SsdGroup-count group)
+                        (json-array-length cells)))
+                  (json-object-put-json-array! json "bbox" (floatArrayToJson (SsdGroup-bbox group)))
+                  (json-object-put-json-array! json "cell_ids" ids)
+                  (json-object-put-json-array! json "cells" cells)
+                  (json-object-put-string! json "notes" (SsdGroup-notes group))
+                  (if (string-blank? (SsdGroup-firingArc group))
+                      (int32 0)
+                      (begin
+                        (json-object-put-string! json "firing_arc" (SsdGroup-firingArc group))
+                        (int32 0)))
+                  json)))))
+        (def (ssdSessionToTruthJson (session : SsdSession)) : JSONObject
+          (let ((groupsJson (json-array-empty)))
+            (let ((suppressedJson (json-array-empty)))
+              (let ((sourceJson (json-object-empty)))
+                (let ((imageJson (json-object-empty)))
+                  (let ((parserJson (json-object-empty)))
+                    (let ((payload (json-object-empty)))
+                      (begin
+                        (for/fold ((ignored (int32 0)))
+                                  ((i (in-range (int32 0) (list-size (SsdSession-groups session)))))
+                          (let ((group (list-ref (SsdSession-groups session) i)))
+                            (if (ssdSessionReviewedGroup? group)
+                                (begin
+                                  (json-array-put-json-object! groupsJson
+                                    (ssdGroupToTruthJsonFromSession session group))
+                                  ignored)
+                                ignored)))
+                        (for/fold ((ignored (int32 0)))
+                                  ((i (in-range (int32 0) (list-size (SsdSession-suppressedGroups session)))))
+                          (begin
+                            (json-array-put-json-object! suppressedJson
+                              (ssdGroupToTruthJsonFromSession session
+                                (list-ref (SsdSession-suppressedGroups session) i)))
+                            ignored))
+                        (json-object-put-string! sourceJson "kind" "pdf")
+                        (json-object-put-string! sourceJson "path" (SsdSession-sourceUri session))
+                        (json-object-put-string! sourceJson "name" (SsdSession-sourceName session))
+                        (json-object-put-int32! sourceJson "page" (SsdSession-page session))
+                        (json-object-put-int32! sourceJson "page_count" (SsdSession-pageCount session))
+                        (json-object-put-int32! sourceJson "dpi" (SsdSession-dpi session))
+                        (json-object-put-int32! imageJson "width" (SsdSession-imageWidth session))
+                        (json-object-put-int32! imageJson "height" (SsdSession-imageHeight session))
+                        (json-object-put-string! parserJson "name" "SFB SSD Review Android")
+                        (json-object-put-string! parserJson "version" "android-kotlin-mvp-1")
+                        (json-object-put-json-array! parserJson "cell_detection"
+                          (ssdSessionCellDetectionJson session))
+                        (json-object-put-string! parserJson "ocr" "mlkit-text-recognition-latin-bundled")
+                        (json-object-put-int32! parserJson "ocr_word_count"
+                          (list-size (SsdSession-ocrWords session)))
+                        (json-object-put-int32! payload "schema_version" (int32 1))
+                        (json-object-put-string! payload "generated_at"
+                          (system-current-time-millis-string))
+                        (json-object-put-string! payload "session_id" (SsdSession-sessionId session))
+                        (json-object-put-string! payload "source_key" (SsdSession-sourceKey session))
+                        (json-object-put-string! payload "source_sha1"
+                          (string-substring-before (SsdSession-sourceKey session) "-p"))
+                        (json-object-put-json-object! payload "source" sourceJson)
+                        (json-object-put-json-object! payload "image" imageJson)
+                        (json-object-put-json-object! payload "parser" parserJson)
+                        (json-object-put-json-array! payload "groups" groupsJson)
+                        (json-object-put-json-array! payload "suppressed_groups" suppressedJson)
+                        (if (nullable-null? (SsdSession-ssdArea session))
+                            (int32 0)
+                            (begin
+                              (json-object-put-json-array! payload "ssd_area"
+                                (floatArrayToJson (nullable-get (SsdSession-ssdArea session))))
+                              (int32 0)))
+                        payload))))))))))
+
     (typed-kotlin-file "com/sfb/ssdreview/Guess.kt"
       (typed-library (com sfb ssdreview)
         (export make-Guess Guess? Guess-label Guess-boxType Guess-reason)
@@ -3646,54 +3772,6 @@
        "    }"
        "}"
        ))
-    (kotlin-file-lines "com/sfb/ssdreview/Models.kt"
-      (
-       "package com.sfb.ssdreview"
-       ""
-       "import org.json.JSONArray"
-       "import org.json.JSONObject"
-       "import kotlin.math.max"
-       "import kotlin.math.min"
-       ""
-       "fun ssdSessionCellsById(session: SsdSession): Map<String, SsdCell> = session.cells.associateBy { it.id }"
-       ""
-       "fun ssdSessionToTruthJson(session: SsdSession): JSONObject {"
-       "    val cellsById = ssdSessionCellsById(session)"
-       "    val groupsJson = JSONArray()"
-       "    session.groups.filter { it.status == \"approved\" || it.status == \"reviewed\" }.forEach {"
-       "        groupsJson.put(ssdGroupToTruthJson(it, cellsById))"
-       "    }"
-       "    val suppressedJson = JSONArray()"
-       "    session.suppressedGroups.forEach { suppressedJson.put(ssdGroupToTruthJson(it, cellsById)) }"
-       "    val payload = JSONObject()"
-       "        .put(\"schema_version\", 1)"
-       "        .put(\"generated_at\", System.currentTimeMillis().toString())"
-       "        .put(\"session_id\", session.sessionId)"
-       "        .put(\"source_key\", session.sourceKey)"
-       "        .put(\"source_sha1\", session.sourceKey.substringBefore(\"-p\"))"
-       "        .put(\"source\", JSONObject()"
-       "            .put(\"kind\", \"pdf\")"
-       "            .put(\"path\", session.sourceUri)"
-       "            .put(\"name\", session.sourceName)"
-       "            .put(\"page\", session.page)"
-       "            .put(\"page_count\", session.pageCount)"
-       "            .put(\"dpi\", session.dpi))"
-       "        .put(\"image\", JSONObject()"
-       "            .put(\"width\", session.imageWidth)"
-       "            .put(\"height\", session.imageHeight))"
-       "        .put(\"parser\", JSONObject()"
-       "            .put(\"name\", \"SFB SSD Review Android\")"
-       "            .put(\"version\", \"android-kotlin-mvp-1\")"
-       "            .put(\"cell_detection\", JSONArray(if (session.cells.any { it.detector.startsWith(\"rust\") }) listOf(\"jerboa-vision-rust\", \"android-threshold-components\") else listOf(\"android-threshold-components\")))"
-       "            .put(\"ocr\", \"mlkit-text-recognition-latin-bundled\")"
-       "            .put(\"ocr_word_count\", session.ocrWords.size))"
-       "        .put(\"groups\", groupsJson)"
-       "        .put(\"suppressed_groups\", suppressedJson)"
-       "    session.ssdArea?.let { payload.put(\"ssd_area\", floatArrayToJson(it)) }"
-       "    return payload"
-       "}"
-       ""
-	       ))
     (kotlin-file-lines "com/sfb/ssdreview/SsdDetector.kt"
       (
        "package com.sfb.ssdreview"