#!/usr/bin/guile -s
!#

;;; -*- scheme -*-

;;; Parse for enhanced XMCD. Original format: http://ftp.freedb.org/pub/freedb/latest/DBFORMAT

(use-modules (ice-9 format)
	     (ice-9 rdelim)
	     (ice-9 streams)
	     (ice-9 regex)
	     (ice-9 vlist)

	     (srfi srfi-1))

;;; VList/VHash utility functions

(define (vhash-cat key new-value vhash)
  "Add NEW-VALUE to the VList stored under VHASH.KEY"
  (vhash-set key (vlist-append (let ((lst (vhash-assoc key vhash)))
				  (if lst (cdr lst) vlist-null))
				(vlist-cons new-value vlist-null))
	      vhash))

(define (vhash-set key new-value vhash)
  (vhash-cons key new-value (vhash-delete key vhash)))


;;; Simple key/value database for cddb and toc info

;;; DO NOT RELY ON THE IMPLEMENTATION, it sucks. Always use the query
;;; functions. The disc query functions return the list of values, the
;;; track query functions return an alist of (track-num
;;; . values). Values are always plural, just grab the car if you want
;;; a single value. It's not the best interface, but it sure beats
;;; grepping the xmcd file!

(define (make-initial-db . toplevel-keys)
  (fold (lambda (key db) (vhash-cons key vlist-null db)) vlist-null toplevel-keys))

(define (cddb-query-disc db tag)
  "Query the database for a disc attribute"
  (let ((result (vhash-assoc tag (cdr (vhash-assoc 'disc db)))))
    (if result (vlist->list (cdr result)) #f)))

(define (cddb-query-tracks db tag)
  "Query the database for a track attribute and return alist
of (disc-number . tag-value)"
  (let ((r (vlist->list (vhash-fold (lambda (key vh results)
				      (let ((result (vhash-assoc tag vh)))
					(if result
					    (vhash-cons key (vlist->list (cdr result)) results)
					    results)))
				    vlist-null
				    (cdr (vhash-assoc 'tracks db))))))
    (if (null? r) #f r)))

(define (read-cddb cddb-port)
  (define (parse-cddb-line line db)
    (define (line-match regex) (string-match regex line))

    (cond
     ((line-match "^#(.*)$") => (lambda (x) (vhash-cat 'comment (match:substring x 1) db)))
     ((line-match "^DISCID=([[:graph:]]+)$") => (lambda (x) (let ((disc-db (cdr (vhash-assoc 'disc db))))
							 (vhash-set 'disc (vhash-cat 'DISCID (match:substring x 1) disc-db)
								    db))))
     ((line-match "^D([[:alpha:]]+)=([[:graph:][:space:]]+)$") => (lambda (x)
								    (let ((disc-db (cdr (vhash-assoc 'disc db)))
									  (key (string->symbol (match:substring x 1))))
								      (vhash-set 'disc (vhash-cat key (match:substring x 2) disc-db)
										 db))))
   
     ((line-match "^T([[:alpha:]]+)([[:digit:]]+)=([[:graph:][:space:]]+)$")
      => (lambda (x)
	   (let* ((tracks-db (cdr (vhash-assoc 'tracks db)))
		  (tracknum (string->number (match:substring x 2)))
		  (tracknum-db ((lambda (vh) (if vh (cdr vh) vlist-null)) (vhash-assoc tracknum tracks-db)))
		  (key (string->symbol (match:substring x 1)))
		  (tag-value (match:substring x 3)))
	     (vhash-set 'tracks (vhash-set tracknum (vhash-cat key tag-value tracknum-db)
					   tracks-db)
			db))))
   
     ;; Also match EXTD? Might just punt if abcde handles it separately
     (else db)))
  
  (stream-fold parse-cddb-line
	       (make-initial-db 'comment 'disc 'tracks)
	       (port->stream cddb-port read-line)))

;;; Commands

;; string-tokenize is weird, might want to just use regexeps instead
(define cddb-dtitle-char-set (char-set-difference char-set:printing
						  (char-set #\/)))

(define* (cddb->export cddb #:optional (out (current-output-port)))
  "Convert database to shell expression for abcde"
  ;; Using single quoting instead of "" to make life easier
  (letrec* ((escape-for-shell
	     (lambda (x) (regexp-substitute/global #f "['\\\\]" x
					      'pre
					      (lambda (m) (string-append "\\" (match:substring m)))
					      'post)))
	    (disc-query (lambda* (key #:optional (default '("")))
			    (cond ((cddb-query-disc cddb key) => identity)
				  (else default))))

	    (artist ((lambda (s) (substring s 0 (- (string-index s #\/) 1))) (car (disc-query 'TITLE)))

	     #;(string-trim-right (car (string-tokenize (car (disc-query 'TITLE)) cddb-dtitle-char-set))))
	    
	    (album ((lambda (s) (substring s (+ (string-index s #\/) 2))) (car (disc-query 'TITLE)))
	     #;(string-trim (string-join (cdr (string-tokenize (car (disc-query 'TITLE)) cddb-dtitle-char-set))
					      "/"))))
    
    
    (newline out)

  ;; Not exported CDDBGENRE intentionally, since it appears unused
    (format out "DISCID=$'~A'~%DALBUM=$'~A'~%DARTIST=$'~A'~%CDYEAR=$'~A'~%"
	    (escape-for-shell (car (disc-query 'DISCID)))
	    (escape-for-shell album)
	    (escape-for-shell artist)
	    (escape-for-shell (car (disc-query 'YEAR))))
    
  ;; Store genre(s) in a bash array. mp3s will just have to live with
  ;; using the first, but Vorbis/FLAC can handle an arbitrary set of
  ;; genres
    (format out "CDGENRE=(~{$'~A' ~})~%" (map escape-for-shell (disc-query 'GENRE)))

    (format out "~:{TRACK~A=$'~A'~%~}"
	    (map (lambda (ttitle) (list (1+ (first ttitle)) (escape-for-shell (second ttitle))))
		 (cddb-query-tracks cddb 'TITLE)))))

(define (main args)
  (cond ((string= (second args) "parse")
	 (call-with-input-file (third args)
	   (lambda (f) (cddb->export (read-cddb f)))))
	(else
	 (apply execlp "cddb-tool" args))))


(when (batch-mode?)
  (exit (main (program-arguments))))