#lang racket/base
(require racket/class
         racket/draw
         racket/list
         racket/set
         compiler/cm
         setup/dirs
         planet/config
         pkg/lib
         (prefix-in *** '#%foreign) ;; just to make sure it is here
         )

(provide set-basic-parameters/no-gui
         set-module-language-parameters
         (struct-out prefab-module-settings)
         transform-module
         get-init-dir)

;; get-init-dir : (or/c path? #f) -> path?
;; returns the initial directory for a program
;; that is saved in 'path/f' (with #f indicating
;; an unsaved file)
(define (get-init-dir path/f)
  (cond
    [path/f
     (let-values ([(base name dir?) (split-path path/f)])
       base)]
    [else
     (find-system-path 'home-dir)]))

(struct prefab-module-settings
  (command-line-args
   collection-paths
   compilation-on?
   full-trace?
   annotations)
  #:prefab)

(define orig-namespace (current-namespace))

(define (set-basic-parameters/no-gui)
  (let ([cust (current-custodian)])
    (define (drracket-plain-exit-handler arg)
      (custodian-shutdown-all cust))
    (exit-handler drracket-plain-exit-handler))
  (current-thread-group (make-thread-group))
  (current-command-line-arguments #())
  (current-pseudo-random-generator (make-pseudo-random-generator))
  (current-evt-pseudo-random-generator (make-pseudo-random-generator))
  (read-curly-brace-as-paren #t)
  (read-square-bracket-as-paren #t)
  (error-print-width 250)
  (current-ps-setup (make-object ps-setup%))
  (current-namespace (make-base-empty-namespace))
  ;; is this wise?
  #;(namespace-attach-module orig-namespace ''#%foreign))
  

(define (set-module-language-parameters settings 
                                        module-language-parallel-lock-client
                                        currently-open-files
                                        #:use-use-current-security-guard? [use-current-security-guard? #f])
  (current-command-line-arguments (prefab-module-settings-command-line-args settings))
  (let* ([default (current-library-collection-paths)]
         [cpaths (append-map (λ (x) (if (symbol? x) default (list x)))
                             (prefab-module-settings-collection-paths settings))])
    (when (null? cpaths)
      (eprintf "WARNING: your collection paths are empty!\n"))
    (current-library-collection-paths cpaths))
  
  (compile-context-preservation-enabled (prefab-module-settings-full-trace? settings))
  
  (when (prefab-module-settings-compilation-on? settings)
    (define open-pkgs
      (for/fold ([s (set)]) ([path (in-list currently-open-files)])
        (define pkg (path->pkg path))
        (if (and pkg
                 (memq 'write
                       (file-or-directory-permissions (pkg-directory pkg))))
            (set-add s pkg)
            s)))
    (for ([pkg (in-set open-pkgs)])
      (log-info "DrRacket: enabling bytecode-file compilation for package ~s" pkg))
    (define skip-path?
      (let* ([cd (find-collects-dir)]
             [no-dirs (if cd 
                          (list (CACHE-DIR) cd)
                          (list (CACHE-DIR)))])
        (λ (p) (or (file-stamp-in-paths p no-dirs)
                   (let ([pkg (path->pkg p)])
                     (and pkg
                          (not (set-member? open-pkgs pkg))
                          (file-stamp-in-paths p (list (pkg-directory pkg)))))))))
    (define extra-compiled-file-path
      (case (prefab-module-settings-annotations settings)
        [(none) (build-path "compiled" "drracket")]
        [(debug) (build-path "compiled" "drracket" "errortrace")]
        [else #f]))
    (when extra-compiled-file-path
      ;; Add extra compiled-file path:
      (use-compiled-file-paths
       (cons extra-compiled-file-path
             (use-compiled-file-paths)))
      ;; If we ever skip a file, then don't use the extra compiled-file
      ;; path for the skipped file's dependencies (because modules
      ;; compiled against the non-DrRacket-generated bytecode might not
      ;; work with any DrRacket-generated bytecode that is sitting around):
      (current-load/use-compiled
       (let ([orig (current-load/use-compiled)])
         (lambda (path mod-name)
           (if (and (member extra-compiled-file-path (use-compiled-file-paths))
                    (skip-path? path))
               (parameterize ([use-compiled-file-paths
                               (remove extra-compiled-file-path 
                                       (use-compiled-file-paths))])
                 (orig path mod-name))
               (orig path mod-name))))))
    ;; Install the compilation manager:
    (parallel-lock-client module-language-parallel-lock-client)
    (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler 
                                #t
                                #:security-guard (and use-current-security-guard?
                                                      (current-security-guard))))
    (manager-skip-file-handler skip-path?)))

(define (transform-module filename stx raise-hopeless-syntax-error)
  (define-values (mod name lang body)
    (syntax-case stx ()
      [(module name lang . body)
       (eq? 'module (syntax-e #'module))
       (values #'module #'name #'lang #'body)]
      [_ (raise-hopeless-syntax-error
          (string-append "only a module expression is allowed, either\n"
                         "    #lang <language-name>\n or\n"
                         "    (module <name> <language> ...)\n")
          stx)]))
  (define name* (syntax-e name))
  (unless (symbol? name*)
    (raise-hopeless-syntax-error "bad syntax in name position of module"
                                 stx name))
  (let* (;; rewrite the module to use the racket/base version of `module'
         [mod  (datum->syntax #'here 'module mod)]
         [expr (datum->syntax stx `(,mod ,name ,lang . ,body) stx stx)])
    (values name lang expr)))