c-spencer · December 23, 2015 02:49 · Sep 15, 2013 · Sep 15, 2013 · Sep 15, 2013
diff --git a/core.clj b/core.clj
@@ -0,0 +1,41 @@
+(defn create-type
+  "Extract a type from provided field idents stored in Datomic database at uri."
+  [uri type-name overrides]
+  (let [c (d/connect uri)
+        d (d/db c)
+        datomic-type-map {:db.type/string 'String
+                          :db.type/ref 'Any}
+        mt (dt/q> :- [EntityID]
+              '[:find ?e
+                :in $ ?t-name
+                :where [?e :type/name ?t-name]]
+                d
+                type-name)
+        t-e (->> (ffirst mt) (d/entity d) d/touch)
+        man-attrs (:type/mandatory t-e)
+        opt-attrs (:type/optional t-e)
+        get-type
+          (fn [kw]
+            (->>
+              (dt/q> :- [Keyword]
+                '[:find ?v
+                  :in $ ?a
+                  :where [?e :db/ident ?a]
+                         [?e :db/valueType ?v]]
+                  d
+                  kw)
+              ffirst
+              (d/ident d)
+              datomic-type-map))
+        t-map (fn [m] (apply merge
+                        (map (fn [k] { k (get-type k) }) m)))
+        man-t (merge (t-map man-attrs) overrides)
+        opt-t (t-map opt-attrs)]
+    `(~'HMap :mandatory ~man-t :optional ~opt-t :complete? true)))
+
+(defmacro create-typer [n uri]
+  `(defmacro ~n
+    ([n# type-name#]
+      `(def-alias ~n# ~(create-type ~uri type-name# {})))
+    ([n# type-name# overrides#]
+      `(def-alias ~n# ~(create-type ~uri type-name# overrides#)))))
diff --git a/datomic-types.clj b/datomic-types.clj
@@ -36,7 +36,7 @@
 
 ;; Storing the optional/mandatory inside the database like so:
 
-  { :db/id :types
+  { :db/id #db/id[:db.part/types]
     :type/name "User"
     :type/mandatory [:user/id
                      :user/email

diff --git a/datomic-types.clj b/datomic-types.clj
@@ -0,0 +1,46 @@
+; Create a type extractor for this database.
+(dat/create-typer create-type "datomic:mem://jelp")
+
+; Use to reify a User type
+(create-type User "User")
+
+; Create Admin type from User, with a fixed :user/group
+; Lets Admins be used wherever a User is, and be statically checked.
+(create-type Admin "User" {:user/group (Value "admin")})
+
+(ann my-admin Admin)
+(def my-admin {:user/id "my-id"
+               :user/email "my@email.com"
+               :user/password "my-pass"
+               :user/group "admin"})
+
+(ann my-user User)
+(def my-user {:user/id "my-id"
+              :user/email "my@email.com"
+              :user/password "my-pass"
+              :user/group "user"})
+
+;; Failing cases
+
+(ann my-not-admin Admin)
+(def my-not-admin {:user/id "my-id"
+                   :user/email "my@email.com"
+                   :user/password "my-pass"
+                   :user/group "user"}) ; this isn't the admin group
+
+(ann my-invalid-user User)
+(def my-invalid-user {:user/id 10 ; should be string
+                      :user/email "my@email.com"
+                      :user/password "my-pass"
+                      :user/group "admin"})
+
+;; Storing the optional/mandatory inside the database like so:
+
+  { :db/id :types
+    :type/name "User"
+    :type/mandatory [:user/id
+                     :user/email
+                     :user/password
+                     :user/group]
+    :type/optional  [:user/forename
+                     :user/surname] }
No results found