#lang racket/base
;; For legal info, see file "info.rkt".

(require planet/version)

;;------------------------------------------------------------------- Constants

(define mcfly-minimum-compatible-planet-spec-string "neil/mcfly:1:0")

;;-----------------------------------------------------------------------------

(define (%format-exact-planet-version-string owner name major minor)
  (let ((name (regexp-replace #"\\.plt$" name "")))
    (format "~A/~A:~A:=~A" owner name major minor)))

(define (%this-planet-exact-version-string)
  (with-handlers ((exn? (lambda (x) #f)))
    (apply %format-exact-planet-version-string
           (this-package-version))))

(define (this-mcfly-tools-exact-require-spec-string)
  (cond ((%this-planet-exact-version-string)
         => (lambda (str)
              (string-append "(planet " str ")")))
        (else #f)))

(define (make-mcfly-generated-file-updater #:error-name    error-name
                                           #:cookie-string cookie-string
                                           #:write-proc    write-proc)
  (let ((cookie-rx (regexp (string-append "(?m:^"
                                          (regexp-quote cookie-string)
                                          "(?:[ \t]|$))"))))
    (lambda (rkt-path out-path)
      (let ((out-path (cleanse-path out-path)))
        (and (file-exists? out-path)
             (call-with-input-file out-path
               (lambda (in)
                 (or (regexp-match? cookie-rx in)
                     (error error-name
                            "File ~S exists and does not contain the McFly ~S line."
                            (path->string out-path)
                            cookie-string)))))
        (call-with-output-file out-path
          (lambda (out)
            ;; TODO: Don't pass rkt-path and out-path.  Make them get from
            ;; other source if they need.
            (write-proc rkt-path out-path out))
          #:exists 'replace)))))

;;-----------------------------------------------------------------------------

(define (write-mcfly-cookie-line cookie-string out)
  (fprintf out
           "~A ~A\n"
           cookie-string
           (or (this-mcfly-tools-exact-require-spec-string)
               "[unknown]")))

(define mcfly-tools-scribble-file-cookie-string
  "@; THIS-FILE-WAS-GENERATED-BY-MCFLY-TOOLS")

(define (write-mcfly-scribble-file rkt-path out-path out)
  (display "#lang scribble/manual\n" out)
  (write-mcfly-cookie-line mcfly-tools-scribble-file-cookie-string out)
  (display "@(require (for-syntax   racket/base)\n"     out)
  (display "          (for-template racket/base)\n"     out)
  (fprintf out
           "          (planet ~A/mcfly-scribble)\n"
           mcfly-minimum-compatible-planet-spec-string)
  (fprintf out
           "          (planet ~A/mcfly-expand))\n"
           mcfly-minimum-compatible-planet-spec-string)
  ;; TODO: Make rkt-path be minimal relative to out-path.  Might need to write
  ;; a utility function to do that. See (require setup/path-to-relative)
  (fprintf out
           "@(mcfly-expand ~S)\n"
           (path->string (cleanse-path rkt-path))))

(define create-or-update-mcfly-scribble-file
  (make-mcfly-generated-file-updater
   #:error-name    'create-or-update-mcfly-scribble-file
   #:cookie-string mcfly-tools-scribble-file-cookie-string
   #:write-proc    write-mcfly-scribble-file))

(provide
 create-or-update-mcfly-scribble-file
 write-mcfly-scribble-file)