path: root/wiki-engine.el

;;; wiki-engine.el -- client to wiki engines -*- lexical-binding: t -*-

;; Copyright (C) 2023  Free Software Foundation, Inc.

;; Author: Yuchen Pei <id@ypei.org>

;; This file is part of wiki.el.

;; wiki.el is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; wiki.el is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
;; Public License for more details.

;; You should have received a copy of the GNU Affero General Public
;; License along with wiki.el.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; client to wiki engines, wiki server software. Each engine defines
;; how Emacs interacts with the remote server, including how to
;; construct a url to fetch from.

;;; Code:
(require 'wiki-utils)
(require 'wiki-markup)
(require 'generic-search)

;; TODO: make this a defcustom
(defvar wiki-default-engine 'mediawiki
  "The default wiki engine, when one is not supplied.")

(defun wiki-engine-html-url (site title)
  "Return the url of the html webpage of TITLE on SITE."
  (format "%s/%s" (wiki-engine-compute-base-url
                   (alist-get site wiki-sites))
          title))

(defun wiki-current-html-url ()
  "Return the url of the html webpage of the current wiki buffer."
  (unless (and wiki-site wiki-title)
    (error "Nil wiki-site or wiki-title!"))
  (wiki-engine-html-url wiki-site wiki-title))

(defun wiki-fetch-url (url title &optional dir callback)
  "Fetch URL asynchronously to a file in DIR.

Then call CALLBACK which is a closure taking no argument.

A non-nil TITLE overrides title inferred from the url."
  (let ((cb (lambda (status)
              (wiki-save-fetched-and-switch status title dir)
              (when callback (funcall callback)))))
    (with-current-buffer (get-buffer-create wiki-client-buffer-name)
      (goto-char (point-max))
      (insert "[" (current-time-string) "] Request: " url "\n"))
    (url-retrieve url cb))
  )

(defun wiki-save-string-and-switch (to-insert title dir)
  "Insert string TO-INSERT to TITLE under DIR and switch to buffer."
  (let ((buffer (wiki-find-file title dir t))
        (coding-system-for-write 'utf-8))
    (with-current-buffer buffer
      (insert to-insert)
      (goto-char (point-min))
      (save-buffer)
      (revert-buffer t t))
    (switch-to-buffer buffer)))

(defun wiki-save-fetched-and-switch (status title dir)
  "If STATUS is ok, insert response payload to TITLE under DIR.

And switch to the corresponding buffer."
  (with-current-buffer wiki-client-buffer-name
    (insert "[" (current-time-string) "] Response: "
            (if (plist-get status :error)
                (format "%s" (car (last (plist-get status :error))))
              "200")
            "\n"))
  (when (plist-get status :error)
    (error "Wiki fetch failed: %s" (plist-get status :error)))
  (wiki-delete-http-header)
  (let ((to-insert (buffer-string))
        (_ (kill-buffer)))
    (wiki-save-string-and-switch to-insert title dir)))

(defun wiki-engine-compute-engine (site-info)
  "Return :engine of SITE-INFO, or the default engine."
  (or (plist-get site-info :engine) wiki-default-engine))

(defun wiki-engine-compute-display-name (site-id site-info)
  "Return :display-name of SITE-INFO, or the default from SITE-ID."
  (or (plist-get site-info :display-name)
      (let ((name
             (replace-regexp-in-string
              "-" " " (capitalize (format "%s" site-id)))))
        (if (string-suffix-p " Wiki" name)
            name
          (format "%s Wiki" name)))))

(defun wiki-engine-compute-base-url (site-info)
  "Return :base-url of SITE-INFO, or engine-specific default."
  (or (plist-get site-info :base-url)
      (let ((host (plist-get site-info :host)))
        (pcase (wiki-engine-compute-engine site-info)
          ('mediawiki (format "%s/wiki" host))
          ('moinmoin host)
          ('oddmuse (format "%s/wiki" host))
          (_ (error "Unknown engine: %s" engine))))))

(defun wiki-engine-compute-api-base-url (site-info)
  "Return :api-base-url of SITE-INFO, or engine-specific default."
  (or (plist-get site-info :api-base-url)
      (let ((host (plist-get site-info :host)))
        (pcase (wiki-engine-compute-engine site-info)
          ('mediawiki (format "%s/w" host))
          ('moinmoin (error "API not supported for engine: %s" engine))
          ('oddmuse (error "API not supported for engine: %s" engine))
          (_ (error "Unknown engine: %s" engine))))))

(defun wiki-engine-compute-fetcher (site-info)
  "Return :fetcher of SITE-INFO, or default."
  (or (plist-get site-info :fetcher) 'wiki-engine-simple-fetch))

(defun wiki-engine-wiki-url (site title)
  "Construct the url to fetch wiki of TITLE from SITE."
  (let* ((site-info (alist-get site wiki-sites))
         (engine (wiki-engine-compute-engine site-info))
         (base-url (wiki-engine-compute-base-url site-info)))
    (pcase engine
      ('mediawiki (format "%s/%s?action=raw" base-url title))
      ('moinmoin (format "%s/%s?action=raw" base-url title))
      ('oddmuse (format "%s?action=download;id=%s" base-url title))
      (_ (error "Unknown engine: %s" engine)))))

(defun wiki-engine-simple-fetch (site-id title)
  "A simple method to fetch TITLE from site with SITE-ID.

If the site has a `local' engine, \"fetch\" locally. Otherwise,
if `wiki-fetch-prefer-local' is non-nil, try fetching locally,
and if the title cannot be found locally, fetch remotely."
  (when (string-empty-p title) (setq title "Main Page"))
  (let* ((engine (wiki-engine-compute-engine (alist-get site-id wiki-sites)))
         (found-local
          (when (or wiki-fetch-prefer-local (eq engine 'local))
            (wiki-find-file title (wiki-locate-dir site-id)
                            (eq engine 'local)))))
    (if found-local
        (switch-to-buffer found-local)
      (wiki-fetch-url
       (wiki-engine-wiki-url site-id title)
       title
       (wiki-locate-dir site-id)
       (lambda ()
         (wiki-mode)
         (setq-local wiki-site site-id
                     wiki-title title))))))

(defun wiki-engine-mediawiki-api-wiki (api-base-url title)
  "Fetch the wikitext of TITLE using json api.

API-BASE-URL is the base url for the api request."
  (wiki-url-fetch-json
   (format
    "%s/api.php?action=query&format=json&titles=%s&prop=revisions&rvprop=content&rvslots=main"
    api-base-url title)))

(defun wiki-engine-mediawiki-api-fetch (site-id title)
  "Fetch TITLE from site with SITE-ID using mediawiki api."
  (when (string-empty-p title) (setq title "Main Page"))
  (let* ((engine (wiki-engine-compute-engine
                  (alist-get site-id wiki-sites)))
         (api-base-url (wiki-engine-compute-api-base-url
                        (alist-get site-id wiki-sites)))
         (found-local
          (when (or wiki-fetch-prefer-local (eq engine 'local))
            (wiki-find-file title (wiki-locate-dir site-id)
                            (eq engine 'local)))))
    (if found-local
        (switch-to-buffer found-local)
      (wiki-save-string-and-switch
       (alist-get
        '* (alist-get
            'main (alist-get
                   'slots (elt
                           (alist-get
                            'revisions
                            (cdr
                             (car
                              (alist-get
                               'pages (alist-get
                                       'query
                                       (wiki-engine-mediawiki-api-wiki
                                        api-base-url title))))))
                           0))))
       title
       (wiki-locate-dir site-id))
      (wiki-mode)
      (setq-local wiki-site site-id
                  wiki-title title))))

(defun wiki-locate-dir (site-id)
  "Locate the directory for a SITE-ID."
  (expand-file-name (format "%s" site-id) wiki-local-dir))

(defun wiki-find-file (title &optional dir create-if-not-exists)
  "Find local TITLE in DIR. Do not switch to buffer.

Return the buffer if success, and nil otherwise. If
CREATE-IF-NOT-EXISTS is non-nil, creates the file is not found.
DIR defaults to `default-directory'."
  (interactive (list (read-file-name "Find wiki file: ")))
  (unless dir (setq dir default-directory))
  (let ((file-name (expand-file-name
                    (concat title wiki-extension)
                    dir)))
    (when (or (file-exists-p file-name) create-if-not-exists)
      (setq dir (file-name-directory file-name))
      (unless (file-exists-p dir) (make-directory dir t))
      (with-current-buffer (find-file-noselect file-name)
        (wiki-mode)
        (buffer-name)))))

(defmacro wiki-define-site-commands ()
  "Defines all wiki fetcher functions."
  (cons 'progn
        (mapcar
         (lambda (pair)
           (pcase-let ((`(,id . ,info) pair))
             (let ((engine-fetcher
                    (wiki-engine-compute-fetcher info)))
               `(progn
                  (defun ,(wiki-site-fetcher id) (title)
                    (interactive ,(format "sFetch title for %s: "
                                          (wiki-engine-compute-display-name
                                           id info)))
                    (,engine-fetcher ',id title))
                  (defun ,(wiki-site-searcher id) (title)
                    (interactive ,(format "sSearch %s for: "
                                          (wiki-engine-compute-display-name
                                           id info)))
                    (wiki-engine-simple-search ',id title))))))
         (seq-filter #'cdr wiki-sites)
         )))

(wiki-define-site-commands)

;; FIXME: make this work with local wiki, by using say grep-based
;; search.
(defun wiki-engine-simple-search (site-id query)
  "Simple search of QUERY using eww with its default search.

SITE-ID is the id of the site."
  (let ((site-info (alist-get site-id wiki-sites)))
    (pcase (wiki-engine-compute-engine site-info)
      ('mediawiki (wiki-engine-mediawiki-search site-id query))
      ('local (error "Search not implemented for local engine yet" ))
      (_
       (eww (format "%s site:%s" query
                    (plist-get (alist-get site-id wiki-sites) :host)))))))

(defun wiki-engine-mediawiki-api-search (api-base-url query)
  "Make an API call searching for QUERY.

API-BASE-URL is the base url for the api request."
  (wiki-url-fetch-json
   (format
    "%s/api.php?action=query&format=json&list=search&srsearch=%s"
    api-base-url query)))

(defun wiki-engine-mediawiki-search-action (site-id)
  (lambda (info)
    (interactive)
    (funcall (wiki-site-fetcher site-id) (alist-get 'title info))))

(defun wiki-engine-mediawiki-search (site-id query)
  (let ((api-base-url (wiki-engine-compute-api-base-url
                       (alist-get site-id wiki-sites))))
    (generic-search-open
     (alist-get 'search
                (alist-get 'query
                           (wiki-engine-mediawiki-api-search
                            api-base-url query)))
     (format "%s-query:%s" site-id query)
     `((formatter . wiki-engine-mediawiki-format-query-result)
       (default-action . ,(wiki-engine-mediawiki-search-action
                           site-id))
       (keymap . ,my-wikipedia-button-keymap)))))

(defun wiki-engine-mediawiki-format-query-result (result)
  (concat
   (format "%s (%d words)"
           (alist-get 'title result)
           (alist-get 'wordcount result))
   (propertize
    (format "\n\n%s"
            (wiki-mediawiki-highlight-snippet-matches
             (alist-get 'snippet result)))
    'face 'default)))

(defun wiki-mediawiki-highlight-snippet-matches (snippet)
  (with-temp-buffer
    (insert snippet)
    (goto-char (point-min))
    (while (re-search-forward
            "<span class=\"searchmatch\">\\(.*?\\)</span>" nil t)
      (replace-match
       (propertize (match-string 1) 'face 'match)))
    (buffer-string)))

(defun wiki-open-url (url)
  "Open the raw wiki corresponding to the URL of a html wiki page.

If URL points to html title, open the corresponding raw title."
  (interactive "sURL: ")
  (when-let
      ((found-site
        (seq-find
         (lambda (site-pair)
           (when-let ((base-url (wiki-engine-compute-base-url
                                 (cdr site-pair))))
             (string-prefix-p (format "%s/" base-url) url)))
         wiki-sites)))
    (pcase-let ((`(,site-id . ,site-info) found-site))
      (funcall (wiki-site-fetcher site-id)
               (string-remove-prefix
                (format "%s/" (wiki-engine-compute-base-url site-info))
                url))))
  )

(provide 'wiki-engine)
;;; wiki-engine.el ends here