;;
;; member-file.scm
;;
;; Member file parsing.
;;
;; ISC License
;;
;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(module
 member-file
 (
  load-member-file
  member-file-tests!
  )

 (import scheme
	 (chicken base)
	 (chicken string)
	 (chicken io)
	 dictionary
	 month
	 period
	 testing)

 ;; Specification of known keys for various types of parsing
 (define known-keys '(nick mail phone name born joined))
 (define start/stop-keys '(student suspend))
 (define multi-keys '(card desfire credit))

 ;; Member File Parser: remove comments from line and return the result
 (define (line-remove-comments l)
   (let ((si (substring-index "#" l)))
     (if si
	 (if (= si 0)
	     ""
	     (car (string-chop l si)))
	 l)))

 ;; Parses given key-value line. Key is up to first space, value is the
 ;; rest of the line. If the line doesn't contain anything, returns #f.
 (define (parse-member-line l)
   (let ((sp (string-split (line-remove-comments l) " ")))
     (and sp
	  (not (null? sp))
	  (list (string->symbol (car sp))
		(string-intersperse (cdr sp))))))

 ;; If given symbol represents start/stop symbol of either kind,
 ;; returns a list of the symbol representing the type and start/stop
 ;; symbol. It returns false otherwise.
 (define (split-start/stop-symbol s)
   (cond ((eq? s 'studentstart) '(student start))
	 ((eq? s 'studentstop) '(student stop))
	 ((eq? s 'suspendstart) '(suspend start))
	 ((eq? s 'suspendstop) '(suspend stop))
	 (else #f)))

 ;; Processes member line adding given value v to the dictionary d
 ;; under key k. Special handling for start/stop symbols means given
 ;; value is prepended to given start/stop key (student/suspend) as
 ;; parsed month for later processing of student/suspend periods.
 (define (process-member-line d k v)
   (let ((ss (split-start/stop-symbol k)))
     (if ss
	 (let ((pk (car ss))
	       (pd (cadr ss))
	       (vl (string-split v " ")))
	   (if (null? vl)
	       (error 'process-member-line "Missing date for start/stop symbol" k)
	       (let ((ds (car vl)))
		 (dict-set d pk
			   (cons (cons pd (string->month ds))
				 (dict-ref d pk '()))))))
	 (case k
	   ((card desfire credit) (dict-set d k (cons v (dict-ref d k '()))))
	   (else
	    (dict-set d k v))))))

 ;; Converts given key in member info dictionary from period markers
 ;; list to periods.
 (define (convert-member-key:markers->periods m k)
   (dict-set m k
	     (period-markers->periods
	      (sort-period-markers
	       (dict-ref m k '())))))

 ;; Converts all given keys using period-markers->periods.
 (define (convert-member-keys:markers->periods m . ks)
   (let loop ((m m)
	      (ks ks))
     (if (null? ks)
	 m
	 (loop (convert-member-key:markers->periods m (car ks))
	       (cdr ks)))))

 ;; Fills-in the defaults
 (define (make-default-member-info)
   (dict-set
    (make-dict)
    'joined
    "2015-01"))

 ;; Processes all lines and returns a dictionary representing given
 ;; member. 
 (define (parse-member-lines ls)
   (let loop ((ls ls)
	      (r (make-default-member-info))
	      (line-number 1))
     (if (null? ls)
	 (convert-member-keys:markers->periods r 'suspend 'student)
	 (let ((p (parse-member-line (car ls))))
	   (loop (cdr ls)
		 (if p
		     (apply process-member-line r p)
		     r)
		 (+ line-number 1))))))

 ;; Loads lines from given file and parses them.
 (define (load-member-file ffn)
   (let* ((f (open-input-file ffn))
	  (ls (read-lines f))
	  (md (parse-member-lines ls)))
     (display ".")
     md))

 ;; Performs self-tests of the member-file module.
 (define (member-file-tests!)
   (run-tests
    member-file
    (test-equal? line-remove-comments (line-remove-comments "# all comment") "")
    (test-equal? line-remove-comments (line-remove-comments "") "")
    (test-equal? line-remove-comments (line-remove-comments "test # comment") "test ")
    (test-equal? line-remove-comments (line-remove-comments "test") "test")
    ))

 )