From ca1270d7aec342c3c12ffa65af9b1d3114423898 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 30 Mar 2023 21:15:00 +0200 Subject: [PATCH] Keep track of last displayed value. --- bank-fio.scm | 25 ++++++++++++++----------- csv-simple.scm | 15 +++++++++++++-- members-base.scm | 2 +- progress.scm | 9 ++++++--- 4 files changed, 34 insertions(+), 17 deletions(-) diff --git a/bank-fio.scm b/bank-fio.scm index 815ecb8..066eafc 100644 --- a/bank-fio.scm +++ b/bank-fio.scm @@ -35,7 +35,8 @@ (chicken base) (chicken irregex) bank-account - csv-simple) + csv-simple + progress) ;; Converts Fio account statement transaction row into standardized ;; bank transaction structure. @@ -52,15 +53,17 @@ ;; Loads Fio bank accound statement. (define (bank-fio-parse fn) - (let* ((csv (csv-parse fn)) - (head+body (csv-split-header csv)) - (head (car head+body)) - (body (cadr head+body)) - (numrow (assoc "accountId" head)) - (num (if numrow (cadr numrow) "ERROR")) - (bankrow (assoc "bankId" head)) - (bank (if bankrow (cadr bankrow) "ERROR"))) - (make-bank-account num bank - (map make-fio-transaction body)))) + (with-progress% + #t fn + (let* ((csv (csv-parse fn)) + (head+body (csv-split-header csv)) + (head (car head+body)) + (body (cadr head+body)) + (numrow (assoc "accountId" head)) + (num (if numrow (cadr numrow) "ERROR")) + (bankrow (assoc "bankId" head)) + (bank (if bankrow (cadr bankrow) "ERROR"))) + (make-bank-account num bank + (map make-fio-transaction body))))) ) diff --git a/csv-simple.scm b/csv-simple.scm index 52ca827..886bb81 100644 --- a/csv-simple.scm +++ b/csv-simple.scm @@ -85,8 +85,19 @@ (let* ((separator (get-keyword #:separator args (lambda () ";"))) (string-delimiter (get-keyword #:string-delimiter args (lambda () "\""))) (lines (read-lines (open-input-file fn))) - (csv-parse-line (make-csv-line-parser separator string-delimiter))) - (map csv-parse-line lines))) + (csv-parse-line (make-csv-line-parser separator string-delimiter)) + (total (max (sub1 (length lines)) 1))) + (let loop ((lines lines) + (idx 0) + (res '())) + (if (null? lines) + (reverse res) + (let ((line (car lines))) + (progress%-advance (/ idx total)) + (loop (cdr lines) + (add1 idx) + (cons (csv-parse-line line) + res))))))) ;; Splits CSV into header and body based on the first empty row. (define (csv-split-header csv) diff --git a/members-base.scm b/members-base.scm index 6adcbb8..386f5e0 100644 --- a/members-base.scm +++ b/members-base.scm @@ -71,8 +71,8 @@ (prg 0) (mb0 (dict-map (lambda (symfn symlinks) - (set! prg (add1 prg)) (progress%-advance (/ prg tot)) + (set! prg (add1 prg)) (members-dir-load-member dn symfn symlinks)) diff --git a/progress.scm b/progress.scm index 600c35c..239fc89 100644 --- a/progress.scm +++ b/progress.scm @@ -103,6 +103,7 @@ (define *current-progress%* (make-parameter #f)) (define *current-progress%-echo?* (make-parameter #f)) (define *current-progress%-value* (make-parameter #f)) + (define *current-progress%-last-value* (make-parameter #f)) (define *current-progress%-range* (make-parameter (cons 0 1))) ;; Unconditionally prints the current progress. @@ -117,15 +118,16 @@ (value% (* 100 value)) (ivalue% (inexact->exact (round value%)))) (display - (sprintf "\r[]~A%" ivalue%))))) + (sprintf "\r[]~A% ~A" ivalue% (*current-progress%*)))))) ;; If the new value is different-enough from the current one, updates ;; it and re-prints the progress% (define (progress%-advance new-value) (when (*current-progress%*) - (let ((old-value (*current-progress%-value*))) + (*current-progress%-value* new-value) + (let ((old-value (*current-progress%-last-value*))) (when (>= (abs (- new-value old-value)) (*progress%-step*)) - (*current-progress%-value* new-value) + (*current-progress%-last-value* new-value) (print-current-progress%))))) ;; Procedure realizing the actual progress tracking @@ -133,6 +135,7 @@ (parameterize ((*current-progress%* name) (*current-progress%-echo?* echo?) (*current-progress%-value* 0) + (*current-progress%-last-value* 0) (*current-progress%-range* (cons 0 1))) (print-current-progress%) (let ((result (thunk)))