(module let-monad-test *

(import scheme)
(import chicken.base)

#| these are all equivalent

   (let/m <maybe>
     ((a (return 1))
      (b (return (+ a 1))))
     (return (* b 2)))

   do a <- return 1
      b <- return $ a + 1
      return $ b * 2

   (>>= (return 1) (lambda (a)
        (return (+ a 1)) (lambda (b)
        (return (* b 2)))))
|#

(define (just? v) (and (list? v) (not (null? v)) (eq? (car v) 'Just)))
(define (nothing? v) (eq? v 'Nothing))

(define (<maybe>-return v) `(Just ,v))
(define (<maybe>-bind v f) (if (eq? v 'Nothing) 'Nothing (f (cadr v))))
(define (<maybe>-fail) 'Nothing)

(define-syntax let/m
  (er-macro-transformer (lambda (e r c) 
    (let* ((m (cadr e))
           (return (symbol-append m '-return))
           (bind (symbol-append m '-bind))
           (fail (symbol-append m '-fail)))
          `(let ((return ,return) (bind ,bind) (fail ,fail)) (let-monad ,@(cddr e)))))))

(define-syntax let-monad
  (syntax-rules ()
    ((let-monad () body1 body2 ...)
     (let () body1 body2 ...))
    ((let-monad ((name1 val1) (name2 val2) ...) body1 body2 ...)
     (bind val1 (lambda (name1) (let-monad ((name2 val2) ...) body1 body2 ...))))))

)