Demonstration of a monad comprehension macro in Sibilant, a Lisp dialect that compiles to JavaScript. See http://sibilantjs.info/ for information on Sibilant.

for.sibilant

; A monad comprehension is a syntactic construct that translates
; synchronous-looking code into a callback-based implementation.  Monads
; are a very general abstraction - which means that monad comprehensions
; have more expressive power than other sync-to-async code
; transformations.

; Here is an example that uses jQuery's $.get method to fetch resources:

(def post-with-author (id)
  (for
    (<- post   ($.get (+ "/posts" id)))
    (<- author ($.get (+ "/users" post.authorId)))
    [author post]))

; The HTTP methods provided by jQuery return objects called promises.
; A promise represents an eventual outcome, such as the response to an
; HTTP request.  One can add success or error callbacks to a promise
; using the `then` method.  The `for` macro used above produces the this
; javascript code:

; var postWithAuthor = (function(id) {
;   return $.get(("/posts" + id)).then((function(post) {
;     return $.get(("/users" + post.authorId)).then((function(author) {
;       return [ author, post ];
;     }));
;   }));
; });

; Promises are monads, which is what makes this work.  If `then` is
; given a callback that returns another promise then the `then` call
; itself returns a promise with the same eventual value as the promise
; returned by the callback.  Or if a callback returns a non-promise
; value then the `then` call returns a promise that resolves to that
; value.

; There is more information on how promises behave as monads at
; http://sitr.us/2012/07/31/promise-pipelines-in-javascript.html

; It is often useful to be able to assign the results of synchronous
; expressions to variables in monad comprehensions.  To support that
; there is a `let` keyword.  For example, here is a function with some
; more steps:

(def first-post()
  (for
    (<- posts  ($.get "/posts"))
    (let post  (get posts 0))
    (<- author (if post.authorId
      ($.get (+ "/users" post.authorId))
      ($.get "/users/anonymous")))
    [author post]))

; Arrays can also be monads.  It is just necessary to define an array
; method that behaves like the promise `then` method.  That method is
; sometimes called `flatMap` because it works like the usual array `map`
; method except that if the given callback returns another array
; `flatMap` flattens the resulting array of arrays.

(def Array.prototype.flatMap (fn)
  (var mapped (this.map fn))
  (if (mapped.every is-array)
    (flatten mapped)
    mapped))

(def is-array (obj)
  (= (Object.prototype.toString.call obj) "[object Array]"))

(def flatten (array)
  (var result [])
  (each (elem) array
    (each (sub-elem) elem
      (result.push sub-elem)))
  result)

; For compatibility with the `for` macro let's create an alias for
; `flatMap` called `then`.

(set Array.prototype 'then Array.prototype.flatMap)

; With this method in place it is possible to use the same `for` macro
; to iterate over arrays.  This is a handy way to generate every
; possible combination of elements from multiple input arrays.  Let's
; make a list of all of the possible positions in the game Battleship:

(def battleship-positions()
  (var
    cols: ['A 'B 'C 'D 'E 'F 'G 'H 'I 'J]
    rows: ['1 '2 '3 '4 '5 '6 '7 '8 '9 '10])
  (for
    (<- col cols)
    (<- row rows)
    (+ col row)))

; You might not want an exhaustive search though.  I'm pretty sure that
; there are never any ships in the H column.  Here is how to apply that
; optimization:

(for
  (<- col cols)
  (when (!= col 'H))
  (<- row rows)
  (+ col row))

; The `when` keyword when used in a `for` macro results in a `filter`
; invocation which excludes elements of the first list from the inner
; iteration.  That macro produces this javascript code:

; cols.filter((function(col) {
;   return (col !== "H");
; })).then((function(col) {
;   return rows.then((function(row) {
;     return (col + row);
;   }));
; }))

; Uses of arrays-as-monads can get more sophisticated.  Consider the
; n-queens problem: given an n-by-n chessboard how can one arrange
; n queens so that none is in a position to capture any of the others?
; This is another problem that can be solved by using the array monad to
; search a solution space.  Here is one such solution adapted from
; https://gist.github.com/ornicar/1115259

(def n-queens (size)
  (def place-queens (n)
    (if (<= n 0)
      [[]]
      (for
        (<- queens (place-queens (- n 1)))
        (<- y      (range 1 size))
        (let queen {x: n, y: y})
        (when (is-safe queen queens))
        [(queens.concat queen)])))
  (place-queens size))

(def is-safe (queen others)
  (others.every
    (#(other) (! (is-attacked queen other)))))

(def is-attacked (q1 q2)
  (or
    (= q1.x q2.x)
    (= q1.y q2.y)
    (=
      (Math.abs (- q2.x q1.x))
      (Math.abs (- q2.y q1.y)))))

(def range (min max)
  (var
    result []
    i      min)
  (while (<= i max)
    (result.push i)
    (++ i))
  result)

; Here is a very simple implementation of the `for` macro:

(macro simple-for (&rest steps)
  (var
    step  (get steps 0)
    ident (get step 1)
    expr  (get step 2)
    rest  (steps.slice 1))
  (macros.send expr 'then
    (macros.lambda [ident]
      (if (> rest.length 1)
        (apply macros.simple-for rest)
        (get rest 0)))))

; This version will correctly handle `post-with-author` and
; `battleship-positions`, which do not use `let` or `when`.  Here is the
; full implementation with support for `let` and `when`:

(macro for (&rest steps)
  (get (macros.for-helper steps []) 0))

(macro for-helper (steps accum)
  (if (<= steps.length 0)
    accum

    (do (var
      step  (get-from steps -1)
      rest  (steps.slice 0 -1)
      instr (get step 0))

      (if-else
        (= instr "<-")
          (macros.for-gets rest accum step)
        (= instr 'let)
          (macros.for-let rest accum step)
        (= instr 'when)
          (macros.for-when rest accum step)
        (macros.for-expression rest accum step)))))

(macro for-gets (steps accum step)
  (var
    ident (get step 1)
    expr  (get step 2))
  (macros.for-helper steps
    [(macros.send expr 'then
      (apply macros.lambda (send [[ident]] concat accum)))]))

(macro for-expression (steps accum step)
  (var
    expr step)
  (macros.for-helper steps
    (if (> accum.length 0)
      [(macros.send expr 'then
        (apply macros.lambda (send [[]] concat accum)))]
      [expr])))

(macro for-let (steps accum step)
  (var
    letvar (get step 1)
    rval   (get step 2))
  (macros.for-helper steps
    (send [(macros.var letvar rval)] concat accum)))

(macro for-when (steps accum step)
  (var
    expr     (get step 1)
    last-idx undefined)
  (each (elem i) steps
    (var
      instr (get elem 0))
    (when (and (!= instr 'let) (!= instr 'when))
      (assign last-idx i)))
  (var
    last-step  (get steps last-idx)
    last-instr (get last-step 0)
    last-ident undefined
    last-expr  undefined)
  (if (= last-instr "<-")
    (assign last-ident (get last-step 1), last-expr (get last-step 2))
    (assign last-expr last-step))
  (var
    inter-steps  (steps.slice (+ last-idx 1))
    inter-result (macros.for-helper inter-steps [])
    filtered     (macros.send last-expr 'filter
                   (apply macros.lambda (send [(if last-ident [last-ident] [])] concat
                                          inter-steps [expr])))
    rest         (steps.slice))
  (set rest last-idx
    (if last-ident
      ["<-" last-ident filtered]
      filtered))
  (macros.for-helper rest accum))

(macro get-from (array, idx)
  (var
    sliced (macros.send array 'slice idx))
  (if (>= idx 0)
    (macros.get array idx)
    (macros.get sliced 0)))