summaryrefslogtreecommitdiff
path: root/src/clojure_sql/writer.clj
blob: 176cc67a56050603c721c9774d1dc7c9b7e57922 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
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 (every? #(% (second args)) [symbol? #(= (name %) "<-")])
           (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))