(declare (module scramble))

(import scheme (chicken base)
        (chicken file)
        (chicken format)
        (chicken pathname)
        (chicken process)
        (chicken process-context)
        (chicken string)
        (srfi 1))

;; dependencies should be like
;; (((output jimmy.util) (source jimmy.util))
;;  ((output jimmy.read) (source jimmy.read) (source jimmy.util))
;;  ((output jimmy.emit) (source jimmy.emit) (source jimmy.util)))

(define egg (make-parameter #f))
(define build-dir (make-parameter "build"))

(define csc-options '("-setup-mode"
                      "-host"
                      "-D compiling-extension"
                      "-emit-all-import-libraries"
                      "-dynamic"
                      "-regenerate-import-libraries"
                      "-I $(PWD)"
                      "-C -I$(PWD)"))

(define source-extensions
  ;; The possible extensions source files can take.
  (make-parameter '("scm" "sld" "ss")))

(define (read-egg #!optional egg-file)
  ;; Read EGG-FILE and return the structure inside.
  (unless egg-file
    (set! egg-file
      (receive (_ _ dirs) (decompose-directory (current-directory))
        (make-pathname (current-directory) (car (reverse dirs)) "egg"))))
  (assert (file-exists? egg-file) "Can't find egg file" egg-file)
  (assert (file-readable? egg-file) "Can't read egg file" egg-file)
  (cons* `(egg-directory ,(pathname-directory egg-file))
         `(egg-name ,(string->symbol (pathname-file egg-file)))
         (with-input-from-file egg-file read)))

(define (egg-directory) (alist-ref 'egg-directory (egg)))
(define (egg-name) (car (alist-ref 'egg-name (egg))))
(define (egg-components) (alist-ref 'components (egg)))
(define (egg-csc-options)
  (let ((opts (alist-walk (egg) 'component-options 'csc-options)))
    (if opts (map ->string opts) '())))

(define (source-of c)
  ;; Find the source file of C and return it.  If not found, error.
  (cond
   ((alist-ref 'source (cddr (find-component c)))
    => (lambda (s)
         (receive (dirs file ext) (decompose-pathname (->string (car s)))
           (make-pathname (append (egg-directory)
                                  (if (list? dirs) dirs (list dirs)))
                          file ext))))
   (else
    (let loop ((ext (source-extensions)))
      (if (null? ext) #f
          (let ((cand (make-pathname (egg-directory) c ext)))
            (if (file-exists? cand) cand
                (loop (cdr ext)))))))))

(define (output-of c)
  ;; Return the output file of C.  It's okay if it doesn't exist.
  (make-pathname (append (egg-directory) (list (build-dir)))
                 (->string c)
                 (case (car (find-component c))
                   ((extension) "so")
                   ((program)))))

(define (find-component name)
  (find (lambda (c) (eq? name (cadr c)))
        (alist-ref 'components (egg))))

(define (dependency-graph)
  ;; Build a dependency graph from the egg.
  (define (component->deps c)
    (let* ((c-name (cadr c))
           (c-info (cddr c))
           (c-deps (or (alist-ref 'component-dependencies c-info) '()))
           (s-deps (or (alist-ref 'source-dependencies c-info) '())))
      (if (null? (append c-deps s-deps))
          `(,c-name ,c-name)
          `(,c-name . ,(cons c-name
                             (append c-deps
                                     (map ->string s-deps)))))))
  (filter-map component->deps (egg-components)))

(define (alist-walk lis . keys)
  (if (null? keys)
      lis
      (let ((kv (assoc (car keys) lis)))
        (cond
         ((not kv) #f)
         ((atom? (cdr kv))
          (and (null? (cdr keys))       ; this shouldn't error...
               (cdr kv)))
         ((list? (cdr kv))
          (apply alist-walk (cdr kv) (cdr keys)))))))

(define (string-join ss)
  (string-intersperse ss " "))

(define (find-executable name)
  (let loop ((path (string-split (get-environment-variable "PATH") ":")))
    (cond
     ;; If no executable is found, return just the name.  Another option would
     ;; be to error out if there isn't an executable here ...
     ((null? path) name)
     ((and (directory-exists? (car path))
           (member name (directory (car path) 'with-dotfiles)))
      (make-pathname (car path) name))
     (else (loop (cdr path))))))

(define (rule c)
  (let ((deps (alist-ref c (dependency-graph))))
    (sprintf "~a: ~a $(BUILD)\n\t~a\n\t-mv ~a.import.scm $(BUILD)/"
             (output-of c)
             (string-join (cons (source-of (car deps))
                                (map output-of (cdr deps))))
             "$(CSC) $(CSC_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@"
             c)))

(define (emit-makefile egg-file)
  (parameterize ((egg (read-egg egg-file)))
    (print "# Automatically generated by scramble") (newline)
    (print "NAME = " (egg-name))
    (print "CSC = " (find-executable "csc"))
    (print "CSC_OPTIONS = " (string-join csc-options))
    (print "CSC_OPTIONS_EXTRA = " (string-join (egg-csc-options)))
    (print "CSI = " (find-executable "csi"))
    (print "BUILD = $(PWD)/" (build-dir))
    (print "TESTS = $(PWD)/tests")
    (print "TEST_ENV = env BUILD=$(BUILD) TESTS=$(TESTS)")
    (newline)
    (print ".PHONY: all test clean install uninstall")
    (print "all: " (string-join (map (o source-of car) (dependency-graph))))
    (print "test: build"
           "\n\t" "cd $(BUILD) && "
           "$(TEST_ENV) $(CSI) -setup-mode -s $(TESTS)/run.scm $(NAME)")
    (print "clean:\n\t-rm -rf $(BUILD)")
    (print "install:\n\tchicken-install -s")
    (print "uninstall:\n\tchicken-uninstall -s")
    (newline) (print "# " (egg-name)) (newline)
    (print "$(BUILD):\n\t-mkdir $(BUILD)")
    (for-each (o print rule cadr) (egg-components))
    ))