#!/usr/bin/guile
!#

(use-modules (sph) (sph alist)
  (sph filesystem) (sph hashtable) (sph cli) (sph lang scm-format) (sph lang scheme))

(define (scm-suffix-file-path a)
  (if (string-suffix? ".scm" a) a
    (if (file-exists? a) a
      (let (a-with-suffix (string-append a ".scm"))
        (if (file-exists? a-with-suffix) a-with-suffix a)))))

(define parse-program-arguments
  (cli-create #:options
    (q
      ( (output #:value-required? #t) (in-place #:names #\i)
        (format #:value-required? #t #:description "a scheme list for scm-format format options")
        (transform #:value-required? #t
          #:description
          "sort-definitions #f separate-unexported-definitions #f sort-export #t sort-import #t")
        ((source-path ...))))))

(define (parse-scm-arg-hashtable a) (ht-from-list (string->datums a)))

(define (create-config format transform)
  (ht-from-list
    (append
      (list (q scm-read) read)
      (if format (list (q format) (parse-scm-arg-hashtable format)) (list))
      (if transform (list (q transform) (parse-scm-arg-hashtable transform)) (list)))))

(define (scm-format-file-path file-path in-place output config)
  (let (file-path (scm-suffix-file-path file-path))
    ( (if in-place
        (l (r)
          (if (not (string-null? r))
            (begin
              (copy-file file-path (get-unique-path (string-append "/tmp/" (basename file-path))))
              (call-with-output-file file-path (l (file) (display r file))))))
        (if output (l (r) (call-with-output-file output (l (a) (display r a)))) display))
      (call-with-input-file file-path (l (a) (scm-format-port a config))))))

(define (scm-format-cli)
  (alist-bind (parse-program-arguments) (source-path format transform in-place output)
    (let (config (create-config format transform))
      (if source-path (each (l (a) (scm-format-file-path a in-place output config)) source-path)
        (if output
          (call-with-output-file output
            (l (port-output) (display (scm-format-port (current-input-port) config) port-output)))
          (display (scm-format-port (current-input-port) config)))))))

(scm-format-cli)