Add typed SSD server models
ober
ca44dba29d550e1ca9d3849a089cf549ebd76f3a
new file mode 100644 --- /dev/null +++ b/templates/ssd-review-parts/server-models.ss @@ -0,0 +1,298 @@ +(import (jerboa prelude)) + +(def fragment + '((typed-kotlin-file "com/sfb/ssdreview/SfbServerModels.kt" + (kotlin-imports (org json JSONArray) (org json JSONObject)) + (typed-library (com sfb ssdreview) + (export make-SfbServerAddress SfbServerAddress? + SfbServerAddress-url SfbServerAddress-label + make-SfbServerInfo SfbServerInfo? + SfbServerInfo-ok SfbServerInfo-name SfbServerInfo-addresses + make-SfbServerPdf SfbServerPdf? + SfbServerPdf-pdfId SfbServerPdf-name SfbServerPdf-path + SfbServerPdf-pageCount + make-SfbServerCatalog SfbServerCatalog? SfbServerCatalog-pdfs + make-SfbServerPage SfbServerPage? + SfbServerPage-page SfbServerPage-dpi + SfbServerPage-width SfbServerPage-height + make-SfbServerPageCatalog SfbServerPageCatalog? + SfbServerPageCatalog-pdfId SfbServerPageCatalog-pages + make-SfbServerManifest SfbServerManifest? + SfbServerManifest-pdfId SfbServerManifest-page + SfbServerManifest-dpi SfbServerManifest-ssdArea + make-SfbServerSnapshot SfbServerSnapshot? + SfbServerSnapshot-pdfId SfbServerSnapshot-page + SfbServerSnapshot-dpi SfbServerSnapshot-bytes + make-SfbServerPageTruth SfbServerPageTruth? + SfbServerPageTruth-pdfId SfbServerPageTruth-page + SfbServerPageTruth-dpi SfbServerPageTruth-truth + make-SfbServerRecognition SfbServerRecognition? + SfbServerRecognition-pdfId SfbServerRecognition-page + SfbServerRecognition-dpi SfbServerRecognition-ssdArea + SfbServerRecognition-groups SfbServerRecognition-cells + SfbServerRecognition-ocrWords + sfbServerInfoFromJson sfbServerCatalogFromJson + sfbServerPagesFromJson sfbServerManifestFromJson + sfbServerTruthFromJson sfbServerRecognitionFromJson + sfbServerOcrWordsFromJson sfbFindServerPdfByName) + (type FloatArray) + (type Int32) + (type JSONArray) + (type JSONObject) + (type OcrWord) + (type SsdCell) + (type SsdGroup) + (record SfbServerAddress + ((url : String) + (label : String))) + (record SfbServerInfo + ((ok : Bool) + (name : String) + (addresses : (List SfbServerAddress)))) + (record SfbServerPdf + ((pdfId : String) + (name : String) + (path : String) + (pageCount : Int32))) + (record SfbServerCatalog + ((pdfs : (List SfbServerPdf)))) + (record SfbServerPage + ((page : Int32) + (dpi : Int32) + (width : Int32) + (height : Int32))) + (record SfbServerPageCatalog + ((pdfId : String) + (pages : (List SfbServerPage)))) + (record SfbServerManifest + ((pdfId : String) + (page : Int32) + (dpi : Int32) + (ssdArea : (Nullable FloatArray)))) + (record SfbServerSnapshot + ((pdfId : String) + (page : Int32) + (dpi : Int32) + (bytes : Bytes))) + (record SfbServerPageTruth + ((pdfId : String) + (page : Int32) + (dpi : Int32) + (truth : (Nullable JSONObject)))) + (record SfbServerRecognition + ((pdfId : String) + (page : Int32) + (dpi : Int32) + (ssdArea : (Nullable FloatArray)) + (groups : (List SsdGroup)) + (cells : (List SsdCell)) + (ocrWords : (List OcrWord)))) + (def (sfbJsonArrayOrEmpty (value : (Nullable JSONArray))) : JSONArray + (if (nullable-null? value) + (json-array-empty) + (nullable-get value))) + (def (sfbServerAddressesFromJson (items : JSONArray)) : (MutableList SfbServerAddress) + (for/fold ((out (mutable-list-empty SfbServerAddress))) + ((i (in-range (int32 0) (json-array-length items)))) + (let ((entry (json-array-opt-json-object items i))) + (begin + (if (nullable-null? entry) + (begin) + (let ((json (nullable-get entry))) + (let ((url (json-object-opt-string json "url"))) + (if (string-blank? url) + (begin) + (mutable-list-add! + out + (make-SfbServerAddress + url + (json-object-opt-string-default json "label" url))))))) + out)))) + (def (sfbServerInfoFromJson (json : JSONObject)) : SfbServerInfo + (make-SfbServerInfo + (json-object-opt-bool-default json "ok" #f) + (json-object-opt-string-default json "name" "sfb-server") + (sfbServerAddressesFromJson + (sfbJsonArrayOrEmpty + (json-object-opt-json-array json "addresses"))))) + (def (sfbServerPdfFromJson (json : JSONObject)) : SfbServerPdf + (make-SfbServerPdf + (json-object-opt-string-default + json + "pdf_id" + (json-object-opt-string json "id")) + (json-object-opt-string-default + json + "name" + (json-object-opt-string json "path")) + (json-object-opt-string json "path") + (json-object-opt-int32-default json "page_count" (int32 0)))) + (def (sfbServerCatalogFromJson (json : JSONObject)) : SfbServerCatalog + (let ((items + (sfbJsonArrayOrEmpty + (json-object-opt-json-array json "pdfs")))) + (make-SfbServerCatalog + (for/fold ((out (mutable-list-empty SfbServerPdf))) + ((i (in-range (int32 0) (json-array-length items)))) + (let ((entry (json-array-opt-json-object items i))) + (begin + (if (nullable-null? entry) + (begin) + (let ((pdf (sfbServerPdfFromJson (nullable-get entry)))) + (if (string-blank? (SfbServerPdf-pdfId pdf)) + (begin) + (mutable-list-add! out pdf)))) + out)))))) + (def (sfbServerPageFromJson (json : JSONObject)) : SfbServerPage + (let ((image + (truthJsonObjectOrEmpty + (json-object-opt-json-object json "image")))) + (make-SfbServerPage + (json-object-opt-int32-default json "page" (int32 0)) + (json-object-opt-int32-default json "dpi" (int32 0)) + (json-object-opt-int32-default + json + "width" + (json-object-opt-int32-default image "width" (int32 0))) + (json-object-opt-int32-default + json + "height" + (json-object-opt-int32-default image "height" (int32 0)))))) + (def (sfbServerPagesFromJson (pdfId : String) + (json : JSONObject)) : SfbServerPageCatalog + (let ((items + (sfbJsonArrayOrEmpty + (json-object-opt-json-array json "pages")))) + (make-SfbServerPageCatalog + pdfId + (for/fold ((out (mutable-list-empty SfbServerPage))) + ((i (in-range (int32 0) (json-array-length items)))) + (let ((entry (json-array-opt-json-object items i))) + (begin + (if (nullable-null? entry) + (begin) + (mutable-list-add! + out + (sfbServerPageFromJson (nullable-get entry)))) + out)))))) + (def (sfbServerManifestFromJson (pdfId : String) + (page : Int32) + (dpi : Int32) + (json : JSONObject)) : SfbServerManifest + (make-SfbServerManifest + pdfId + page + dpi + (jsonRect (json-object-opt-json-array json "ssd_area")))) + (def (sfbServerTruthFromJson (pdfId : String) + (page : Int32) + (dpi : Int32) + (json : JSONObject)) : SfbServerPageTruth + (make-SfbServerPageTruth + pdfId + page + dpi + (json-object-opt-json-object json "truth"))) + (def (sfbServerOcrWordsFromJson (json : JSONObject)) : (MutableList OcrWord) + (let ((items + (sfbJsonArrayOrEmpty + (json-object-opt-json-array json "words")))) + (for/fold ((out (mutable-list-empty OcrWord))) + ((i (in-range (int32 0) (json-array-length items)))) + (let ((entry (json-array-opt-json-object items i))) + (begin + (if (nullable-null? entry) + (begin) + (let ((word (nullable-get entry))) + (let ((text (string-trim (json-object-opt-string word "text"))) + (bbox (jsonRect (json-object-opt-json-array word "bbox")))) + (if (or (string-blank? text) (nullable-null? bbox)) + (begin) + (mutable-list-add! + out + (make-OcrWord + text + (json-object-opt-float32-default + word + "confidence" + (float32 0.0)) + (nullable-get bbox))))))) + out))))) + (def (sfbRecognitionGroupsFromJson + (items : JSONArray)) : (Pair (MutableList SsdGroup) (MutableList SsdCell)) + (let ((groups (mutable-list-empty SsdGroup)) + (cells (mutable-list-empty SsdCell))) + (begin + (for/fold ((ignored (int32 0))) + ((i (in-range (int32 0) (json-array-length items)))) + (let ((entry (json-array-opt-json-object items i))) + (begin + (if (nullable-null? entry) + (begin) + (let ((parsed (ssdGroupFromTruthJson (nullable-get entry)))) + (begin + (mutable-list-add! groups (pair-first parsed)) + (mutable-list-add-all! cells (pair-second parsed))))) + ignored))) + (pair groups cells)))) + (def (sfbServerRecognitionFromJson + (pdfId : String) + (page : Int32) + (dpi : Int32) + (recognition : JSONObject) + (ocr : (Nullable JSONObject))) : SfbServerRecognition + (let ((parsed + (sfbRecognitionGroupsFromJson + (sfbJsonArrayOrEmpty + (json-object-opt-json-array recognition "approved_groups"))))) + (make-SfbServerRecognition + pdfId + page + dpi + (jsonRect (json-object-opt-json-array recognition "ssd_area")) + (pair-first parsed) + (pair-second parsed) + (if (nullable-null? ocr) + (mutable-list-empty OcrWord) + (sfbServerOcrWordsFromJson (nullable-get ocr)))))) + (def (sfbCanonicalPdfName (value : String)) : String + (canonicalSourceName value)) + (def (sfbFindExactPdf (pdfs : (List SfbServerPdf)) + (wanted : String)) : (Nullable SfbServerPdf) + (for/fold ((found (nullable-none SfbServerPdf))) + ((i (in-range (int32 0) (list-size pdfs)))) + (if (nullable-null? found) + (let ((pdf (list-ref pdfs i))) + (if (equal? + (sfbCanonicalPdfName (SfbServerPdf-name pdf)) + wanted) + (nullable-some pdf) + found)) + found))) + (def (sfbFindStemPdf (pdfs : (List SfbServerPdf)) + (wanted : String)) : (Nullable SfbServerPdf) + (let ((wantedStem (string-replace-regex wanted "pdf$" ""))) + (for/fold ((found (nullable-none SfbServerPdf))) + ((i (in-range (int32 0) (list-size pdfs)))) + (if (nullable-null? found) + (let ((pdf (list-ref pdfs i))) + (let ((candidate + (string-replace-regex + (sfbCanonicalPdfName (SfbServerPdf-name pdf)) + "pdf$" + ""))) + (if (or (equal? candidate wantedStem) + (or (string-contains? candidate wantedStem) + (string-contains? wantedStem candidate))) + (nullable-some pdf) + found))) + found)))) + (def (sfbFindServerPdfByName (catalog : SfbServerCatalog) + (name : String)) : (Nullable SfbServerPdf) + (let ((wanted (sfbCanonicalPdfName name))) + (if (string-blank? wanted) + (nullable-none SfbServerPdf) + (let ((exact (sfbFindExactPdf (SfbServerCatalog-pdfs catalog) wanted))) + (if (nullable-null? exact) + (sfbFindStemPdf (SfbServerCatalog-pdfs catalog) wanted) + exact)))))))))