Skip to content

Commit

Permalink
imports git
Browse files Browse the repository at this point in the history
  • Loading branch information
@richhickey
richhickey committed Oct 3, 2012
1 parent f7bbde7 commit 81d0afe
Showing 1 changed file with 96 additions and 69 deletions.
165 changes: 96 additions & 69 deletions src/datomic/codeq/core.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,6 @@

(set! *warn-on-reflection* true)

(defn ^java.io.Reader exec-stream
[^String cmd]
(-> (Runtime/getRuntime)
(.exec cmd)
.getInputStream
io/reader))

(def schema
[
{:db/id #db/id[:db.part/db]
Expand Down Expand Up @@ -63,10 +56,10 @@
:db.install/_attribute :db.part/db}

{:db/id #db/id[:db.part/db]
:db/ident :git/deletes
:db/ident :git/tree
:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many
:db/doc "Git objects (trees/blobs) deleted by a commit"
:db/cardinality :db.cardinality/one
:db/doc "Root node of a commit"
:db.install/_attribute :db.part/db}

{:db/id #db/id[:db.part/db]
Expand Down Expand Up @@ -138,14 +131,21 @@
:db.install/_attribute :db.part/db}

{:db/id #db/id[:db.part/db]
:db/ident :person/email
:db/ident :email/address
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/doc "An email address"
:db/unique :db.unique/identity
:db.install/_attribute :db.part/db}
])

(defn ^java.io.Reader exec-stream
[^String cmd]
(-> (Runtime/getRuntime)
(.exec cmd)
.getInputStream
io/reader))

(defn ensure-schema [conn]
(or (-> conn d/db (d/entid :git/commit))
@(d/transact conn schema)))
Expand Down Expand Up @@ -173,56 +173,16 @@
;;040000 tree 6b880666740300ac57361d5aee1a90488ba1305c src
;;040000 tree 407924e4812c72c880b011b5a1e0b9cb4eb68cfa test

;;example diff-tree
;;RichMacPro:datomic rich$ git diff-tree -r -c -M -C -t --no-commit-id --root 25a6763864c48bee17ce4872b040c9427b6dbec9
;;:040000 040000 c70bd51b94ca4db0a2aa655bc6ba68c422ee7de2 98c0c5199bbde068d2c41505370f8692b67d5d20 M build
;;:100644 100644 1203148b1adc481d30d7509b9d2fb4124fe6ac1f e69fbb4496d1101d53560e84475e5ef13d484dfa M build/packaging.org
;;:040000 040000 32f70caacd52279587b42a38227977eab503c16b 903c61af7f9acd99dc8262801ed18261ef1e185c M siderail
;;:100644 100644 ce62de79aabd59d8b5994f0b8b5cb893cface5e3 70ae7b725c861b1401c26a6f51b5c4f5cb3264eb R053 src/clj/datomic/aws_runtime.clj siderail/snippets.clj
;;:040000 040000 01707b6d46d7c8d19384b7948d3b385c60d8e1a3 2f66f5d7f95031b9b6d2077ebf1c8ac89ccc3a7d M src
;;:040000 040000 1a7394d6083bf797dabaa9e21a239f72e32dddf8 81735f5ffa837e7e778eadc6189fdd3687818fee M src/clj
;;:040000 040000 0a72bc83597a0294eb3eabc64755191c65f6af36 9dca65a1b1a3db07d6ea4bfdd7db0dd0acbcc03d M src/clj/datomic
;;:000000 100644 0000000000000000000000000000000000000000 3cb285abbac17e3a9a983524b6d18a0658994070 A src/clj/datomic/aws_detect.clj
;;:100644 100644 595a6ab95fdefda585be139beb73f1427e37e8cf 1cfcbb19f269a6b2d857b5c48cda98d476269714 M src/clj/datomic/connector.clj
;;:100644 100644 041c22c6c8466aa2f1c5ef577ca661a1c6dc2169 43e633d190b4d8469f915394a1949c1c226bc894 M src/clj/datomic/transactor.clj
;;:040000 040000 57b7f95c0791ef307dbc0edab5980dcd3c1e5577 1477ca0fbe83a0e3fcbbe06631e82170d2ffd467 M test
;;:040000 040000 6d2a855f5bcfc6dbb7edec71562dc0b588d89ce7 69b10b84c358a37eed41dbe1628870f3d78c3b38 M test/src
;;:040000 040000 f8749c54f2630b31476a5e8a53645ea9608a7ed8 f775a1741648a2b6ae7b588c16a642ee9dab8879 M test/src/dtest
;;:100644 100644 9a57b8bc470a1e70f73f201bddda5b02cae14b76 037adb65eadc7c7f6a62324b1682524edabf9ca4 M test/src/dtest/web.clj
;;:040000 040000 f1858d625337a7b43e3c99b1b6c1c1ed61a3f535 b7f7aa245f7de94f7716e8ed3e462d5865777246 M tix
;;:100644 100644 f3def8b510500009953879f2d89d93f554e86e67 5f9b77505a97f690ff12b3c18b0b871b09725b85 M tix/datomic-free.org

(defn dir
"Returns [[sha path] ...]"
"Returns [[sha :type path] ...]"
[tree]
(with-open [s (exec-stream (str "git cat-file -p " tree))]
(let [es (line-seq s)]
(mapv #(vector (nth (string/split ^String % #"\s") 2)
(subs % (inc (.indexOf ^String % "\t")) (count %))) es))))

(defn changes [tree]
(with-open [s (exec-stream (str "git diff-tree -r -c -M -C -t --no-commit-id --root " tree))]
(mapv
(fn [^String e]
(let [mode1 (subs e 1 7)
mode2 (subs e 8 14)
sha1 (subs e 15 55)
sha2 (subs e 56 96)
prior-sha (when (not= sha1 "0000000000000000000000000000000000000000") sha1)
sha (when (not= sha2 "0000000000000000000000000000000000000000") sha2)
op (subs e 97 98)
path (subs e (inc (.lastIndexOf e "\t")) (count e))]
(into {}
(remove (fn [[_ v]] (nil? v))
{:prior-sha (when (not= op "T") prior-sha)
:sha sha
:op ({"A" :add "M" :modify "D" :delete "C" :copy "R" :rename "T" :type-change} op)
:path path
:prior-path (cond (= op "D") path
(= op "R") (subs e (inc (.indexOf e "\t")) (.lastIndexOf e "\t")))
:dir (when (and sha (= mode2 "040000")) (dir sha))
}))))
(line-seq s))))
(mapv #(let [ss (string/split ^String % #"\s")]
[(nth ss 2)
(keyword (nth ss 1))
(subs % (inc (.indexOf ^String % "\t")) (count %))])
es))))

(defn commit
[[sha msg]]
Expand All @@ -240,21 +200,17 @@
{:sha sha
:msg msg
:tree tree
:dir (dir tree)
:parents parents
:changes (changes sha)
:author (trim-email (author 2))
:authored (dt (author 1))
:committer (trim-email (committer 2))
:committed (dt (committer 1))}))

(defn index-get-id
[db attr v]
(let [d (first (d/index-range db attr v))]
(let [d (first (d/index-range db attr v nil))]
(when (and d (= (:v d) v))
(:e d)))
#_(ffirst (d/q '[:find ?e :in $ ?a ?v :where [?e ?a ?v]]
db attr v)))
(:e d))))

(defn index->id-fn
[db attr]
Expand All @@ -263,12 +219,68 @@
(or (index-get-id db attr x)
(d/tempid :db.part/user)))))

(defmacro cond->
[init & steps]
(assert (even? (count steps)))
(let [g (gensym)
pstep (fn [[pred step]] `(if ~pred (-> ~g ~step) ~g))]
`(let [~g ~init
~@(interleave (repeat g) (map pstep (partition 2 steps)))]
~g)))

(defn commit-tx-data
[db commit]
(let [tempid? map? ;;todo - better
[db {:keys [sha msg tree parents author authored committer committed] :as commit}]
(let [tempid? map? ;;todo - better pred
sha->id (index->id-fn db :git/sha)
email->id (index->id-fn db :person/emailcz)
]))
email->id (index->id-fn db :email/address)
authorid (email->id author)
committerid (email->id committer)
cid (d/tempid :db.part/user)
tx-data (fn f [[sha type path]]
(let [id (sha->id sha)
nodeid (or (and (not (tempid? id))
(ffirst (d/q '[:find ?e :in $ ?path ?id
:where [?e :git/path ?path] [?e :git/object ?id]]
db path id)))
(d/tempid :db.part/user))
data (cond-> []
(tempid? nodeid) (conj {:db/id nodeid :git/path path :git/object id})
(tempid? id) (conj {:db/id id :git/sha sha :git/type type}))
data (if (and (tempid? id) (= type :tree))
(let [es (dir sha)]
(reduce (fn [data child]
(let [[cid cdata] (f child)
data (into data cdata)]
(conj data [:db/add id :git/nodes cid])))
data es))
data)]
[nodeid data]))
[treeid treedata] (tx-data [tree :tree ""])
tx (into treedata
[{:db/id (d/tempid :db.part/tx)
:git/commit cid
:codeq/op :import}
(cond-> {:db/id cid
:git/type :commit
:git/tree treeid
:git/sha sha
:git/author authorid
:git/authoredAt authored
:git/committer committerid
:git/committedAt committed
}
msg (assoc :git/message msg)
parents (assoc :git/parents
(mapv (fn [p]
(let [id (sha->id p)]
(assert (not (tempid? id))
(str "Parent " p " not previously imported"))
id))
parents)))])
tx (cond-> tx
(tempid? authorid) (conj [:db/add authorid :email/address author])
(and (not= committer author) (tempid? committerid)) (conj [:db/add committerid :email/address committer]))]
tx))

(defn commits
"Returns log as [[sha msg] ...], in commit order. commit-name may be nil
Expand Down Expand Up @@ -300,14 +312,29 @@
(ensure-schema conn)
conn))

(defn import-git
[conn commits]
(doseq [commit commits]
(let [db (d/db conn)]
(prn (:sha commit))
(d/transact conn (commit-tx-data db commit)))))

(defn -main
[& [db-uri commit]]
(if db-uri
(let [conn (ensure-db db-uri)]
(unimported-commits (d/db conn) commit))
(import-git conn (unimported-commits (d/db conn) commit)))
(println "Usage: datomic.codeq.core db-uri [commit-name]")))


(comment
(datomic.codeq.core/-main "datomic:mem://test" "20f8db11804afc8c5a1752257d5fdfcc2d131d08")
;;(def uri "datomic:mem://codeq")
(def uri "datomic:free://localhost:4334/codeq")
(datomic.codeq.core/-main uri "c3bd979cfe65da35253b25cb62aad4271430405c")
(datomic.codeq.core/-main uri "20f8db11804afc8c5a1752257d5fdfcc2d131d08")
(datomic.codeq.core/-main uri)
(require '[datomic.api :as d])
(def conn (d/connect uri))
(def db (d/db conn))
(seq (d/datoms db :aevt :git/type))
)

0 comments on commit 81d0afe

Please sign in to comment.