financisto.lisp 9.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172
  1. (defvar *financisto-backup-path* #P"/home/enikesha/Documents/backups/financisto/")
  2. (defun find-last-backup ()
  3. (first (sort (mapcar #'namestring
  4. (directory
  5. (make-pathname
  6. :name :wild
  7. :type "backup"
  8. :defaults *financisto-backup-path*)))
  9. #'string>)))
  10. (defun load-backup (filename)
  11. (gzip-stream:with-open-gzip-file (stream filename)
  12. (setq stream (flexi-streams:make-flexi-stream stream :external-format :utf-8))
  13. (loop
  14. for line = (read-line stream nil)
  15. with data = (make-hash-table :test 'equal) and table and entity and table-name
  16. while line
  17. do (cond
  18. ((starts-with line "$ENTITY:")
  19. (setf table-name (subseq line 8)
  20. table (gethash table-name data (make-hash-table :test 'equal))
  21. (gethash table-name data) table
  22. entity nil))
  23. ((string= line "$$")
  24. (if (getf entity :-id)
  25. (setf (gethash (parse-integer (getf entity :-id)) table) entity
  26. table-name nil)
  27. (progn
  28. (when (eql (type-of table) 'hash-table)
  29. (setf table nil))
  30. (setf (gethash table-name data) (push entity table)
  31. table-name nil))))
  32. (table-name (let ((i (position #\: line)))
  33. (setf (getf entity (make-keyword (substitute #\- #\_ (subseq line 0 i))))
  34. (subseq line (1+ i))))))
  35. finally (return data))))
  36. (defun make-finance-doc (e db balances)
  37. (let* ((accounts (gethash "account" db))
  38. (currencies (gethash "currency" db))
  39. (from-account (gethash (parse-integer (getf e :from-account-id)) accounts))
  40. (from-currency (gethash (parse-integer (getf from-account :currency-id)) currencies))
  41. (from-decimals (expt 10d0 (parse-integer (getf from-currency :decimals))))
  42. (from-amount (/ (parse-integer (getf e :from-amount)) from-decimals))
  43. (from-balance (/ (gethash (parse-integer (getf from-account :-id)) balances 0) from-decimals))
  44. (spend (< from-amount 0))
  45. (original-currency (gethash (parse-integer (getf e :original-currency-id)) currencies))
  46. (original-from-amount (and original-currency
  47. (/ (parse-integer (getf e :original-from-amount))
  48. (expt 10d0 (parse-integer (getf original-currency :decimals))))))
  49. (payee (gethash (parse-integer (getf e :payee-id)) (gethash "payee" db)))
  50. (category (gethash (parse-integer (getf e :category-id)) (gethash "category" db)))
  51. (to-account (gethash (parse-integer (getf e :to-account-id)) accounts))
  52. (to-currency (and to-account (gethash (parse-integer (getf to-account :currency-id)) currencies)))
  53. (to-decimals (and to-account (expt 10d0 (parse-integer (getf to-currency :decimals)))))
  54. (to-amount (and to-account (/ (parse-integer (getf e :to-amount)) to-decimals)))
  55. (to-balance (and to-account (/ (gethash (parse-integer (getf to-account :-id)) balances 0) to-decimals)))
  56. (transfer (cond
  57. ((and to-account (equal (getf from-account :type)
  58. "LIABILITY")
  59. (< from-balance 0)) :borrow)
  60. ((and to-account (equal (getf to-account :type)
  61. "LIABILITY")
  62. (<= to-balance 0)) :repay)
  63. ((and to-account (equal (getf to-account :type)
  64. "LIABILITY")
  65. (> to-balance 0)) :lend)
  66. ((and to-account (equal (getf from-account :type)
  67. "LIABILITY")
  68. (>= from-balance 0)) :repaid)
  69. (to-account :transfer)
  70. (t nil)))
  71. (title (if transfer
  72. (format
  73. nil "~A ~$~A from ~A (bal ~$~A) to ~A~:[~*~;~:* ~$~A~] (bal ~$~A)~@[ (~A)~]"
  74. (ecase transfer
  75. (:borrow "Borrowed")
  76. (:repay "Repaid")
  77. (:lend "Lend")
  78. (:repaid "Got repaid")
  79. (:transfer "Transferred"))
  80. (abs from-amount) (getf from-currency :symbol)
  81. (getf from-account :title)
  82. from-balance (getf from-currency :symbol)
  83. (getf to-account :title)
  84. (and (not (equal (getf from-account :currency-id)
  85. (getf to-account :currency-id)))
  86. (abs to-amount))
  87. (getf to-currency :symbol)
  88. to-balance (getf to-currency :symbol)
  89. (getf e :note))
  90. (format
  91. nil "~A ~$~A~:[~*~;~:* (~$~A)~] ~A ~A~@[ for ~A~]~@[ at ~A~]~@[ (~A)~]. Balance ~$~A"
  92. (if spend "Spend" "Earned")
  93. (abs from-amount) (getf from-currency :symbol)
  94. (and original-from-amount (abs original-from-amount))
  95. (getf original-currency :symbol)
  96. (if spend "from" "to")
  97. (getf from-account :title)
  98. (and category (not (equal (getf category :-id) "0")) (getf category :title))
  99. (and payee (getf payee :title))
  100. (getf e :note)
  101. from-balance (getf from-currency :symbol))))
  102. (type (if transfer (string-downcase (string transfer)) (if spend "spend" "earned")))
  103. (financisto (if transfer
  104. (kv "transfer" (kv
  105. (kv "from_account" (getf from-account :title))
  106. (kv "from_amount" from-amount)
  107. (kv "from_currency" (getf from-currency :name))
  108. (kv "from_balance" from-balance)
  109. (kv "to_account" (getf to-account :title))
  110. (kv "to_amount" to-amount)
  111. (kv "to_currency" (getf to-currency :name))
  112. (kv "to_balance" to-balance)))
  113. (kv "transaction" (kv
  114. (kv "account" (getf from-account :title))
  115. (kv "amount" from-amount)
  116. (kv "currency" (getf from-currency :name))
  117. (kv "balance" from-balance)
  118. (kv "original_amount" original-from-amount)
  119. (kv "original_currency" (getf original-currency :name)))))))
  120. (kv
  121. (kv "ts" (ms->ts (parse-integer (getf e :datetime))))
  122. (kv "type" "finance")
  123. (kv "title" title)
  124. (kv "financisto"
  125. (kv
  126. (kv "id" (parse-integer (getf e :-id)))
  127. (kv "type" type)
  128. (kv "payee" (getf payee :title))
  129. (kv "category" (and category (not (equal (getf category :-id) "0")) (getf category :title)))
  130. (kv "note" (getf e :note))
  131. financisto)))))
  132. (defun financisto-import ()
  133. (let* ((filename (find-last-backup))
  134. (db (load-backup filename))
  135. (transactions (sort (loop for entity being the hash-values of (gethash "transactions" db)
  136. when (not (string= (getf entity :category-id) "-1"))
  137. collect entity)
  138. #'<
  139. :key #'(lambda (i) (parse-integer (getf i :datetime)))))
  140. (balances (make-hash-table :size (hash-table-count (gethash "account" db)))))
  141. (format t "Got ~A with ~A transactions~%" filename (length transactions))
  142. (dolist (entity transactions)
  143. (destructuring-bind (&key from-account-id from-amount
  144. to-account-id to-amount
  145. -id datetime
  146. &allow-other-keys) entity
  147. (incf (gethash (parse-integer from-account-id) balances 0) (parse-integer from-amount))
  148. (when (not (string= to-account-id "0"))
  149. (incf (gethash (parse-integer to-account-id) balances 0) (parse-integer to-amount)))
  150. (let* ((new-doc (make-finance-doc entity db balances))
  151. (existing-doc (first (docs (db.find "events"
  152. (kv ($ "type" "finance")
  153. ($ "financisto.id" (parse-integer -id)))))))
  154. (new-ts (parse-integer datetime)))
  155. (cl-mongo::kv-container-add
  156. (kv "loc"
  157. (if (and existing-doc (= new-ts (cl-mongo::raw
  158. (get-element "ts" existing-doc))))
  159. (get-element "loc" existing-doc)
  160. (point->doc (find-location-at new-ts))))
  161. new-doc)
  162. (if existing-doc
  163. (progn
  164. (cl-mongo::kv-container-add (kv "_id" (doc-id existing-doc)) new-doc)
  165. (db.save "events" new-doc))
  166. (db.insert "events" new-doc)))))))