diff options
| author | W. Kosior <koszko@koszko.org> | 2025-03-26 16:35:47 +0100 |
|---|---|---|
| committer | W. Kosior <koszko@koszko.org> | 2025-03-26 16:35:47 +0100 |
| commit | cdd8c94c06d3be08322eddb769f2ea611a78c486 (patch) | |
| tree | e1a1751da46bacfcedac895ce11a97fe4fb2fc21 | |
| parent | 00b299e7b17e9c05596e7ed77778bf54d55c8dec (diff) | |
| download | cantius-cdd8c94c06d3be08322eddb769f2ea611a78c486.tar.gz cantius-cdd8c94c06d3be08322eddb769f2ea611a78c486.zip | |
Allow using custom syntactic monad when defining an endpoint.
| -rw-r--r-- | src/guile/cantius.scm | 32 |
1 files changed, 22 insertions, 10 deletions
diff --git a/src/guile/cantius.scm b/src/guile/cantius.scm index 5e48612..d6d64a3 100644 --- a/src/guile/cantius.scm +++ b/src/guile/cantius.scm @@ -592,6 +592,12 @@ (lambda (x) (syntax-case x () ((source-stx endset-identifier (handler-identifier . handler-formals) + . rest) + #'(source-stx endset-identifier #f (handler-identifier . handler-formals) + . rest)) + + ((source-stx endset-identifier maybe-monad-identifier + (handler-identifier . handler-formals) path arg-converters-list handler-body handler-body-rest ...) (and (identifier? #'endset-identifier) @@ -602,22 +608,28 @@ (full-path-stx #``(,@#,path-stx . #,(or path-rest-stx '()))) (stx (cut datum->syntax #'source-stx <>)) - (endpoint-matched-path (stx 'cant$endpoint-matched-path))) + (endpoint-matched-path (stx 'cant$endpoint-matched-path)) + + (lambda-stx + #`(lambda (. handler-formals) + (let (#,@(if path-rest-stx + #`((#,path-rest-stx + (drop #,endpoint-matched-path + path-len))) + '())) + handler-body handler-body-rest ...)))) + #`(begin (define evaluated-path #,path-stx) (define handler-identifier (let ((path-len (length evaluated-path))) - #,((macro-transformer (module-ref (resolve-module '(cantius)) - '$)) - #`(source-stx lambda (. handler-formals) - (let (#,@(if path-rest-stx - #`((#,path-rest-stx - (drop #,endpoint-matched-path - path-len))) - '())) - handler-body handler-body-rest ...))))) + #,(if (syntax->datum #'maybe-monad-identifier) + #`(maybe-monad-identifier . #,lambda-stx) + ((macro-transformer + (module-ref (resolve-module '(cantius)) '$)) + #`(source-stx . #,lambda-stx))))) (define endset-identifier (endset-+ endset-identifier |