become a clojure wikipunk

wikipunk.clj

(in-ns 'user)

(require '[clojure.java.io :as io]
         '[clojure.data.json :as json]
         '[datomic.client.api :as d])

(def metadata
  "redmod/metadata.json"
  (with-open [rdr (io/reader "https://gist.githubusercontent.com/aamedina/01ed2dcc1c318d6992b0ecb6761acb45/raw/2c776b67200044717bdb5643558d294f36238089/metadata.json")]
    (json/read rdr)))
         
(def client
  "datomic dev-local client"
  (d/client {:server-type :dev-local :system "redmod"}))

(d/create-database client {:db-name "metadata"})

(def conn
  "redmod metadata database connection"
  (d/connect client {:db-name "metadata"}))

(def seed
  "bootstrap the database with these attributes"
  [#:db{:ident       :redmod.type/name
        :valueType   :db.type/string
        :unique      :db.unique/identity
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.type/size
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.type/alignment
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.type/type
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}

   #:db{:ident       :redmod.class/name
        :valueType   :db.type/string
        :unique      :db.unique/identity
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.class/parent
        :valueType   :db.type/string
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.class/alignment
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.class/flags
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.class/property
        :valueType   :db.type/ref
        :cardinality :db.cardinality/many
        :isComponent true}
   #:db{:ident       :redmod.class/function
        :valueType   :db.type/ref
        :cardinality :db.cardinality/many
        :isComponent true}

   #:db{:ident       :redmod.class.property/name
        :valueType   :db.type/string
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.class.property/type
        :valueType   :db.type/string
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.class.property/offset
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.class.property/flags
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}

   #:db{:ident       :redmod.function/name
        :valueType   :db.type/string
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.function/flags
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.function/static
        :valueType   :db.type/boolean
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.function/global
        :valueType   :db.type/string
        :unique      :db.unique/identity
        :cardinality :db.cardinality/one}

   #:db{:ident       :redmod.alias/k
        :valueType   :db.type/string
        :unique      :db.unique/identity
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.alias/v
        :valueType   :db.type/string
        :cardinality :db.cardinality/one}

   #:db{:ident       :redmod/alias
        :valueType   :db.type/tuple
        :tupleAttrs  [:redmod.alias/k :redmod.alias/v]
        :unique      :db.unique/value
        :cardinality :db.cardinality/one}

   #:db{:ident       :redmod.bitfield/name
        :valueType   :db.type/string
        :unique      :db.unique/identity
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.bitfield/size
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.bitfield/alignment
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.bitfield/bit
        :valueType   :db.type/ref
        :cardinality :db.cardinality/many
        :isComponent true}

   #:db{:ident       :redmod.bitfield.bit/name
        :valueType   :db.type/string
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.bitfield.bit/value
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}

   #:db{:ident       :redmod.enum/name
        :valueType   :db.type/string
        :unique      :db.unique/identity
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.enum/size
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.enum/option
        :valueType   :db.type/ref
        :cardinality :db.cardinality/many
        :isComponent true}

   #:db{:ident       :redmod.enum.option/name
        :valueType   :db.type/string
        :cardinality :db.cardinality/one}
   #:db{:ident       :redmod.enum.option/value
        :valueType   :db.type/long
        :cardinality :db.cardinality/one}])

;; seed the schema
(d/transact conn {:tx-data seed})

(defn install
  "Transacts facts into connection in partitions of size n."
  [connection facts & {:keys [n] :or {n 2048}}]
  (doseq [tx-data (partition-all n facts)]
    (d/transact connection {:tx-data tx-data})))

;; install simple_types
(install
  conn
  (into []
        (map (fn [{:strs [name size alignment type]}]
               {:redmod.type/name      name
                :redmod.type/size      size
                :redmod.type/alignment alignment
                :redmod.type/type      type}))
        (get metadata "simple_types")))

;; install global_functions
(install
  conn
  (into []
        (map (fn [{:strs [name flags]}]
               {:redmod.function/name   name
                :redmod.function/global name
                :redmod.function/flags  flags}))
        (get metadata "global_functions")))

;; install aliases
(install
  conn
  (into []
        (map (fn [[k v]]
               {:redmod.alias/k k :redmod.alias/v v}))
        (get metadata "aliases")))

;; install bitfield schema
(install
  conn
  (into []
        (mapcat
          (fn [{:strs [name size alignment bits]}]
            (into []
                  (map (fn [[bit-name _]]
                         {:db/ident                 (keyword name bit-name)
                          :db/valueType             :db.type/long
                          :db/cardinality           :db.cardinality/one
                          :redmod.bitfield.bit/name bit-name}))
                  bits)))
        (get metadata "bitfields")))

;; install bitfields
(install
  conn
  (into []
        (map (fn [{:strs [name size alignment bits]}]
               {:redmod.bitfield/name      name
                :redmod.bitfield/size      size
                :redmod.bitfield/alignment alignment
                :redmod.bitfield/bit
                (into []
                      (map (fn [[bit-name bit-value]]
                             {(keyword name bit-name) bit-value}))
                      bits)}))
        (get metadata "bitfields")))

;; install enum schema
(install
  conn
  (into []
        (mapcat
          (fn [{:strs [name size options]}]
            (into []
                  (map (fn [[option _]]
                         {:db/ident                (keyword name option)
                          :db/valueType            :db.type/long
                          :db/cardinality          :db.cardinality/one
                          :redmod.enum.option/name option}))
                  options)))
        (get metadata "enums")))

;; install enums
(install
  conn
  (into []
        (map (fn [{:strs [name size options]}]
               {:redmod.enum/name name
                :redmod.enum/size size
                :redmod.enum/option
                (into []
                      (map (fn [[option value]]
                             {(keyword name option) value}))
                      options)}))
        (get metadata "enums")))

;; install classes
(install
  conn
  (into []
        (map (fn [{:strs [name parent alignment flags properties functions static_functions]}]
               (cond-> {:redmod.class/name name
                        :redmod.class/parent parent
                        :redmod.class/alignment alignment
                        :redmod.class/flags flags}
                 (seq properties)
                 (assoc :redmod.class/property
                        (map (fn [{:strs [name type offset flags]}]
                               {:redmod.class.property/name   name
                                :redmod.class.property/type   type
                                :redmod.class.property/offset offset
                                :redmod.class.property/flags  flags})
                             properties))
                 (seq functions)
                 (assoc :redmod.class/function
                        (set (map (fn [{:strs [name flags]}]
                                    {:redmod.function/name  name
                                     :redmod.function/flags flags})
                                  functions)))

                 (seq static_functions)
                 (update :redmod.class/function
                         into
                         (map (fn [{:strs [name flags]}]
                                {:redmod.function/name   name
                                 :redmod.function/flags  flags
                                 :redmod.function/static true})
                              static_functions)))))
        (get metadata "classes")))

(comment
  ;; fall into the rabbit hole
  (->> (d/qseq '[:find (pull ?e [*])
                 :where [?e :redmod.class/name ?class-name]]
               (d/db conn))
       (random-sample 0.25)
       (ffirst)))