1 files changed, 69 insertions, 0 deletions
diff --git a/src/clojure_sql/writer.clj b/src/clojure_sql/writer.clj
new file mode 100644
index 0000000..5f4250b
--- /dev/null
+++ b/src/clojure_sql/writer.clj
@@ -0,0 +1,69 @@
+(ns clojure-sql.writer 
+  (:refer-clojure :exclude [sequence]))
+
+
+;; A small writer monad implementation, for what we need
+(defn return [x]
+  (fn [s] [x s]))
+
+(defn bind [mv f]
+  {:pre [(not (nil? mv))]}
+  (fn [s]
+    (let [[x s2] (mv s)]
+      ((f x) s2))))
+
+(defn tell [val]
+  (fn [s] [nil (conj s val)]))
+
+(defn join [mv]
+  (bind mv identity))
+
+(defn sequence
+  ([] (return nil))
+  ([mv & mvs]
+     {:pre [(not (nil? mv))]}
+     (bind mv
+           (fn [x]
+             (bind (apply sequence mvs)
+                   (fn [xs]
+                     (return (cons x xs))))))))
+
+(defn lift [f]
+  (fn [& args]
+    (bind (apply sequence args)
+          (fn [s]
+            (return (apply f s))))))
+
+(defn p-lift [f & args]
+  (lift (apply partial f args)))
+
+(defn >> 
+  ([arg]
+     arg)
+  ([arg1 & args]
+     (bind arg1
+           (fn [x]
+             (apply >> args)))))
+
+(defn do-m*
+  ([] (throw (ex-info "No." {})))
+  ([& args]
+     (or (if (nil? (next args))
+           (first args))
+         (if (= (first args) :let)
+           `(let ~(second args)
+              ~(apply do-m* (nnext args))))
+         (if (= (name (second args)) "<-")
+           (let [[var <- val & others] args]
+             `(bind ~val
+                    (fn [~var]
+                      ~(apply do-m* others)))))
+         `(bind ~(first args)
+                (fn [_#]
+                  ~(apply do-m* (next args)))))))
+
+(defmacro do-m [& args]
+  (apply do-m* args))
+
+(defmacro do [& args]
+  (apply do-m* args))