Add typed Kotlin JSON object helpers
ober
08784495ba2ea91885f6e4f44f50715d47a5a4ee
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -452,6 +452,9 @@ (cons 'string-remove-prefix (make-typed-call-sig (list 'String 'String) 'String '() 'jvm-string-remove-prefix '())) + (cons 'string-substring-before + (make-typed-call-sig (list 'String 'String) 'String '() + 'jvm-string-substring-before '())) (cons 'string->int32-or-null (make-typed-call-sig (list 'String) (list 'Nullable 'Int32) '() 'jvm-string-to-int32-or-null '())) @@ -518,6 +521,9 @@ (cons 'json-object-put-json-array! (make-typed-call-sig (list 'JSONObject 'String 'JSONArray) 'Unit '() 'jvm-json-object-put-json-array '())) + (cons 'json-object-put-json-object! + (make-typed-call-sig (list 'JSONObject 'String 'JSONObject) 'Unit '() + 'jvm-json-object-put-json-object '())) (cons 'json-object-opt-string (make-typed-call-sig (list 'JSONObject 'String) 'String '() 'jvm-json-object-opt-string '())) @@ -533,6 +539,9 @@ (cons 'json-object-opt-json-array (make-typed-call-sig (list 'JSONObject 'String) (list 'Nullable 'JSONArray) '() 'jvm-json-object-opt-json-array '())) + (cons 'system-current-time-millis-string + (make-typed-call-sig '() 'String '() + 'jvm-system-current-time-millis-string '())) ;; 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 @@ -152,11 +152,14 @@ jvm-json-object-put-int32 jvm-json-object-put-float32 jvm-json-object-put-json-array + jvm-json-object-put-json-object jvm-json-object-opt-string jvm-json-object-opt-string-default jvm-json-object-opt-float32 jvm-json-object-opt-int32-default jvm-json-object-opt-json-array + jvm-string-substring-before + jvm-system-current-time-millis-string record-ctor record-pred record-accessor --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -266,6 +266,8 @@ (make-kt-member-call (car args) 'trim '())] [(jvm-string-remove-prefix) (make-kt-member-call (car args) 'removePrefix (cdr args))] + [(jvm-string-substring-before) + (make-kt-member-call (car args) 'substringBefore (cdr args))] [(jvm-string-to-int32-or-null) (make-kt-member-call (car args) 'toIntOrNull '())] [(jvm-string-replace-regex) @@ -300,6 +302,11 @@ (make-kt-call (make-kt-name '(java net URLEncoder encode)) (list (car args) (make-kt-lit 'String "UTF-8")))] + [(jvm-system-current-time-millis-string) + (make-kt-member-call + (make-kt-call (make-kt-name '(java lang System currentTimeMillis)) '()) + 'toString + '())] [(jvm-float-array) (make-kt-call (kt-name1 'floatArrayOf) args)] [(jvm-float-array-ref) @@ -451,6 +458,15 @@ 'put (list (cadr args) (caddr args))))) (make-kt-lit 'Unit '()))] + [(jvm-json-object-put-json-object) + (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) --- a/tests/test-typed-checker.ss +++ b/tests/test-typed-checker.ss @@ -1009,6 +1009,25 @@ (json-object-opt-json-array json "items"))))) '()) +(test "json-object accepts nested object puts" + (error-kinds + '(typed-library (body json-object-nested) + (export put-nested) + (type JSONObject) + (def (put-nested (json : JSONObject) (child : JSONObject)) : Unit + (json-object-put-json-object! json "child" child)))) + '()) + +(test "string substring-before and system millis helpers typecheck" + (error-kinds + '(typed-library (body jvm-string-time) + (export f now) + (def (f (key : String)) : String + (string-substring-before key "-p")) + (def (now) : String + (system-current-time-millis-string)))) + '()) + (test "pair constructor returns pair of operand types" (error-kinds '(typed-library (body pair-ok) --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -331,6 +331,20 @@ "sourceSha1.take(16)") (test-contains "String padStart lowers to Kotlin padStart" key-kotlin "page.toString().padStart(4, '0')") +(test-contains "String substring-before lowers to Kotlin substringBefore" + (typed-library-form->kotlin-string + '(typed-library (sample typed substring-before) + (export sourceSha) + (def (sourceSha (key : String)) : String + (string-substring-before key "-p")))) + "key.substringBefore(\"-p\")") +(test-contains "Current time millis string lowers to JVM System call" + (typed-library-form->kotlin-string + '(typed-library (sample typed clock) + (export timestamp) + (def (timestamp) : String + (system-current-time-millis-string)))) + "java.lang.System.currentTimeMillis().toString()") (define race-form '(typed-library (sample typed race) @@ -703,13 +717,15 @@ (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)))) + (let ((meta (json-object-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-object-put-json-object! json "meta" meta) + json))))) (def (readX (json : JSONObject)) : Float32 (json-object-opt-float32 json "x")) (def (readCount (json : JSONObject)) : Int32 @@ -738,6 +754,9 @@ (test-contains "JSONObject put JSONArray lowers directly" json-object-kotlin "json.put(\"mean_bgr\", mean)") +(test-contains "JSONObject put JSONObject lowers directly" + json-object-kotlin + "json.put(\"meta\", meta)") (test-contains "JSONObject opt Float32 lowers through optDouble" json-object-kotlin "json.optDouble(\"x\").toFloat()")