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

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

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

(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.
  (define (last-dir pn) (pathname-file pn))
  (set! egg-file
    (cond
     ((not egg-file)
      (make-pathname (current-directory) (last-dir (current-directory)) "egg"))
     ((directory? egg-file)
      (assert (directory-exists? egg-file)
              "Egg directory doesn't exist" egg-file)
      (let ((dir egg-file))
        (make-pathname dir (last-dir dir) "egg")))
     (else egg-file)))

  (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 ((exts (source-extensions)))
      (if (null? exts) #f
          (let ((cand (make-pathname (egg-directory) (->string c) (car exts))))
            (if (file-exists? cand) cand
                (loop (cdr exts)))))))))

(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 (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))))
    (print-rule (relativize (output-of c))
                (cons (relativize (source-of (car deps)))
                      (map (o relativize source-of) (cdr deps)))
                "@mkdir -p $(BUILD)"
                `("$(CSC) $(CSC_OPTIONS)"
                  ,(if (eq? (car (find-component c)) 'extension)
                       "$(CSC_LIB_OPTIONS)" "")
                  "$(CSC_OPTIONS_EXTRA)"
                  "$< -o $@")
                (let ((.import.scm (string-append (->string c) ".import.scm")))
                  (list "@test -f" .import.scm "&&"
                        "mv" .import.scm "$(BUILD)/" "||true")))))

(define (relativize pn)
  (let ((ed (string-append
             (if (pair? (egg-directory))
                 (car (egg-directory))
                 (egg-directory))
             "/")))
    (if (string-prefix? ed pn)
        (substring pn (string-length ed))
        pn)))

(define (print-rule target deps . commands)
  (define (list?->string x) (if (list? x) (string-join x) x))
  (print target ": " (list?->string deps))
  (for-each (lambda (c) (print "\t" (list?->string c)))
            commands))

(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_LIB_OPTIONS = " (string-join csc-lib-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)")
    (print "TEST_ENV_EXTRA = TEST_USE_ANSI=0")
    (print "ARTEFACTS = *.build.sh *.install.sh $(NAME)"
           " *.import.scm *.so *.link *.o")
    (newline)
    (print-rule ".PHONY" "all test clean install uninstall")
    (print-rule "all" (map (o relativize output-of car)
                           (dependency-graph)))
    (print-rule "test" "all"
                "cd $(BUILD) && \\"
                "$(TEST_ENV) $(TEST_ENV_EXTRA) \\"
                "$(CSI) -setup-mode -s $(TESTS)/run.scm $(NAME)")
    (print-rule "clean" ""
                "-rm -rf $(BUILD) $(ARTEFACTS)")
    (print-rule "install" ""
                "chicken-install -s"
                "@-rm -rf $(ARTEFACTS)")
    (print-rule "uninstall" ""
                "chicken-uninstall -s $(NAME)")
    (newline)
    (print "# " (egg-name))
    (newline)
    (for-each (o rule cadr)
              (egg-components))))

(define (main args)
  (let ((egg-file (if (null? args) (current-directory) (car args))))
    ;; TODO: allow customizing build directory
    (emit-makefile egg-file)))

(cond-expand
  ((or chicken-script compiling)
   (import (chicken process-context))
   (main (command-line-arguments)))
  (else))