Files
integreat/src/clj/auto_ap/solr.clj
2023-06-13 08:48:26 -07:00

240 lines
8.6 KiB
Clojure

(ns auto-ap.solr
(:require
[auto-ap.datomic :refer [conn pull-id]]
[cemerick.url :as url]
[auto-ap.time :as atime]
[clj-http.client :as client]
[clj-time.coerce :as c]
[clojure.data.json :as json]
[clojure.string :as str]
[config.core :refer [env]]
[datomic.api :as dc]))
(defn escape [s]
(str/escape s
(into {}
(for [c "\\+-&&||!(){}[]^\"~*?:/"]
[c (str "\\" c)]))))
(def solr-uri (:solr-uri env))
(defn fmt-amount [a]
(with-precision 2
(some-> a
bigdec
(.setScale 2 java.math.RoundingMode/HALF_UP)
(double))))
(defmulti datomic->solr (fn [d]
(let [entity (dc/pull (dc/db conn) '[:transaction/date :invoice/date :payment/date :journal-entry/date] d)]
(cond (:transaction/date entity)
"transaction"
(:invoice/date entity)
"invoice"
(:payment/date entity)
"payment"
(:journal-entry/date entity)
"journal-entry"
:else
nil))))
(defmethod datomic->solr "transaction" [d]
(let [i (dc/pull (dc/db conn) '[:db/id :transaction/description-original
:transaction/amount
{:transaction/client [:client/code :db/id]
:transaction/vendor [:vendor/name :db/id]}
:transaction/date]
d)]
{"id" (-> i :db/id)
"client_id" (-> i :transaction/client :db/id)
"client_code" (-> i :transaction/client :client/code)
"date" (some-> i :transaction/date c/to-date-time (atime/unparse atime/iso-date) (str "T00:00:00Z"))
"amount" (-> i :transaction/amount fmt-amount)
"description" (-> i :transaction/description-original)
"vendor_name" (-> i :transaction/vendor :vendor/name)
"vendor_id" (-> i :transaction/vendor :db/id)
"type" "transaction"}))
(defmethod datomic->solr nil [d]
nil)
(defmethod datomic->solr "journal-entry" [d]
(let [i (dc/pull (dc/db conn) '[:db/id
:journal-entry/amount
:journal-entry/source
{:journal-entry/client [:client/code :db/id]
:journal-entry/vendor [:vendor/name :db/id]
:journal-entry/line-items [{:journal-entry-line/account [:account/name :account/numeric-code]}]}
:journal-entry/date]
d)]
{"id" (-> i :db/id)
"client_id" (-> i :journal-entry/client :db/id)
"client_code" (-> i :journal-entry/client :client/code)
"date" (some-> i :journal-entry/date c/to-date-time (atime/unparse atime/iso-date) (str "T00:00:00Z"))
"amount" (-> i :journal-entry/amount fmt-amount)
"description" (str
(when (:journal-entry/source i)
(str (:journal-entry/source i) ": "))
(str/join ", " (set (map
(fn [li]
(format "%s (%s)" (:account/name (:journal-entry-line/account li))
(:account/numeric-code (:journal-entry-line/account li))))
(:journal-entry/line-items i)))))
"vendor_name" (-> i :journal-entry/vendor :vendor/name)
"vendor_id" (-> i :journal-entry/vendor :db/id)
"type" "journal-entry"}))
(defmethod datomic->solr "invoice" [d]
(let [i (dc/pull (dc/db conn) '[:db/id :invoice/invoice-number
:invoice/total
{:invoice/client [:client/code :db/id]
:invoice/vendor [:vendor/name :db/id]}
:invoice/date]
d)]
{"id" (-> i :db/id)
"client_id" (-> i :invoice/client :db/id)
"client_code" (-> i :invoice/client :client/code)
"date" (some-> i :invoice/date c/to-date-time (atime/unparse atime/iso-date) (str "T00:00:00Z"))
"amount" (-> i :invoice/total fmt-amount)
"number" (-> i :invoice/invoice-number)
"vendor_name" (-> i :invoice/vendor :vendor/name)
"vendor_id" (-> i :invoice/vendor :db/id)
"type" "invoice"}))
(defmethod datomic->solr "payment" [d]
(let [i (dc/pull (dc/db conn) '[:db/id :payment/check-number
:payment/amount
{:payment/client [:client/code :db/id]
:payment/vendor [:vendor/name :db/id]}
:payment/date]
d)]
{"id" (-> i :db/id)
"client_id" (-> i :payment/client :db/id)
"client_code" (-> i :payment/client :client/code)
"date" (some-> i :payment/date c/to-date-time (atime/unparse atime/iso-date) (str "T00:00:00Z"))
"amount" (-> i :payment/amount fmt-amount)
"description" (-> i :payment/check-number)
"vendor_name" (-> i :payment/vendor :vendor/name)
"vendor_id" (-> i :payment/vendor :db/id)
"type" "payment"}))
(defprotocol SolrClient
(index-documents-raw [this index xs])
(index-documents [this index xs])
(query [this index q])
(delete [this index]))
(defrecord RealSolrClient [solr-uri]
SolrClient
(index-documents-raw [this index xs]
(client/post
(str (assoc (url/url solr-uri "solr" index "update")
:query {"commitWithin" 5000
"commit" true}))
{:headers {"Content-Type" "application/json"}
:socket-timeout 30000
:connection-timeout 30000
:method "POST"
:body (json/write-str xs)}))
(index-documents [this index xs]
(client/post
(str (assoc (url/url solr-uri "solr" index "update")
:query {"commitWithin" 5000
"commit" true}))
{:headers {"Content-Type" "application/json"}
:socket-timeout 30000
:connection-timeout 30000
:method "POST"
:body (json/write-str (filter identity (map datomic->solr xs)))}))
(query [this index q]
(-> (client/post (str (url/url solr-uri "solr" index "query"))
{:body (json/write-str q )
:socket-timeout 30000
:connection-timeout 30000
:headers {"Content-Type" "application/json"}
:as :json}
)
:body
:response
:docs))
(delete [this index]
(client/post
(str (assoc (url/url solr-uri "solr" index "update")
:query {"commitWithin" 15000
"commit" true}))
{:headers {"Content-Type" "application/json"}
:method "POST"
:body (json/write-str {"delete" {"query" "*:*"}})})))
(defrecord MockSolrClient []
SolrClient
(index-documents [this index xs]
nil)
(index-documents-raw [this index xs]
nil)
(query [this index q]
nil)
(delete [this index]
nil))
(def impl (if (= :solr (:solr-impl env))
(->RealSolrClient (:solr-uri env))
(->MockSolrClient )))
(defn touch-with-ledger [i]
(index-documents impl "invoices" [i [:journal-entry/original-entity i]]))
(defn touch
([i] (touch i "invoices"))
([i index]
(index-documents impl index [i])))
(defrecord InMemSolrClient [data-set-atom]
SolrClient
(index-documents [this index xs]
(swap! data-set-atom
(fn [data-set]
(reduce
(fn [data-set x]
(let [thing (datomic->solr x)]
(update data-set index conj [(str/join " " (vals x)) thing])))
data-set
xs)))
nil)
(index-documents-raw [this index xs]
(swap! data-set-atom
(fn [data-set]
(reduce
(fn [data-set x]
(update data-set index conj [(str/join " " (vals x)) x]))
data-set
xs))))
(query [this index q]
(filter
(fn [[x e]]
(str/includes? x (get q "query")))
(get @data-set-atom index)))
(delete [this index]
(swap! data-set-atom dissoc index)))