(ql:quickload '(:cl-ppcre :alexandria :lparallel :verbose))

(defvar *replacements* '(("#\\|\\W*This file is a part of(.|\\n)*?\\|#\\n*" "")
                         ("Nicolas Hafner" "Yukari Hafner")))

(unless lparallel:*kernel*
  (setf lparallel:*kernel* (lparallel:make-kernel 8)))

(defun replace-string (string replacements)
  (let ((changed NIL))
    (loop for (search replace) in replacements
          do (multiple-value-bind (updated changed-p) (cl-ppcre:regex-replace-all search string replace)
               (when changed-p
                 (setf string updated)
                 (setf changed T))))
    (values string changed)))

(defun regex-replace-file (file replacements)
  (multiple-value-bind (string modified-p)
      (replace-string (alexandria:read-file-into-string file) replacements)
    (when modified-p
      (alexandria:write-string-into-file string file :if-exists :supersede)
      T)))

(defun regex-search-file (file replacements)
  (loop with string = (alexandria:read-file-into-string file)
        for (search) in replacements
        thereis (cl-ppcre:scan search string)))

(defun update-source-file (file &optional dry-run)
  (let ((replacements *replacements*))
    (if dry-run
        (regex-search-file file replacements)
        (regex-replace-file file replacements))))

(defun update-files (dir &optional dry-run)
  (let ((updated NIL))
    (dolist (file (uiop:directory-files dir))
      (when (or (string= "asd" (pathname-type file))
                (string= "lisp" (pathname-type file))
                (string= "LICENSE" (pathname-name file))
                (string= "LICENCE" (pathname-name file)))
        (when (update-source-file file dry-run)
          (push file updated))))
    (dolist (dir (uiop:subdirectories dir) updated)
      (setf updated (nconc updated (update-files dir dry-run))))))

(defun git (dir &rest args)
  (let ((ret (with-output-to-string (out)
               (let ((process (sb-ext:run-program "git" args :directory dir :output out :error *error-output* :search T)))
                 (when (/= 0 (sb-ext:process-exit-code process))
                   (error "~a~%git ~{~a~^ ~}" dir args))))))
    (string-right-trim '(#\Linefeed) ret)))

(defun git-push (dir &rest args)
  (apply #'git dir "push" (append args (list "origin" (git dir "rev-parse" "--abbrev-ref" "HEAD")))))

(defun update-repo (dir &optional dry-run)
  (org.shirakumo.verbose:info :update "Updating ~a" dir)
  (handler-case
      (let ((files (update-files dir dry-run)))
        (cond (files
               (unless dry-run
                 (apply #'git dir "stage" (mapcar #'uiop:native-namestring files))
                 (git dir "commit" "-m" "Update copyright")
                 (handler-case (git-push dir)
                   (error ()
                     (org.shirakumo.verbose:warn :update "Failed to push ~a" dir))))
               (list dir NIL))
              (T
               (list NIL NIL))))
    (error ()
      (list NIL dir))))

(defun spawn-updates (channel root &optional dry-run)
  (let ((tasks ()))
    (dolist (path (uiop:subdirectories root) tasks)
      (unless (string= ".git" (car (last (pathname-directory path))))
        (when (probe-file (merge-pathnames ".git/" path))
          (push path tasks)
          (lparallel:submit-task channel #'update-repo path dry-run))
        (setf tasks (nconc tasks (spawn-updates channel path)))))))

(defun update-all (root &optional dry-run)
  (let* ((channel (lparallel:make-channel))
         (tasks (spawn-updates channel root dry-run))
         succeeded failed)
    (with-simple-restart (abort "Stop waiting for threads and quit.")
      (loop repeat (length tasks)
            for (s f) = (lparallel:receive-result channel)
            do (when s
                 (push s succeeded)
                 (setf tasks (delete s tasks)))
               (when f
                 (push f failed)
                 (setf tasks (delete f tasks)))))
    (values succeeded failed tasks)))

(defun last-non-copy-commit (repo)
  (loop for i from 0
        for rev = (format NIL "HEAD~~~d" i)
        do (let ((message (git repo "log" "--format=%B" "-n" "1" rev)))
             (when (string/= message "Update copyright")
               (return rev)))))

(defun undo-copy-commit (repo)
  (with-simple-restart (abort "Don't undo ~a" repo)
    (let ((last (last-non-copy-commit repo)))
      (unless (string= last "HEAD~0")
        (git repo "reset" "--hard" last)
        (git-push repo "--force-with-lease")))))