ledger-xact: Add ledger-xact-fill to insert missing amount

ledger-commodities.el

@@ -115,6 +115,10 @@ directly."
     (list (+ (car c1) (car c2)) (cadr c1)))
    (t (error "Can't add different commodities: %S + %S" c1 c2))))
 
+(defun ledger-negate-commodity (c)
+  "Return the negative of the commoditized amount C."
+  (list (- (car c)) (cadr c)))
+
 (defun ledger-strip (str char)
   "Return STR with CHAR removed."
   (replace-regexp-in-string char "" str))

ledger-post.el

@@ -27,6 +27,10 @@
 (require 'ledger-navigate)
 
 (declare-function calc-renumber-stack "calc" ())
+(declare-function ledger-add-commodity "ledger-commodities" (c1 c2))
+(declare-function ledger-commodity-to-string "ledger-commodities" (c1))
+(declare-function ledger-negate-commodity "ledger-commodities" (c))
+(declare-function ledger-split-commodity-string "ledger-commodities" (str))
 (declare-function ledger-string-to-number "ledger-commodities" (str &optional decimal-comma))
 
 ;;; Code:
@@ -188,6 +192,56 @@ the amount and return to ledger."
       (push-mark (point) 'nomsg)
       (calc))))
 
+(defun ledger-post-xact-total ()
+  "Return (TOTAL . MISSING-POSITIONS) for the transaction at point.
+
+TOTAL is a commoditized amount representing the total amount of
+the postings in the transaction.
+
+MISSING-POSITIONS is a list of positions in the buffer where the
+transaction do not have an amount specified (such postings do not
+contribute to TOTAL).  Specifically, the positions are at the end
+of the account name on such posting lines.
+
+Error if the commodities do not match."
+  (save-excursion
+    (pcase-let ((`(,begin ,end) (ledger-navigate-find-xact-extents (point))))
+      (goto-char begin)
+      (cl-loop
+       while (re-search-forward ledger-post-line-regexp end t)
+       for account-end = (match-end ledger-regex-post-line-group-account)
+       for amount-string = (when-let ((amount-string (match-string ledger-regex-post-line-group-amount)))
+                             (unless (string-empty-p (string-trim amount-string))
+                               amount-string))
+       if (not amount-string)
+       collect account-end into missing-positions
+       else
+       collect (ledger-split-commodity-string amount-string) into amounts
+       finally return (cons (if amounts
+                                (cl-reduce #'ledger-add-commodity amounts)
+                              '(0 nil))
+                            missing-positions)))))
+
+(defun ledger-post-fill ()
+  "Find a posting with no amount and insert it.
+
+Even if ledger allows for one missing amount per transaction, you
+might want to insert it anyway."
+  (interactive)
+  (pcase-let* ((`(,total . ,missing-positions) (ledger-post-xact-total))
+               (missing-amount (ledger-negate-commodity total))
+               (amounts-balance (< (abs (car missing-amount)) 0.0001)))
+    (pcase missing-positions
+      ('() (unless amounts-balance
+             (user-error "Postings do not balance, but no posting to fill")))
+      (`(,missing-pos)
+       (if amounts-balance
+           (user-error "Missing amount but amounts balance already")
+         (goto-char missing-pos)
+         (insert "  " (ledger-commodity-to-string missing-amount))
+         (ledger-post-align-xact (point))))
+      (_ (user-error "More than one posting with missing amount")))))
+
 (provide 'ledger-post)
 
 

test/post-test.el

@@ -454,6 +454,209 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=946"
 " ))))
 
 
+(ert-deftest ledger-post/test-post-xact-total-001 ()
+  "Basic functionality test for `ledger-post-xact-total'."
+  :tags '(post)
+
+  ;; one amount missing
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Assets:Bar
+"
+
+    (should
+     (equal (ledger-post-xact-total)
+            '((10 "$") . (83)))))
+
+  ;; one amount missing with trailing spaces
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Assets:Bar       \n"
+
+    (should
+     (equal (ledger-post-xact-total)
+            '((10 "$") . (83)))))
+
+  ;; all amounts missing
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo
+    Assets:Bar
+"
+
+    (should
+     (equal (ledger-post-xact-total)
+            '((0 nil) . (32 47)))))
+
+  ;; no amounts missing
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo     $10
+    Assets:Bar      $-10
+"
+
+    (should
+     (equal (ledger-post-xact-total)
+            '((0 "$") . nil)))))
+
+
+(ert-deftest ledger-post/test-post-xact-total-002 ()
+  "`ledger-post-xact-total' error cases."
+  :tags '(post)
+
+  ;; mismatched commodities
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Expenses:Baz                                  10 €
+    Assets:Bar
+"
+    (should (string-prefix-p
+             "Can’t add different commodities"
+             (cadr (should-error (ledger-post-xact-total)))))))
+
+
+(ert-deftest ledger-post/test-post-fill-001 ()
+  "Basic functionality test for `ledger-post-fill'."
+  :tags '(post)
+
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Assets:Bar
+"
+    (ledger-post-fill)
+    (should
+     (equal (buffer-string)
+            "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Assets:Bar                                 $ -10
+")))
+
+  ;; trailing spaces
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Assets:Bar    \n"
+    (ledger-post-fill)
+    (should
+     (equal (buffer-string)
+            "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Assets:Bar                                 $ -10    \n")))
+
+  ;; no commodity
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                  10
+    Assets:Bar
+"
+    (ledger-post-fill)
+    (should
+     (equal (buffer-string)
+            "\
+2013-05-01 foo
+    Expenses:Foo                                  10
+    Assets:Bar                                   -10
+")))
+
+  ;; does not interfere with comments on posting line
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                  10
+    Assets:Bar  ; Payee: bar
+"
+    (ledger-post-fill)
+    (should
+     (equal (buffer-string)
+            "\
+2013-05-01 foo
+    Expenses:Foo                                  10
+    Assets:Bar                                   -10  ; Payee: bar
+")))
+
+  ;; no posting with missing amounts, but they balance
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Assets:Bar                                  $-10
+"
+    (ledger-post-fill)
+    (should
+     (equal (buffer-string)
+            "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Assets:Bar                                  $-10
+"))))
+
+
+(ert-deftest ledger-post/test-post-fill-002 ()
+  "`ledger-post-fill' error cases."
+  :tags '(post)
+
+  ;; mismatched commodities
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Expenses:Baz                                  10 €
+    Assets:Bar
+"
+    (should (string-prefix-p
+             "Can’t add different commodities"
+             (cadr (should-error (ledger-post-fill))))))
+
+  ;; more than one missing amount
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Expenses:Baz
+    Assets:Bar
+"
+    (should (string-equal
+             (cadr (should-error (ledger-post-fill)))
+             "More than one posting with missing amount")))
+
+  ;; no missing amount, and amounts don't balance
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $10
+    Expenses:Baz                                  $5
+"
+    (should (string-equal
+             (cadr (should-error (ledger-post-fill)))
+             "Postings do not balance, but no posting to fill")))
+
+  ;; missing amount but amounts balance already
+  (ledger-tests-with-temp-file
+      "\
+2013-05-01 foo
+    Expenses:Foo                                 $-10
+    Expenses:Baz                                  $5
+    Expenses:Bar                                  $5
+    Expenses:Bla
+"
+    (should (string-equal
+             (cadr (should-error (ledger-post-fill)))
+             "Missing amount but amounts balance already"))))
+
 (provide 'post-test)
 
 ;;; post-test.el ends here