diff options
| -rw-r--r-- | .agignore | 5 | ||||
| -rw-r--r-- | Makefile | 1 | ||||
| -rw-r--r-- | bot/sx-bot.el | 82 | ||||
| -rwxr-xr-x | bot/sx-bot.sh | 36 | ||||
| -rw-r--r-- | sx-favorites.el | 10 | ||||
| -rw-r--r-- | sx-filter.el | 34 | ||||
| -rw-r--r-- | sx-load.el | 1 | ||||
| -rw-r--r-- | sx-method.el | 30 | ||||
| -rw-r--r-- | sx-networks.el | 38 | ||||
| -rw-r--r-- | sx-request.el | 2 | ||||
| -rw-r--r-- | sx-site.el | 27 | ||||
| -rw-r--r-- | sx-tag.el | 27 | ||||
| -rw-r--r-- | sx.el | 1 | ||||
| -rw-r--r-- | test/test-api.el | 6 | ||||
| -rw-r--r-- | test/test-search.el | 4 | ||||
| -rw-r--r-- | test/tests.el | 1 |
16 files changed, 229 insertions, 76 deletions
@@ -1,3 +1,5 @@ +# -*- gitignore -*- + # Backup files *~ \#*\# @@ -18,3 +20,6 @@ test/data-samples # Info files *.info + +# Data directory +data/ @@ -25,6 +25,7 @@ $(VERSIONS) :: evm use emacs-24.$@-bin emacs --version cask install + rm -rf .sx/ emacs --batch -L . -l ert -l test/tests.el -f ert-run-tests-batch-and-exit install_cask: diff --git a/bot/sx-bot.el b/bot/sx-bot.el new file mode 100644 index 0000000..b32a69c --- /dev/null +++ b/bot/sx-bot.el @@ -0,0 +1,82 @@ +;;; sx-bot.el --- Functions for automated maintanence -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file defines the behavior of a bot. To allow completion for +;; tags, this bot runs through all sites in the network and retrieves +;; all of their tags. This data is then written to a directory which +;; is tracked by the git repository. + + +;;; Code: + +(require 'package) +(package-initialize) + +(require 'sx-load) + +(setq sx-request-remaining-api-requests-message-threshold 50000) + +(defcustom sx-bot-out-dir "./data/tags/" + "Directory where output tag files are saved." + :type 'directory + :group 'sx) + + +;;; Printing +(defun sx-bot-write-to-file (data) + "Write (cdr DATA) to file named (car DATA). +File is savedd in `sx-bot-out-dir'." + (let ((file-name (expand-file-name (car data) sx-bot-out-dir))) + (with-temp-file file-name + (let* (print-length + (repr (prin1-to-string + (sort (cdr data) + #'string-lessp)))) + (insert repr "\n") + (goto-char (point-min)) + (while (search-forward "\" \"" nil t) + (replace-match "\"\n \"" nil t)))) + (message "Wrote %S" file-name) + file-name)) + +(defun sx-bot-fetch-and-write-tags () + "Get a list of all tags of all sites and save to disk." + (make-directory sx-bot-out-dir t) + (let* ((url-show-status nil) + (site-tokens (sx-site-get-api-tokens)) + (number-of-sites (length site-tokens)) + (current-site-number 0) + (sx-request-all-items-delay 0.25)) + (mapcar + (lambda (site) + (message "[%d/%d] Working on %S" + (cl-incf current-site-number) + number-of-sites + site) + (sx-bot-write-to-file + (cons (concat site ".el") + (sx-tag--get-all site)))) + site-tokens))) + + +;;; Newest +(provide 'sx-bot) +;;; sx-bot.el ends here diff --git a/bot/sx-bot.sh b/bot/sx-bot.sh new file mode 100755 index 0000000..6a5df17 --- /dev/null +++ b/bot/sx-bot.sh @@ -0,0 +1,36 @@ +#!/usr/bin/bash + +DESTINATION_BRANCH=gh-pages + +function notify-done { + local title + local message + title="SX Tag Bot" + message="Finished retrieving tag lists" + case $(uname | tr '[[:upper:]]' '[[:lower:]]') in + darwin) + terminal-notifier \ + -message ${message} \ + -title ${title} \ + -sound default + ;; + *) + echo ${message} + esac +} + +function generate-tags { + emacs -Q --batch \ + -L "./" -L "./bot/" -l sx-bot \ + -f sx-bot-fetch-and-write-tags + ret = $? + notify-done + return ${ret} +} + +git branch ${DESTINATION_BRANCH} && + git pull && + generate-tags && + git stage data/ && + git commit -m "Update tag data" && + echo 'Ready for "git push"' diff --git a/sx-favorites.el b/sx-favorites.el index d957167..e86e521 100644 --- a/sx-favorites.el +++ b/sx-favorites.el @@ -25,15 +25,11 @@ (require 'sx-cache) (require 'sx-site) (require 'sx-networks) +(require 'sx-filter) (defvar sx-favorite-list-filter - '((.backoff - .items - .quota_max - .quota_remaining - question.question_id) - nil - none)) + (sx-filter-from-nil + (question.question_id))) (defvar sx-favorites--user-favorite-list nil "Alist of questions favorited by the user. diff --git a/sx-filter.el b/sx-filter.el index 8c00c12..c67d05b 100644 --- a/sx-filter.el +++ b/sx-filter.el @@ -41,7 +41,39 @@ Structure: ...)") -;;; Compilation +;;; Creation + +(defmacro sx-filter-from-nil (included) + "Creates a filter data structure with INCLUDED fields. +All wrapper fields are included by default." + ;; @OTODO: it would be neat to have syntax like + ;; + ;; (field-a + ;; field-b + ;; (object-a subfield) + ;; field-c + ;; (object-b subfield-a subfield-b)) + ;; + ;; expand into + ;; + ;; (field-a + ;; field-b + ;; object-a.subfield + ;; field-c + ;; object-b.subfield-a object-b.subfield-b) + `(quote ((,@included + .backoff + .error_id + .error_message + .error_name + .has_more + .items + .page + .page_size + .quota_max + .quota_remaining + .type) + nil none))) ;;; @TODO allow BASE to be a precompiled filter name (defun sx-filter-compile (&optional include exclude base) @@ -45,6 +45,7 @@ sx-site sx-switchto sx-tab + sx-tag )) (provide 'sx-load) diff --git a/sx-method.el b/sx-method.el index 8fa30c9..e68a4ea 100644 --- a/sx-method.el +++ b/sx-method.el @@ -35,6 +35,8 @@ (cl-defun sx-method-call (method &key id submethod keywords + page + (pagesize 100) (filter '(())) auth (url-method "GET") @@ -55,6 +57,11 @@ authentication. :SITE is the api parameter specifying the site. :GET-ALL is nil or non-nil :PROCESS-FUNCTION is a response-processing function +:PAGE is the page number which will be requested +:PAGESIZE is the number of items to retrieve per request, default 100 + +Any conflicting information in :KEYWORDS overrides the :PAGE +and :PAGESIZE settings. When AUTH is nil, it is assumed that no auth-requiring filters or methods will be used. If they are an error will be signaled. This is @@ -100,12 +107,10 @@ Return the entire response as a complex alist." (format "?site=%s" site) (setq site nil))))) (call (if get-all #'sx-request-all-items #'sx-request-make)) - (get-all-stop-when + (get-all (cond ((eq get-all t) #'sx-request-all-stop-when-no-more) - (get-all get-all) - (t nil))) - parameters) + (t get-all)))) (lwarn "sx-call-method" :debug "A: %S T: %S. M: %S,%s. F: %S" (equal 'warn auth) access-token method-auth full-method filter-auth) (unless access-token @@ -124,19 +129,18 @@ Return the entire response as a complex alist." ((and (or filter-auth method-auth) (not auth)) (error "This request requires authentication.")))) ;; Concatenate all parameters now that filter is ensured. - (setq parameters - (cons (cons 'filter (sx-filter-get-var filter)) - keywords)) + (push `(filter . ,(sx-filter-get-var filter)) keywords) + (unless (assq 'page keywords) + (push `(page . ,page) keywords)) + (unless (assq 'pagesize keywords) + (push `(pagesize . ,pagesize) keywords)) (when site - ;; @TODO: Maybe use `push' instead? - (setq parameters (cons (cons 'site site) parameters))) + (push `(site . ,site) keywords)) (funcall call full-method - parameters + keywords url-method - (if get-all - get-all-stop-when - process-function)))) + (or get-all process-function)))) (provide 'sx-method) ;;; sx-method.el ends here diff --git a/sx-networks.el b/sx-networks.el index e4660af..20ac65c 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -24,31 +24,23 @@ (require 'sx-method) (require 'sx-cache) (require 'sx-site) +(require 'sx-filter) (defvar sx-network--user-filter - '((.backoff - .error_id - .error_message - .error_name - .has_more - .items - .quota_max - .quota_remaining - badge_count.bronze - badge_count.silver - badge_count.gold - network_user.account_id - network_user.answer_count - network_user.badge_counts - network_user.creation_date - network_user.last_access_date - network_user.reputation - network_user.site_name - network_user.site_url - network_user.user_id - network_user.user_type) - nil - none)) + (sx-filter-from-nil + (badge_count.bronze + badge_count.silver + badge_count.gold + network_user.account_id + network_user.answer_count + network_user.badge_counts + network_user.creation_date + network_user.last_access_date + network_user.reputation + network_user.site_name + network_user.site_url + network_user.user_id + network_user.user_type))) (defun sx-network--get-associated () "Retrieve cached information for network user. diff --git a/sx-request.el b/sx-request.el index da0a1fb..b2aee5d 100644 --- a/sx-request.el +++ b/sx-request.el @@ -202,7 +202,7 @@ the main content of the response is returned." (sx-message "%d API requests remaining" sx-request-remaining-api-requests)) (funcall (or process-function #'sx-request-response-get-items) - response))))))) + response))))))) (defun sx-request-fallback (_method &optional _args _request-method) "Fallback method when authentication is not available. @@ -23,25 +23,16 @@ (require 'sx-method) (require 'sx-cache) +(require 'sx-filter) (defvar sx-site-browse-filter - '((.backoff - .error_id - .error_message - .error_name - .has_more - .items - .quota_max - .quota_remaining - site.site_type - site.name - site.site_url - site.api_site_parameter - site.related_sites - related_site.api_site_parameter - related_site.relation) - nil - none) + (sx-filter-from-nil + (site.site_type + site.name + site.api_site_parameter + site.related_sites + related_site.api_site_parameter + related_site.relation)) "Filter for browsing sites.") (defun sx-site--get-site-list () @@ -49,7 +40,7 @@ (sx-cache-get 'site-list '(sx-method-call 'sites - :keywords '((pagesize . 999)) + :pagesize 999 :filter sx-site-browse-filter))) (defcustom sx-site-favorites @@ -26,9 +26,27 @@ ;;; Getting the list from a site -(defvar sx-tag-filter '((tag.name)) +(defvar sx-tag-filter + (sx-filter-from-nil + (tag.name + tag.synonyms)) "Filter used when querying tags.") +(defun sx-tag--get-all (site &optional no-synonyms) + "Retrieve all tags for SITE. +If NO-SYNONYMS is non-nil, don't return synonyms." + (cl-reduce + (lambda (so-far tag) + (let-alist tag + (cons .name + (if no-synonyms so-far + (append .synonyms so-far))))) + (sx-method-call 'tags + :get-all t + :filter sx-tag-filter + :site site) + :initial-value nil)) + (defun sx-tag--get-some-tags-containing (site string) "Return at most 100 tags for SITE containing STRING. Returns an array." @@ -36,7 +54,7 @@ Returns an array." :auth nil :filter sx-tag-filter :site site - :keywords `((page . 1) (pagesize . 100) (inname . ,string)))) + :keywords `((inname . ,string)))) (defun sx-tag--get-some-tag-names-containing (site string) "Return at most 100 tag names for SITE containing STRING. @@ -52,7 +70,7 @@ TAGS can be a string (the tag name) or a list of strings. Fails if TAGS is a list with more than 100 items. Return the list of invalid tags in TAGS." (and (listp tags) (> (length tags) 100) - (error "Invalid argument. TAG has more than 100 items")) + (error "Invalid argument. TAG has more than 100 items")) (let ((result (mapcar (lambda (x) (cdr (assoc 'name x))) @@ -61,8 +79,7 @@ Return the list of invalid tags in TAGS." :submethod 'info :auth nil :filter sx-tag-filter - :site site - :keywords '((page . 1) (pagesize . 100)))))) + :site site)))) (cl-remove-if (lambda (x) (member x result)) tags))) (provide 'sx-tag) @@ -151,6 +151,7 @@ If ALIST doesn't have a `site' property, one is created using the ;;; Browsing filter (defvar sx-browse-filter + ;; @TODO: Use `sx-filter-from-nil' '((question.body_markdown question.comments question.answers diff --git a/test/test-api.el b/test/test-api.el index 91a8adb..b7d5dbb 100644 --- a/test/test-api.el +++ b/test/test-api.el @@ -11,12 +11,6 @@ (should-error (sx-request-make "questions" '(())))) -(ert-deftest test-request-all () - "Test request all items" - (should - (< 250 - (length (sx-request-all-items "sites"))))) - (ert-deftest test-method-get-all () "Tests sx-method interface to `sx-request-all-items'" (should (< 250 (length (sx-method-call 'sites :get-all t))))) diff --git a/test/test-search.el b/test/test-search.el index 72dbcdc..72f0846 100644 --- a/test/test-search.el +++ b/test/test-search.el @@ -29,8 +29,8 @@ (ert-deftest test-search-full-page () "Test retrieval of the full search page" (should - (= 30 (length (sx-search-get-questions - "stackoverflow" 1 "jquery"))))) + (= 100 (length (sx-search-get-questions + "stackoverflow" 1 "jquery"))))) (ert-deftest test-search-exclude-tags () "Test excluding tags from a search" diff --git a/test/tests.el b/test/tests.el index d06c0ff..ce42a9f 100644 --- a/test/tests.el +++ b/test/tests.el @@ -11,6 +11,7 @@ sx-initialized t sx-request-remaining-api-requests-message-threshold 50000 debug-on-error t + url-show-status nil user-emacs-directory "." sx-test-base-dir (file-name-directory (or load-file-name "./"))) |