Add typed Kotlin JSON object helpers
ober
e4843b4a75ecc0c9fb377c82338e5b0632d55b96
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -484,12 +484,39 @@ (cons 'json-array-put-float32! (make-typed-call-sig (list 'JSONArray 'Float32) 'Unit '() 'jvm-json-array-put-float32 '())) + (cons 'json-array-put-int32! + (make-typed-call-sig (list 'JSONArray 'Int32) 'Unit '() + 'jvm-json-array-put-int32 '())) (cons 'json-array-length (make-typed-call-sig (list 'JSONArray) 'Int32 '() 'jvm-json-array-length '())) (cons 'json-array-opt-float32 (make-typed-call-sig (list 'JSONArray 'Int32 'Float32) 'Float32 '() 'jvm-json-array-opt-float32 '())) + (cons 'json-object-empty + (make-typed-call-sig '() 'JSONObject '() + 'jvm-json-object-empty '())) + (cons 'json-object-put-string! + (make-typed-call-sig (list 'JSONObject 'String 'String) 'Unit '() + 'jvm-json-object-put-string '())) + (cons 'json-object-put-int32! + (make-typed-call-sig (list 'JSONObject 'String 'Int32) 'Unit '() + 'jvm-json-object-put-int32 '())) + (cons 'json-object-put-float32! + (make-typed-call-sig (list 'JSONObject 'String 'Float32) 'Unit '() + 'jvm-json-object-put-float32 '())) + (cons 'json-object-put-json-array! + (make-typed-call-sig (list 'JSONObject 'String 'JSONArray) 'Unit '() + 'jvm-json-object-put-json-array '())) + (cons 'json-object-opt-string + (make-typed-call-sig (list 'JSONObject 'String) 'String '() + 'jvm-json-object-opt-string '())) + (cons 'json-object-opt-string-default + (make-typed-call-sig (list 'JSONObject 'String 'String) 'String '() + 'jvm-json-object-opt-string-default '())) + (cons 'json-object-opt-float32 + (make-typed-call-sig (list 'JSONObject 'String) 'Float32 '() + 'jvm-json-object-opt-float32 '())) ;; crypto primitives — FFI to vetted RustCrypto crates, never reimplemented. ;; Each carries kind 'crypto-prim and an info `prim` the emitter dispatches ;; on; the Rust block they emit references the crate (sha2/hmac/hkdf) that --- a/lib/jerboa/typed/core.ss +++ b/lib/jerboa/typed/core.ss @@ -139,8 +139,17 @@ jvm-mutable-list-set jvm-json-array-empty jvm-json-array-put-float32 + jvm-json-array-put-int32 jvm-json-array-length jvm-json-array-opt-float32 + jvm-json-object-empty + jvm-json-object-put-string + jvm-json-object-put-int32 + jvm-json-object-put-float32 + jvm-json-object-put-json-array + jvm-json-object-opt-string + jvm-json-object-opt-string-default + jvm-json-object-opt-float32 record-ctor record-pred record-accessor --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -362,6 +362,15 @@ (list (make-kt-member-call (cadr args) 'toDouble '()))))) (make-kt-lit 'Unit '()))] + [(jvm-json-array-put-int32) + (make-kt-block + (list + (make-kt-expr-stmt + (make-kt-member-call + (car args) + 'put + (list (cadr args))))) + (make-kt-lit 'Unit '()))] [(jvm-json-array-length) (make-kt-member-call (car args) 'length '())] [(jvm-json-array-opt-float32) @@ -374,6 +383,55 @@ (make-kt-member-call (caddr args) 'toDouble '()))) 'toFloat '())] + [(jvm-json-object-empty) + (make-kt-new (make-kt-type 'JSONObject #f '()) '())] + [(jvm-json-object-put-string) + (make-kt-block + (list + (make-kt-expr-stmt + (make-kt-member-call + (car args) + 'put + (list (cadr args) (caddr args))))) + (make-kt-lit 'Unit '()))] + [(jvm-json-object-put-int32) + (make-kt-block + (list + (make-kt-expr-stmt + (make-kt-member-call + (car args) + 'put + (list (cadr args) (caddr args))))) + (make-kt-lit 'Unit '()))] + [(jvm-json-object-put-float32) + (make-kt-block + (list + (make-kt-expr-stmt + (make-kt-member-call + (car args) + 'put + (list + (cadr args) + (make-kt-member-call (caddr args) 'toDouble '()))))) + (make-kt-lit 'Unit '()))] + [(jvm-json-object-put-json-array) + (make-kt-block + (list + (make-kt-expr-stmt + (make-kt-member-call + (car args) + 'put + (list (cadr args) (caddr args))))) + (make-kt-lit 'Unit '()))] + [(jvm-json-object-opt-string) + (make-kt-member-call (car args) 'optString (cdr args))] + [(jvm-json-object-opt-string-default) + (make-kt-member-call (car args) 'optString (cdr args))] + [(jvm-json-object-opt-float32) + (make-kt-member-call + (make-kt-member-call (car args) 'optDouble (cdr args)) + 'toFloat + '())] [(jvm-boolean-array-ref) (make-kt-index-get (car args) (cadr args))] [(jvm-boolean-array-set) --- a/tests/test-typed-checker.ss +++ b/tests/test-typed-checker.ss @@ -924,6 +924,47 @@ (json-array-opt-float32 items index (float32 0.0))))) '(argument-type-mismatch)) +(test "json-object primitives accept declared JSON types" + (error-kinds + '(typed-library (body json-object-ok) + (export make-json read-x) + (type JSONObject) + (type JSONArray) + (type Float32) + (type Int32) + (def (make-json (id : String) (x : Float32) (n : Int32)) : JSONObject + (let ((json (json-object-empty))) + (let ((items (json-array-empty))) + (begin + (json-array-put-int32! items n) + (json-object-put-string! json "id" id) + (json-object-put-float32! json "x" x) + (json-object-put-int32! json "count" n) + (json-object-put-json-array! json "items" items) + json)))) + (def (read-x (json : JSONObject)) : Float32 + (json-object-opt-float32 json "x")))) + '()) + +(test "json-object put rejects non-String key" + (error-kinds + '(typed-library (body json-object-key) + (export f) + (type JSONObject) + (type Float32) + (type Int32) + (def (f (json : JSONObject) (key : Int32) (x : Float32)) : Unit + (json-object-put-float32! json key x)))) + '(argument-type-mismatch)) + +(test "json-object opt rejects non-JSONObject receiver" + (error-kinds + '(typed-library (body json-object-receiver) + (export f) + (def (f (json : String)) : String + (json-object-opt-string json "id")))) + '(argument-type-mismatch)) + (test "variant constructor and predicate calls" (error-kinds '(typed-library (body variant-ok) --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -621,6 +621,15 @@ (test-contains "JSONArray put Float32 lowers through Double" json-array-kotlin "items.put(a.toDouble())") +(test-contains "JSONArray put Int32 lowers directly" + (typed-library-form->kotlin-string + '(typed-library (sample typed json-array-int) + (export putCount) + (type JSONArray) + (type Int32) + (def (putCount (items : JSONArray) (count : Int32)) : Unit + (json-array-put-int32! items count)))) + "items.put(count)") (test-contains "JSONArray length lowers to method call" json-array-kotlin "items.length()") @@ -628,6 +637,57 @@ json-array-kotlin "items.optDouble(0, 0.0f.toDouble()).toFloat()") +(define json-object-form + '(typed-library (sample typed json-object) + (export makeCell readX readName readNameDefault) + (type JSONObject) + (type JSONArray) + (type Float32) + (type Int32) + (def (makeCell (id : String) (x : Float32) (count : Int32)) : JSONObject + (let ((json (json-object-empty))) + (let ((mean (json-array-empty))) + (begin + (json-array-put-int32! mean (int32 0)) + (json-object-put-string! json "id" id) + (json-object-put-float32! json "x" x) + (json-object-put-int32! json "count" count) + (json-object-put-json-array! json "mean_bgr" mean) + json)))) + (def (readX (json : JSONObject)) : Float32 + (json-object-opt-float32 json "x")) + (def (readName (json : JSONObject)) : String + (json-object-opt-string json "name")) + (def (readNameDefault (json : JSONObject)) : String + (json-object-opt-string-default json "name" "truth")))) + +(define json-object-kotlin (typed-library-form->kotlin-string json-object-form)) + +(test-contains "JSONObject empty lowers to constructor" + json-object-kotlin + "val json: JSONObject = JSONObject()") +(test-contains "JSONObject put String lowers directly" + json-object-kotlin + "json.put(\"id\", id)") +(test-contains "JSONObject put Float32 lowers through Double" + json-object-kotlin + "json.put(\"x\", x.toDouble())") +(test-contains "JSONObject put Int32 lowers directly" + json-object-kotlin + "json.put(\"count\", count)") +(test-contains "JSONObject put JSONArray lowers directly" + json-object-kotlin + "json.put(\"mean_bgr\", mean)") +(test-contains "JSONObject opt Float32 lowers through optDouble" + json-object-kotlin + "json.optDouble(\"x\").toFloat()") +(test-contains "JSONObject opt String lowers to optString" + json-object-kotlin + "json.optString(\"name\")") +(test-contains "JSONObject opt String default lowers to optString default" + json-object-kotlin + "json.optString(\"name\", \"truth\")") + (define fold-form '(typed-library (sample typed fold) (export sumTo)