watch-rpc.rkt

#lang racket/base

(require (for-syntax racket/base
                     racket/syntax
                     syntax/parse/pre)
         (only-in noise/private/serde ->field-type field-type-swift-proc)
         noise/serde
         racket/match
         racket/string)

(provide
 define-watch-rpcs
 write-rpc-code
 write-rpc-handler
 write-rpc-handler-protocol)

(struct rpc-arg-info (id type))
(struct rpc-method-info (id args type))
(struct rpc-info (id methods))

(begin-for-syntax
  (define-syntax-class rpc-definition
    #:literals (:)
    (pattern (id:id [arg-id:id : arg-type:expr] ... : type:expr))))

(define-syntax (define-watch-rpcs stx)
  (syntax-parse stx
    [(_ enum-id:id def:rpc-definition ...+)
     #:with info-id (format-id stx "~a-rpc-info" #'enum-id)
     #'(begin
         (define-enum enum-id
           [def.id {def.arg-id : def.arg-type} ...] ...)
         (define info-id
           (rpc-info
            #;id 'enum-id
            (list
             (rpc-method-info
              #;id 'def.id
              #;args (list (rpc-arg-info 'def.arg-id (->field-type 'define-watch-rpcs def.arg-type)) ...)
              #;type (->field-type 'define-watch-rpcs def.type)) ...))))]))

(define (~swift id)
  (regexp-replace*
   #;re #rx"-[a-zA-Z0-9]"
   #;needle (symbol->string id)
   #;replacement (λ (m) (string-upcase (substring m 1)))))

(define (swift-type t)
  ((field-type-swift-proc t)))

(define (write-rpc-code info class-name [out (current-output-port)])
  (fprintf out "// This file was generated by watch-rpc.rkt~n")
  (fprintf out "import Foundation~n")
  (fprintf out "import NoiseSerde~n")
  (fprintf out "~n")
  (fprintf out "extension ~a {~n" class-name)
  (match-define (rpc-info id methods) info)
  (define id-str (~swift id))
  (for ([(ri idx) (in-indexed (in-list methods))])
    (match-define (rpc-method-info method-id args type) ri)
    (define method-id-str (~swift method-id))
    (define args-header-str
      (string-join
       (for/list ([ai (in-list args)])
         (match-define (rpc-arg-info id arg-type) ai)
         (format "~a: ~a" (~swift id) (swift-type arg-type)))
       ", "))
    (define type-str (swift-type type))
    (define send-args-str
      (cond
        [(null? args) ""]
        [else
         (let ([args-str (string-join (map (compose1 ~swift rpc-arg-info-id) args) ", ")])
           (format "(~a)" args-str))]))
    (unless (zero? idx)
      (fprintf out "~n"))
    (fprintf out "  func ~a(~a) async throws -> ~a {~n" method-id-str args-header-str type-str)
    (fprintf out "    return try await send(message: ~a.~a~a)~n" id-str method-id-str send-args-str)
    (fprintf out "  }~n"))
  (fprintf out "}~n"))

(define (write-rpc-handler info class-name [out (current-output-port)])
  (fprintf out "// This file was generated by watch-rpc.rkt~n")
  (fprintf out "import Foundation~n")
  (fprintf out "import NoiseSerde~n")
  (fprintf out "import WatchConnectivity~n")
  (fprintf out "~n")
  (fprintf out "extension ~a: WCSessionManagerDelegate {~n" class-name)
  (match-define (rpc-info _ methods) info)
  (fprintf out "  nonisolated func handle(session: WCSession, watchMessage message: WatchMessage) -> any Writable {~n")
  (fprintf out "    switch message {~n")
  (for ([ri (in-list methods)])
    (match-define (rpc-method-info method-id args _) ri)
    (define method-id-str (~swift method-id))
    (cond
      [(null? args)
       (fprintf out "    case .~a:~n" method-id-str)
       (fprintf out "      return ~a(session: session)~n" method-id-str)]
      [else
       (define case-args-str
         (string-join
          (for/list ([ai (in-list args)])
            (match-define (rpc-arg-info id _) ai)
            (format "let ~a" (~swift id)))
          ", "))
       (define args-str
         (string-join
          (cons
           "session: session"
           (for/list ([ai (in-list args)])
             (match-define (rpc-arg-info id _) ai)
             (define id-str (~swift id))
             (format "~a: ~a" id-str id-str)))
          ", "))
       (fprintf out "    case .~a(~a):~n" method-id-str case-args-str)
       (fprintf out "      return ~a(~a)~n" method-id-str args-str)]))
  (fprintf out "    }~n")
  (fprintf out "  }~n")
  (fprintf out "}~n"))

(define (write-rpc-handler-protocol info protocol-name [out (current-output-port)])
  (fprintf out "// This file was generated by watch-rpc.rkt~n")
  (fprintf out "import Foundation~n")
  (fprintf out "import NoiseSerde~n")
  (fprintf out "import WatchConnectivity~n")
  (fprintf out "~n")
  (fprintf out "protocol ~a {~n" protocol-name)
  (match-define (rpc-info _ methods) info)
  (for ([ri (in-list methods)])
    (match-define (rpc-method-info method-id args type) ri)
    (define method-id-str (~swift method-id))
    (define args-header-str
      (string-join
       (cons
        "session: WCSession"
        (for/list ([ai (in-list args)])
          (match-define (rpc-arg-info id arg-type) ai)
          (format "~a: ~a" (~swift id) (swift-type arg-type))))
       ", "))
    (define type-str (swift-type type))
    (fprintf out "  func ~a(~a) -> ~a~n" method-id-str args-header-str type-str))
  (fprintf out "}~n"))

Am I using it correctly?