Skip to content

Instantly share code, notes, and snippets.

@c-spencer
Last active December 23, 2015 02:49
Show Gist options
  • Star 7 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save c-spencer/6569571 to your computer and use it in GitHub Desktop.
Save c-spencer/6569571 to your computer and use it in GitHub Desktop.
Simple demo of type construction from Datomic with core.typed and a little glue
(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#)))))
; 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 #db/id[:db.part/types]
:type/name "User"
:type/mandatory [:user/id
:user/email
:user/password
:user/group]
:type/optional [:user/forename
:user/surname] }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment