(module parse-playlist mzscheme
  (require (lib "contract.ss")
           (lib "lex.ss" "parser-tools")
           (lib "yacc.ss" "parser-tools")
           (lib "etc.ss")
           (lib "pregexp.ss")
           (lib "plist.ss" "xml")
           (lib "list.ss"))

  (define-struct music-db (indexer records outputter))
  
  (define/contract construct-music-db
    ((string? . -> . ((listof any/c) . -> . any))  ; record-indexer
     (listof (listof any/c)) ; records
     ((listof (listof any/c)) port? . -> . void?) ; db-outputter
     . -> .
     music-db?)
    (lambda (indexer records outputter)
      (make-music-db indexer records outputter)))

  (provide/contract [music-db? (any/c . -> . boolean?)])
  
  (provide/contract [parse-playlist (string? . -> . music-db?)])
  
  (provide/contract [music-db-indexer (music-db? . -> . (string? . -> . ((listof any/c) . -> . any)))]
                    [music-db-records (music-db? . -> . (listof (listof any/c)))]
                    [music-db-outputter (music-db? . -> . ((listof (listof any/c)) port? . -> . void?))])
  
  (provide/contract [required-fields (case-> ( -> (listof string?))
                                            ((listof string?) . -> . void?))]
                    [verbose-output? (case-> ( -> boolean?)
                                            (boolean? . -> . void?))])
  
  (define required-fields (make-parameter `("Name" "Location" "Size")))
  (define verbose-output? (make-parameter #t))
  
  (define (make-indexer record-name-list)
    (let ([index (map list 
		      record-name-list
		      (build-list (length record-name-list)
				  (lambda (index)
				    (lambda (record)
				      (list-ref record index)))))])
      (lambda (name)
        (let ([result (assoc name index)])
          (unless result 
            (error 'indexer "field name ~v not found" name))
          (cadr result)))))
  
  (define (make-outputter record-name-list)
    (lambda (record-list port)
      (for-each (lambda (record)
                  (let loop ([fields record])
                    (when (car fields)
                      (fprintf port "~a" (car fields)))
                    (if (null? (cdr fields))
                        (display #\return port)
                        (begin (display #\tab port)
                               (loop (cdr fields))))))
                (cons record-name-list record-list))))
  
  (define-tokens normal (field tab newline eof))
  
  (define (post-parse field)
    (cond [(string=? field "") #f]
          [(pregexp-match "^[0-9 ]*$" field) (string->number field)]
          [else field]))

  (define field-pattern (byte-regexp #"[^\r\t]*"))
  
  (define (parse-file port)
    (letrec ([read-record 
               (lambda ()
                 (let loop ()
                   (let ([next-field (regexp-match field-pattern port)])
                     (when (null? next-field)
                       (error "regexp-match returned zero matches"))
                     (when (not (null? (cdr next-field)))
                       (error "regexp-match returned more than one match: ~v" next-field))
                     (let* ([field-content (bytes->string/latin-1 (car next-field))]
                            [real-field (if (= (string-length field-content) 0)
                                            #f
                                            (let ([try-num (string->number field-content)])
                                              (or try-num
                                                  field-content)))]
                            [next-char (read-char port)])
                       (if (eof-object? next-char)
                           (error "unexpected location for eof")
                           (if (eq? next-char #\return)
                               (list real-field)
                               (cons real-field (loop))))))))])
       (let loop ()
         (if (eof-object? (peek-char port))
             null
             (cons (read-record)
                   (loop))))))
  
  (define (check-record-validity index-list record-list indexer)
    (let ([index-length (length index-list)])
      (filter (lambda (record)
                (if (not (= (length record) index-length))
                    (begin (when verbose-output?
                             (fprintf (current-error-port) "omitting record for wrong length: ~e\n" record))
                           #f)
                    (let loop ([req-fields (required-fields)])
                      (if (null? req-fields)
                          #t
                          (if (not ((indexer (car req-fields)) record))
                              (begin (when verbose-output?
                                       (fprintf (current-error-port) "omitting record as missing field ~v: ~e\n" (car req-fields) record))
                                     #f)
                              (loop (cdr req-fields)))))))
                record-list)))
  
  (define (parse-playlist filename)
    (call-with-input-file filename
      (lambda (port)
        (let ([parsed-file (parse-file port)])
          (let ([indexer (make-indexer (car parsed-file))])
          (construct-music-db indexer
                              (check-record-validity (car parsed-file)
                                                     (cdr parsed-file)
                                                     indexer)
                              (make-outputter (car parsed-file))))))))
  
  
  ;(define test-db (parse-playlist "/Users/clements/Documents/Library.txt"))
  ;(printf "~e\n" (map ((music-db-indexer test-db) "My Rating")
  ;                    (music-db-records test-db)))
  )