Keep track of last displayed value.

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)))))
 
  )

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)

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))

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)))