(require 'cl-lib)

(require 'browse-url)

(require 'json)

(require 'subr-x)

(require 'package) ; for #'learn-ocaml-upgrade-packages

(defgroup learn-ocaml nil

"learn-ocaml in Emacs "

:group 'applications

:prefix "learn-ocaml-")

(defvar learn-ocaml-fail-noisely nil

"Set `learn-ocaml-fail-noisely' to non-nil for `ert'-testing purposes.")

(defconst learn-ocaml-timeout 4

"Time in s for `learn-ocaml-await-for' to wait after calling `make-process'.")

(defconst learn-ocaml-mode-version "1.0.0-git")

(defconst learn-ocaml-command-name "learn-ocaml-client")

(defconst learn-ocaml-temp-prefix "learn-ocaml-mode"

"Prefix of the HTML temporary directory given to `make-temp-file'.")

(defconst learn-ocaml-temp-html-file "results.html"

"Constant filename created in temporary folder.")

(defvar learn-ocaml-temp-dir nil)

(defvar learn-ocaml-use-passwd nil)

(defvar learn-ocaml-log-buffer nil)

(defun learn-ocaml-log-buffer ()

"Return the value of variable `learn-ocaml-log-buffer'.

(unless (buffer-live-p learn-ocaml-log-buffer)

(setq learn-ocaml-log-buffer (get-buffer-create "*learn-ocaml-log*")))

learn-ocaml-log-buffer)

(defvar learn-ocaml-warning-message

"learn-ocaml.el encountered an error. Open log?")

(defconst learn-ocaml-exo-list-name "*learn-ocaml-exercise-list*")

(defvar learn-ocaml-exo-list-buffer nil)

(defun learn-ocaml-exo-list-buffer ()

"Return the value of variable `learn-ocaml-exo-list-buffer'.

(unless (buffer-live-p learn-ocaml-exo-list-buffer)

(setq learn-ocaml-exo-list-buffer (get-buffer-create learn-ocaml-exo-list-name)))

learn-ocaml-exo-list-buffer)

(defconst learn-ocaml-exo-list-doc

"g : Refresh list | TAB / S-TAB : Navigate | q : Close list")

(defvar learn-ocaml-loaded nil)

(defvar-local learn-ocaml-exercise-id nil)

(defun learn-ocaml--rstrip (str)

"Remove the trailing newline in STR."

(replace-regexp-in-string "\n\\'" "" str))

(defun learn-ocaml-yes-or-no (message &optional dont-trap-quit)

"Display MESSAGE in a yes-or-no popup.

(let ((run (lambda ()

(x-popup-dialog t `(,message ("Yes" . t) ("No" . nil))))))

(if dont-trap-quit

(funcall run)

(condition-case _sig

(funcall run)

(quit nil)))))

(defun learn-ocaml-global-disable-mode ()

"Disable learn-ocaml-mode' in ALL buffers."

(interactive "a")

(dolist (buffer (buffer-list))

(with-current-buffer buffer

(funcall 'learn-ocaml-mode -1))))

(defun learn-ocaml-get-progression-by-id (id json)

(if (cdr (assoc (intern id) json))

(concat (number-to-string (cdr (assoc (intern id) json))) "%")

"N/A"))

(defun learn-ocaml-print-time-stamp ()

"Insert date/time in the buffer given by function `learn-ocaml-log-buffer'."

(set-buffer (learn-ocaml-log-buffer))

(goto-char (point-max))

(insert (concat

"\n\n\n"

"--------------------- "

(current-time-string)

" ---------------------\n")))

(defun escape-secret (secret)

"Add escape to the secret when it's empty"

(if-let (secret-option (string= secret ""))

"\"\""

secret))

(defun learn-ocaml-file-writter-filter (file _proc string)

"Write in FILE the given STRING.

(write-region string nil file t))

(defun learn-ocaml-temp-dir ()

"Return the path of the temp directory attached to current session.

(let ((result (or learn-ocaml-temp-dir

(make-temp-file learn-ocaml-temp-prefix t))))

(setq learn-ocaml-temp-dir result)

(add-hook 'kill-emacs-query-functions #'learn-ocaml-delete-temp)

result))

(defun learn-ocaml-cd (directory)

"Change `default-directory' to DIRECTORY and return previous value.

(let ((old default-directory))

(cd directory)

old))

(defun learn-ocaml-file-path (dir file)

"Return the absolute path (w.r.t. to DIR, if applicable) for FILE."

(if (file-name-absolute-p file)

file

(if (directory-name-p dir)

(concat dir file)

(concat (file-name-as-directory dir) file))))

(defun learn-ocaml-temp-html-glob ()

"Generate the glob pattern used by `learn-ocaml-delete-temp'."

(learn-ocaml-file-path (learn-ocaml-temp-dir)

(concat "*" learn-ocaml-temp-html-file)))

(defun learn-ocaml-delete-temp ()

"Propose to delete temp .html files at exit if not in batch mode.

(interactive)

;; (unless noninteractive ?)

(let ((temp-glob (learn-ocaml-temp-html-glob)))

(when (or noninteractive

(learn-ocaml-yes-or-no

(concat

"learn-ocaml.el automatic cleanup:\n\nDo you want to clear "

temp-glob " ?")))

(let ((files (file-expand-wildcards temp-glob)))

(mapc (lambda (file) (ignore-errors (delete-file file))) files))

(ignore-errors (delete-directory (learn-ocaml-temp-dir)))))

t)

(defun learn-ocaml-server-config (json)

"Set the global variable learn-ocaml-use-passwd according

(if (string= (cdr (assoc 'use_passwd (json-read-from-string json)))

"true")

(setq learn-ocaml-use-passwd t)

(setq learn-ocaml-use-passwd nil)))

(defun learn-ocaml-since-upto (since upto)

"Return (SINCE . UPTO) with args possibly nil, denoting (SINCE <= v < UPTO).

(unless (or (stringp since) (null since))

(error "SINCE must be a string"))

(unless (or (stringp upto) (null upto))

(error "UPTO must be a string"))

(cons since upto))

(defun learn-ocaml-compat (pred-pair version)

"If PRED-PAIR is (since . upto), return (since <= VERSION < upto).

(let ((since (car pred-pair)) (upto (cdr pred-pair)))

(and (if since (version-list-<= (version-to-list since) version) t)

(if upto (version-list-< version (version-to-list upto)) t))))

(defun learn-ocaml-upgrade-packages ()

"Upgrade ELPA packages (using package.el)."

(interactive)

(let ((old-async package-menu-async))

(setq package-menu-async nil)

(package-list-packages)

(package-menu-mark-upgrades)

(let ((use-dialog-box nil))

;; make `y-or-n-p' show up within the minibuffer

;; even if `learn-ocaml-upgrade-packages' was called interactively

(package-menu-execute))

(setq package-menu-async old-async)))

(defun learn-ocaml-temp-html-file (&optional id)

"Return the path of the .html file to consider for exercise ID."

(learn-ocaml-file-path (learn-ocaml-temp-dir)

(if id (concat id "-" learn-ocaml-temp-html-file)

learn-ocaml-temp-html-file)))

(defun learn-ocaml-update-exec-path (default-dir)

"Propose to add a directory, e.g. DEFAULT-DIR, to `exec-path'."

(if noninteractive

(if default-dir

(add-to-list 'exec-path default-dir)

(error "No directory selected (in learn-ocaml-update-exec-path)"))

(let ((dir (condition-case _sig

(read-directory-name "Add folder containing learn-ocaml-client: "

(or default-dir "~/")

(or default-dir "~/")

t "")

(quit ""))))

(if (and dir (not (string-equal "" dir)))

(add-to-list 'exec-path dir)))))

(defun learn-ocaml-change-default-directory (open-exo-list)

"Change `default-directory' interactively.

(interactive)

(let ((dir

(read-directory-name "Choose your working directory: "

default-directory

default-directory

nil "")))

(make-directory dir t)

(setq default-directory dir))

(if open-exo-list (learn-ocaml-display-exercise-list)))

(cl-defun learn-ocaml-make-process-wrapper (&rest args &key command &allow-other-keys)

"Call `make-process' after checking the program is in `exec-path'.

(if (and (listp command) (string-equal learn-ocaml-command-name

(car command))

(not (executable-find (car command)))) ; not found

(if (executable-find "opam")

(progn (message "\"%s\" not found; running \"opam var bin\"..."

learn-ocaml-command-name)

(let ((client-bin

(learn-ocaml--rstrip (shell-command-to-string "opam var bin"))))

(learn-ocaml-update-exec-path client-bin)))

(learn-ocaml-update-exec-path nil)))

(if (executable-find learn-ocaml-command-name)

(apply #'make-process args)

(if noninteractive

(error "\"%s\" not found!" learn-ocaml-command-name)

(if (learn-ocaml-yes-or-no

(format "\"%s\" not found.\n\nCurrent value of exec-path:\n%s\n\nRetry?"

learn-ocaml-command-name

(concat "(\n" (apply #'concat

(cl-map 'list (lambda (s) (concat s "\n"))

exec-path)) ")")))

(apply #'learn-ocaml-make-process-wrapper args) ; this could be a loop

nil))))

(defun learn-ocaml-await-for (fun-kk-body time &optional descr)

"Run FUN-KK-BODY, wait TIME s for a callback to be called, or failwith DESCR.

(let ((wip t))

(catch 'result

(let ((result

#'(lambda (res)

(if wip (throw 'result `(t . ,res))

(message "learn-ocaml-await-for%s: Got result too late [%s]."

(if descr (concat "[" descr "]") "") res))))

(failure

#'(lambda (res)

(if wip (throw 'result `(nil . ,res))

(message "learn-ocaml-await-for%s: Got failure too late [%s]."

(if descr (concat "[" descr "]") "") res)))))

;; Note that FUN-K-BODY is not wrapped by `with-timeout'

;; as FUN-KK-BODY will typically be an async call to `make-process'

;; and we just wait for the subprocess to terminate within TIME s.

(funcall fun-kk-body result failure)

(let ((end-time (+ (float time) (float-time)))) ;; start counting here

(while (< (float-time) end-time)

(accept-process-output nil 0.1)))

(setq wip nil)

(error

"learn-ocaml-await-for%s: didn't receive result after %ds."

(if descr (concat "[" descr "]") "") time)))))

(defun learn-ocaml-command-to-string-await-cmd (args)

"Run \"learn-ocaml-client ARGS\".

;; (learn-ocaml-print-time-stamp) ;; FIXME: enable?

(unless (and args (listp args))

(error "ARGS must be a nonempty list (of strings)"))

(let ((buffer (generate-new-buffer (concat (car args) "-std-out"))))

(learn-ocaml-await-for

#'(lambda (result failure)

(learn-ocaml-make-process-wrapper

:name (car args)

:command (cons learn-ocaml-command-name args)

:buffer buffer

:sentinel (apply-partially

#'learn-ocaml-error-handler-nosplit-catch

buffer

#'(lambda (s) (funcall result s))

#'(lambda (s) (funcall failure s)))))

learn-ocaml-timeout (car args))))

(defun learn-ocaml-client-version ()

"Run \"learn-ocaml-client --version\"."

(string-trim

(cdr (learn-ocaml-command-to-string-await-cmd (list "--version")))))

(defconst learn-ocaml-client-server-min-version-compat

(learn-ocaml-since-upto "0.13.0" nil))

(defun learn-ocaml-client-server-min-version (&optional server)

"Return the min of the learn-ocaml server and learn-ocaml-client versions."

(let* ((client (learn-ocaml-client-version))

(command (list "server-version" "--min"))

(version-string

(if (learn-ocaml-compat learn-ocaml-client-server-min-version-compat

(version-to-list client))

;; TODO: Take errors into account in a better way,

;; instead of waiting that `version-to-list' fails

(string-trim (cdr (learn-ocaml-command-to-string-await-cmd

(if server (append command

(list "-s" server))

command))))

client))

(_check (version-to-list version-string)))

version-string))

(defun learn-ocaml-error-handler (buffer callback proc string)

"Get text from BUFFER and pass it to the CALLBACK.

(let ((result (if (not buffer)

""

(set-buffer buffer)

(buffer-string))))

(when buffer (kill-buffer buffer))

(if (or (string-equal string "finished\n")

(string-match "give-token" (process-name proc))

(string-match "give-server" (process-name proc)))

(funcall callback result)

(progn (set-buffer (learn-ocaml-log-buffer))

(goto-char (point-max))

(let ((message

;; FIXME(Bug): this returns the whole buffer text!

(if (search-backward "[ERROR]" nil t 1)

(buffer-substring (point) (point-max)) "")))

(cl-case (x-popup-dialog

t `(,message

("Ok" . 1)

("Check full learn-ocaml-log" . 2)))

(2 (switch-to-buffer-other-window "*learn-ocaml-log*")))))

(when learn-ocaml-fail-noisely

(with-current-buffer (learn-ocaml-log-buffer)

;; Remark: the log will contain earlier, unrelated info...

(let ((log (buffer-string)))

(error "Process errored. Full log:\n%s" log)))))))

(defun learn-ocaml-error-handler-nosplit-catch (buffer callback-ok callback-err _proc string)

"Get text from BUFFER, pass it to CALLBACK-OK ($?=0) or CALLBACK-ERR.

(let ((result (if (not buffer)

""

(set-buffer buffer)

(buffer-string))))

(when buffer (kill-buffer buffer))

(if (or (string-equal string "finished\n"))

(funcall callback-ok result)

(progn (set-buffer (learn-ocaml-log-buffer))

(insert result)

(funcall callback-err result)))))

(cl-defun learn-ocaml-command-constructor (&key command token server local id html dont-submit param1 param2)

"Construct a shell command with `learn-ocaml-command-name' and options."

(let* ((server-option (when server (concat "--server=" server)))

(token-option (when token (concat "--token=" token)))

(local-option (when local "--local"))

(id-option (when id (concat "--id=" id)))

(html-option (when html "--html"))

(dont-submit-option (when dont-submit "-n"))

(list (list learn-ocaml-command-name command token-option server-option id-option html-option dont-submit-option local-option param1 param2)))

(cl-remove-if-not 'stringp list)))

(cl-defun learn-ocaml-init-user-command-constructor (&key server login password nickname secret)

"Construct a shell command with `learn-ocaml-command-name' and options."

(let* ((nickname-option (when nickname nickname))

(secret-option (when secret secret))

(server-option (when server (concat "--server=" server)))

(list (list learn-ocaml-command-name "init-user" server-option login password nickname-option secret-option)))

(cl-remove-if-not 'stringp list)))

(defun learn-ocaml-create-token-cmd (nickname secret callback)

"Create a new token for NICKNAME.

(learn-ocaml-print-time-stamp)

(let ((buffer (generate-new-buffer "create-token")))

(learn-ocaml-make-process-wrapper

:name "create-token"

:command (learn-ocaml-command-constructor

:command "create-token"

:param1 nickname

:param2 secret)

:stderr (learn-ocaml-log-buffer)

:buffer buffer

:sentinel (apply-partially

#'learn-ocaml-error-handler

buffer

(lambda (s)

(funcall-interactively

callback

(replace-regexp-in-string "\n\\'" "" s)))))))

(defun learn-ocaml-give-exercise-list-cmd (callback)

"Give to the CALLBACK a json containing the exercise list."

(learn-ocaml-print-time-stamp)

(let ((buffer (generate-new-buffer "exercise-list")))

(learn-ocaml-make-process-wrapper

:name "exercise-list"

:command (learn-ocaml-command-constructor

:command "exercise-list")

:stderr (learn-ocaml-log-buffer)

:buffer buffer

:sentinel (apply-partially

#'learn-ocaml-error-handler

buffer

(lambda (s)

(funcall-interactively

callback (json-read-from-string s)))))))

(cl-defun learn-ocaml-download-server-file-cmd (&key token server id directory callback)

"Download from the SERVER the last version of exercise ID in DIRECTORY."

(learn-ocaml-print-time-stamp)

(let ((old (learn-ocaml-cd directory)))

(learn-ocaml-make-process-wrapper

:name (concat "download-" id)

:command (learn-ocaml-command-constructor

:token token

:server server

:param1 id

:command "fetch")

:stderr (learn-ocaml-log-buffer)

:sentinel (apply-partially

#'learn-ocaml-error-handler

nil

callback))

(cd old)))

(cl-defun learn-ocaml-grade-file-cmd (&key id token server dont-submit file callback)

"Grade a .ml file, optionally submitting the code and the note to the server."

(learn-ocaml-print-time-stamp)

(let ((html (learn-ocaml-temp-html-file id)))

(write-region "" nil html nil) ; erase the html file

(learn-ocaml-make-process-wrapper

:name (concat "upload-" id)

:command (learn-ocaml-command-constructor

:token token

:server server

:id id

:dont-submit dont-submit

:param1 file

:html t

:command "grade")

:stderr (learn-ocaml-log-buffer)

:filter (apply-partially

#'learn-ocaml-file-writter-filter

html)

:sentinel (apply-partially

#'learn-ocaml-error-handler

nil

(lambda (_arg)

(funcall-interactively

callback

html))))))

(cl-defun learn-ocaml-init-cmd (&key token server nickname secret callback)

"Run \"learn-ocaml-client init\" with options."

(learn-ocaml-print-time-stamp)

(learn-ocaml-make-process-wrapper

:name "init"

:command (learn-ocaml-command-constructor

:token token

:server server

:param1 nickname

:param2 secret

:command "init")

:stderr (learn-ocaml-log-buffer)

:sentinel (apply-partially

#'learn-ocaml-error-handler

nil

callback)))

(defun learn-ocaml-give-server-cmd (callback)

"Give the current server url to the CALLBACK."

(learn-ocaml-print-time-stamp)

(let ((buffer (generate-new-buffer "give-server")))

(learn-ocaml-make-process-wrapper

:name "give-server"

:command (learn-ocaml-command-constructor

:command "print-server")

:stderr (learn-ocaml-log-buffer)

:buffer buffer

:sentinel (apply-partially

#'learn-ocaml-error-handler

buffer

(lambda (s)

(funcall-interactively

callback

(learn-ocaml--rstrip s)))))))

(defun learn-ocaml-give-token-cmd (callback)

"Gives the current token to the CALLBACK."

(learn-ocaml-print-time-stamp)

(let ((buffer (generate-new-buffer "give-token")))

(learn-ocaml-make-process-wrapper

:name "give-token"

:command (learn-ocaml-command-constructor

:command "print-token")

:stderr (learn-ocaml-log-buffer)

:buffer buffer

:sentinel (apply-partially

#'learn-ocaml-error-handler

buffer

(lambda (s)

(funcall-interactively

callback

(learn-ocaml--rstrip s)))))))

(defun learn-ocaml-use-metadata-cmd (token server callback)

"Set TOKEN, SERVER, and run CALLBACK."

(learn-ocaml-print-time-stamp)

(learn-ocaml-make-process-wrapper

:name "use-metadata"

:command (learn-ocaml-command-constructor

:token token

:server server

:command "set-options")

:stderr (learn-ocaml-log-buffer)

:sentinel (apply-partially

#'learn-ocaml-error-handler

nil

callback)))

(cl-defun learn-ocaml-download-template-cmd (&key token server id local directory callback)

"Download from the SERVER the template code for exercise ID in DIRECTORY."

;; TODO: argument LOCAL is not taken into account in the mode

(learn-ocaml-print-time-stamp)

(let ((old (learn-ocaml-cd directory)))

(learn-ocaml-make-process-wrapper

:name (concat "template-" id)

:command (learn-ocaml-command-constructor

:command "template"

:token token

:server server

:local local

:param1 id)

:stderr (learn-ocaml-log-buffer)

:sentinel (apply-partially

#'learn-ocaml-error-handler

nil

callback))

(cd old)))

(defun learn-ocaml-client-exercise-score-cmd ()

"Run \"learn-ocaml-client exercise-score\"."

(let* ((cmd "exercise-score")

(result (learn-ocaml-command-to-string-await-cmd (list cmd))))

(if (car result) (json-read-from-string (cdr result))

;; FIXME: Use learn-ocaml-log-buffer

(error "%s %s: failed with [%s]." learn-ocaml-command-name cmd

(string-trim (cdr result))))))

(cl-defun learn-ocaml-init-server-cmd (&key server callback)

"Run \"learn-ocaml-client init\" with options."

(learn-ocaml-print-time-stamp)

(learn-ocaml-make-process-wrapper

:name "init-server"

:command (learn-ocaml-command-constructor

:server server

:command "init-server")

:stderr (learn-ocaml-log-buffer)

:sentinel (apply-partially

#'learn-ocaml-error-handler

nil

callback)))

(cl-defun learn-ocaml-client-sign-in-cmd (&key server login password callback-ok callback-err)

"Run \"learn-ocaml-client init-user\" with SERVER LOGIN PASSWORD to login an user."

(learn-ocaml-print-time-stamp)

(let ((buffer (generate-new-buffer "sign-in-std-out")))

(learn-ocaml-make-process-wrapper

:name "init-user"

:command (learn-ocaml-init-user-command-constructor :server server

:login login

:password password)

:buffer buffer

:sentinel (apply-partially

#'learn-ocaml-error-handler-nosplit-catch

buffer

callback-ok

callback-err))))

(cl-defun learn-ocaml-client-sign-up-cmd (&key server login password nickname secret callback-ok callback-err)

"Run \"learn-ocaml-client init-user\" with SERVER LOGIN PASSWORD NICKNAME and SECRET to sign-up an user."

(learn-ocaml-print-time-stamp)

(let ((buffer (generate-new-buffer "sign-up-std-out")))

(learn-ocaml-make-process-wrapper

:name "init-user"

:command (learn-ocaml-init-user-command-constructor :server server

:login login

:password password

:nickname nickname

:secret secret)

:buffer buffer

:sentinel (apply-partially

#'learn-ocaml-error-handler-nosplit-catch

buffer

callback-ok

callback-err))))

(defun learn-ocaml-client-config-cmd ()

"Run \"learn-ocaml-client server-config\"."

(let* ((cmd "server-config")

(result (learn-ocaml-command-to-string-await-cmd (list cmd))))

(if (car result) (cdr result)

;; FIXME: Use learn-ocaml-log-buffer

(error "%s %s: failed with [%s]." learn-ocaml-command-name cmd (string-trim (cdr result))))))

(defconst learn-ocaml-compute-questions-url-token1-compat

(learn-ocaml-since-upto "0.13.0" nil))

(defun learn-ocaml-compute-questions-url (server id token)

"Get subject url for SERVER, exercise ID and user TOKEN."

(let ((token-param

(if (learn-ocaml-compat

learn-ocaml-compute-questions-url-token1-compat

(version-to-list (learn-ocaml-client-server-min-version server)))

(concat "#token1=" (base64-encode-string (format "%192s" token) t))

(concat "#token=" token))))

(concat server "/description/" id token-param)))

(defun learn-ocaml-show-questions (id)

"Open the questions for exercise ID in the default browser."

(interactive)

(learn-ocaml-give-server-cmd

(lambda (server)

(learn-ocaml-give-token-cmd

(lambda (token)

;; very important if you don't do it you risk to open eww

(setq browse-url-browser-function 'browse-url-default-browser)

(browse-url (learn-ocaml-compute-questions-url server id token)))))))

(defun learn-ocaml-show-metadata ()

"Display the token and server url in mini-buffer and `message-box'."

(interactive)

(learn-ocaml-give-server-cmd

(lambda (server)

(learn-ocaml-give-token-cmd

(lambda (token)

(message "learn-ocaml: token %s @ %s" token server)

(message-box "Current token: %s\nCurrent server: %s" token server))))))

(cl-defun learn-ocaml-create-token (nickname secret)

"Create a new token for NICKNAME.

(interactive "sWhat nickname you want to use for the token? \nsWhat secret does the server require? ")

(learn-ocaml-create-token-cmd

nickname

secret

(lambda (token)

(learn-ocaml-use-metadata-cmd

token

nil

(lambda (_)

(message-box "Token created succesfully")

(learn-ocaml-show-metadata))))))

(defun learn-ocaml-change-server ()

"Interactively change the server url."

(interactive)

(learn-ocaml-give-server-cmd

(lambda (s)

(if (learn-ocaml-yes-or-no

(concat "The current configured server is: " s "\n Do you want to change it?"))

(let ((server (read-string "Enter server URL: " "https://")))

(learn-ocaml-use-metadata-cmd

nil

server

(lambda (_)

(message-box "Server changed succesfully")

(cl-case (x-popup-dialog

t `("The old token may not work with the new server.\n What do you want to do?\n"

("Enter my token" . 1)

("Create new token" . 2)))

(1 (let ((token (read-string "Enter token: ")))

(learn-ocaml-use-metadata-cmd

token

nil

(lambda (_)

(message-box "Token changed succesfully")))))

(2 (call-interactively 'learn-ocaml-create-token)))

(learn-ocaml-show-metadata)

(learn-ocaml-display-exercise-list))))))))

(defun learn-ocaml-change-token ()

"Interactively change the user token."

(interactive)

(learn-ocaml-give-token-cmd

(lambda (token)

(if (learn-ocaml-yes-or-no

(concat "The current configured token is: "

token

"\n Do you want to change it?"))

(let ((token (read-string "Enter token: ")))

(learn-ocaml-use-metadata-cmd

token

nil

(lambda (_)

(message-box "Token changed succesfully")

(learn-ocaml-show-metadata))))))))

(defun learn-ocaml-download-server-file (id &optional directory)

"Download the last saved code for exercise ID in DIRECTORY."

(interactive `(,(let ((input (read-string (concat

"Enter the id of the exercise (default "

learn-ocaml-exercise-id

"): "))))

(if (string-equal "" input)

learn-ocaml-exercise-id

input))))

(learn-ocaml-download-server-file-cmd

:id id

:directory (or directory default-directory)

:callback (lambda (_) (message-box "File(s) downloaded correctly"))))

(defun learn-ocaml-download-template (id &optional directory)

"Download the template code for exercise ID in DIRECTORY."

(interactive `(,(let ((input (read-string (concat

"Enter the id of the exercise (default "

learn-ocaml-exercise-id

"): "))))

(if (string-equal "" input)

learn-ocaml-exercise-id

input))))

(learn-ocaml-download-template-cmd

:id id

:directory (or directory default-directory)

:callback (lambda (_) (message-box "Template downloaded correctly"))))

(defun learn-ocaml-grade ()

"Grade the current .ml buffer."

(interactive)

(learn-ocaml-setup nil)

(save-buffer)

(learn-ocaml-grade-file-cmd

:id learn-ocaml-exercise-id

:file buffer-file-name

:callback (lambda (html)

(setq browse-url-browser-function 'browse-url-default-browser)

(browse-url-of-file html))))

(require 'widget)

(define-widget 'learn-ocaml-button 'push-button ""

:button-face 'button)

(defface learn-ocaml-group-title-face

'((t (

:inherit variable-pitch

:foreground "blue1"

:underline nil :weight bold :height 1.2)))

"Face group titles.")

(define-widget 'learn-ocaml-group-title 'lazy ""

:format "%{%t%}"

:sample-face 'learn-ocaml-group-title-face)

(define-widget 'learn-ocaml-exercise-title 'lazy ""

:format "%{%t%}"

:sample-face 'bold)

(defface learn-ocaml-header-hint-face

'((t (

:underline nil :slant italic :height 0.9)))

"Face header hint.")

(define-widget 'learn-ocaml-header-hint 'lazy ""

:format "%{%t%}"

:sample-face 'learn-ocaml-header-hint-face)

(defun learn-ocaml-print-exercise-info (indent tuple json-progression)

"Render an exercise item with leading INDENT from the data in TUPLE."

(let* ((id (elt tuple 0))

(exo (elt tuple 1))

(title (assoc-default 'title exo) )

(short_description (assoc-default 'short_description exo))

(stars (assoc-default 'stars exo))

(progression (learn-ocaml-get-progression-by-id id json-progression)))

(widget-insert "\n")

(widget-insert indent)

(widget-create 'learn-ocaml-exercise-title

:tag title)

(widget-insert "\n")

(widget-insert (concat indent " "))

(widget-insert (if short_description short_description "No description available"))

(widget-insert "\n")

(widget-insert (concat indent " "))

(widget-insert (concat "Difficulty: " (number-to-string stars) "/4"

" progression: "

progression " id: " id ))

(widget-insert "\n")

(widget-insert (concat indent " "))

(widget-create 'learn-ocaml-button

:notify (lambda (&rest _ignore)

(learn-ocaml-show-questions id))

"Browse subject")

(widget-insert " ")

(widget-create 'learn-ocaml-button

:notify (lambda (&rest _ignore)

(learn-ocaml-download-template id))

"Get template")

(widget-insert " ")

(widget-create 'learn-ocaml-button

:notify (lambda (&rest _ignore)

(find-file (concat id ".ml")))

"Open .ml")

(widget-insert " ")

(widget-create 'learn-ocaml-button

:notify (lambda (&rest _ignore)

(learn-ocaml-download-server-file id))

"Get last saved version")

(widget-insert "\n")))

(defun learn-ocaml-print-groups (indent json)

"Render an exercise group with leading INDENT from the data in JSON."

(let ((json-progression

() ;; TODO (learn-ocaml-client-exercise-score-cmd)

)

(head (car json))

(queue (cdr json)))

(if (eq 'groups head)

(progn

(seq-do

(lambda (group)

(widget-create

'learn-ocaml-group-title

:tag (concat indent

(cdr (car (cdr group)))

"\n"))

(learn-ocaml-print-groups (concat indent " ")

(car (cdr (cdr group)))))

queue))

(seq-do (lambda (elt)

(learn-ocaml-print-exercise-info

(concat indent " ") elt json-progression))

queue)

(widget-insert "\n"))))

(defun learn-ocaml-display-exercise-list-aux (json)

"Render the exercise list from the server-provided JSON."

(set-buffer (learn-ocaml-exo-list-buffer))

(kill-all-local-variables)

(let ((inhibit-read-only t))

(erase-buffer))