#!/usr/bin/guile \
-e main -s
!#

;;
;; NAME
;; flatten-ly - flatten lilypond files with nested includes
;;
;; SYNOPSIS
;; flatten-ly [OPTIONS]
;;
;; DESCRIPTION
;; Utility to copy lilypond files, flattening nested includes. If no
;; options are given, reads from standard input, writes to standard
;; output.
;;
;; -i, --input file
;;    Specify input file.
;;
;; -o, --output file
;;    Specify output file.
;;
;; -I, --include path
;;    Search path for included files, a colon separated string.
;;
;; -h, --help
;;    Show usage.
;;
;; -v, --version
;;    Report version.
;;
;; NOTES
;; Outputs lilypond comments indicating source of included material
;; in situ in the output.
;;
;; Written in guile 1.8 for use with lilypond.
;;
;; AUTHOR
;; Written by Andrew Bernard.
;;
;;

(use-modules (ice-9 getopt-long))
(use-modules (ice-9 string-fun))
(use-modules (ice-9 rdelim))
(use-modules (ice-9 regex))
(use-modules (ice-9 format))

;; program version
(define version-number "1.0")

;; main
;;
(define (main args)
  ;; argument processsing
  (let* ((option-spec
	  '((input (single-char #\i) (value #t))
	    (output (single-char #\o) (value #t))
	    (include (single-char #\I) (value #t))
	    (help (single-char #\h (value #f)))
	    (version (single-char #\v (value #f)))))
	 (options (getopt-long args option-spec))
	 (input-file (option-ref options 'input #f))
	 (output-file (option-ref options 'output #f))
	 (include-path (option-ref options 'include #f))
	 (help-wanted (option-ref options 'help #f))
	 (version-wanted (option-ref options 'version #f))
	 ;; include-path can be a colon separated list of dirs.
	 (include-dirs (if include-path
			   (separate-fields-discarding-char #\: include-path list)
			   '()))
	 ;; add current directory to include path
	 (include-dirs (cons "." include-dirs))
	 )

    ;; help required?
    (if help-wanted
	(begin
	  (usage)
	  (exit)))

    ;; version wanted?
    (if version-wanted
	(begin
	  (version)
	  (exit)))
    
    ;; file processing
    (let ((in (if input-file (open-input-file input-file) (current-input-port)))
	  (out (if output-file (open-output-file output-file) (current-output-port))))
      (file-copy-flatten-includes in include-dirs out))))

;; Copy file, flattening files included with lilypond \include command
;; to a single output.
;;
;; in - input port to read from.
;; include-dirs - list of directories in which to search for included files.
;; out - port to write output to.
;;
(define (file-copy-flatten-includes in include-dirs out)
  (let loop ((line (read-line in)))
    (if (not (eof-object? line))
	(begin
	  ;; check line for \include
	  (let ((include-file-name (match-include line)))
	    (if include-file-name
		(let* (
		       (raw-include-file-name include-file-name)
		       (include-file-name (find-file-in-include-path include-file-name include-dirs))
		       )
		  (if include-file-name
		      (begin
			;; recurse to output included file
			(let ((in (open-input-file include-file-name)))
			  (format out "% included from ~a~%" include-file-name)
			  (file-copy-flatten-includes in include-dirs out)))
		      ;; file not found
		      (format out "% include file not found in path: ~a~%" raw-include-file-name)))
		(write-line line out)))
	  (loop (read-line in)))))
  (close-port in))

;; Match function to return file name in a \include line.
;; Return #f if line does not match pattern.
;;
(define match-include
  (lambda (line)
    (let* ((s (string-match "\\include .*\"(.*)\"" line)))
      (if s
	  (match:substring s 1)
	  #f
	  ))))

;; Find file in list of possible directories.
;; Return full path name if found, else #f.
;; Returns first such file if found.
;;
(define (find-file-in-include-path file-name dirs)
  (call/cc
   (lambda (return-immediate)
     (let loop ((lis dirs))
       (if (null? lis)
	   #f
	   (let ((dir (car lis)))
	     ;; try the path
	     (let ((full-path (string-append (string-append dir "/") file-name)))
	       (if (access? full-path R_OK)
		   (return-immediate full-path)))
	     (loop (cdr lis))))))))

;; Show program usage
;;
(define (usage)
  (display "\
NAME
  flatten-ly - flatten lilypond files with nested includes

SYNOPSIS
  flatten-ly [OPTIONS]

DESCRIPTION
  Utility to copy lilypond files, flattening nested includes. If no
  options are given, reads from standard input, writes to standard
  output.

OPTIONS:
  -i, --input file
     Specify input file.
  -o, --output file
     Specify output file.
  -I, --include path
     Search path for included files, a colon separated string.
  -h, --help
     Show usage.
  -v, --version
    Report version.")
  (newline))

;; Report program version
;;
(define (version)
  (display version-number)(newline))