Emacs library to communicate with CouchDB databases.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

176 lines
6.1 KiB

3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
  1. ;;; libelcouch.el --- Communication with CouchDB -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2018 Damien Cassou
  3. ;; Author: Damien Cassou <damien@cassou.me>
  4. ;; Keywords: tools
  5. ;; Url: https:///DamienCassou/mpdel
  6. ;; Package-requires: ((emacs "25.1"))
  7. ;; Version: 0.1.0
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; The package libelcouch is an Emacs library client to communicate with
  20. ;; Music Player Daemon (MPD), a flexible, powerful, server-side
  21. ;; application for playing music. For a user interface, please check
  22. ;; the mpdel project instead (which depends on this one).
  23. ;;; Code:
  24. (require 'cl-lib)
  25. (require 'request)
  26. (require 'json)
  27. (require 'map)
  28. ;;; Customization
  29. (defgroup elcouch nil
  30. "View and manipulate CouchDB databases."
  31. :group 'externa)
  32. (defcustom libelcouch-couchdb-instances nil
  33. "List of CouchDB instances."
  34. :type 'list)
  35. (defcustom libelcouch-timeout 10
  36. "Timeout in seconds for calls to the CouchDB instance.
  37. Number of seconds before a call to CouchDB without answer is
  38. considered to have failed."
  39. :type 'number)
  40. ;;; Structures
  41. (cl-defstruct (libelcouch-named-entity
  42. (:constructor libelcouch--named-entity-create)
  43. (:conc-name libelcouch--named-entity-))
  44. (name nil :read-only t))
  45. (cl-defstruct (libelcouch-instance
  46. (:include libelcouch-named-entity)
  47. (:constructor libelcouch--instance-create)
  48. (:conc-name libelcouch--instance-))
  49. (url nil :read-only t))
  50. (cl-defstruct (libelcouch-database
  51. (:include libelcouch-named-entity)
  52. (:constructor libelcouch--database-create)
  53. (:conc-name libelcouch--database-))
  54. (instance nil :read-only t))
  55. (cl-defstruct (libelcouch-document
  56. (:include libelcouch-named-entity)
  57. (:constructor libelcouch--document-create)
  58. (:conc-name libelcouch--document-))
  59. (revision nil :read-only t)
  60. (database nil :read-only t))
  61. ;;; Accessors
  62. (cl-defgeneric libelcouch-entity-name ((entity libelcouch-named-entity))
  63. "Return the name of ENTITY."
  64. (libelcouch--named-entity-name entity))
  65. (cl-defgeneric libelcouch-entity-full-name ((entity libelcouch-named-entity))
  66. "Return the full name of ENTITY's parent followed by ENTITY name."
  67. (format "%s/%s"
  68. (libelcouch-entity-name (libelcouch-entity-parent entity))
  69. (libelcouch-entity-name entity)))
  70. (cl-defmethod libelcouch-entity-full-name ((entity libelcouch-instance))
  71. (libelcouch-entity-name entity))
  72. (cl-defgeneric libelcouch-entity-parent (entity)
  73. "Return the entity containing ENTITY.")
  74. (cl-defmethod libelcouch-entity-parent ((database libelcouch-database))
  75. (libelcouch--database-instance database))
  76. (cl-defmethod libelcouch-entity-parent ((document libelcouch-document))
  77. (libelcouch--document-database document))
  78. (cl-defgeneric libelcouch-entity-instance (entity)
  79. "Return the CouchDB instance of ENTITY.")
  80. (cl-defmethod libelcouch-entity-instance ((instance libelcouch-instance))
  81. instance)
  82. (cl-defmethod libelcouch-entity-instance ((database libelcouch-database))
  83. (libelcouch--database-instance database))
  84. (cl-defmethod libelcouch-entity-instance ((document libelcouch-document))
  85. (libelcouch-entity-instance (libelcouch--document-database document)))
  86. (cl-defgeneric libelcouch-entity-url (entity)
  87. "Return the url of ENTITY."
  88. (format "%s/%s"
  89. (libelcouch-entity-url (libelcouch-entity-parent entity))
  90. (libelcouch-entity-name entity)))
  91. (cl-defmethod libelcouch-entity-url ((instance libelcouch-instance))
  92. (libelcouch--instance-url instance))
  93. ;;; Private helpers
  94. (cl-defgeneric libelcouch--entity-create-children-from-json (entity json)
  95. "Create and return children of ENTITY from a JSON object.")
  96. (cl-defmethod libelcouch--entity-create-children-from-json ((instance libelcouch-instance) json)
  97. (mapcar
  98. (lambda (database-name) (libelcouch--database-create :name database-name :instance instance))
  99. json))
  100. (cl-defmethod libelcouch--entity-create-children-from-json ((database libelcouch-database) json)
  101. (let ((documents-json (map-elt json 'rows)))
  102. (mapcar
  103. (lambda (document-json) (libelcouch--document-create
  104. :name (map-elt document-json 'id)
  105. :revision (map-nested-elt document-json '(value rev))
  106. :database database))
  107. documents-json)))
  108. (cl-defgeneric libelcouch--entity-children-url (entity)
  109. "Return the path to query all children of ENTITY.")
  110. (cl-defmethod libelcouch--entity-children-url ((instance libelcouch-instance))
  111. (format "%s/%s" (libelcouch-entity-url instance) "_all_dbs"))
  112. (cl-defmethod libelcouch--entity-children-url ((database libelcouch-database))
  113. (format "%s/%s" (libelcouch-entity-url database) "_all_docs"))
  114. ;;; Navigating
  115. (cl-defgeneric libelcouch-entity-list (entity function)
  116. "Evaluate function with the children of ENTITY as parameter."
  117. (request
  118. (libelcouch--entity-children-url entity)
  119. :timeout libelcouch-timeout
  120. :headers '(("Content-Type" . "application/json")
  121. ("Accept" . "application/json"))
  122. :parser 'json-read
  123. :success (cl-function
  124. (lambda (&key data &allow-other-keys)
  125. (message "json: %S" data)
  126. (let* ((children (libelcouch--entity-create-children-from-json entity data)))
  127. (funcall function children))))
  128. :error (cl-function (lambda (&rest args &key error-thrown &allow-other-keys)
  129. (message "Got error: %S" error-thrown)))))
  130. (provide 'libelcouch)
  131. ;;; libelcouch.el ends here