-
-
Notifications
You must be signed in to change notification settings - Fork 95
/
cli.clj
252 lines (221 loc) · 11.1 KB
/
cli.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
(ns datahike.cli
(:gen-class)
(:require [clojure.java.io :as io]
[clojure.pprint :refer [pprint]]
[clojure.string :as str]
[clojure.tools.cli :refer [parse-opts]]
[datahike.api :as d]
[datahike.pod :refer [run-pod]]
[datahike.tools :refer [datahike-logo]]
[clojure.edn :as edn]
[jsonista.core :as j]
[datahike.json :as json]
[clj-cbor.core :as cbor]
[taoensso.timbre :as log])
(:import [java.util Date]))
;; This file is following https://github.com/clojure/tools.cli
(defn usage [options-summary]
(->> [datahike-logo
"This is the Datahike command line interface."
""
"The commands mostly reflect the datahike.api Clojure API. To instantiate a specific database, you can use db:config_file to access the current database value, conn:config_file to create a mutable connection for manipulation, history:config_file for the historical database over all transactions, since:unix_time_in_ms:config_file to create a database with all facts since the time provided and asof:unix_time_in_ms:config_file to create an snapshot as-of the time provided. To pass in edn data use edn:edn_file and for JSON use json:json_file."
""
"Usage: dthk [options] action arguments"
""
"Options:"
options-summary
""
"Actions:"
" create-database Create database for a provided configuration file, e.g. create-database config_file"
" delete-database Delete database for a provided configuration file, e.g. delete-database config_file"
" database-exists Check whether database exists for a provided configuration file, e.g. database-exists config_file"
" transact Transact transactions, optionally from a file with --tx-file or from STDIN. Exampe: transact conn:config_file \"[{:name \"Peter\" :age 42}]\""
" query Query the database, e.g. query '[:find (count ?e) . :where [?e :name _]]' db:mydb.edn. You can pass an arbitrary number of data sources to the query."
" benchmark Benchmarks write performance. The arguments are starting eid, ending eid and the batch partitioning of the added synthetic Datoms. The Datoms have the form [eid :name ?randomly-sampled-name]"
" pull Pull data in a map syntax for a specific entity: pull db:mydb.edn \"[:db/id, :name]\" \"1\"."
" pull-many Pull data in a map syntax for a list of entities: pull db:mydb.edn \"[:db/id, :name]\" \"[1,2]\""
" entity Fetch entity: entity db:mydb.edn \"1\""
" datoms Fetch all datoms from an index: datoms db:mydb.edn \"{:index :eavt :components [1]}\" "
" schema Fetch schema for a db."
" reverse-schema Fetch reverse schema for a db."
" metrics Fetch metrics for a db."
""
"Please refer to the manual page for more information."]
(str/join \newline)))
(defn error-msg [errors]
(str "The following errors occurred while parsing your command:\n\n"
(str/join \newline errors)))
(def actions #{"create-database" "delete-database" "database-exists" "transact" "query" "benchmark"
"pull" "pull-many" "entity" "datoms" "schema" "reverse-schema" "metrics"})
(def cli-options
;; An option with a required argument
(let [formats #{:json :edn :pprint :cbor}]
[["-f" "--format FORMAT" "Output format for the result."
:default :edn
:parse-fn keyword
:validate [formats (str "Must be one of: " (str/join ", " formats))]]
["-if" "--input-format FORMAT" "Input format for the transaction."
:default :edn
:parse-fn keyword
:validate [formats (str "Must be one of: " (str/join ", " formats))]]
[nil "--tx-file PATH" "Use this input file for transactions instead of command line or STDIN."
:default nil
:validate [#(.exists (io/file %)) "Transaction file does not exist."]]
;; A non-idempotent option (:default is applied first)
["-v" nil "Verbosity level"
:id :verbosity
:default 0
:update-fn inc]
;; A boolean option defaulting to nil
["-h" "--help"]]))
(defn validate-args
"Validate command line arguments. Either return a map indicating the program
should exit (with a error message, and optional ok status), or a map
indicating the action the program should take and the options provided."
[args]
(let [{:keys [options arguments errors summary]} (parse-opts args cli-options)
pod? (= "true" (System/getenv "BABASHKA_POD"))]
(cond
pod?
{:action :pod :options options}
(:help options) ; help => exit OK with usage summary
{:exit-message (usage summary) :ok? true :options options}
errors ; errors => exit with description of errors
{:exit-message (error-msg errors) :options options}
(and (not= "transact" (first arguments))
(:tx-file options))
{:exit-message "The option --tx-file is only applicable to the transact action."
:options options}
(actions (first arguments))
{:action (keyword (first arguments)) :options options
:arguments (rest arguments)}
(not (actions (first arguments)))
{:exit-message (str "Unknown action, must be one of: "
(str/join ", " actions))
:options options}
:else ; failed custom validation => exit with usage summary
{:exit-message (usage summary)
:options options})))
(defn exit [status msg]
(println msg)
(System/exit status))
;; format: optional first argument Unix time in ms for history, last file for db
(def input->db
{#"conn:(.+)" #(d/connect (edn/read-string (slurp %)))
#"db:(.+)" #(deref (d/connect (edn/read-string (slurp %))))
#"history:(.+)" #(d/history @(d/connect (edn/read-string (slurp %))))
#"since:(.+):(.+)" #(d/since @(d/connect (edn/read-string (slurp %2)))
(Date. ^Long (edn/read-string %1)))
#"asof:(.+):(.+)" #(d/as-of @(d/connect (edn/read-string (slurp %2)))
(Date. ^Long (edn/read-string %1)))
#"cbor:(.+)" #(cbor/decode (io/input-stream %))
#"edn:(.+)" (comp edn/read-string slurp)
#"json:(.+)" (comp #(j/read-value % json/mapper) slurp)})
(defn load-input [s]
(if-let [res
(reduce (fn [_ [p f]]
(let [m (re-matches p s)]
(when (first m)
(reduced (apply f (rest m))))))
nil
input->db)]
res
(throw (ex-info "Input format not know." {:type :input-format-not-known
:input s}))))
(defn report [format out]
(case format
:json (println (j/write-value-as-string out))
:edn (println (pr-str out))
:pprint (pprint out)
:cbor (.write System/out ^bytes (cbor/encode out))))
(defn -main [& args]
(let [{:keys [action options arguments exit-message ok?]}
(validate-args args)]
(case (int (:verbosity options))
0 ;; default
(log/set-level! :warn)
1
(log/set-level! :info)
2
(log/set-level! :debug)
3
(log/set-level! :trace)
(exit 1 (str "Verbosity level not supported: " (:verbosity options))))
(if exit-message
(exit (if ok? 0 1) exit-message)
(case action
:pod
(run-pod args)
:create-database
(report (:format options)
(d/create-database (read-string (slurp (first arguments)))))
:delete-database
(report (:format options)
(d/delete-database (read-string (slurp (first arguments)))))
:database-exists
(report (:format options)
(d/database-exists? (read-string (slurp (first arguments)))))
:transact
(report (:format options)
(:tx-meta
(d/transact (load-input (first arguments))
(vec ;; TODO support set inputs for transact
(if-let [tf (:tx-file options)]
(load-input tf)
(if-let [s (second arguments)]
(case (:input-format options)
:edn (edn/read-string s)
:pprint (edn/read-string s)
:json (j/read-value s json/mapper)
:cbor (cbor/decode s)) ;; does this really make sense?
(case (:input-format options)
:edn (edn/read)
:pprint (edn/read)
:json (j/read-value *in* json/mapper)
:cbor (cbor/decode *in*))))))))
:benchmark
(let [conn (load-input (first arguments))
args (rest arguments)
tx-data (vec (for [i (range (read-string (first args))
(read-string (second args)))]
[:db/add (inc i)
:name (rand-nth ["Chrislain" "Christian"
"Jiayi" "Judith"
"Konrad" "Pablo"
"Timo" "Wade"])]))]
(doseq [txs (partition (read-string (nth args 2)) tx-data)]
(time
(d/transact conn txs))))
:query
(let [q-args (mapv #(load-input %) (rest arguments))
out (apply d/q (read-string (first arguments))
q-args)]
(report (:format options) out))
:pull
(let [out (into {} (d/pull (load-input (first arguments))
(read-string (second arguments))
(read-string (nth arguments 2))))]
(report (:format options) out))
:pull-many
(let [out (mapv #(into {} %)
(d/pull-many (load-input (first arguments))
(read-string (second arguments))
(read-string (nth arguments 2))))]
(report (:format options) out))
:entity
(let [out (into {} (d/entity (load-input (first arguments))
(read-string (second arguments))))]
(report (:format options) out))
:datoms
(let [out (d/datoms (load-input (first arguments))
(read-string (second arguments)))]
(report (:format options) out))
:schema
(let [out (d/schema (load-input (first arguments)))]
(report (:format options) out))
:reverse-schema
(let [out (d/reverse-schema (load-input (first arguments)))]
(report (:format options) out))
:metrics
(let [out (d/metrics (load-input (first arguments)))]
(report (:format options) out))))))