#lang racket/base

(require racket/string
         racket/file
         racket/port
         racket/serialize
         racket/contract)

(provide file->ini
         ini->file
         ini-get
         ini-set!
         make-ini
	 get-ini-file
         ini-sections
         ini-keys
         ini-for-each
         is-ini?
         )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-struct ini-cfg 
  ((contents #:mutable))
  )

(define (output-value v out)
  (cond
    ((string? v)
     (if (regexp-match? #rx"[\r\n]" v)
         (begin
           (display "VALUE:" out)
           (write v out))
         (display v out)))
    ((path? v)
     (display (format "PATH:~a" v) out))
    ((number? v)
     (display v out))
    ((boolean? v)
     (display (if v "true" "false") out))
    (else
     (display"SER:" out)
     (write (serialize v) out))
    )
  )

(define (section=? sect inp-sect)
   (string-ci=? (format "~a" sect) (format "~a" inp-sect)))

(define (key=? key inp-key)
   (section=? key inp-key))


(define re-num #px"^([+]|[-])?([0-9]+([.]([0-9]+))?)$")
(define re-bool #px"^(#f|#t|true|false)$")
(define re-value #px"^VALUE:(.*)$")
(define re-serialize #px"^SER:(.*)$")
(define re-path #px"^PATH:(.*)$")
  
(define (interpret s)
  (let ((sr (regexp-match re-serialize s)))
    (if (eq? sr #f)
        (let ((m (regexp-match re-value s)))
          (if (eq? m #f)
              (let ((p (regexp-match re-path s)))
                (if (eq? p #f)
                    (let ((ss (string-downcase (string-trim s))))
                      (let ((m-num (regexp-match re-num ss)))
                        (if (eq? m-num #f)
                            (let ((m-b (regexp-match re-bool ss)))
                              (if (eq? m-b #f)
                                  s
                                  (if (or (string=? ss "#t") (string=? ss "true"))
                                      #t
                                      #f)
                                  ))
                            (string->number (car m-num)))))
                    (string->path (cadr p))))
              (let* ((content (cadr m)))
                (with-handlers ([exn? (λ (e) content)])
                  (with-input-from-string content read)))))
        (let ((content (cadr sr)))
          (deserialize (with-input-from-string content read))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (get-ini-file f)
  (if (symbol? f) 
    (let* ((pref-dir (find-system-path 'pref-dir)))
       (build-path pref-dir (string-append (symbol->string f) ".ini")))
    (build-path f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Writes an ini file to the given file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define/contract (ini->file ini file #:private? [private? #f])
  (->* (ini-cfg? path-string?) (#:private? boolean?) void?)
  (let* ((file (get-ini-file file))
         (_ (make-parent-directory* file))
         (out (if (and private?
                       (memq (system-type 'os) '(unix macosx)))
                  (open-output-file file
                                    #:exists 'replace
                                    #:permissions #o600
                                    #:replace-permissions? #t)
                  (open-output-file file #:exists 'replace))))
    (let ((last-is-newline #f))
      (for-each (lambda (section)
                  (let ((section-name (car section)))
                    (if (section=? section-name 'nil)
                        #t
                        (begin
                          (unless last-is-newline (newline out))
                          (display "[" out)
                          (display section-name out)
                          (display "]" out)
                          (newline out)))
                    (let ((lines (cdr section)))
                      (for-each (lambda (line)
                                  (if (eq? (car line) 'comment)
                                      (begin
                                        (set! last-is-newline #f)
                                        (display "; " out)
                                        (display (cadr line) out)
                                        (newline out))
                                      (if (eq? (car line) 'empty)
                                          (begin
                                            (newline out)
                                            (set! last-is-newline #t))
                                          (if (eq? (car line) 'keyval)
                                              (begin
                                                (set! last-is-newline #f)
                                                (display (cadr line) out)
                                                (display "=" out)
                                                (output-value (caddr line) out)
                                                (newline out))
                                              (error "Unknown line format")))))
                                lines))))
                (ini-cfg-contents ini)))
    (close-output-port out))
  (void)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Creates an empty ini structure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (make-ini)
  (make-ini-cfg '()))

(define (is-ini? i)
  (ini-cfg? i))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Reads an ini file to an internal ini structure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (file->ini file*)
  (let* ((file (get-ini-file file*))
	 (lines (if (file-exists? file) (file->lines file) '()))
         (re-section #px"^\\[([a-zA-Z0-9_.-]+)\\]$")
         (re-keyval #px"^([a-zA-Z0-9_.-]+)[=](.*)$")
         (re-comment #px"^[;](.*)$")
	 (line-nr 0))
    (letrec ((f (lambda (sections section lines)
                  (if (null? lines)
                      (append sections (list section))
                      (let* ((line (string-trim (car lines)))
                             (empty (string=? line ""))
                             (m-comment (regexp-match re-comment line))
                             (m-keyval (regexp-match re-keyval line))
                             (m-section (regexp-match re-section line)))
                        (set! line-nr (+ 1 line-nr))
                        (if empty
                            (f sections (append section (list (list 'empty))) (cdr lines))
                            (if m-comment
                                (f sections (append section (list (list 'comment (cadr m-comment)))) (cdr lines))
                                (if m-keyval
                                    (f sections (append section
                                                        (list
                                                         (list 'keyval (string->symbol
                                                                        (string-trim (string-downcase
                                                                                      (cadr m-keyval))))
                                                               (interpret (string-trim (caddr m-keyval)))))) (cdr lines))
                                    (if m-section
                                        (f (append sections (list section)) (list (string->symbol (string-trim (cadr m-section)))) (cdr lines))
                                        (error (format "Unknown INI line\n~a: ~a\n" line-nr line)))))))))))
      (make-ini-cfg (f '() (list 'nil) lines))
      )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Gets a value from the ini structure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (ini-get ini section key def-val)
  (letrec ((g (lambda (ini)
                (if (null? ini)
                    def-val
                    (if (section=? section (caar ini))
                        (letrec ((f (lambda (l)
                                      (if (null? l)
                                          def-val
                                          (let ((entry (car l)))
                                            (if (eq? (car entry) 'keyval)
                                                (if (key=? (cadr entry) key)
                                                    (caddr entry)
                                                    (f (cdr l)))
                                                (f (cdr l))))))))
                          (f (cdar ini)))
                        (g (cdr ini)))))))
    (g (ini-cfg-contents ini))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sets a value in the ini structure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (ini-set! ini section key* val)
  (let ((found #f)
        (key (string->symbol (format "~a" key*)))
        )
    (letrec ((for-sect (lambda (sect)
                         (if (null? sect)
                             (if found
                                 '()
                                 (begin
                                   (set! found #t)
                                   (list (list 'keyval key val))))
                             (let ((entry (car sect)))
                               (if (eq? (car entry) 'keyval)
                                   (if (key=? (cadr entry) key)
                                       (begin
                                         (set! found #t)
                                         (cons (list 'keyval key val) (for-sect (cdr sect))))
                                       (cons entry (for-sect (cdr sect))))
                                   (cons entry (for-sect (cdr sect)))))))))
      (letrec ((for-ini (lambda (ini)
                          (if (null? ini)
                              (if found
                                  '()
                                  (list (list section (list 'keyval key val))))
                              (let* ((ini-section (car ini))
                                     (section-key (car ini-section)))
                                (if (section=? section-key section)
                                    (cons (cons section (for-sect (cdr ini-section))) (for-ini (cdr ini)))
                                    (cons ini-section (for-ini (cdr ini)))))))))
        (let ((new-ini (for-ini (ini-cfg-contents ini))))
          (set-ini-cfg-contents! ini new-ini))
        ini))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Gets all sections of the ini file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define/contract (ini-sections cfg)
  (-> ini-cfg? (listof symbol?))
  (map (λ (sect) (car sect))
       (filter (λ (sect) (not (eq? (car sect) 'nil)))
               (ini-cfg-contents cfg))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Gets all keys for a given section
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define/contract (ini-keys cfg section)
  (-> ini-cfg? symbol? (listof symbol?))
  (let ((s (filter (λ (sect) (eq? (car sect) section)) (ini-cfg-contents cfg))))
    (if (null? s)
        '()
        (map cadr
             (filter (λ (kv)
                       (not (or (eq? (car kv) 'comment) (eq? (car kv) 'empty)))) (cdar s)))
        )
    )
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; iterates over all sections and keys of an ini structure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (any? a) #t)

(define/contract (ini-for-each f cfg)
  (-> procedure? ini-cfg? any?)
  (for-each (λ (s)
              (for-each (λ (kv)
                          (when (eq? (car kv) 'keyval)
                            (f (car s) (cadr kv) (caddr kv))))
                        (cdr s)))
            (ini-cfg-contents cfg)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests for module library.rkt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module+ test
  (require rackunit)

  (define (run-ini-tests)
    (define test-ini (make-ini))
    (ini-set! test-ini 'section1 'key1 "Value 1")
    (ini-set! test-ini 'section1 'key2 42)
    (ini-set! test-ini 'section1 77 7777)

    (ini-set! test-ini 'section2 'key1 (list "Value 1"))
    (ini-set! test-ini 'section2 "my-key" (make-hash '((a . 42) (b . "Hi There"))))
  
    (check-equal?
     (list 'section1 'section2) (ini-sections test-ini))

    test-ini
    )
  )