Permalink
Browse files

imports git

  • Loading branch information...
1 parent f7bbde7 commit 81d0afe42c723af0c686a8dfab88354ce8420ba6 @richhickey richhickey committed Oct 3, 2012
Showing with 96 additions and 69 deletions.
  1. +96 −69 src/datomic/codeq/core.clj
View
@@ -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]
@@ -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]
@@ -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)))
@@ -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]]
@@ -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]
@@ -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
@@ -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.