tag parsing, additional public functions

package.lisp

@@ -28,6 +28,8 @@
            #:parse-journal
            #:parse-query
            #:entries
+           #:get-amounts
+           #:account-parents
            #:balance
            #:format-balance
            #:journal-balance

parsing.lisp

@@ -19,6 +19,9 @@
 (defun .chars (&rest chars)
   (.is #'member chars))
 
+(defun .true (value)
+  (if value (.identity value) (.fail)))
+
 ;; optimized (.first (.map 'list parser at-least))
 (defun .while (parser &key result-type (at-least 1))
   (lambda (input)
@@ -286,15 +289,22 @@
           (value value-parser))
     (.identity (cons type
                      #'(lambda (entry posting)
-                         (let ((key-value (funcall key entry posting)))
-                           (or (eql key-value :t)
-                               (funcall value key-value))))))))
+                         (some #'(lambda (kv)
+                                   (or (eql kv :t)
+                                       (funcall value kv)))
+                               (funcall key entry posting)))))))
 
 (defun .query-entryp (prefix key)
-  (.progn (.string= prefix) (.identity #'(lambda (e p) (declare (ignore p)) (funcall key e)))))
+  (.progn (.string= prefix) (.identity #'(lambda (e p) (declare (ignore p)) (list (funcall key e))))))
 
 (defun .query-postingp (prefix key)
-  (.progn (.string= prefix) (.identity #'(lambda (e p) (declare (ignore e)) (funcall key p)))))
+  (.progn (.string= prefix) (.identity #'(lambda (e p) (declare (ignore e)) (list (funcall key p))))))
+
+(defun .query-bothp (prefix entry-key posting-key)
+  (.progn (.string= prefix)
+          (.identity #'(lambda (e p)
+                         (list (funcall entry-key e)
+                               (funcall posting-key p))))))
 
 (defun .query-value-regex ()
   (.let* ((regex (.until (.eol) :result-type 'string)))
@@ -305,6 +315,18 @@
       (error ()
         (.fail)))))
 
+(defun .query-value-tag-regex ()
+  (.let* ((tag-name (.until (.or (.char= #\:) (.eol)) :result-type 'string))
+          (tag-value (.optional (.progn (.char= #\:)
+                                        (.until (.eol) :result-type 'string :at-least 0)))))
+    (handler-case
+        (let ((matcher (cl-ppcre:create-scanner (format nil "~A:~@[\\s*~A~]" tag-name tag-value)
+                                                :case-insensitive-mode t)))
+          (.identity #'(lambda (value)
+                         (cl-ppcre:scan matcher value))))
+      (error ()
+        (.fail)))))
+
 (defun .query-value-amount ()
   (.let* ((op (.or (.string= ">=")
                    (.string= "<=")
@@ -314,7 +336,7 @@
                    (.identity #\=)))
           (value (.number)))
     (.identity #'(lambda (v)
-                   (funcall (find-symbol (string op)) v value)))))
+                   (funcall (find-symbol (string op)) (abs v) value)))))
 
 (defun .month ()
   (.or (.progn (.or (.string= "january") (.string= "jan")) (.identity 1))
@@ -381,7 +403,15 @@
                                                          0 2))))
                 (.smart-range (.progn (.string= "week")
                                       (.identity (week-start-date now offset)))
-                              (* +day+ 7)))))))
+                              (* +day+ 7))
+                (.progn (.true (= offset -1)) ;; Only 'lastNdays'
+                        (.let* ((days (.number))
+                                (_ (.optional (.whitespace)))
+                                (_ (.optional (.or (.string= "days")
+                                                   (.string= "day")
+                                                   (.string= "d")))))
+                          (.smart-range (.identity (get-date (- now (* days +day+))))
+                                        (* days +day+)))))))))
 
 (defun .query-value-period ()
   (.let* ((period (.or (.let* ((start (.optional (.smart-date)))
@@ -422,25 +452,25 @@
        (.query-coloned :amt (.progn (.string= "amt")
                                     (.identity
                                      #'(lambda (e p)
-                                         (let ((amounts (get-amounts p (entry-postings e))))
-                                           (if (> (length amounts) 1) :t
-                                               (amount-quantity (car amounts)))))))
+                                         (mapcar #'amount-quantity
+                                                 (get-amounts p (entry-postings e))))))
                        (.query-value-amount))
        (.query-coloned :code (.query-entryp "code" #'entry-code)
                        (.query-value-regex))
        (.query-coloned :cur (.progn (.string= "cur")
                                     (.identity
                                      #'(lambda (e p)
-                                         (get-amounts p (entry-postings e)))))
-                       (.let* ((regexp (.query-value-regex)))
-                         (.identity #'(lambda (amounts)
-                                        (find-if regexp amounts :key #'amount-commodity)))))
+                                         (mapcar #'amount-commodity
+                                                 (get-amounts p (entry-postings e))))))
+                       (.query-value-regex))
        (.query-coloned :desc (.query-entryp "desc" #'entry-description)
                        (.query-value-regex))
        (.query-coloned :date (.query-entryp "date" #'entry-date)
                        (.query-value-period))
-       (.query-coloned :comment (.query-entryp "comment" #'entry-comment)
+       (.query-coloned :comment (.query-bothp "comment" #'entry-comment #'posting-comment)
                        (.query-value-regex))
+       (.query-coloned :tag (.query-bothp "tag" #'entry-comment #'posting-comment)
+                       (.query-value-tag-regex))
        (.let* ((value (.query-value-regex)))
          (.identity (cons :acct
                           #'(lambda (entry posting)

pta-ledger.lisp

@@ -52,7 +52,8 @@
 (defun complement-amounts (postings &optional cost)
   (let ((sum
          (reduce #'add-amounts! postings :initial-value nil
-                 :key #'(lambda (p) (when (posting-amount p)
+                 :key #'(lambda (p) (when (and (posting-amount p)
+                                               (null (posting-virtual p)))
                                       (get-amounts p cost))))))
     (dolist (a sum sum)
       (setf (amount-quantity a)
@@ -97,7 +98,7 @@
      (loop for start = 0 then (1+ pos)
         for pos = (position #\: account :start start)
         while pos collect (subseq account 0 pos)))
-      (list account "TOTALS")))
+   (list account "TOTALS")))
 
 (defun remove-extra-parents! (balance)
   (labels ((find-child (parent amounts)