diff --git a/backend/api-servlets.scm b/backend/api-servlets.scm index 44de9db..c17a6f8 100644 --- a/backend/api-servlets.scm +++ b/backend/api-servlets.scm @@ -35,8 +35,56 @@ spiffy (chicken format)) + (define-syntax try-match-lambda1 + (syntax-rules () + ((_ pp plst ((arg ->conv) . args) body) + (let ((as (->conv pp))) + (cond (as + (let ((arg as)) + (try-match-lambda0 plst args body))) + (else + #f)))) + ((_ pp plst (lit . args) body) + (if (equal? pp lit) + (try-match-lambda0 plst args body) + #f)))) + + (define-syntax try-match-lambda0 + (syntax-rules () + ((_ plst () (expr ...)) + (let () + expr ... + #t)) + ((_ plst (arg . args) body) + (cond ((null? plst) + #f) + (else + (let ((pp (car plst))) + (try-match-lambda1 pp (cdr plst) (arg . args) body))))))) + + (define-syntax try-match-lambda + (syntax-rules () + ((_ args . body) + (lambda (plst) + (try-match-lambda0 plst args body))))) + + (define-syntax define-try-match + (syntax-rules () + ((_ (name . args) . body) + (define name (try-match-lambda args . body))))) + + (define-try-match (account-barcode-info "barcode" (barcode string->number)) + (send-response #:body (format "API call [barcode] ~A" barcode))) + + (define api-servlets + (list account-barcode-info)) + (define (api-dispatch plst) - (send-response #:body (format "API call: ~A" plst)) - #t) + (let loop ((as api-servlets)) + (if (null? as) + #f + (if ((car as) plst) + #t + (loop (cdr as)))))) )