#lang racket/base

(require "../main.rkt")
(require "../reader.rkt")
(require racket/match)
(require (only-in racket/list index-of append-map remove-duplicates last drop-right))
(require (only-in racket/string string-split string-prefix?))
(require (only-in racket/file make-parent-directory*))
(require file/glob)

(struct schema (full-input-path
                relative-input-path
                full-output-path
                relative-output-path
                module-path
                value) #:transparent)

(define (clean-input p)
  (path->string (simplify-path (path->complete-path (expand-user-path p)) #f)))

(define (compute-base paths)
  (match paths
    ['() "."]
    [(list p) (path->string (simplify-path (build-path p 'up) #f))]
    [_ (let try-index ((i 0))
         (let scan-paths ((paths paths) (ch #f))
           (match paths
             ['() (try-index (+ i 1))]
             [(cons p more-paths)
              (cond [(= i (string-length p)) (substring p 0 i)]
                    [(not ch) (scan-paths more-paths (string-ref p i))]
                    [(eqv? ch (string-ref p i)) (scan-paths more-paths ch)]
                    [else (substring p 0 i)])])))]))

(define (expand-globs globs base0 output-directory0 k)
  (define base (or base0 (compute-base globs)))
  (define output-directory (or (and output-directory0 (clean-input output-directory0))
                               base))
  (k base
     output-directory
     (for/list [(full-input-path (in-list (map path->string
                                               (remove-duplicates
                                                (append-map (lambda (g)
                                                              (define results (glob g))
                                                              (when (null? results)
                                                                (error 'preserves-schema-rkt
                                                                       "Input not found: ~v" g))
                                                              results)
                                                            globs)))))]
       (when (not (string-prefix? full-input-path base))
         (error 'preserves-schema-rkt "Input filename ~v falls outside base ~v"
                full-input-path
                base))
       (define relative-input-path (substring full-input-path (string-length base)))
       (define module-path (for/list [(p (explode-path relative-input-path))]
                             (string->symbol (path->string (path-replace-extension p "")))))
       (define relative-output-path
         (path->string (path-replace-extension relative-input-path ".rkt")))
       (schema full-input-path
               relative-input-path
               (path->string (build-path output-directory relative-output-path))
               relative-output-path
               module-path
               (file->schema full-input-path)))))

(module+ main
  (require racket/cmdline)
  (require racket/pretty)

  (define output-directory #f)
  (define stdout? #f)
  (define base-directory #f)
  (define additional-modules '())
  (define inputs '())

  (command-line #:once-each
                ["--output" directory "Output directory for modules (default: next to sources)"
                 (set! output-directory directory)]
                ["--stdout" "Prints each module to stdout one after the other instead of writing them to files in the `--output` directory"
                 (set! stdout? #t)]
                ["--base" directory "Base directory for sources (default: common prefix)"
                 (set! base-directory directory)]
                #:multi
                ["--module" namespace=path "Additional Namespace=path import"
                 (let ((i (index-of (string->list namespace=path) #\=)))
                   (when (not i)
                     (error '--module "Argument must be Namespace=path: ~v" namespace=path))
                   (let* ((namespace-str (substring namespace=path 0 i))
                          (path-str (substring namespace=path (+ i 1))))
                     (set! additional-modules
                           (cons (list (map string->symbol (string-split namespace-str "."))
                                       path-str)
                                 additional-modules))))]
                #:args input-glob
                (set! inputs (map clean-input input-glob)))

  (expand-globs inputs
                base-directory
                output-directory
                (lambda (base-directory output-directory schemas)

                  (define index (make-hash))
                  (for [(s (in-list schemas))]
                    (hash-set! index (schema-module-path s) (schema-relative-output-path s)))
                  (for [(e (in-list additional-modules))]
                    (hash-set! index (car e) (cadr e)))

                  (define outputs
                    (for/hash [(s (in-list schemas))]
                      (values (schema-full-output-path s)
                              (schema->module-stx (last (schema-module-path s))
                                                  (lambda (module-path)
                                                    (hash-ref index
                                                              module-path
                                                              (lambda ()
                                                                (error 'preserves-schema-rkt
                                                                       "Undefined module: ~a"
                                                                       module-path))))
                                                  (schema-value s)))))

                  (for [((output-path stx) (in-hash outputs))]
                    (make-parent-directory* output-path)
                    (with-output-to-file output-path #:exists 'replace
                      (lambda () (pretty-write stx)))))))