;;; emacsgolf.el --- Keystroke golf for Emacs, vimgolf-style -*- lexical-binding: t; -*-

;; Author: emacsgolf
;; Version: 0.2.0
;; Package-Requires: ((emacs "28.1"))
;; Keywords: games
;; URL: https://emacsgolf.com

;;; Commentary:

;; Emacsgolf is to Emacs what vimgolf.com is to Vim: you are given a
;; start buffer and a target buffer, and must transform one into the
;; other in as few keystrokes as possible.
;;
;;   M-x emacsgolf            browse the course, RET to tee off
;;   M-x emacsgolf-play       tee off on a specific hole
;;   M-x emacsgolf-register   claim a golfer name (once, before submitting)
;;
;; While playing:
;;   C-c C-c   check your buffer against the target; submit if it matches
;;   C-c C-d   diff your buffer against the target
;;   C-c C-r   mulligan (reset the buffer AND the meter)
;;   C-c C-k   walk off the course
;;
;; Scoring: every keystroke between tee-off and C-c C-c counts, as
;; measured by Emacs' own input event counter (`num-nonmacro-input-events').
;; That includes M-x invocations, minibuffer typing, C-g, and window
;; navigation.  Events replayed from a keyboard macro are free — but the
;; keys you typed to define the macro were not.  The final C-c C-c is on
;; the house.
;;
;; Submitted scores are verified server-side by replaying your key log
;; in vanilla `emacs -Q'.  The fairway is stock Emacs: custom
;; keybindings won't survive the replay, and (for now) neither do
;; solutions that define keyboard macros mid-round.

;;; Code:

(require 'json)
(require 'url)
(require 'subr-x)
(require 'seq)
(require 'tabulated-list)

(defvar url-http-end-of-headers)
(defvar url-http-response-status)
(defvar url-request-noninteractive)

(defgroup emacsgolf nil
  "Keystroke golf for Emacs."
  :group 'games
  :prefix "emacsgolf-")

(defcustom emacsgolf-host "https://emacsgolf.com"
  "Base URL of the emacsgolf server.
Point this at http://localhost:1985 when developing locally."
  :type 'string)

(defcustom emacsgolf-player (user-login-name)
  "Golfer name for leaderboard submissions.
Set for you by `emacsgolf-register'."
  :type 'string)

(defcustom emacsgolf-token nil
  "API token identifying you to the emacsgolf server.
Set for you by `emacsgolf-register'."
  :type '(choice (const :tag "Not registered" nil) string))

(defcustom emacsgolf-lossage-size 20000
  "Minimum keystroke history to retain while playing.
The key log submitted with your score is reconstructed from
lossage; rounds longer than this cannot submit a log."
  :type 'natnum)

(defconst emacsgolf--client-id "emacsgolf.el/0.1.0")

;;; Game state

(defvar emacsgolf--challenge nil
  "Alist describing the hole currently being played, or nil.")
(defvar emacsgolf--buffer nil)
(defvar emacsgolf--target-buffer nil)
(defvar emacsgolf--baseline 0
  "Value of `num-nonmacro-input-events' at tee-off.")
(defvar emacsgolf--saved-lossage nil)

;;; HTTP

(defun emacsgolf--url (path)
  (concat (string-remove-suffix "/" emacsgolf-host) path))

(defun emacsgolf--auth-headers ()
  "Authorization headers for the configured token, if any."
  (when (and emacsgolf-token (not (string-empty-p emacsgolf-token)))
    `(("Authorization" . ,(concat "Bearer " emacsgolf-token)))))

(defun emacsgolf--request (method path &optional payload)
  "Perform METHOD on PATH against `emacsgolf-host', return parsed JSON.
PAYLOAD, if given, is serialized as a JSON request body."
  (let* ((url-request-method method)
         ;; A 401 must surface as our error, not url.el's Username: prompt.
         (url-request-noninteractive t)
         (url-request-extra-headers
          (append (and payload '(("Content-Type" . "application/json")))
                  (emacsgolf--auth-headers)))
         (url-request-data
          (and payload (encode-coding-string (json-serialize payload) 'utf-8)))
         (buf (url-retrieve-synchronously (emacsgolf--url path) t nil 15)))
    (unless buf
      (error "emacsgolf: no response from %s" emacsgolf-host))
    (with-current-buffer buf
      (unwind-protect
          (let ((status url-http-response-status)
                (body (progn
                        (goto-char (or url-http-end-of-headers (point-min)))
                        (ignore-errors
                          (json-parse-string
                           (decode-coding-string
                            (buffer-substring-no-properties (point) (point-max))
                            'utf-8)
                           :object-type 'alist :array-type 'list
                           :null-object nil :false-object nil)))))
            (when (or (null status) (>= status 400))
              (error "emacsgolf: server said %s%s" (or status "nothing")
                     (let ((e (and (listp body) (alist-get 'error body))))
                       (if e (format " — %s" e) ""))))
            body)
        (kill-buffer buf)))))

;;; Scoring helpers (pure-ish, exercised by the test suite)

(defun emacsgolf--score ()
  "Keystrokes spent so far this round."
  (max 0 (- num-nonmacro-input-events emacsgolf--baseline)))

(defun emacsgolf--buffer-matches-p (buffer target)
  "Non-nil if BUFFER's contents are exactly the string TARGET."
  (with-current-buffer buffer
    (string= (buffer-substring-no-properties (point-min) (point-max)) target)))

(defun emacsgolf--key-log (recent total tail)
  "Extract the round's key log from the lossage vector RECENT.
TOTAL is the number of events since tee-off, including the TAIL
events that invoked the finishing command (which are not part of
the score).  Return a list of key description strings, or nil if
lossage does not reach back far enough."
  (let ((n (length recent)))
    (when (and (>= n total) (>= total tail))
      (mapcar #'single-key-description
              (seq-take (seq-drop (append recent nil) (- n total))
                        (- total tail))))))

(defun emacsgolf--payload (score keys)
  "Build the submission object for the server.
Identity travels in the Authorization header, not the body."
  `((score . ,score)
    (keys . ,(vconcat keys))
    (client . ,emacsgolf--client-id)))

;;; Accounts

;;;###autoload
(defun emacsgolf-register (name)
  "Claim golfer NAME on the server and store the token it returns."
  (interactive
   (list (string-trim
          (read-string (format "Claim a golfer name (default %s): " emacsgolf-player)
                       nil nil emacsgolf-player))))
  (let ((result (emacsgolf--request "POST" "/api/players" `((name . ,name)))))
    (setq emacsgolf-player (alist-get 'name result)
          emacsgolf-token (alist-get 'token result))
    (condition-case nil
        (progn
          (customize-save-variable 'emacsgolf-player emacsgolf-player)
          (customize-save-variable 'emacsgolf-token emacsgolf-token)
          (message "⛳ Registered as %s — token saved via Customize." emacsgolf-player))
      (error
       (message "⛳ Registered as %s — couldn't save settings; add to your init file:\n  (setq emacsgolf-player %S\n        emacsgolf-token %S)"
                emacsgolf-player emacsgolf-player emacsgolf-token)))))

(defun emacsgolf--ensure-account ()
  "Make sure we have a token, offering to register if not."
  (unless (emacsgolf--auth-headers)
    (if (y-or-n-p "No golfer account on this server yet.  Register one now? ")
        (call-interactively #'emacsgolf-register)
      (user-error "Submitting needs an account — M-x emacsgolf-register"))))

;;; Playing

(defvar emacsgolf-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-c C-c") #'emacsgolf-done)
    (define-key map (kbd "C-c C-d") #'emacsgolf-diff)
    (define-key map (kbd "C-c C-r") #'emacsgolf-reset)
    (define-key map (kbd "C-c C-k") #'emacsgolf-quit)
    map))

(define-minor-mode emacsgolf-mode
  "Minor mode active in a live emacsgolf challenge buffer.
The lighter shows the running keystroke count."
  :lighter (" ⛳" (:eval (number-to-string (emacsgolf--score)))))

(defun emacsgolf--read-challenge-id ()
  (let* ((challenges (emacsgolf--request "GET" "/api/challenges"))
         (table (mapcar (lambda (c)
                          (cons (alist-get 'id c) (alist-get 'title c)))
                        challenges))
         (completion-extra-properties
          (list :annotation-function
                (lambda (id) (format "  — %s" (cdr (assoc id table)))))))
    (completing-read "Hole: " table nil t)))

;;;###autoload
(defun emacsgolf-play (id)
  "Tee off on the emacsgolf hole named ID."
  (interactive (list (emacsgolf--read-challenge-id)))
  (let ((challenge (emacsgolf--request
                    "GET" (concat "/api/challenges/" (url-hexify-string id)))))
    (emacsgolf--teardown)
    (setq emacsgolf--challenge challenge)
    (let ((play (get-buffer-create (format "*golf/%s*" id)))
          (target (get-buffer-create (format "*golf/%s target*" id))))
      (with-current-buffer target
        (let ((inhibit-read-only t))
          (erase-buffer)
          (insert (alist-get 'end challenge)))
        (goto-char (point-min))
        (read-only-mode 1))
      (with-current-buffer play
        (erase-buffer)
        (insert (alist-get 'start challenge))
        (goto-char (point-min))
        (set-buffer-modified-p nil)
        (emacsgolf-mode 1))
      (setq emacsgolf--buffer play
            emacsgolf--target-buffer target)
      (when (fboundp 'lossage-size)
        (setq emacsgolf--saved-lossage (lossage-size))
        (when (< emacsgolf--saved-lossage emacsgolf-lossage-size)
          (lossage-size emacsgolf-lossage-size)))
      (delete-other-windows)
      (set-window-buffer (selected-window) play)
      (set-window-buffer (split-window-right) target)
      (message "⛳ %s (par %s) — make this buffer match the target, then C-c C-c."
               (alist-get 'title challenge) (alist-get 'par challenge))
      ;; Set the baseline last: everything typed from here on counts.
      (setq emacsgolf--baseline num-nonmacro-input-events))))

(defun emacsgolf--assert-playing ()
  (unless (and emacsgolf--challenge
               (buffer-live-p emacsgolf--buffer)
               (eq (current-buffer) emacsgolf--buffer))
    (user-error "Not in a live emacsgolf buffer — M-x emacsgolf-play to tee off")))

(defun emacsgolf-done ()
  "Check the buffer against the target; offer to submit on a match.
The keystrokes used to invoke this command are not counted."
  (interactive)
  (emacsgolf--assert-playing)
  (let* ((tail (length (this-command-keys-vector)))
         (total (- num-nonmacro-input-events emacsgolf--baseline))
         (score (max 0 (- total tail)))
         (par (alist-get 'par emacsgolf--challenge)))
    (if (not (emacsgolf--buffer-matches-p
              emacsgolf--buffer (alist-get 'end emacsgolf--challenge)))
        (message "Not there yet — buffer differs from target (C-c C-d for a diff).  The meter keeps running.")
      ;; Snapshot the log before any prompt adds new events to lossage.
      (let ((log (emacsgolf--key-log (recent-keys) total tail)))
        (if (not (y-or-n-p (format "Holed out in %d keystrokes (par %s)!  Submit to leaderboard? "
                                   score par)))
            (message "Holed out in %d keystrokes.  C-c C-r to golf again, C-c C-k to leave."
                     score)
          (unless log
            (user-error "Keystroke log truncated (round longer than emacsgolf-lossage-size); cannot submit"))
          (when (zerop score)
            (user-error "Zero keystrokes?  The clubhouse frowns on that"))
          (emacsgolf--ensure-account)
          (let ((result (emacsgolf--request
                         "POST"
                         (format "/api/challenges/%s/submissions"
                                 (url-hexify-string (alist-get 'id emacsgolf--challenge)))
                         (emacsgolf--payload score log))))
            (message "⛳ Submitted: %d keystrokes on %s%s — rank #%s of %s.  C-c C-r to try to beat it."
                     score (alist-get 'id emacsgolf--challenge)
                     (if (eq (alist-get 'verified result) t)
                         ", replay-verified ✓" " (unverified)")
                     (alist-get 'rank result) (alist-get 'players result))))))))

(defun emacsgolf-diff ()
  "Diff the challenge buffer against the target (costs keystrokes!)."
  (interactive)
  (emacsgolf--assert-playing)
  (diff-buffers emacsgolf--buffer emacsgolf--target-buffer))

(defun emacsgolf-reset ()
  "Mulligan: restore the start text and reset the keystroke meter."
  (interactive)
  (emacsgolf--assert-playing)
  (erase-buffer)
  (insert (alist-get 'start emacsgolf--challenge))
  (goto-char (point-min))
  (set-buffer-modified-p nil)
  (message "Fresh ball.  The meter is back to zero.")
  (setq emacsgolf--baseline num-nonmacro-input-events))

(defun emacsgolf-quit ()
  "Abandon the current round and clean up."
  (interactive)
  (emacsgolf--teardown)
  (message "Walked off the course.  The lake accepts your ball."))

(defun emacsgolf--teardown ()
  (when (buffer-live-p emacsgolf--buffer) (kill-buffer emacsgolf--buffer))
  (when (buffer-live-p emacsgolf--target-buffer) (kill-buffer emacsgolf--target-buffer))
  (when (and emacsgolf--saved-lossage (fboundp 'lossage-size)
             (> (lossage-size) emacsgolf--saved-lossage))
    (lossage-size emacsgolf--saved-lossage))
  (setq emacsgolf--challenge nil
        emacsgolf--buffer nil
        emacsgolf--target-buffer nil
        emacsgolf--saved-lossage nil))

;;; Course browser

(defvar-keymap emacsgolf-browse-mode-map
  :parent tabulated-list-mode-map
  "RET" #'emacsgolf-browse-play)

(define-derived-mode emacsgolf-browse-mode tabulated-list-mode "EmacsGolf"
  "Major mode listing emacsgolf holes.  RET tees off."
  (setq tabulated-list-format
        [("Hole" 22 t)
         ("Par" 5 nil :right-align t)
         ("Best" 5 nil :right-align t)
         ("Golfers" 8 nil :right-align t)
         ("Title" 40 t)])
  (setq tabulated-list-padding 1)
  (tabulated-list-init-header))

(defun emacsgolf-browse-play ()
  "Tee off on the hole at point."
  (interactive)
  (let ((id (tabulated-list-get-id)))
    (unless id (user-error "No hole at point"))
    (emacsgolf-play id)))

;;;###autoload
(defun emacsgolf ()
  "Browse the emacsgolf course."
  (interactive)
  (let ((challenges (emacsgolf--request "GET" "/api/challenges")))
    (with-current-buffer (get-buffer-create "*emacsgolf*")
      (emacsgolf-browse-mode)
      (setq tabulated-list-entries
            (mapcar (lambda (c)
                      (list (alist-get 'id c)
                            (vector
                             (alist-get 'id c)
                             (number-to-string (alist-get 'par c))
                             (let ((best (alist-get 'best c)))
                               (if best (number-to-string best) "—"))
                             (number-to-string (or (alist-get 'golfers c) 0))
                             (alist-get 'title c))))
                    challenges))
      (tabulated-list-print t)
      (pop-to-buffer (current-buffer))
      (message "RET to tee off.  Fairways are metaphorical."))))

(provide 'emacsgolf)
;;; emacsgolf.el ends here