;;
;; member-parser.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.
;;

(declare (unit member-parser))

(module
 member-parser
 (
  parse-member-file
  member-parser-tests!
  )

 (import scheme
	 (chicken base)
	 (chicken io)
	 (chicken irregex)
	 member2-record
	 testing)

 ;; Removes any comments and removes any leading and trailing
 ;; whitespace.
 (define (preprocess-member-line line)
   (irregex-replace (irregex "[ \\t]*$" 'u)
		    (irregex-replace (irregex "^[ \\t]*" 'u)
				     (irregex-replace (irregex "#.*$" 'u) line "")
				     "")
		    ""))

 ;; Expects line with comments and surrounding whitespace removed,
 ;; returns either #f if nothing was parsed, symbol if only one token
 ;; was there and pair of symbol and string if both key and the value
 ;; were present.
 (define (parse-member-line line)
   (if (= (string-length line) 0)
       #f
       (let ((dm (irregex-search (irregex "[ \\t]" 'u) line)))
	 (if dm
	     (let* ((sep-idx (irregex-match-start-index dm))
		    (key-str (substring line 0 sep-idx))
		    (key (string->symbol key-str))
		    (sep+val (substring line sep-idx))
		    (val (irregex-replace (irregex "^[ \\t]*" 'u) sep+val "")))
	       (cons key val))
	     (string->symbol line)))))

 ;; Adds parsed lines to member record.
 (define (parse-member-lines mr source)
   (let loop ((lines source)
	      (mr (member-record-set mr #:source source))
	      (result '())
	      (line-number 1))
     (if (null? lines)
	 (member-record-set mr #:parsed (reverse result))
	 (let ((parsed-line (parse-member-line
			     (preprocess-member-line
			      (car lines)))))
	   (loop (cdr lines)
		 (if (symbol? parsed-line)
		     (member-record-add-highlight mr line-number "Got only key" 1 'error)
		     mr)
		 (if (pair? parsed-line)
		     (cons (list (car parsed-line)
				 (cdr parsed-line)
				 line-number)
			   result)
		     result)
		 (add1 line-number))))))

 ;; Loads member file source. Performs passes 0 and 1 on each line
 ;; returning parsed source. Parsed source is a list of lists
 ;; containing '(key value line-number) information. Leading and
 ;; trailing whitespace is trimmed for both keys and values.
 (define (parse-member-file mr)
   (let* ((mrif (member-record-input-file mr))
	  (source (read-lines mrif))
	  (mrp (parse-member-lines mr source)))
     mrp))

 ;; Performs self-tests of the member-parser module.
 (define (member-parser-tests!)
   (run-tests
    member-parser
    (test-equal? preprocess-member-line
		 (preprocess-member-line "# all comment")
		 "")
    (test-equal? preprocess-member-line
		 (preprocess-member-line "   # all comment after spaces")
		 "")
    (test-equal? preprocess-member-line
		 (preprocess-member-line " test  # spaces and comment after spaces")
		 "test")
    (test-equal? preprocess-member-line
		 (preprocess-member-line "key value  # spaces and comment after spaces")
		 "key value")
    (test-false parse-member-line
		(parse-member-line ""))
    (test-eq? parse-member-line
	      (parse-member-line "key")
	      'key)
    (test-equal? parse-member-line
		 (parse-member-line "key value")
		 '(key . "value"))
    (test-equal? parse-member-line
		 (parse-member-line "key     value")
		 '(key . "value"))
    (test-equal? parse-member-line
		 (parse-member-line "key     value and some")
		 '(key . "value and some"))
    (test-equal? parse-member-line
		 (parse-member-line "key     value     lot of spaces")
		 '(key . "value     lot of spaces"))
    ))

 )

(import member-parser)

(member-parser-tests!)
(print (parse-member-file (make-member-record "joe" "members/joe" '())))