Add DSL for specifying servlets.

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))))))
 
   )