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

;; A script to compute Guile module dependencies.

;; Copyright (C) 2024 Tommi Höynälänmaa

;; Distributed under GNU LGPL.

(use-modules (srfi srfi-1)
             (rnrs lists)
             (rnrs io ports)
             (th-scheme-utilities stdutils))

(define (process-toplevel-expression sx l-s-lib)
  (if (and (list? sx) (not-null? sx) (memq (car sx) '(use-modules import)))
    (filter (lambda (sx-module)
              (and (list? sx-module)
                   (not-null? sx-module)
                   (equal? (drop-right sx-module 1) l-s-lib)))
            (cdr sx))
    '()))

(define (process-all-expressions l-sx l-s-lib)
  (apply append
    (map (lambda (sx) (process-toplevel-expression sx l-s-lib)) l-sx)))

(define (print-output-deps str-name l-sx-deps)
  (display (string-append str-name ".go :"))
  (for-each
   (lambda (l-s-dep)
     (if (and (list? l-s-dep) (not-null? l-s-dep) (for-all symbol? l-s-dep))
       (begin
        (display " \\\n  ")
        (display (string-append (symbol->string (last l-s-dep)) ".go")))
       (begin
        (display "warning: invalid module " (standard-error-port))
        (display l-s-dep (standard-error-port))
        (newline (standard-error-port)))))
   l-sx-deps)
  (newline)
  (newline))

(define (get-filename-without-ext filename)
  (let ((index (string-index filename #\.)))
    (if (eq? index #f)
      filename
      (string-take filename index))))

(define (parse-library str-lib)
  (map string->symbol (split-string str-lib #\space)))

(define (main args)
  (if (eqv? (length args) 3)
    (let* ((str-source (cadr args))
           (str-lib (caddr args))
           (l-s-lib (parse-library str-lib))
         	 (str-name (get-filename-without-ext str-source))
         	 (ip (open-input-file str-source))
         	 (l-sx (read-file ip)))
      (close-input-port ip)
      (let ((l-deps (process-all-expressions l-sx l-s-lib)))
        (print-output-deps str-name l-deps))
      (exit 0))
    (begin
     (display "Invalid number of arguments.\n" (standard-error-port))
     (exit 1))))
  
