#!/usr/bin/env guile
!#

(use-modules ((srfi srfi-1) #:select (every fold-right)) (sph)
  (sph lang indent-syntax) (sph lang scheme)
  (sph string) ((sph io) #:select (port->lines))
  ((rnrs exceptions) #:select (guard)) (sph list)
  ((sph filesystem) #:select (ensure-trailing-slash ensure-directory-structure path->full-path))
  (sph alist) (sph lang sc) (sph cli))

(define (process input-port output-port check port->datums*)
  (let (expressions (pair (q begin) (port->datums* input-port)))
    (guard
      (a
        ( (sc-syntax-error? a)
          (raise (append a (list (pair (q port-filename) (port-filename input-port)))))))
      (let
        ( (load-paths
            (pair
              (ensure-trailing-slash
                (let (a (port-filename input-port)) (if a (path->full-path (dirname a)) (getcwd))))
              (sc-default-load-paths))))
        (if check (debug-log (sc-syntax-check expressions load-paths))
          (display (sc->c expressions (sc-state-new load-paths #f)) output-port))))))

(define (with-input-file path c)
  (call-with-input-file path (l (a) (set-port-filename! a path) (c a))))

(define (each-input-file proc paths) (each (l (a) (with-input-file a proc)) paths))

(define* (sc #:optional source-paths target-path parents check includes wisp)
  "appends multiple sources"
  (let
    (process*
      (l (input-port output-port)
        (process input-port output-port
          check
          (if
            (or wisp
              (let (filename (port-filename input-port))
                (and filename (string-suffix? ".scw" filename))))
            (module-ref (resolve-interface (q (language wisp))) (q wisp-scheme-read-all))
            port->datums))))
    (if includes (each-input-file (l (a) (process* a (%make-void-port "w"))) includes))
    (if target-path
      (if parents
        (each
          (l (a)
            (let
              (target-path
                (string-append target-path "/"
                  (string-drop-suffix-if-exists (if (string-suffix? ".scw" a) ".scw" ".sc") a) ".c"))
              (and (ensure-directory-structure (dirname target-path))
                (call-with-output-file target-path
                  (l (target-file) (with-input-file a (l (a) (process* a target-file))))))))
          source-paths)
        (call-with-output-file target-path
          (l (target-file) (each-input-file (l (a) (process* a target-file)) source-paths))))
      (if source-paths (each-input-file (l (a) (process* a (current-output-port))) source-paths)
        (process* (current-input-port) (current-output-port))))))

(define (display-syntax-error a) (display "sc syntax error\n")
  (display
    (prefix-tree->indent-tree
      (alist-bind (tail a) (expected irritant port-filename)
        (compact
          (list (and port-filename (string-append "in " (any->string-write port-filename)))
            (and irritant (string-append "at " (any->string-write irritant)))
            (and expected (pair "expected" (map any->string-write expected))))))
      1))
  (newline))

(define (string-append-lines . a) (string-join a "\n"))

(define sc-cli
  (let
    (cli
      (cli-create #:description
        (string-append-lines
          "compiles sc to c. uses standard input/output or files, depending on how many paths have been given."
          "no path: read from standard input and write to standard output"
          "one path: read from standard input and write to standard output"
          "two or more paths: read from all leading paths and write to the last path")
        #:options
        (q
          ( ( (source-path ... target-path)) ((source-path))
            (parents #:description
              "treat target as directory and recreate the directory structure of source files")
            (check #:names #\c #:description "only validate syntax")
            (stdin-input-paths #:description "read input file paths to process from standard input")
            (includes #:value-required? #t #:description "include macros from these sc files")
            (wisp #:description
              "treat input as wisp syntax. forms that accept associations in a flat key/value format will use ((key value) ...) format, which is easier to type in wisp")))))
    (l (arguments)
      (alist-bind (cli arguments)
        (source-path target-path parents check stdin-input-paths includes wisp)
        (let
          ( (target-path (if stdin-input-paths source-path target-path))
            (source-path
              (if stdin-input-paths (port->lines (current-input-port))
                (and source-path (any->list source-path))))
            (includes (and includes (string-split includes #\,))))
          (guard (a ((sc-syntax-error? a) (display-syntax-error a)))
            (sc source-path target-path parents check includes wisp)))))))

(sc-cli (tail (program-arguments)))