(ns auto-ap.graphql.ledger (:require [auto-ap.datomic :refer [audit-transact-batch conn remove-nils uri]] [auto-ap.datomic.accounts :as a] [auto-ap.datomic.clients :as d-clients] [auto-ap.datomic.ledger :as l] [auto-ap.datomic.vendors :as d-vendors] [auto-ap.graphql.utils :refer [->graphql <-graphql assert-admin assert-can-see-client result->page]] [auto-ap.parse.util :as parse] [auto-ap.utils :refer [by dollars=]] [auto-ap.pdf.ledger :refer [print-pnl]] [clj-time.coerce :as coerce] [clojure.tools.logging :as log] [com.walmartlabs.lacinia.util :refer [attach-resolvers]] [datomic.api :as d] [mount.core :as mount] [unilog.context :as lc] [yang.scheduler :as scheduler])) (mount/defstate running-balance-cache :start (atom {})) (defn get-ledger-page [context args _] (let [args (assoc args :id (:id context)) [journal-entries journal-entries-count] (l/get-graphql (assoc (<-graphql (:filters args)) :id (:id context))) journal-entries (mapv (fn [je] (-> je (update :journal-entry/original-entity :db/id) (update :journal-entry/line-items (fn [jels] (mapv (fn [jel] (assoc jel :running-balance (get-in @running-balance-cache [(:db/id (:journal-entry/client je)) (:db/id jel)]))) jels))))) journal-entries)] (result->page journal-entries journal-entries-count :journal_entries (:filters args)))) ;; TODO a better way to do this might be to accumulate ALL credits and ALL debits, and then just do for credits: balance = credits - debits. and for debits balance = debits - credits (defn credit-account? [account] (or (#{:account-type/liability :account-type/equity :account-type/revenue} (:db/ident (:account/type account))) (#{:bank-account-type/credit} (-> account :bank-account/type :db/ident )))) (defn debit-account? [account] (or (#{:account-type/asset :account-type/dividend :account-type/expense} (:db/ident (:account/type account))) (#{:bank-account-type/check :bank-account-type/cash} (-> account :bank-account/type :db/ident )))) (defn expense-account? [account] (= :account-type/expense (:db/ident (:account/type account)))) (defn account-name [account client] (let [overriden-name (->> (:account/client-overrides account) (filter (fn [co] (= (:db/id (:account-client-override/client co)) (:db/id client)))) (map :account-client-override/name) first)] (or overriden-name (:account/name account)))) (defn roll-up-until ([lookup-account all-ledger-entries end-date] (roll-up-until lookup-account all-ledger-entries end-date nil)) ([lookup-account all-ledger-entries end-date start-date] (->> all-ledger-entries (filter (fn [[d]] (if start-date (and (>= (compare d start-date) 0) (<= (compare d end-date) 0)) (<= (compare d end-date) 0)))) (reduce (fn [acc [_ _ account location debit credit]] (-> acc (update-in [[location account] :debit] (fnil + 0.0) debit) (update-in [[location account] :credit] (fnil + 0.0) credit) (update-in [[location account] :count] (fnil + 0) 1)) ) {}) (reduce-kv (fn [acc [location account-id] {:keys [debit credit count]}] (let [account (lookup-account account-id) account-type (:account_type account)] (conj acc (merge {:id (str account-id "-" location) :location (or location "") :count count :amount (if account-type (if (#{:account-type/asset :account-type/dividend :account-type/expense} account-type) (- debit credit) (- credit debit)) 0.0)} account))) ) [])))) (defn build-account-lookup [client-id] (let [accounts (by :db/id (map first (d/query {:query {:find ['(pull ?e [:db/id :account/name :account/numeric-code {:account/type [:db/ident] :account/client-overrides [:account-client-override/client :account-client-override/name]} ])] :in ['$] :where ['[?e :account/name]]} :args [(d/db (d/connect uri) )]}))) bank-accounts (by :db/id (map first (d/query {:query {:find ['(pull ?e [:db/id :bank-account/name :bank-account/numeric-code {:bank-account/type [:db/ident]}])] :in ['$] :where ['[?e :bank-account/name]]} :args [(d/db (d/connect uri))]}))) overrides-by-client (->> accounts vals (mapcat (fn [a] (map (fn [o] [[(:db/id a) (:db/id (:account-client-override/client o))] (:account-client-override/name o)]) (:account/client-overrides a)) ) ) (into {} ))] (fn [a] {:name (or (:bank-account/name (bank-accounts a)) (overrides-by-client [a client-id]) (:account/name (accounts a))) :account_type (or (:db/ident (:account/type (accounts a))) ({:bank-account-type/check :account-type/asset :bank-account-type/cash :account-type/asset :bank-account-type/credit :account-type/liability} (:db/ident (:bank-account/type (bank-accounts a))))) :numeric_code (or (:account/numeric-code (accounts a)) (:bank-account/numeric-code (bank-accounts a))) :client_id client-id}))) (defn full-ledger-for-client [client-id] (->> (d/query {:query {:find ['?d '?jel '?account '?location '?debit '?credit] :in ['$ '?client-id] :where '[[?e :journal-entry/client ?client-id] [?e :journal-entry/date ?d] [?e :journal-entry/line-items ?jel] (or-join [?e] (and [?e :journal-entry/original-entity ?i] (or-join [?e ?i] (and [?i :transaction/bank-account ?b] (or [?b :bank-account/include-in-reports true] (not [?b :bank-account/include-in-reports]))) (not [?i :transaction/bank-account]))) (not [?e :journal-entry/original-entity ])) [(get-else $ ?jel :journal-entry-line/account :account/unknown) ?account] [(get-else $ ?jel :journal-entry-line/debit 0.0) ?debit ] [(get-else $ ?jel :journal-entry-line/credit 0.0) ?credit] [(get-else $ ?jel :journal-entry-line/location "") ?location]] } :args [(d/db (d/connect uri)) client-id]}) (sort-by first))) (defn get-balance-sheet [context args _] (let [client-id (:client_id args) _ (assert-can-see-client (:id context) client-id) end-date (coerce/to-date (:date args)) comparable-date (coerce/to-date (:comparison_date args)) all-ledger-entries (full-ledger-for-client client-id) lookup-account (build-account-lookup client-id)] (log/info "Running balance sheet with " args) (cond-> {:balance-sheet-accounts (roll-up-until lookup-account all-ledger-entries end-date)} (:include_comparison args) (assoc :comparable-balance-sheet-accounts (roll-up-until lookup-account all-ledger-entries comparable-date)) true ->graphql))) (defn get-profit-and-loss [context args _] (let [client-id (:client_id args) client-ids (or (some-> client-id vector) (filter identity (:client_ids args))) _ (when (not (seq client-ids)) (throw (ex-info "Please select a client." {:validation-error "Please select a client."}))) _ (doseq [client-id client-ids] (assert-can-see-client (:id context) client-id)) all-ledger-entries (->> client-ids (map (fn [client-id] [client-id (full-ledger-for-client client-id)])) (into {})) lookup-account (->> client-ids (map (fn [client-id] [client-id (build-account-lookup client-id)])) (into {}))] (->graphql {:periods (->> (:periods args) (mapv (fn [{:keys [start end]}] {:accounts (mapcat #(roll-up-until (lookup-account %) (all-ledger-entries %) (coerce/to-date end) (coerce/to-date start) ) client-ids)})))}))) (defn profit-and-loss-pdf [context args value] (let [data (get-profit-and-loss context args value) result (print-pnl (:id context) args data)] (->graphql result))) (defn assoc-error [f] (fn [entry] (try (f entry) (catch Exception e (log/warn (.getMessage e)) (assoc entry :error (.getMessage e) :status (or (:status (ex-data e)) :error)))))) (defn delete-external-ledger [context args _] (let [_ (assert-admin (:id context)) args (assoc args :id (:id context)) ids (some-> (:filters args) (assoc :only-external true) (<-graphql) (assoc :per-page Integer/MAX_VALUE) (#(l/raw-graphql-ids (d/db conn) %)) :ids) specific-ids (l/filter-ids (:ids args)) all-ids (into (set ids) specific-ids)] (if (> (count all-ids) 1000) {:message (str "You can only delete 1000 ledger entries at a time.")} (do (log/info "Deleting " (count all-ids) args) (audit-transact-batch (map (fn [i] [:db/retractEntity i]) all-ids) (:id context)) {:message (str "Succesfully deleted " (count all-ids) " ledger entries.")})))) (defn import-ledger [context args _] (assert-admin (:id context)) (lc/with-context {:area "import ledger"} (let [all-vendors (by :vendor/name (d-vendors/get-graphql {})) all-clients (by :client/code (d-clients/get-all )) all-client-bank-accounts (reduce (fn [acc client] (assoc acc (:client/code client) (set (->> (:client/bank-accounts client) (map :bank-account/code) )))) {} (d-clients/get-all)) all-client-locations (reduce (fn [acc client] (assoc acc (:client/code client) (-> (set (:client/locations client)) (conj "HQ") (conj "A")))) {} (d-clients/get-all)) new-hidden-vendors (reduce (fn [new-vendors {:keys [vendor_name]}] (if (or (all-vendors vendor_name) (new-vendors vendor_name)) new-vendors (assoc new-vendors vendor_name {:vendor/name vendor_name :vendor/hidden true :db/id vendor_name}))) {} (:entries args)) _ (audit-transact-batch (vec (vals new-hidden-vendors)) (:id context)) all-vendors (by :vendor/name (d-vendors/get-graphql {})) all-accounts (transduce (map (comp str :account/numeric-code)) conj #{} (a/get-accounts)) transaction (doall (map (assoc-error (fn [entry] (let [vendor (all-vendors (:vendor_name entry))] (when-not (all-clients (:client_code entry)) (throw (ex-info (str "Client '" (:client_code entry )"' not found.") {:status :error}) )) (when-not vendor (throw (ex-info (str "Vendor '" (:vendor_name entry) "' not found.") {:status :error}))) (when-not (re-find #"\d{1,2}/\d{1,2}/\d{4}" (:date entry)) (throw (ex-info (str "Date must be MM/dd/yyyy") {:status :error}))) (when-not (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line_items entry))) (reduce (fnil + 0.0 0.0) 0.0 (map :credit (:line_items entry)))) (throw (ex-info (str "Debits '" (reduce (fnil + 0.0 0.0) 0 (map :debit (:line_items entry))) "' and credits '" (reduce (fnil + 0.0 0.0) 0 (map :credit (:line_items entry))) "' do not add up.") {:status :error}))) (when (dollars= (reduce (fnil + 0.0 0.0) 0.0 (map :debit (:line_items entry))) 0.0) (throw (ex-info (str "Cannot have ledger entries that total $0.00") {:status :ignored}))) (assoc entry :status :success :tx (remove-nils {:journal-entry/source (:source entry) :journal-entry/client [:client/code (:client_code entry)] :journal-entry/date (coerce/to-date (parse/parse-value :clj-time "MM/dd/yyyy" (:date entry))) :journal-entry/external-id (:external_id entry) :journal-entry/vendor (:db/id (all-vendors (:vendor_name entry))) :journal-entry/amount (:amount entry) :journal-entry/note (:note entry) :journal-entry/cleared-against (:cleared_against entry) :journal-entry/line-items (mapv (fn [ea] (let [debit (or (:debit ea) 0.0) credit (or (:credit ea) 0.0)] (when (and (not (get (get all-client-locations (:client_code entry)) (:location ea))) (not= "A" (:location ea))) (throw (ex-info (str "Location '" (:location ea) "' not found.") {:status :error}))) (when (and (<= debit 0.0) (<= credit 0.0)) (throw (ex-info (str "Line item amount " (or debit credit) " must be greater than 0.") {:status :error}))) (when (and (not (all-accounts (:account_identifier ea))) (not (get (get all-client-bank-accounts (:client_code entry)) (:account_identifier ea)))) (throw (ex-info (str "Account '" (:account_identifier ea) "' not found.") {:status :error}))) (let [matching-account (when (re-matches #"^[0-9]+$" (:account_identifier ea)) (a/get-account-by-numeric-code-and-sets (Integer/parseInt (:account_identifier ea)) ["default"]))] (when (and matching-account (:account/location matching-account) (not= (:account/location matching-account) (:location ea))) (throw (ex-info (str "Account '" (:account/numeric-code matching-account) "' requires location '" (:account/location matching-account) "' but got '" (:location ea) "'") {:status :error}))) (when (and matching-account (not (:account/location matching-account)) (= "A" (:location ea))) (throw (ex-info (str "Account '" (:account/numeric-code matching-account) "' cannot use location '" (:location ea) "'") {:status :error}))) (remove-nils (cond-> {:journal-entry-line/location (:location ea) :journal-entry-line/debit (when (> debit 0) debit) :journal-entry-line/credit (when (> credit 0) credit)} matching-account (assoc :journal-entry-line/account (:db/id matching-account)) (not matching-account) (assoc :journal-entry-line/account [:bank-account/code (:account_identifier ea)])))))) (:line_items entry)) :journal-entry/cleared true}))))) (:entries args))) errors (filter #(= (:status %) :error) transaction) ignored (filter #(= (:status %) :ignored) transaction) success (filter #(= (:status %) :success) transaction) retraction (mapv (fn [x] [:db/retractEntity [:journal-entry/external-id (:external_id x)]]) success) ignore-retraction (->> ignored (map :external_id ) (d/q '[:find [?je ...] :in $ [?ei ...] :where [?je :journal-entry/external-id ?ei]] (d/db conn) ) (map (fn [je] [:db/retractEntity je])))] (log/info "manual ledger import has " (count success) " new rows") (log/info errors) (audit-transact-batch retraction (:id context)) (when (seq ignore-retraction) (audit-transact-batch ignore-retraction (:id context))) #_(log/info (map :tx success)) (audit-transact-batch (map :tx success) (:id context)) {:successful (map (fn [x] {:external_id (:external_id x)}) success) :ignored (map (fn [x] {:external_id (:external_id x)}) ignored) :existing [] :errors (map (fn [x] {:external_id (:external_id x) :error (:error x)}) errors)}))) (defn build-running-balance ([lookup-account all-ledger-entries] (->> all-ledger-entries (reduce (fn [[rollup cache] [_ _ jel account location debit credit]] (let [rollup (-> rollup (update-in [[location account] :debit] (fnil + 0.0) debit) (update-in [[location account] :credit] (fnil + 0.0) credit) (update-in [[location account] :count] (fnil + 0) 1))] [rollup (assoc cache jel (assoc (get rollup [location account]) :account-id account))])) [{} {}]) (second) (reduce-kv (fn [acc jel {:keys [debit credit account-id]}] (let [account (lookup-account account-id) account-type (:account_type account)] (assoc acc jel (if account-type (if (#{:account-type/asset :account-type/dividend :account-type/expense} account-type) (- debit credit) (- credit debit)) 0.0)))) {})))) (defn running-balance-for [client-id] (let [lookup-account (build-account-lookup client-id)] (->> (d/query {:query {:find ['?d '?e '?jel '?account '?location '?debit '?credit] :in ['$ '?client-id] :where '[[?e :journal-entry/client ?client-id] [?e :journal-entry/date ?d] [?e :journal-entry/line-items ?jel] (or-join [?e] (and [?e :journal-entry/original-entity ?i] (or-join [?e ?i] (and [?i :transaction/bank-account ?b] (or [?b :bank-account/include-in-reports true] (not [?b :bank-account/include-in-reports]))) (not [?i :transaction/bank-account]))) (not [?e :journal-entry/original-entity ])) [(get-else $ ?jel :journal-entry-line/account :account/unknown) ?account] [(get-else $ ?jel :journal-entry-line/debit 0.0) ?debit ] [(get-else $ ?jel :journal-entry-line/credit 0.0) ?credit] [(get-else $ ?jel :journal-entry-line/location "") ?location]] } :args [(d/db conn) client-id]}) (sort-by (juxt first second)) (build-running-balance lookup-account)))) (def last-run-running-balance (atom nil)) (defn build-running-balance-cache [] (let [clients-needing-refresh (if-let [last-run @last-run-running-balance] (->> (d/query {:query {:find ['?v] :in ['$ '?log '?since '?till] :where ['[(tx-ids ?log ?since ?till) [?tx ...]] '[$ _ :journal-entry/client ?v ?tx]]} :args [(d/history (d/db conn)) (d/log conn) last-run (java.util.Date.)]}) (map first) (into #{})) (into #{} (map :db/id (d-clients/get-all)))) starting (java.util.Date.)] (log/info (count clients-needing-refresh) "Clients need their balance cache refreshed.") (swap! running-balance-cache merge (reduce (fn [acc client] (log/info "Computing running balance cache for " (:client/code (d/entity (d/db conn) client))) (assoc acc client (running-balance-for client))) {} clients-needing-refresh)) (log/info "Done refreshing " (count clients-needing-refresh) " client caches") (reset! last-run-running-balance starting))) (defn refresh-running-balance-cache [] (lc/with-context {:source "running-balance-cache"} (try (log/info "Refreshing running balance cache") (build-running-balance-cache) (catch Exception e (log/error e))))) (mount/defstate running-balance-cache-worker :start (scheduler/every (* 15 60 1000) refresh-running-balance-cache) :stop (scheduler/stop running-balance-cache-worker)) (def objects {:balance_sheet_account {:fields {:id {:type 'String} :amount {:type 'String} :location {:type 'String} :client_id {:type :id} :count {:type 'Int} :numeric_code {:type 'Int} :account_type {:type :account_type} :name {:type 'String}}} :profit_and_loss_pdf {:fields {:url {:type 'String} :name {:type 'String}}} :balance_sheet {:fields {:balance_sheet_accounts {:type '(list :balance_sheet_account)} :comparable_balance_sheet_accounts {:type '(list :balance_sheet_account)}}} :profit_and_loss_report_period {:fields {:accounts {:type '(list :balance_sheet_account)}}} :profit_and_loss_report {:fields {:periods {:type '(list :profit_and_loss_report_period)}}} :journal_entry_line {:fields {:id {:type :id} :account {:type :account} :location {:type 'String} :debit {:type 'String} :credit {:type 'String} :running_balance {:type :money}}} :journal_entry {:fields {:id {:type :id} :source {:type 'String} :external_id {:type 'String} :original_entity {:type :id} :amount {:type 'String} :note {:type 'String} :cleared_against {:type 'String} :client {:type :client} :vendor {:type :vendor} :alternate_description {:type 'String} :date {:type 'String} :line_items {:type '(list :journal_entry_line)}}} :ledger_page {:fields {:journal_entries {:type '(list :journal_entry)} :count {:type 'Int} :total {:type 'Int} :start {:type 'Int} :end {:type 'Int}}} :import_ledger_entry_result {:fields {:external_id {:type 'String} :error {:type 'String} :status {:type 'String}}} :import_ledger_result {:fields {:successful {:type '(list :import_ledger_entry_result)} :existing {:type '(list :import_ledger_entry_result)} :ignored {:type '(list :import_ledger_entry_result)} :errors {:type '(list :import_ledger_entry_result)}}}}) (def queries {:balance_sheet {:type :balance_sheet :args {:client_id {:type :id} :include_comparison {:type 'Boolean} :date {:type :iso_date} :comparison_date {:type :iso_date}} :resolve :get-balance-sheet} :profit_and_loss {:type :profit_and_loss_report :args {:client_id {:type :id} :client_ids {:type '(list :id)} :periods {:type '(list :date_range)} :include_deltas {:type 'Boolean}} :resolve :get-profit-and-loss} :profit_and_loss_pdf {:type :profit_and_loss_pdf :args {:client_id {:type :id} :client_ids {:type '(list :id)} :periods {:type '(list :date_range)} :include_deltas {:type 'Boolean}} :resolve :profit-and-loss-pdf} :ledger_page {:type :ledger_page :args {:filters {:type :ledger_filters}} :resolve :get-ledger-page}}) (def mutations {:import_ledger {:type :import_ledger_result :args {:entries {:type '(list :import_ledger_entry)}} :resolve :mutation/import-ledger} :delete_external_ledger {:type :message :args {:filters {:type :ledger_filters} :ids {:type '(list :id)}} :resolve :mutation/delete-external-ledger}}) (def input-objects {:ledger_filters {:fields {:client_id {:type :id} :vendor_id {:type :id} :account_id {:type :id} :amount_lte {:type :money} :amount_gte {:type :money} :bank_account_id {:type :id} :date_range {:type :date_range} :location {:type 'String} :from_numeric_code {:type 'Int} :to_numeric_code {:type 'Int} :start {:type 'Int} :per_page {:type 'Int} :only_external {:type 'Boolean} :external_id_like {:type 'String} :source {:type 'String} :sort {:type '(list :sort_item)}}} :import_ledger_line_item {:fields {:account_identifier {:type 'String} :location {:type 'String} :debit {:type :money} :credit {:type :money}}} :import_ledger_entry {:fields {:source {:type 'String} :external_id {:type 'String} :client_code {:type 'String} :date {:type 'String} :vendor_name {:type 'String} :amount {:type :money} :note {:type 'String} :cleared_against {:type 'String} :line_items {:type '(list :import_ledger_line_item)}}} }) (def enums {:payment_type {:values [{:enum-value :check} {:enum-value :cash} {:enum-value :debit} {:enum-value :credit}]} :payment_status {:values [{:enum-value :voided} {:enum-value :pending} {:enum-value :cleared}]}}) (def resolvers {:get-ledger-page get-ledger-page :get-balance-sheet get-balance-sheet :get-profit-and-loss get-profit-and-loss :profit-and-loss-pdf profit-and-loss-pdf :mutation/delete-external-ledger delete-external-ledger :mutation/import-ledger import-ledger}) (defn attach [schema] (-> (merge-with merge schema {:objects objects :queries queries :mutations mutations :input-objects input-objects :enums enums}) (attach-resolvers resolvers)))