add syntactic sugar for XMPP conversations

1 files changed, 40 insertions, 0 deletions

diff --git a/sugar.scm b/sugar.scm
new file mode 100644
index 0000000..b201844
--- /dev/null
+++ b/sugar.scm
@@ -0,0 +1,40 @@
+(define-module (gnubba sugar)
+  #:use-module ((sxml simple) #:select (sxml->xml))
+  #:export (xmpp->))
+
+;; Simple syntax for XMPP "discussions".
+;; TODO: can this become an actual monad?  Would it be worth the
+;; effort?
+(define-syntax xmpp->
+  (lambda (x)
+    (syntax-case x (<-)
+      ;; send and forget stanza
+      ((_ sock (<- stanza) exp ...)
+       #'(begin
+           (sxml->xml stanza sock)
+           (xmpp-> sock exp ...)))
+      ;; send stanza and pass response to next expression
+      ((_ sock (res <- stanza) exp ...)
+       #'(let ((s stanza))
+           (begin
+             (register-temp-stanza-handler-for-id
+              (stanza-id s)
+              (lambda (res)
+                (xmpp-> sock exp ...)))
+             (sxml->xml s sock))))
+      ;; unwrap single expression
+      ((_ sock exp)
+       #'exp)
+      ;; simply evaluate expression and move on to match next expression
+      ((_ sock exp exp* ...)
+       #'(begin
+           exp
+           (xmpp-> sock exp* ...))))))
+
+;; EXAMPLE
+;; (xmpp-> (current-output-port)
+;;         (res <- (iq "hello"))
+;;         (display res)
+;;         (display "something else")
+;;         (<- (message "mama@localhost" "hello, there"))
+;;         (display "we ignore a response to this message"))