Add visible SSD work timing status
ober
f06372f1638720dd3ac802b6d3cabf91e300a53c
--- a/templates/ssd-review-parts/main-ai-flow.ss +++ b/templates/ssd-review-parts/main-ai-flow.ss @@ -45,6 +45,7 @@ (type Int32) (type Intent) (type MainActivity) + (type MainWorkToken) (type JSONObject) (type ScrollView) (type SfbAiApkArtifact) @@ -112,6 +113,20 @@ (activity : MainActivity) (action : (-> Unit))) : Unit (kotlin-member-call runOnUiThread)) + (extern (mainAiWorkBegin + (activity : MainActivity) + (label : String)) : MainWorkToken + (kotlin-call mainWorkBegin)) + (extern (mainAiWorkDone + (activity : MainActivity) + (token : MainWorkToken) + (label : String)) : Unit + (kotlin-call mainWorkDone)) + (extern (mainAiWorkFailed + (activity : MainActivity) + (token : MainWorkToken) + (label : String)) : Unit + (kotlin-call mainWorkFailed)) (extern (mainAiViewWidth (view : SsdReviewView)) : Int32 (kotlin-member-get width)) @@ -641,50 +656,57 @@ (activity : MainActivity) (description : String) (screenshot : Bytes)) : Unit - (begin - (mainAiSetStatus activity "Sending display to AI...") - (mainAiRunBackground - "sfb-ai-report-upload" - (lambda () - (try - (let ((submission - (mainAiSubmit - (mainAiClient activity) - (mainAiIssueRequest - activity description screenshot)))) - (let ((jobId (mainAiSubmissionJobId submission))) - (begin - (mainAiStoreString activity "pending_ai_job" jobId) - (mainAiLogEvent - activity - "ssd-ai-report-submitted" - (mainAiSubmissionFields - submission - (mainAiBytesSize screenshot))) - (mainAiRunOnUi - activity - (lambda () - (mainAiSetStatus - activity - (string-append - "AI report " - (string-append - (mainAiSubmissionState submission) + (let ((token (mainAiWorkBegin activity "Sending display to AI"))) + (begin + (mainAiSetStatus activity "Sending display to AI...") + (mainAiRunBackground + "sfb-ai-report-upload" + (lambda () + (try + (let ((submission + (mainAiSubmit + (mainAiClient activity) + (mainAiIssueRequest + activity description screenshot)))) + (let ((jobId (mainAiSubmissionJobId submission))) + (begin + (mainAiStoreString activity "pending_ai_job" jobId) + (mainAiLogEvent + activity + "ssd-ai-report-submitted" + (mainAiSubmissionFields + submission + (mainAiBytesSize screenshot))) + (mainAiRunOnUi + activity + (lambda () + (begin + (mainAiSetStatus + activity (string-append - ": " + "AI report " (string-append - jobId - "; waiting for full feedback"))))))) - (mainAiPollJob activity jobId)))) - (catch (error : Exception) - (mainAiRunOnUi - activity - (lambda () - (mainAiSetStatus - activity - (string-append - "AI report failed: " - (mainAiErrorText error))))))))))) + (mainAiSubmissionState submission) + (string-append + ": " + (string-append + jobId + "; waiting for full feedback"))))) + (mainAiWorkDone + activity token "AI report submitted")))) + (mainAiPollJob activity jobId)))) + (catch (error : Exception) + (mainAiRunOnUi + activity + (lambda () + (let ((message + (string-append + "AI report failed: " + (mainAiErrorText error)))) + (begin + (mainAiSetStatus activity message) + (mainAiWorkFailed + activity token message)))))))))))) (def (mainAiShowIssueDialog (activity : MainActivity)) : Unit (try --- a/templates/ssd-review-parts/main-server-pages.ss +++ b/templates/ssd-review-parts/main-server-pages.ss @@ -28,6 +28,7 @@ (type FloatArray) (type Int32) (type MainActivity) + (type MainWorkToken) (type OcrWord) (type SfbServerCatalog) (type SfbServerClient) @@ -366,6 +367,20 @@ (activity : MainActivity) (stage : String)) : Unit (kotlin-call mainSelfTestLog)) + (extern (mainServerPageWorkBegin + (activity : MainActivity) + (label : String)) : MainWorkToken + (kotlin-call mainWorkBegin)) + (extern (mainServerPageWorkDone + (activity : MainActivity) + (token : MainWorkToken) + (label : String)) : Unit + (kotlin-call mainWorkDone)) + (extern (mainServerPageWorkFailed + (activity : MainActivity) + (token : MainWorkToken) + (label : String)) : Unit + (kotlin-call mainWorkFailed)) (def (mainServerPageErrorText (error : Exception)) : String (let ((message (mainServerPageExceptionMessage error))) (if (nullable-null? message) @@ -502,56 +517,73 @@ (int32->string (list-size pdfs)) " server SSD PDFs"))))))) (def (mainServerOpenPdfs (activity : MainActivity)) : Unit - (begin - (mainServerPageSetStatus activity "Loading server SSD catalog...") - (mainServerPageRunBackground - "sfb-server-catalog" - (lambda () - (try - (let ((catalog - (mainServerPageClientCatalog - (mainServerPageClient activity)))) - (mainServerPageRunOnUi - activity - (lambda () - (mainServerShowCatalog activity catalog)))) - (catch (error : Exception) - (mainServerPageRunOnUi - activity - (lambda () - (mainServerPageSetStatus - activity - (string-append - "Server SSD catalog failed: " - (mainServerPageErrorText error))))))))))) + (let ((token + (mainServerPageWorkBegin + activity "Loading server SSD catalog"))) + (begin + (mainServerPageSetStatus activity "Loading server SSD catalog...") + (mainServerPageRunBackground + "sfb-server-catalog" + (lambda () + (try + (let ((catalog + (mainServerPageClientCatalog + (mainServerPageClient activity)))) + (mainServerPageRunOnUi + activity + (lambda () + (begin + (mainServerShowCatalog activity catalog) + (mainServerPageWorkDone + activity token "Loaded server SSD catalog"))))) + (catch (error : Exception) + (mainServerPageRunOnUi + activity + (lambda () + (let ((message + (string-append + "Server SSD catalog failed: " + (mainServerPageErrorText error)))) + (begin + (mainServerPageSetStatus activity message) + (mainServerPageWorkFailed + activity token message)))))))))))) (def (mainServerFindEndpointAsync (activity : MainActivity)) : Unit - (begin - (mainServerPageSetStatus activity "Finding sfb-server...") - (mainServerPageRunBackground - "sfb-server-find" - (lambda () - (try - (let ((client (mainServerPageClient activity))) - (begin - (mainServerPageClientRefresh client) + (let ((token + (mainServerPageWorkBegin activity "Finding sfb-server"))) + (begin + (mainServerPageSetStatus activity "Finding sfb-server...") + (mainServerPageRunBackground + "sfb-server-find" + (lambda () + (try + (let ((client (mainServerPageClient activity))) + (begin + (mainServerPageClientRefresh client) + (mainServerPageRunOnUi + activity + (lambda () + (let ((message + (string-append + "Server ready: " + (mainServerPageClientEndpoint client)))) + (begin + (mainServerPageSetStatus activity message) + (mainServerPageWorkDone + activity token "Found server"))))))) + (catch (error : Exception) (mainServerPageRunOnUi activity (lambda () - (mainServerPageSetStatus - activity - (string-append - "Server ready: " - (mainServerPageClientEndpoint client))))))) - (catch (error : Exception) - (mainServerPageRunOnUi - activity - (lambda () - (mainServerPageSetStatus - activity - (string-append - "Server discovery failed: " - (mainServerPageErrorText error))))))))))) + (let ((message + (string-append + "Server discovery failed: " + (mainServerPageErrorText error)))) + (begin + (mainServerPageSetStatus activity message) + (mainServerPageWorkFailed + activity token message)))))))))))) (def (mainServerShowEndpointDialog (activity : MainActivity)) : Unit (let ((input (mainServerPageEditText activity))) new file mode 100644 --- /dev/null +++ b/templates/ssd-review-parts/main-work-status.ss @@ -0,0 +1,244 @@ +(import (jerboa prelude)) + +(def fragment + '((typed-kotlin-file "com/sfb/ssdreview/MainWorkStatus.kt" + (kotlin-imports (android graphics Color) + (android os SystemClock) + (android view View) + (android widget LinearLayout) + (android widget TextView) + (org json JSONObject)) + (typed-library (com sfb ssdreview) + (export mainWorkInstallStatusView mainWorkBegin + mainWorkStep mainWorkDone mainWorkFailed) + (type Int) + (type Int32) + (type LinearLayout) + (type MainActivity) + (type JSONObject) + (type TextView) + (record MainWorkToken + ((id : Int32) (startedMs : Int))) + (extern (mainWorkTextView + (activity : MainActivity)) : TextView + (kotlin-call TextView)) + (extern (mainWorkTextSizeSet + (view : TextView) + (size : Float32)) : Unit + (kotlin-member-set textSize)) + (type Float32) + (extern (mainWorkTextColorSet + (view : TextView) + (color : Int32)) : Unit + (kotlin-member-call setTextColor)) + (extern (mainWorkBackgroundSet + (view : TextView) + (color : Int32)) : Unit + (kotlin-member-call setBackgroundColor)) + (extern (mainWorkPaddingSet + (view : TextView) + (left : Int32) + (top : Int32) + (right : Int32) + (bottom : Int32)) : Unit + (kotlin-member-call setPadding)) + (extern (mainWorkVisibilitySet + (view : TextView) + (visibility : Int32)) : Unit + (kotlin-member-set visibility)) + (extern (mainWorkTextSet + (view : TextView) + (text : String)) : Unit + (kotlin-member-set text)) + (extern (mainWorkGone) : Int32 + (kotlin-value View GONE)) + (extern (mainWorkVisible) : Int32 + (kotlin-value View VISIBLE)) + (extern (mainWorkColor + (red : Int32) + (green : Int32) + (blue : Int32)) : Int32 + (kotlin-call Color rgb)) + (extern (mainWorkRootAdd + (root : LinearLayout) + (view : TextView)) : Unit + (kotlin-member-call addView)) + (extern (mainWorkStatusViewSet + (activity : MainActivity) + (view : TextView)) : Unit + (kotlin-member-set activityStatus)) + (extern (mainWorkStatusView + (activity : MainActivity)) : TextView + (kotlin-member-get activityStatus)) + (extern (mainWorkCurrentId + (activity : MainActivity)) : Int32 + (kotlin-member-get workActivityId)) + (extern (mainWorkCurrentIdSet + (activity : MainActivity) + (id : Int32)) : Unit + (kotlin-member-set workActivityId)) + (extern (mainWorkNow) : Int + (kotlin-call SystemClock uptimeMillis)) + (extern (mainWorkRemainder + (value : Int) + (divisor : Int)) : Int + (kotlin-member-call rem)) + (extern (mainWorkRunOnUi + (activity : MainActivity) + (action : (-> Unit))) : Unit + (kotlin-member-call runOnUiThread)) + (extern (mainWorkLog + (activity : MainActivity) + (event : String) + (fields : JSONObject)) : Unit + (kotlin-call mainActivityLogClientEvent)) + (def (mainWorkInstallStatusView + (activity : MainActivity) + (root : LinearLayout)) : Unit + (let ((view (mainWorkTextView activity))) + (begin + (mainWorkTextSizeSet view (float32 13.0)) + (mainWorkTextColorSet + view + (mainWorkColor (int32 15) (int32 23) (int32 42))) + (mainWorkPaddingSet + view (int32 10) (int32 7) (int32 10) (int32 7)) + (mainWorkBackgroundSet + view + (mainWorkColor (int32 226) (int32 232) (int32 240))) + (mainWorkVisibilitySet view (mainWorkGone)) + (mainWorkStatusViewSet activity view) + (mainWorkRootAdd root view)))) + (def (mainWorkElapsed + (token : MainWorkToken)) : Int + (let ((elapsed (- (mainWorkNow) (MainWorkToken-startedMs token)))) + (if (< elapsed (int 0)) (int 0) elapsed))) + (def (mainWorkDuration (elapsed : Int)) : String + (if (< elapsed (int 1000)) + (string-append (int->string elapsed) " ms") + (string-append + (int->string (/ elapsed (int 1000))) + (string-append + "." + (string-append + (int->string + (mainWorkRemainder + (/ elapsed (int 100)) + (int 10))) + " s"))))) + (def (mainWorkRender + (activity : MainActivity) + (token : MainWorkToken) + (prefix : String) + (label : String) + (background : Int32) + (foreground : Int32)) : Unit + (if (equal? + (MainWorkToken-id token) + (mainWorkCurrentId activity)) + (let ((view (mainWorkStatusView activity))) + (begin + (mainWorkVisibilitySet view (mainWorkVisible)) + (mainWorkTextColorSet view foreground) + (mainWorkBackgroundSet view background) + (mainWorkTextSet + view + (string-append + prefix + (string-append + ": " + (string-append + label + (string-append + " - " + (mainWorkDuration (mainWorkElapsed token))))))))) + (begin))) + (def (mainWorkStartedFields + (token : MainWorkToken) + (label : String)) : JSONObject + (let ((fields (json-object-empty))) + (begin + (json-object-put-string! fields "label" label) + (json-object-put-int32! + fields "activity_id" (MainWorkToken-id token)) + fields))) + (def (mainWorkFinishedFields + (token : MainWorkToken) + (label : String) + (success : Bool)) : JSONObject + (let ((fields (mainWorkStartedFields token label))) + (begin + (json-object-put-bool! fields "success" success) + (json-object-put-int! + fields "elapsed_ms" (mainWorkElapsed token)) + fields))) + (def (mainWorkBegin + (activity : MainActivity) + (label : String)) : MainWorkToken + (let ((token + (make-MainWorkToken + (+ (mainWorkCurrentId activity) (int32 1)) + (mainWorkNow)))) + (begin + (mainWorkCurrentIdSet activity (MainWorkToken-id token)) + (mainWorkRunOnUi + activity + (lambda () + (mainWorkRender + activity token "Working" label + (mainWorkColor (int32 219) (int32 234) (int32 254)) + (mainWorkColor (int32 30) (int32 64) (int32 175))))) + (mainWorkLog + activity + "ssd-activity-started" + (mainWorkStartedFields token label)) + token))) + (def (mainWorkStep + (activity : MainActivity) + (token : MainWorkToken) + (label : String)) : Unit + (begin + (mainWorkRunOnUi + activity + (lambda () + (mainWorkRender + activity token "Working" label + (mainWorkColor (int32 219) (int32 234) (int32 254)) + (mainWorkColor (int32 30) (int32 64) (int32 175))))) + (mainWorkLog + activity + "ssd-activity-step" + (mainWorkFinishedFields token label #t)))) + (def (mainWorkFinish + (activity : MainActivity) + (token : MainWorkToken) + (label : String) + (success : Bool)) : Unit + (begin + (mainWorkRunOnUi + activity + (lambda () + (mainWorkRender + activity token + (if success "Done" "Failed") + label + (if success + (mainWorkColor (int32 220) (int32 252) (int32 231)) + (mainWorkColor (int32 254) (int32 226) (int32 226))) + (if success + (mainWorkColor (int32 22) (int32 101) (int32 52)) + (mainWorkColor (int32 153) (int32 27) (int32 27)))))) + (mainWorkLog + activity + "ssd-activity-finished" + (mainWorkFinishedFields token label success)))) + (def (mainWorkDone + (activity : MainActivity) + (token : MainWorkToken) + (label : String)) : Unit + (mainWorkFinish activity token label #t)) + (def (mainWorkFailed + (activity : MainActivity) + (token : MainWorkToken) + (label : String)) : Unit + (mainWorkFinish activity token label #f)))))) --- a/templates/ssd-review-parts/server-ai.ss +++ b/templates/ssd-review-parts/server-ai.ss @@ -14,4 +14,5 @@ (include-fragment "SsdSelfTestFixture.ss") (include-fragment "SsdSelfTestTelemetry.ss") (include-fragment "TruthStoreSelfTest.ss") - (include-fragment "main-self-test.ss"))) + (include-fragment "main-self-test.ss") + (include-fragment "main-work-status.ss")))