Files
integreat/src/clj/user.clj

750 lines
34 KiB
Clojure

(ns user
(:require [auto-ap.datomic :refer [uri]]
[config.core :refer [env]]
[auto-ap.utils :refer [by]]
[clojure.core.async :as async]
#_[auto-ap.ledger :as l]
[unilog.context :as lc]
[mount.core :as mount]
[auto-ap.server ]
[datomic.api :as d]
[clojure.data.csv :as csv]
[clj-time.coerce :as c]
[clj-time.core :as t]
[clojure.java.io :as io]
[clojure.string :as str]
[auto-ap.routes.queries :as q]
[amazonica.aws.s3 :as s3])
(:import [org.apache.commons.io.input BOMInputStream]
java.util.UUID))
(defn mark-until-date [client end]
(let [conn (d/connect uri)]
(doseq [p (->>
(d/query {:query {:find '[?e]
:in '[$ ?client ?end ]
:where [
'[?e :invoice/client ?c]
'[?c :client/code ?client]
'[?e :invoice/date ?d ]
'[(<= ?d ?end) ]]}
:args [(d/db conn)
client
(c/to-date end)]})
(mapv first)
(mapv (fn [i]
{:db/id i
:invoice/exclude-from-ledger true}))
(partition-all 100))]
@(d/transact conn p)
(println "process 100"))
(doseq [p (->>
(d/query {:query {:find '[?e]
:in '[$ ?client ?end ]
:where [
'[?e :transaction/client ?c]
'[?c :client/code ?client]
'[?e :transaction/date ?d ]
'[(<= ?d ?end) ]]}
:args [(d/db conn)
client
(c/to-date end)]})
(mapv first)
(mapv (fn [i]
{:db/id i
:transaction/approval-status :transaction-approval-status/excluded}))
(partition-all 100))]
@(d/transact conn p) (println "process 100"))))
(defn unapprove-all []
(let [conn (d/connect uri)]
(doseq [p (->>
(d/query {:query {:find '[?e]
:in '[$ ]
:where ['[?e :transaction/date ?d ]]}
:args [(d/db conn)]})
(mapv first)
(mapv (fn [i]
{:db/id i
:transaction/approval-status :transaction-approval-status/unapproved}))
(partition-all 100))]
@(d/transact conn p)
(println "process 100"))))
(defn load-accounts [conn]
(let [[header & rows] (-> "master-account-list.csv" (io/resource) io/input-stream (BOMInputStream.) (io/reader) csv/read-csv)
headers (map read-string header)
code->existing-account (by :account/numeric-code (map first (d/query {:query {:find ['(pull ?e [:account/numeric-code
:db/id])]
:in ['$]
:where ['[?e :account/name]]}
:args [(d/db conn)]})))
also-merge-txes (fn [also-merge old-account-id]
(if old-account-id
(let [[sunset-account]
(first (d/query {:query {:find ['?a ]
:in ['$ '?ac ]
:where ['[?a :account/numeric-code ?ac]]}
:args [(d/db conn) also-merge ]}))]
(into (mapv
(fn [[entity id sunset-account]]
[:db/add entity id old-account-id])
(d/query {:query {:find ['?e '?id '?a ]
:in ['$ '?ac ]
:where ['[?a :account/numeric-code ?ac]
'[?e ?at ?a]
'[?at :db/ident ?id]]}
:args [(d/db conn) also-merge ]}))
[[:db/retractEntity sunset-account]]))
[]))
txes (transduce
(comp
(map (fn ->map [r]
(into {} (map vector header r))))
(map (fn parse-map [r]
{:old-account-id (:db/id (code->existing-account
(or
(if (= (get r "IOL Account #")
"NEW")
nil
(Integer/parseInt (get r "IOL Account #")))
(Integer/parseInt (get r "Account #")))))
:new-account-number (Integer/parseInt (get r "Account #"))
:name (get r "Default Name")
:location (when-not (str/blank? (get r "Forced Location"))
(get r "Forced Location"))
:also-merge (when-not (str/blank? (get r "IOL # additional"))
(Integer/parseInt (get r "IOL # additional")))
:account-type (keyword "account-type"
(str/lower-case (get r "Account Type")))
:applicability (keyword "account-applicability"
(condp = (get r "Visiblity (Per-customer, Visible by default, hidden by default)")
"Visible by default"
"global"
"Hidden by default"
"optional"
"Per Customer"
"customized"))}))
(mapcat (fn ->tx [{:keys [old-account-id new-account-number name location also-merge account-type applicability]}]
(let [tx [(cond-> {:account/name name
:account/type account-type
:account/account-set "default"
:account/applicability applicability
:account/numeric-code new-account-number}
old-account-id (assoc :db/id old-account-id)
location (assoc :account/location location))]]
(if also-merge
(into tx
(also-merge-txes also-merge old-account-id))
tx)
))))
conj
[]
rows)]
@(d/transact conn txes)))
(defn find-bad-accounts []
(set (map second (d/query {:query {:find ['(pull ?x [*]) '?z]
:in ['$]
:where ['[?e :account/numeric-code ?z]
'[(<= ?z 9999)]
'[?x ?a ?e]]}
:args [(d/db (d/connect uri))]}))))
(defn delete-4-digit-accounts []
@(d/transact (d/connect uri)
(transduce
(comp
(map first)
(map (fn [old-account-id]
[:db/retractEntity old-account-id])))
conj
[]
(d/query {:query {:find ['?e]
:in ['$]
:where ['[?e :account/numeric-code ?z]
'[(<= ?z 9999)]]}
:args [(d/db (d/connect uri))]})))
)
(defn find-conflicting-accounts []
(filter
(fn [[k v]]
(> (count v) 1))
(reduce
(fn [acc [e z]]
(update acc z conj e))
{}
(d/query {:query {:find ['?e '?z]
:in ['$]
:where ['[?e :account/numeric-code ?z]]}
:args [(d/db (d/connect uri))]}))))
(defn customize-accounts [customer filename]
(let [conn (d/connect uri)
[header & rows] (-> filename (io/resource) io/input-stream (BOMInputStream.) (io/reader) csv/read-csv)
[client-id] (first (d/query (-> {:query {:find ['?e]
:in ['$ '?z]
:where [['?e :client/code '?z]]}
:args [(d/db (d/connect uri)) customer]})))
_ (println client-id)
headers (map read-string header)
code->existing-account (by :account/numeric-code (map first (d/query {:query {:find ['(pull ?e [:account/numeric-code
{:account/applicability [:db/ident]}
:db/id])]
:in ['$]
:where ['[?e :account/name]]}
:args [(d/db conn)]})))
existing-account-overrides (d/query (-> {:query {:find ['?e]
:in ['$ '?client-id]
:where [['?e :account-client-override/client '?client-id]]}
:args [(d/db (d/connect uri)) client-id]}))
_ (if-let [bad-rows (seq (->> rows
(group-by (fn [[_ account]]
account))
vals
(filter #(> (count %) 1))
(filter (fn [duplicates]
(apply not= (map rest duplicates))))
#_(map (fn [[[_ account]]]
account))
))]
(throw (Exception. (str "These accounts are duplicated:" (str bad-rows)))))
rows (vec (set (map rest rows)))
txes (transduce
(comp
(mapcat (fn parse-map [[account account-name override-name _ type]]
(let [code (some-> account
not-empty
Integer/parseInt)
existing (code->existing-account code)]
(cond (not code)
[]
(and existing (or (#{:account-applicability/optional :account-applicability/customized}
(:db/ident (:account/applicability existing)))
(and (not-empty override-name)
(not-empty account-name)
(not= override-name account-name)
)))
[{:db/id (:db/id existing)
:account/client-overrides [{:account-client-override/client client-id
:account-client-override/name (or (not-empty override-name)
(not-empty account-name))}]}]
(not existing)
[{:account/applicability :account-applicability/customized
:account/name account-name
:account/account-set "default"
:account/numeric-code code
:account/code (str code)
:account/type (if (str/blank? type)
:account-type/expense
(keyword "account-type" (str/lower-case type)))
:account/client-overrides [{:account-client-override/client client-id
:account-client-override/name (or (not-empty override-name)
(not-empty account-name))}]}]
:else
[])))))
conj
(mapv
(fn [[x]]
[:db/retractEntity x])
existing-account-overrides)
rows)]
txes
#_@(d/transact conn txes)))
(defn attach-signature [client-code filename]
@(d/transact (d/connect uri)
[{:db/id [:client/code client-code]
:client/signature-file (str "https://s3.amazonaws.com/integreat-signature-images/" filename)}]))
(defn fix-transactions-without-locations [client-code location]
(->>
(d/query {:query {:find ['(pull ?e [*])]
:in ['$ '?client-code]
:where ['[?e :transaction/accounts ?ta]
'[?e :transaction/matched-rule]
'[?e :transaction/approval-status :transaction-approval-status/approved]
'(not [?ta :transaction-account/location])
'[?e :transaction/client ?c]
'[?c :client/code ?client-code]
]}
:args [(d/db (d/connect uri)) client-code]})
(mapcat
(fn [[{:transaction/keys [accounts]}]]
(mapv
(fn [a]
{:db/id (:db/id a)
:transaction-account/location location}
)
accounts)
)
)
vec))
;; TODO uncommenting the two below this makes lein build not work, probably related to the ledger
#_(defn patch-missing-ledger-entries []
@(d/transact
(d/connect uri)
(mapv
#(l/entity-change->ledger (d/db (d/connect uri)) [:transaction %])
(concat
(->>
(d/query {:query {:find ['?t ]
:in ['$]
:where ['[?t :transaction/date]
'(not [?t :transaction/approval-status :transaction-approval-status/excluded])
'(not-join [?t] [?e :journal-entry/original-entity ?t])]}
:args [(d/db (d/connect uri))]})
(map first))))))
#_(defn check-for-out-of-date-ledger [code]
[(d/query {:query {:find ['(count ?e)]
:in ['$ '?code]
:where ['[?e :transaction/accounts ?ta]
'[?e :transaction/matched-rule]
'[?e :transaction/approval-status :transaction-approval-status/approved]
'(not [?ta :transaction-account/location])
'[?e :transaction/client ?c]
'[?c :client/code ?code]
]}
:args [(d/db (d/connect uri)) code]})
(d/query {:query {:find ['?t ]
:in ['$]
:where ['[?t :transaction/date]
'[?t :transaction/client ?c]
'[?c :client/code ?code]
'(not [?t :transaction/approval-status :transaction-approval-status/excluded])
'(not-join [?t] [?e :journal-entry/original-entity ?t])]}
:args [(d/db (d/connect uri))]})
(d/query {:query {:find ['?t ]
:in ['$]
:where ['[?t :transaction/date]
'[?t :transaction/client ?c]
'[?c :client/code ?code]
'(not [?t :transaction/approval-status :transaction-approval-status/excluded])
'[?t :transaction/vendor ?v]
'[?j :journal-entry/original-entity ?t]
'(not [?j :journal-entry/vendor ?v])
#_'(not-join [?t] [?e :journal-entry/original-entity ?t])]}
:args [(d/db (d/connect uri))]})
(d/query {:query {:find ['(count ?i) ]
:in ['$]
:where ['[?i :invoice/client ?c]
'(not [?i :invoice/status :invoice-status/voided])
'[?c :client/code ?code]
'(not-join [?i] [?e :journal-entry/original-entity ?i])]}
:args [(d/db (d/connect uri))]})])
(defn go []
(require '[mount.core :as mount])
(require '[auto-ap.server])
(mount/start-without #'auto-ap.server/jetty))
(defn entity-history [i]
(vec (sort-by first (d/query
{:query {:find ['?tx '?z '?v ]
:in ['?i '$]
:where ['[?i ?a ?v ?tx ?ad]
'[?a :db/ident ?z]
'[(= ?ad true)]]}
:args [i (d/history (d/db (d/connect uri)))]}))))
(defn entity-history-with-revert [i]
(vec (sort-by first (d/query
{:query {:find ['?tx '?z '?v '?ad ]
:in ['?i '$]
:where ['[?i ?a ?v ?tx ?ad]
'[?a :db/ident ?z]]}
:args [i (d/history (d/db (d/connect uri)))]}))))
(defn tx-detail [i]
(map (juxt :e #(d/ident (d/db (d/connect uri)) (:a %)) :v)
(:data (first
(d/tx-range (d/log (d/connect uri))
i
(inc i))))))
(defn tx-range-detail [i]
(map (juxt :e #(d/ident (d/db (d/connect uri)) (:a %)) :v)
(mapcat :data (d/tx-range (d/log (d/connect uri))
(- i 100)
(+ i 100)))))
(defn start-db []
(mount.core/start (mount.core/only #{#'auto-ap.datomic/conn})))
(defn touch-transaction-ledger [e]
@(d/transact auto-ap.datomic/conn [[:db/retractEntity [:journal-entry/original-entity e]]])
@(d/transact auto-ap.datomic/conn [(auto-ap.ledger/entity-change->ledger (d/db auto-ap.datomic/conn)
[:transaction e])]))
(defn mismatched-transactions []
(let [jel-accounts (reduce
(fn [acc [e lia]]
(update acc e (fnil conj #{} ) lia))
{}
(d/query {:query {:find ['?e '?lia]
:in ['$]
:where ['[?je :journal-entry/line-items ?li]
'[?je :journal-entry/original-entity ?e]
'[?li :journal-entry-line/account ?lia]
'[?lia :account/name]]}
:args [(d/db auto-ap.datomic/conn)]}))
transaction-accounts (reduce
(fn [acc [e lia]]
(update acc e (fnil conj #{} ) lia))
{}
(d/query {:query {:find ['?e '?lia]
:in ['$]
:where ['[?e :transaction/accounts ?li]
'(not [?e :transaction/approval-status :transaction-approval-status/excluded])
'[?li :transaction-account/account ?lia]
'[?lia :account/name]]}
:args [(d/db auto-ap.datomic/conn)]}))
]
(filter
(fn [[e accounts]] (not= accounts (get jel-accounts e)))
transaction-accounts)))
(defn spit-csv [columns data ]
(csv/write-csv *out*
(into [(map name columns)]
(for [r data]
((apply juxt columns) r )))))
(defn find-queries [words]
(let [obj (s3/list-objects-v2 :bucket-name (:data-bucket env)
:prefix (str "queries/"))]
(let [concurrent 30
output-chan (async/chan)]
(async/pipeline-blocking concurrent
output-chan
(comp
(map #(do
[(:key %)
(str (slurp (:object-content (s3/get-object
:bucket-name (:data-bucket env)
:key (:key %)))))]))
(filter #(->> words
(every? (fn [w] (str/includes? (second %) w)))))
(map first)
(map #(str/replace % #"queries/" ""))
)
(async/to-chan (:object-summaries obj))
true
(fn [e]
(println "failed " e)))
(async/<!! (async/into [] output-chan)))))
(def sales-summary-query
"[:find ?d4 (sum ?total) (sum ?tax) (sum ?tip) (sum ?service-charge) (sum ?discount) (sum ?returns)
:with ?s
:in $
:where
[?s :sales-order/client [:client/code \"%s\"]]
[?s :sales-order/date ?d]
[?s :sales-order/total ?total]
[?s :sales-order/tax ?tax]
[?s :sales-order/tip ?tip]
[?s :sales-order/service-charge ?service-charge]
[?s :sales-order/returns ?returns]
[?s :sales-order/discount ?discount]
[(clj-time.coerce/to-date-time ?d) ?d2]
[(auto-ap.time/localize ?d2) ?d3]
[(auto-ap.time/unparse-local ?d3 auto-ap.time/normal-date) ?d4]
]")
(def sales-category-query
"[:find ?d4 ?n ?n2 (sum ?total) (sum ?tax) (sum ?discount)
:with ?s ?li
:in $
:where
[?s :sales-order/client [:client/code \"%s\"]]
[?s :sales-order/date ?d]
[?s :sales-order/line-items ?li]
[?li :order-line-item/category ?n]
[(get-else $ ?li :order-line-item/item-name \"\") ?n2]
[?li :order-line-item/total ?total]
[?li :order-line-item/tax ?tax]
[?li :order-line-item/discount ?discount]
[(clj-time.coerce/to-date-time ?d) ?d2]
[(auto-ap.time/localize ?d2) ?d3]
[(auto-ap.time/unparse-local ?d3 auto-ap.time/normal-date) ?d4]
]")
(def expected-deposits-query
"[:find ?d4 ?t ?f
:in $
:where
[?c :client/code \"%s\"]
[?s :expected-deposit/client ?c]
[?s :expected-deposit/total ?t]
[?s :expected-deposit/fee ?f]
[?s :expected-deposit/sales-date ?date]
[(clj-time.coerce/to-date-time ?date) ?d2]
[(auto-ap.time/localize ?d2) ?d3]
[(auto-ap.time/unparse-local ?d3 auto-ap.time/normal-date) ?d4]
]")
(def tenders-query
"[:find ?d4 ?type ?p2 (sum ?total) (sum ?tip)
:with ?charge
:in $
:where
[?c :client/code \"%s\"]
[?s :sales-order/client ?c]
[?s :sales-order/charges ?charge]
[?charge :charge/type-name ?type]
[?charge :charge/total ?total]
[?charge :charge/tip ?tip]
[(get-else $ ?charge :charge/processor :na) ?ccp]
[(get-else $ ?ccp :db/ident :na) ?p]
[(name ?p) ?p2]
[?s :sales-order/date ?date]
[(clj-time.coerce/to-date-time ?date) ?d2]
[(auto-ap.time/localize ?d2) ?d3]
[(auto-ap.time/unparse-local ?d3 auto-ap.time/normal-date) ?d4]
]")
(def refunds-query
"[:find ?d4 ?t (sum ?total) (sum ?fee)
:with ?r
:in $
:where
[?r :sales-refund/client [:client/code \"%s\"]]
[?r :sales-refund/total ?total]
[?r :sales-refund/fee ?fee]
[?r :sales-refund/date ?date]
[?r :sales-refund/type ?t]
[(clj-time.coerce/to-date-time ?date) ?d2]
[(auto-ap.time/localize ?d2) ?d3]
[(auto-ap.time/unparse-local ?d3 auto-ap.time/normal-date) ?d4]]")
(defn setup-sales-queries [client-code]
(let [sales-summary-id (or (first (find-queries [client-code "service-charge"]))
(str (UUID/randomUUID)))
sales-category-id (or (first (find-queries [client-code "item-name"]))
(str (UUID/randomUUID)))
expected-deposit-id (or (first (find-queries [client-code "expected-deposit"]))
(str (UUID/randomUUID)))
tender-id (or (first (find-queries [client-code ":charge"]))
(str (UUID/randomUUID)))
refund-id (or (first (find-queries [client-code "sales-refund"]))
(str (UUID/randomUUID)))]
(map (comp :json-results-url :body)
[(q/put-query sales-summary-id
(format sales-summary-query client-code)
(str "sales query for " client-code)
)
(q/put-query sales-category-id
(format sales-category-query client-code)
(str "sales category query for " client-code)
)
(q/put-query expected-deposit-id
(format expected-deposits-query client-code)
(str "expected deposit query for " client-code)
)
(q/put-query tender-id
(format tenders-query client-code)
(str "tender query for " client-code))
(q/put-query refund-id
(format refunds-query client-code)
(str "refunds query for " client-code)
)])))
(defn print-sales-queries [client-code]
(let [sales-summary-id (first (find-queries [client-code "service-charge"]))
sales-category-id (first (find-queries [client-code "item-name"]))
expected-deposit-id (first (find-queries [client-code "expected-deposit"]))
tender-id (first (find-queries [client-code ":charge"]))
refund-id (first (find-queries [client-code "sales-refund"]))]
(println "For" client-code ":")
(println "Sales: " (str "https://app.integreatconsult.com/api/queries/" sales-summary-id "/results/json"))
(println "Sales Category: " (str "https://app.integreatconsult.com/api/queries/" sales-category-id "/results/json"))
(println "Expected Deposits: " (str "https://app.integreatconsult.com/api/queries/" expected-deposit-id "/results/json"))
(println "Tenders: " (str "https://app.integreatconsult.com/api/queries/" tender-id "/results/json"))
(println "Refund: " (str "https://app.integreatconsult.com/api/queries/" refund-id "/results/json"))
(println "")))
(defn historical-load-sales [client-code days]
(println "orders")
(lc/with-context {:source "Historical loading data"}
(doseq [d (clj-time.periodic/periodic-seq (t/plus (t/now) (t/days (- days)))
(t/now)
(t/days 1))]
(println d)
(auto-ap.square.core/upsert client-code d)))
(println "refunds")
(auto-ap.square.core/upsert-refunds client-code)
(println "settlements")
(with-redefs [auto-ap.square.core/lookup-dates (fn lookup-dates []
(->> (clj-time.periodic/periodic-seq (t/plus (t/now) (t/days (- days)))
(t/now)
(t/days 2))
(map (fn [d]
[(auto-ap.time/unparse (t/plus d (t/days 1)) auto-ap.time/iso-date)
(auto-ap.time/unparse (t/plus d (t/days 2)) auto-ap.time/iso-date)]))))]
(auto-ap.square.core/upsert-settlements client-code)))
(defn upsert-invoice-amounts [tsv]
(let [data (with-open [reader (io/reader (char-array tsv))]
(doall (csv/read-csv reader :separator \tab)))
db (d/db auto-ap.datomic/conn)
invoice-totals (->> data
(drop 1)
(group-by first)
(map (fn [[k values]]
[(Long/parseLong k)
(reduce + 0.0
(->> values
(map (fn [[_ _ _ _ amount]]
(- (Double/parseDouble amount))))))
]))
(into {}))]
(->>
(for [[invoice-id invoice-expense-account-id target-account target-date amount expense-account location] (drop 1 data)
:let [
invoice-id (Long/parseLong invoice-id)
invoice (d/entity db invoice-id)
current-total (:invoice/total invoice)
target-total (invoice-totals invoice-id) ;; TODO should include expense accounts not visible
new-account? (not (boolean (or (some-> invoice-expense-account-id not-empty Long/parseLong)
(:db/id (first (:invoice/expense-accounts invoice))))))
invoice-expense-account-id (or (some-> invoice-expense-account-id not-empty Long/parseLong)
(:db/id (first (:invoice/expense-accounts invoice)))
(d/tempid :db.part/user))
invoice-expense-account (when-not new-account?
(d/entity db invoice-expense-account-id))
current-account-id (:db/id (:invoice-expense-account/account invoice-expense-account))
target-account-id (Long/parseLong (str/trim target-account))
target-date (clj-time.coerce/to-date (auto-ap.time/parse target-date auto-ap.time/normal-date))
current-date (:invoice/date invoice)
current-expense-account-amount (:invoice-expense-account/amount invoice-expense-account)
target-expense-account-amount (- (Double/parseDouble amount))
current-expense-account-location (:invoice-expense-account/location invoice-expense-account)
target-expense-account-location location
[[payment-id payment-amount invoice-payment]] (vec (d/q
'[:find ?p ?a ?ip
:in $ ?i
:where [?ip :invoice-payment/invoice ?i]
[?ip :invoice-payment/amount ?a]
[?ip :invoice-payment/payment ?p]
]
db invoice-id))]
:when current-total]
[
(when (not (auto-ap.utils/dollars= current-total target-total))
{:db/id invoice-id
:invoice/total target-total})
(when new-account?
{:db/id invoice-id
:invoice/expense-accounts invoice-expense-account-id})
(when (and target-date (not= current-date target-date))
{:db/id invoice-id
:invoice/date target-date})
(when (and
(not (auto-ap.utils/dollars= current-total target-total))
invoice-payment)
[:db/retractEntity invoice-payment])
(when (or new-account?
(not (auto-ap.utils/dollars= current-expense-account-amount target-expense-account-amount)))
{:db/id invoice-expense-account-id
:invoice-expense-account/amount target-expense-account-amount})
(when (not= current-expense-account-location
target-expense-account-location)
{:db/id invoice-expense-account-id
:invoice-expense-account/location target-expense-account-location})
(when (not= current-account-id target-account-id )
{:db/id invoice-expense-account-id
:invoice-expense-account/account target-account-id})])
(mapcat identity)
(filter identity)
vec)))
(defn get-schema [prefix]
(->> (d/q '[:find ?i
:in $ ?p
:where [_ :db/ident ?i]
[(namespace ?i) ?p]] (d/db auto-ap.datomic/conn) prefix)
(mapcat identity)
vec))
(defn get-idents []
(->> (d/q '[:find ?i
:in $
:where [_ :db/ident ?i]]
(d/db auto-ap.datomic/conn) )
(mapcat identity)
(map str)
(sort)
vec))
(defn init-repl []
(set! nrepl.middleware.print/*print-fn* clojure.pprint/pprint))