Commits

Alex Suraci  committed 89faa13

initial record
Ignore-this: dded1130e8c5872c55e1983e4066cc9e

  • Participants

Comments (0)

Files changed (2)

+use: "http"
+use: "json"
+
+CouchDB =
+  Object clone do:
+    { host = "127.0.0.1"
+      port = 5984
+    }
+
+{ json-do: p :=
+    JSON parse: (p call: [HTTP]) body
+    
+  (c: CouchDB) base-url :=
+  "http://" .. c host .. ":" .. c port show
+
+  (c: CouchDB) databases :=
+    json-do: @(get: (c base-url .. "/_all_dbs"))
+
+  (c: CouchDB) uuid :=
+    (json-do: @(get: (c base-url .. "/_uuids"))) uuids head
+
+  (c: CouchDB) uuids: (count: Integer) :=
+    (json-do: @(get: (c base-url .. "/_uuids?count=" .. count show))) uuids
+
+  (c: CouchDB) create: (name: String) :=
+    { r = json-do: @(put: (c base-url .. "/" .. name))
+
+      when: r (responds-to?: @error)
+        do: {
+          r error match: {
+            "file_exists" -> raise: @(database-already-exists: name)
+            _ -> raise: @(couch-error: r error reason: r reason)
+          }
+        }
+    } call
+
+  (c: CouchDB) delete: (name: String) :=
+    { r = json-do: @(delete: (c base-url .. "/" .. name))
+
+      when: r (responds-to?: @error)
+        do: {
+          r error match: {
+            "not_found" -> raise: @(database-not-found: name)
+            _ -> raise: @(couch-error: r error reason: r reason)
+          }
+        }
+    } call
+
+  (c: CouchDB) all-documents: (db: String) :=
+    (json-do: @(get: (c base-url .. "/" .. db .. "/_all_docs"))) rows
+
+  (c: CouchDB) create: (obj: JSON) in: (db: String) :=
+    { doc = obj copy
+      doc _id = c uuid
+
+      path = c base-url .. "/" .. db .. "/" .. doc _id
+      r = json-do: @(put: path body: doc (as: String))
+
+      when: r (responds-to?: @error)
+        do: {
+          r error match: {
+            "bad_request" -> raise: @(bad-request: r reason)
+            "conflict" -> raise: @(conflict: obj)
+            _ -> raise: @(couch-error: r error reason: r reason)
+          }
+        }
+
+      @(id: r id rev: r rev)
+    } call
+
+  (c: CouchDB) update: (id: String) revision: (rev: String) in: (db: String) to: (obj: JSON) :=
+    { doc = obj copy
+      doc _id = id
+      doc _rev = rev
+
+      path = c base-url .. "/" .. db .. "/" .. id
+      r = json-do: @(put: path body: doc (as: String))
+
+      when: r (responds-to?: @error)
+        do: {
+          r error match: {
+            "bad_request" -> raise: @(bad-request: r reason)
+            "conflict" -> raise: @(conflict: obj)
+            _ -> raise: @(couch-error: r error reason: r reason)
+          }
+        }
+
+      @(id: r id rev: r rev)
+    } call
+
+  (c: CouchDB) get: (doc: String) from: (database: String) :=
+    json-do: @(get: (c base-url .. "/" .. database .. "/" .. doc))
+
+  (c: CouchDB) delete: (doc: String) revision: (rev: String) from: (db: String) :=
+    json-do: @(delete: (c base-url .. "/" .. db .. "/" .. doc .. "?rev=" .. rev))
+
+  (c: CouchDB) query: (db: String) design: (d: String) view: (v: String) :=
+    { path = [c base-url, db, "_design", d, "_view", v] join: "/"
+      r = json-do: @(get: path)
+      r rows
+    } call
+
+  (c: CouchDB) query: (db: String) design: (d: String) view: (v: String) params: (l: List) :=
+    { path = [c base-url, db, "_design", d, "_view", v] join: "/"
+      params = l clone map:
+        { p |
+          p to = p to (as: JSON) (as: String)
+          p
+        }
+
+      r = json-do: @(get: path with: params)
+      r rows
+    } call
+
+  (c: CouchDB) find: key in: (db: String) design: (d: String) view: (v: String) :=
+    { q = c query: db design: d view: v params: ["key" -> key]
+
+      q match: {
+        [] -> @none
+        (r . _) -> @(ok: r)
+      }
+    } call
+} call
+name: "couchdb"
+version: 0 . 1
+description: "a CouchDB interface"
+author: "Alex Suraci"
+depends-on:
+    [ "http"
+    , "json"
+    ]