#!/bin/sh
#| -*- scheme -*-
exec racket -um "$0" "$@"
|#

#lang racket/base
(require version/utils racket/file)

(define (patches)
  ;; no grouping parens in regexps
  (let* ([parts# (length (regexp-split #rx"[.]" the-version))]
         [concat
          (lambda xs
            (apply bytes-append
                   (map (lambda (x) (if (string? x) (string->bytes/utf-8 x) x))
                        xs)))]
         [commas  "<1>, *<2>, *<3>, *<4>"]
         [periods "<1>.<2>.<3>.<4>"]
         [rc-patch (list (concat "\r\n *FILEVERSION "commas" *"
                                 "\r\n *PRODUCTVERSION "commas" *\r\n")
                         (concat "\r\n *VALUE \"FileVersion\", *\""commas
                                 "(?:\\\\0)?\"")
                         (concat "\r\n *VALUE \"ProductVersion\", *\""commas
                                 "(?:\\\\0)?\""))]
         [manifest-patch (list (concat "assemblyIdentity[ \r\n]+"
                                       "version=\""periods"\"[ \r\n]"))])
    `([#t ; only verify that it has the right contents
       "src/racket/src/schvers.h"
       ,(concat "\n#define MZSCHEME_VERSION \"<1>.<2>"
                (if (parts# . >= . 3) ".<3>" "")
                (if (parts# . >= . 4) ".<4>" "")
                "\"\n")
       ,@(for/list ([x+n (in-list '([X 1] [Y 2] [Z 3] [W 4]))])
           (format "\n#define MZSCHEME_VERSION_~a ~a\n"
                   (car x+n)
                   (if ((cadr x+n) . > . parts#)
                     "0" (format "<~a>" (cadr x+n)))))]
      ["src/worksp/racket/racket.rc"   ,@rc-patch]
      ["src/worksp/gracket/gracket.rc" ,@rc-patch]
      ["src/worksp/starters/start.rc"  ,@rc-patch]
      ["src/worksp/racket/racket.manifest"   ,@manifest-patch]
      ["src/worksp/gracket/gracket.manifest" ,@manifest-patch]
      ["src/worksp/mzcom/mzobj.rgs"
       ,(concat "MzCOM.MzObj."periods" = s 'MzObj Class'")
       ,(concat "CurVer = s 'MzCOM.MzObj."periods"'")
       ,(concat "ProgID = s 'MzCOM.MzObj."periods"'")]
      ["src/worksp/mzcom/mzcom.rc"       ,@rc-patch
       #"\r\n *CTEXT +\"MzCOM v. <1>.<2>\",IDC_STATIC"
       #"\r\n *CTEXT +\"Racket v. <1>.<2>\",IDC_STATIC"])))

(define the-version #f)

(define getv
  (let ([vlist #f])
    (lambda (i)
      (unless vlist
        (set! vlist (map (compose string->bytes/utf-8 number->string)
                         (version->list the-version))))
      (list-ref vlist i))))

(define (replace-pattern pattern buf err)
  (let* ([rx (regexp-replace* #rx#"<[1234]>" pattern #"([0-9]+)")]
         [vs (map (lambda (m)
                    (let* ([m (regexp-replace #rx#"^<(.+)>$" m #"\\1")]
                           [m (string->number (bytes->string/utf-8 m))])
                      (sub1 m)))
                  (regexp-match* #rx#"<[1234]>" pattern))]
         [m  (regexp-match-positions rx buf)])
    (cond
      [(not m) (err "pattern ~s not found" pattern)]
      [(regexp-match? rx buf (cdar m))
       (err "pattern ~s matches more than once" pattern)]
      [else (let loop ([m (cdr m)] [i 0] [vs vs] [r '()])
              (cond [(and (null? m) (null? vs))
                     (apply bytes-append (reverse (cons (subbytes buf i) r)))]
                    [(or (null? m) (null? vs)) (error "internal error")]
                    [else (loop (cdr m) (cdar m) (cdr vs)
                                (list* (getv (car vs))
                                       (subbytes buf i (caar m))
                                       r))]))])))

(define (do-patch file . specs)
  (let* ([only-verify? (eq? file #t)]
         [file  (if only-verify? (car specs) file)]
         [specs (if only-verify? (cdr specs) specs)]
         [_ (begin (printf "  ~a..." file) (flush-output))]
         [contents (file->bytes file)]
         [buf contents]
         [err (lambda (fmt . args)
                (error 'versionpatch "~a, in ~s"
                       (apply format fmt args) file))])
    (for ([spec (in-list specs)]) (set! buf (replace-pattern spec buf err)))
    (if (equal? buf contents)
      (printf (if only-verify? " verified.\n" " no change.\n"))
      (begin (printf " modified.\n")
             (if only-verify?
               (error 'versionpatch
                      "this file is expected to have a correct version")
               (with-output-to-file file (lambda () (write-bytes buf))
                                    #:exists 'truncate))))))

(provide main)
(define (main ver)
  (set! the-version ver)
  ;; (printf "Patching files for ~a...\n" ver)
  (for ([p (in-list (patches))]) (apply do-patch p))
  (printf "Done.\n"))