(define-record-type song :song
  (make-song length title url)
  song?
  (length song-length)
  (title song-title)
  (url song-url))

(define-record-discloser :song
  (lambda (r)
    `(song ,(if (song-ext3-info? r)
		(song-title r)
		(song-url r)))))

(define (song-ext3-info? song)
  (and (song-title song) (song-length song)))

(define (extm3u-header? line)
  (string=? line "#EXTM3U"))

(define cs:no-end-line 
  (rx (- any ,(ascii->char 10) ,(ascii->char 13))))

(define (parse-extm3u-comment line)
  (if-match (regexp-search
	     (rx (: bos "#EXTINF:" 
		    (submatch (+ digit)) "," 
		    (submatch (+ ,cs:no-end-line))))
	     line)
	    (whole seconds-str title)
	    (cons (string->number seconds-str) 
		  (string-trim-right title))
	    #f))

(define (read-m3u-file file-name)
  (call-with-input-file file-name
    (lambda (port)
      (let lp ((line (read-line port)) (res '()))
	(cond
	 ((eof-object? line)
	  (reverse res))
	 ((extm3u-header? line)
	  (lp (read-line port) res))
	 ((parse-extm3u-comment line)
	  => (lambda (pair)
	       (let ((seconds (car pair))
		     (title (cdr pair))
		     (url-line (read-line port)))
		 (if (eof-object? url-line)
		     (error "Unexpected EOF" port)
		     (lp (read-line port)
			 (cons (make-song seconds title
					  (string-trim-right url-line))
			       res))))))
	 ((string-match (rx (: bos #\#)) line)
	  (lp (read-line port) res))
	 (else
	  (lp (read-line port)
	      (cons 
	       (make-song #f #f (string-trim-right line))
	       res))))))))

(define (all-songs-have-ext-info? list-of-songs)
  (every?-ec (:list s list-of-songs) 
    (song-ext3-info? s)))

(define (write-m3u-file songs port)
  (with-current-output-port port
    (let ((ext-info? (all-songs-have-ext-info? songs)))
      (if ext-info?
	  (display "#EXTM3U\n"))
      (do-ec (:list s songs)
	(begin
	  (if ext-info?
	      (begin
		(display "#EXTINF:")
		(display (song-length s))
		(display ",")
		(display (song-title s))
		(newline)))
	  (display (song-url s))
	  (newline))))))