#!/usr/bin/env racket
#lang racket
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(require file/glob)
(require racket/date)

(define ((re p) i) (regexp-match p i))
(define ((re? p) i) (regexp-match? p i))
(define ((s p ins) i) (regexp-replace p i ins))

(define this-year (number->string (date-year (current-date))))

(define (get-git-config key)
  (string-trim (with-output-to-string
                 (lambda () (system (format "git config --get ~a" key))))))

(define user-name (get-git-config "user.name"))
(define user-email (get-git-config "user.email"))

(define user (format "~a <~a>" user-name user-email))

(define (make-copyright who low [hi #f])
  (if (and hi (not (string=? low hi)))
      (format "Copyright © ~a-~a ~a" low hi who)
      (format "Copyright © ~a ~a" low who)))

(define total-file-count 0)
(define total-changed-files 0)
(define dry-run? #f)

(define (fix-files file-type-name file-pattern front-matter-re leading-comment-re comment-prefix)
  (define matched-files (glob file-pattern))
  (define file-count (length matched-files))
  (define changed-files 0)
  (for [(file-number (in-naturals))
        (f (in-list matched-files))]
    (printf "~a [~a/~a] ~a ..." file-type-name file-number file-count f)
    (flush-output)
    (define all-lines (file->lines f))
    (define-values (front-matter head tail)
      (let*-values (((lines) all-lines)
                    ((front-matter lines) (if front-matter-re
                                              (splitf-at lines (re? front-matter-re))
                                              (values '() lines)))
                    ((head tail) (splitf-at lines (re? leading-comment-re))))
        (values front-matter head tail)))
    (let* ((head (map (s leading-comment-re "") head))
           (head (map (lambda (l)
                        (match (regexp-match "^([^:]+): (.*)$" l)
                          [(list _ k v) (list k v)]
                          [#f (list #f l)]))
                      head))
           (head (if (assoc "SPDX-FileCopyrightText" head)
                     head
                     (cons (list "SPDX-FileCopyrightText" (make-copyright user this-year)) head)))
           (head (if (assoc "SPDX-License-Identifier" head)
                     head
                     (cons (list "SPDX-License-Identifier" "LGPL-3.0-or-later") head)))
           (head (map (lambda (l)
                        (match l
                          [(list "SPDX-FileCopyrightText"
                                 (and (regexp (regexp-quote user-name))
                                      (regexp #px"(\\d{4})-\\d{4}" (list _ low))))
                           (list "SPDX-FileCopyrightText"
                                 (make-copyright user low this-year))]
                          [(list "SPDX-FileCopyrightText"
                                 (and (regexp (regexp-quote user-name))
                                      (regexp #px"\\d{4}" (list low))))
                           (list "SPDX-FileCopyrightText"
                                 (make-copyright user low this-year))]
                          [_ l]))
                      head))
           (head (map (lambda (l) (string-append comment-prefix
                                                 (match l
                                                   [(list #f v) v]
                                                   [(list k v) (format "~a: ~a" k v)])))
                      head))
           (new-lines `(,@front-matter
                        ,@head
                        ""
                        ,@(dropf tail (lambda (l) (string=? (string-trim l) "")))))
           (changed? (not (equal? all-lines new-lines))))
      (when (and changed? (not dry-run?))
        (call-with-atomic-output-file
         f
         (lambda (port _tmp-path)
           (for [(l front-matter)] (displayln l port))
           (for [(l head)] (displayln l port))
           (newline port)
           (for [(l (dropf tail (lambda (l) (string=? (string-trim l) ""))))] (displayln l port)))))
      (if changed?
          (begin (set! changed-files (+ changed-files 1))
                 (printf "\e[41mchanged\e[0m\n"))
          (printf "\r\e[K"))))
  (when (positive? changed-files)
    (printf "~a [~a total files, ~a changed]\n" file-type-name file-count changed-files))
  (set! total-file-count (+ total-file-count file-count))
  (set! total-changed-files (+ total-changed-files changed-files)))

(command-line #:once-each
              [("-n" "--dry-run") "Do not write back changes to files"
               (set! dry-run? #t)])

(void (fix-files "Racket" "**.rkt" #px"^#" #px"^;+ *" ";;; "))
(printf "fixcopyright: ~a files examined, ~a ~a\n"
        total-file-count
        total-changed-files
        (if dry-run?
            (if (zero? total-changed-files)
                "changes are needed"
                "files need to be updated")
            (if (zero? total-changed-files)
                "changes were needed"
                "files were updated")))
(void (system "chmod a+x fixcopyright.rkt"))
(exit (if (positive? total-changed-files) 1 0))