Is it possible to do the Free Monad in Clojure?

Question

There has been some outstanding work with Monads in Clojure by Konrad Hinsen, Jim Duey and Leonardo Borges.

My question is - is it possible to do the Free Monad in Clojure?

This is an example in Haskell from an article on Scala:

data Free f r = Free (f (Free f r)) | Pure r

This is the corresponding Scala example

sealed abstract class Free[S[+_], +A](implicit S: Functor[S]) {
  final def map[B](f: A => B): Free[S, B] =
    flatMap(a => Return(f(a)))

  final def flatMap[B](f: A => Free[S, B]): Free[S, B] = this match {
    case Gosub(a, g) => Gosub(a, (x: Any) => Gosub(g(x), f))
    case a           => Gosub(a, f)
  }
  ...
}

Answer 1

Yes, following Luis Casillas answer, here is an implementation in clojure of the Free monad in clojure.

    (use 'clojure.algo.monads)

    ;; data Free f r = Free (f (Free f r)) | Pure r
    (defn pure [v] {:t :pure :v v})
    (defn impure [v] {:t :impure :v v })

    (defn free-monad
    [fmap]
    (letfn [
            (fm-result [v] (pure v))         
            (fm-bind [mv mf]                 
                (if (= :pure (:t mv))
                    (mf (:v mv))             ;; Pure a >>= f = f a
                    (impure                  ;; Free fa >>= f = Free (fmap (>>=f) fa) 
                     ((fmap (fn [lmv] (fm-bind lmv mf))) (:v mv)))))          
            ]
        {
        :m-result fm-result
        :m-bind fm-bind
        :m-zero ::undefined 
        :m-plus ::undefined
        }
        ) 
    )

And an example from Why free monads matter:

Definition of toy language.

    ;; Toy language
    ;; 
    (defn output [c n] [{:t :output :v c}, n])
    (defn bell [n] [{:t :bell}, n]) 
    (defn done [] [{:t :done}, nil]) 
    (defn toy-fmap [f]
    (fn [[e c]]
    (if (= :done (:t e))
        [e c]
        [e (f c)] 
        ))  
    )

Definition of the monad for the toy language + helper functions

    ;;
    (def tt-monad 
    (free-monad toy-fmap))


    (defn liftF [toy]
    (impure ((toy-fmap (fn [c] (pure c))) toy))
    )

    (defn m-output [x] (liftF (output x nil)))
    (defn m-bell [] (liftF (bell nil)))
    (defn m-done [] (liftF (done)))
    (defn f-m-done [_] (m-done))

And checking some rules :

    ;; return "a" >>= output  is Free(Output "a", ())
    ;; {:t :impure, :v [{:t :output, :v \a} {:t :pure, :v nil}]}  
    (with-monad tt-monad
    (m-bind (m-result \a) m-output)
    )


    ;; output "a" >>= return  is Free(Output "a", ())
    ;; {:t :impure, :v [{:t :output, :v \a} {:t :pure, :v nil}]}
    (with-monad tt-monad
    (m-bind (m-output \a) m-result)
    )

    ;; ((output 'A' >> done) >> output 'C')
    (with-monad tt-monad
    (m-bind (m-bind (m-output \a) f-m-done) (fn [_] (m-output \c))))

    ;;(output 'A' >> (done >> output 'C')) is output 'A' Done
    (with-monad tt-monad
    (m-bind (m-output \a) (fn [x] (m-bind (m-done) (fn [_] (m-output \c))))))

This could be improved quite a lot in terms of readability of the data structure. Comments and improvements most welcome.