clarity: Storing structured data in datomic.

clj/clarity/.gitignore

@@ -0,0 +1 @@
/target

clj/clarity/clarity.clj

@@ -0,0 +1,151 @@
(ns clarity
  (:use clojure.core.typed))
; (HMap :mandatory {:a ... :b ...}) -> { :a input :b input }
;   needs nesting, dynamic rules?
; - required/optional? sometimes comes from above, an environment?
; - optional fields: adding dynamically would be better?
;     * but how to realize without creating an abstract ui model?
; - additional attributes (req/opt, hidden, defaults) are a problem
;   in general as they are quite tightly coupled to the implementations,
;   is there a name for this? is this a leaking abstraction?
; what do i want? from a description of the data i want to create an
; input method that only allows inserting valid values.
; sometimes we have existing data present or required so we must
; render that as part of the input tree. we also sometimes want to add
; information dynamically, for example adding key-value-pairs to maps
; and new elements to collections. to be able to do that we need to
; dynamically add new typed input methods on request. we also want to
; delete information sometimes, but only when it is not required.
(defmulti make-input (fn [type & _]
                       (if (seq? type)
                         (first type)
                         type)))
(defmethod make-input 'Value [type]
  (let [x (second type)
        attrs {:value (str x)
               :readonly ""}]
    [:input (into attrs
              (cond
               (instance? Boolean x) {:type "checkbox"}
               (number? x) {:type "number"}
               (or (instance? java.net.URL x) (instance? java.net.URI x)) {:type "url"}
               (keyword? x) {:pattern "^:(\\w+|\\w+(\\.\\w+)*\\/\\w+)$"
                             :type "text"}
               :else {:type "text"}))]))
(defmethod make-input 'Option [[_ type]]
  (make-input type))
(defmethod make-input 'U [[_ & alts]]
  [:select
   (map (fn [[_ x]]
          [:option (str x)])
        alts)])
(defmethod make-input 'Keyword [_]
  [:input {:type "text"
           :placeholder ":my.ns/identifier"
           :pattern "^:(\\w+|\\w+(\\.\\w+)*\\/\\w+)$"}])
(defmethod make-input 'String [_]
  [:input {:type "text"}])
(defmethod make-input 'Boolean [_]
  [:input {:type "checkbox"}])
(defmethod make-input 'Number [_]
  [:input {:type "number"}])
(defmethod make-input 'HVec [[_ & types]]
  ; display existing values as editable *and* allow adding new elements
  ; those elements can be of multiple types -> dynamism required?
  )
(defmethod make-input 'HMap [[ _ & {:keys [mandatory optional]}]]
  (concat '("{")
          (map (fn [[ key val]]
                 [:div.field
                  [:label (str key)]
                  (make-input val)])
               mandatory)
          (map (fn [[key val]]
                 [:div.field.optional
                  [:label (str key)]
                  (make-input val)])
               optional)
          '("}")))
(def datomic-attr-type
  '(HMap :mandatory {:db/id (Value "#db/id[db.part/db]")
                     :db/ident Keyword
                     :db/valueType (U (Value :db.type/keyword)
                                      (Value :db.type/string)
                                      (Value :db.type/boolean)
                                      (Value :db.type/long)
                                      (Value :db.type/bigint)
                                      (Value :db.type/float)
                                      (Value :db.type/double)
                                      (Value :db.type/bigdec)
                                      (Value :db.type/ref)
                                      (Value :db.type/instant)
                                      (Value :db.type/uuid)
                                      (Value :db.type/uri)
                                      (Value :db.type/bytes))
                     :db/cardinality (U (Value :db.cardinality/one)
                                        (Value :db.cardinality/many))
                     :db.install/_attribute (Value :db.part/db)}
         :optional {:db/doc String
                    :db/unique (Option (U (Value :db.unique/value)
                                          (Value :db.unique/identity)))
                    :db/index Boolean ; what about defaults?
                    :db/fulltext Boolean
                    :db/isComponent (Value :db.type/ref) ; FIXME: needs a custom type (dynamic even, because only valid refs should be allowed)
                    :db/noHistory Boolean}))
(defmulti friendly-check (fn [form type]
                           (if (seq? type)
                             (first type)
                             type)))
(defmethod friendly-check 'Value [val [_ expected]]
  (if (= val expected)
    true
    {:error (str "Expected value " expected ", but found " val ".")}))
(defmacro def-friendly-check [sym pred]
  `(defmethod friendly-check ~sym [val# _#]
     (if (~pred val#)
       true
       {:error (str "Expected value of type " (name ~sym) ", but got value " val# ".")})))
(def-friendly-check 'String string?)
(def-friendly-check 'Keyword keyword?)
(def-friendly-check 'Boolean #(instance? Boolean %))
(defmethod friendly-check 'U [val [_ & types]]
  (if (some true? (map (partial friendly-check val) types))
    true
    {:error (str "Expected one of " types ", but found " val ".")}))
(defn friendly-check-keys [m mandatory _]
  (map (fn [[key type]]
         (if-let [val (get m key)]
           (let [check (friendly-check val type)]
             (if (true? check)
               true
               {key (:error check)}))
           {key (str "No value found, but expected one of type " type ".")}))
       mandatory))
(defmethod friendly-check 'HMap [val [_ & {:keys [mandatory optional]}]]
  (if (map? val)
    (let [key-checks (friendly-check-keys val mandatory optional)]
      (if (every? true? key-checks)
        true
        {:error (filter (comp not true?) key-checks)}))
    {:error (str "Expected value of type Map, but got value " val ".")}))

clj/clarity/clarity/server.clj

@@ -0,0 +1,35 @@
(ns clarity.server
  (:use compojure.core)
  (:use ring.middleware.params
        ring.middleware.keyword-params)
  (:use [clojure.java.io :only (reader)])
  (:require [clojure.tools.reader.edn :as edn])
  (:use [hiccup.core :only (html)])
  (:require clarity)
  (:require [datomic.api :as d]))
(defonce conn
  (do
    (d/create-database "datomic:mem://self.data")
    (d/connect "datomic:mem://self.data")))
(defn read-tx-data [str]
  (edn/read-string {:readers {'db/id (partial apply d/tempid)}} str))
(defroutes app-routes
  (GET "/" []
       {:status 200
        :headers {"Content-Type" "text/html"}
        :body (html [:form#query {:action "/facts" :accept-charset "utf-8"}
                     [:textarea {:name "q" :cols 80 :rows 20}]
                     [:input {:type "submit"}]])})
  (GET "/facts" {{query :q} :params}
       (pr-str (d/q (edn/read-string query) (d/db conn))))
  (POST "/facts" [facts]
        (pr-str (d/transact conn (read-tx-data facts)))))
(def app
  (-> app-routes
      wrap-keyword-params
      wrap-params))

clj/clarity/map-sample.html

@@ -0,0 +1,94 @@
<!doctype html>
<html>
<head>
	<title>editing a map (clarity)</title>
	<meta charset="utf-8" />
	<style type="text/css">
	.field {
		display: block;
		margin: 0.5em 1em;
	}
	</style>
</head>
<body>
	<form id="sample">
		{
		<span class="field">
			<label>:db/id</label>
			<input type="text" readonly value="#db/id[db.part/db]" />
		</span>
		<span class="field">
			<label>:db/ident</label>
			<input type="text" required pattern="^:\w+$|^:\w+(\.\w+)?\/\w+$" placeholder=":my.ns/identifier" />
		</span>
		<span class="field">
			<label>:db/valueType</label>
			<!--<input type="text" list="db-valueType" required>-->
			<!--<datalist id="db-valueType">-->
			<select required>
				<option>:db.type/keyword</option>
				<option>:db.type/string</option>
				<option>:db.type/boolean</option>
				<option>:db.type/long</option>
				<option>:db.type/bigint</option>
				<option>:db.type/float</option>
				<option>:db.type/double</option>
				<option>:db.type/bigdec</option>
				<option>:db.type/ref</option>
				<option>:db.type/instant</option>
				<option>:db.type/uuid</option>
				<option>:db.type/uri</option>
				<option>:db.type/bytes</option>
			<!--</datalist>-->
			</select>
		</span>
		<span class="field">
			<label>:db/cardinality</label>
			<select required>
				<option>:db.cardinality/one</option>
				<option>:db.cardinality/many</option>
			</select>
		</span>
		<span class="field">
			<label>:ext/multiField</label>
			[
			<span class="field">
				<input type="text" placeholder=":my.ns/identifier" />
				<input type="button" value="Delete" />
			</span>
			<span class="field">
				<input type="text" placeholder=":my.ns/identifier" />
				<input type="button" value="Delete" />
			</span>
			]
			<input type="button" value="Delete" />
		</span>
		<span class="field">
			<label>:db.install/_attribute</label>
			<input type="text" readonly value=":db.part/db" />
		</span>
		<span class="field">
			<select>
				<option>:db/doc</option>
				<option>:db/unique</option>
				<option>:db/index</option>
				<option>:db/fulltext</option>
				<option>:db/isComponent</option>
				<option>:db/noHistory</option>
			</select>
			<input type="text" disabled />
			<input type="button" value="Add" />
		</span>
		}
	</form>
</body>
</html>

clj/clarity/project.clj

@@ -0,0 +1,13 @@
(defproject clarity "0.0-SNAPSHOT"
  :dependencies [[org.clojure/clojure "1.5.1"]
                 [org.clojure/core.typed "0.2.19"]
                 [com.datomic/datomic-free "0.9.4331"]
                 [ring "1.2.1"]
                 [compojure "1.1.6"]
                 [hiccup "1.0.4"]]
  :source-paths ["."]
  :plugins [[lein-ring "0.8.8"]]
  :ring {:handler clarity.server/app})