timeliner/process-financisto.lisp

(defvar *financisto-backup-path* #P"/home/enikesha/dev/lisp/timeliner/")

(defun find-last-backup ()
  (first (sort (mapcar #'namestring
                       (directory
                        (make-pathname
                         :name :wild
                         :type "backup"
                         :defaults *financisto-backup-path*)))
               #'string>)))

(defun starts-with (str with)
  (string= (subseq str 0 (min (length str)
                              (length with)))
           with))

(defmacro aget (key alist)
  `(cdr (assoc ,key ,alist :test #'string=)))

(defun make-keyword (name) (values (intern (string-upcase name) "KEYWORD")))

(defun load-backup (filename)
  (gzip-stream:with-open-gzip-file (stream filename)
    (setq stream (flexi-streams:make-flexi-stream stream :external-format :utf-8))
    (loop
       for line = (read-line stream nil)
       with data = (make-hash-table :test 'equal) and table and entity and table-name
       while line
       do (cond
            ((starts-with line "$ENTITY:")
             (setf table-name (subseq line 8)
                   table (gethash table-name data (make-hash-table :test 'equal))
                   (gethash table-name data) table
                   entity nil))
            ((string= line "$$")
             (if (getf entity :-id)
                 (setf (gethash (parse-integer (getf entity :-id)) table) entity
                       table-name nil)
                 (progn
                   (when (eql (type-of table) 'hash-table)
                     (setf table nil))
                   (setf (gethash table-name data) (push entity table)
                         table-name nil))))
            (table-name (let ((i (position #\: line)))
                          (setf (getf entity (make-keyword (substitute #\- #\_ (subseq line 0 i))))
                                (subseq line (1+ i))))))
       finally (return data))))

(defun make-finance-doc (e db balances)
  (let* ((accounts (gethash "account" db))
         (currencies (gethash "currency" db))
         (from-account (gethash (parse-integer (getf e :from-account-id)) accounts))
         (from-currency (gethash (parse-integer (getf from-account :currency-id)) currencies))
         (from-decimals (expt 10 (parse-integer (getf from-currency :decimals))))
         (from-amount (float (/ (parse-integer (getf e :from-amount)) from-decimals)))
         (from-balance (float (/ (gethash (parse-integer (getf from-account :-id)) balances 0) from-decimals)))
         (spend (< from-amount 0))         
         (original-currency (gethash (parse-integer (getf e :original-currency-id)) currencies))
         (original-from-amount (and original-currency
                                    (float (/ (parse-integer (getf e :original-from-amount))
                                              (expt 10 (parse-integer (getf original-currency :decimals)))))))
         (payee (gethash (parse-integer (getf e :payee-id)) (gethash "payee" db)))
         (category (gethash (parse-integer (getf e :category-id)) (gethash "category" db)))
         
         (to-account (gethash (parse-integer (getf e :to-account-id)) accounts))
         (to-currency (and to-account (gethash (parse-integer (getf to-account :currency-id)) currencies)))
         (to-decimals (and to-account (expt 10 (parse-integer (getf to-currency :decimals)))))
         (to-amount (and to-account (float (/ (parse-integer (getf e :to-amount)) to-decimals))))
         (to-balance (and to-account (float (/ (gethash (parse-integer (getf to-account :-id)) balances 0) to-decimals))))

         (transfer (cond
                     ((and to-account (equal (getf from-account :type)
                                             "LIABILITY")
                           (< from-balance 0)) :borrow)
                     ((and to-account (equal (getf to-account :type)
                                             "LIABILITY")
                           (<= to-balance 0)) :repay)
                     ((and to-account (equal (getf to-account :type)
                                             "LIABILITY")
                           (> to-balance 0)) :lend)
                     ((and to-account (equal (getf from-account :type)
                                             "LIABILITY")
                           (>= from-balance 0)) :repaid)
                     (to-account :transfer)
                     (t nil)))
         (title (if transfer
                    (format
                     nil "~A ~$~A from ~A (bal ~$~A) to ~A~:[~*~;~:* ~$~A~] (bal ~$~A)~@[ (~A)~]"
                     (ecase transfer
                       (:borrow "Borrowed")
                       (:repay "Repaid")
                       (:lend "Lend")
                       (:repaid "Got repaid")
                       (:transfer "Transferred"))
                     (abs from-amount) (getf from-currency :symbol)
                     (getf from-account :title)
                     from-balance (getf from-currency :symbol)
                     (getf to-account :title)
                     (and (not (equal (getf from-account :currency-id)
                                      (getf to-account :currency-id)))
                          (abs to-amount))
                     (getf to-currency :symbol)
                     to-balance (getf to-currency :symbol)                    
                     (getf e :note))
                    (format
                     nil "~A ~$~A~:[~*~;~:* (~$~A)~] ~A ~A~@[ for ~A~]~@[ at ~A~]~@[ (~A)~]. Balance ~$~A"
                     (if spend "Spend" "Earned")
                     (abs from-amount) (getf from-currency :symbol)
                     (and original-from-amount (abs original-from-amount))
                     (getf original-currency :symbol)
                     (if spend "from" "to")
                     (getf from-account :title)
                     (and category (not (equal (getf category :-id) "0")) (getf category :title))
                     (and payee (getf payee :title))
                     (getf e :note)
                     from-balance (getf from-currency :symbol))))
         (type (if transfer (string-downcase (string transfer)) (if spend "spend" "earned")))
         (financisto (if transfer
                         (kv "transfer" (kv
                                         (kv "from_account" (getf from-account :title))
                                         (kv "from_amount" from-amount)
                                         (kv "from_currency" (getf from-currency :name))
                                         (kv "from_balance" from-balance)
                                         (kv "to_account" (getf to-account :title))
                                         (kv "to_amount" to-amount)
                                         (kv "to_currency" (getf to-currency :name))
                                         (kv "to_balance" to-balance)))
                         (kv "transaction" (kv
                                            (kv "account" (getf from-account :title))
                                            (kv "amount" from-amount)
                                            (kv "currency" (getf from-currency :name))
                                            (kv "balance" from-balance)
                                            (kv "original_amount" original-from-amount)
                                            (kv "original_currency" (getf original-currency :name)))))))
    (kv
     (kv "ts" (parse-integer (getf e :datetime)))
     (kv "type" "finance")
     (kv "title" title)
     (kv "financisto"
         (kv
          (kv "id" (parse-integer (getf e :-id)))
          (kv "type" type)
          (kv "payee" (getf payee :title))
          (kv "category" (and category (not (equal (getf category :-id) "0")) (getf category :title)))
          (kv "note" (getf e :note))
          financisto)))))

(defun financisto-import ()
  (let* ((filename (find-last-backup))
         (db (load-backup filename))
         (transactions (sort (loop for entity being the hash-values of (gethash "transactions" db)
                                when (not (string= (getf entity :category-id) "-1"))
                                collect entity)
                             #'<
                             :key #'(lambda (i) (parse-integer (getf i :datetime)))))
         (balances (make-hash-table :size (hash-table-count (gethash "account" db)))))
    (format t "Got ~A with ~A transactions~%" filename (length transactions))
    (dolist (entity transactions)
      (destructuring-bind (&key from-account-id from-amount
                                to-account-id to-amount
                                -id datetime
                                &allow-other-keys) entity
        (incf (gethash (parse-integer from-account-id) balances 0) (parse-integer from-amount))
        (when (not (string= to-account-id "0"))
          (incf (gethash (parse-integer to-account-id) balances 0) (parse-integer to-amount)))
        (let* ((new-doc (make-finance-doc entity db balances))
               (existing-doc (first (docs (db.find "events"
                                                   (kv ($ "type" "finance")
                                                       ($ "financisto.id" (parse-integer -id)))))))
               (new-ts (parse-integer datetime)))
          (cl-mongo::kv-container-add
           (kv "loc"
               (if (and existing-doc (= new-ts (get-element "ts" existing-doc)))
                   (get-element "loc" existing-doc)
                   (point->doc (find-location-at new-ts))))
           new-doc)
          (if existing-doc
              (progn
                (cl-mongo::kv-container-add (kv "_id" (doc-id existing-doc)) new-doc)
                (db.save "events" new-doc))
              (db.insert "events" new-doc)))))))