Emacs library to control Basecamp
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.

175 lines
6.6KB

  1. ;;; libbcel-structs.el --- Define Basecamp data structures -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2019 Damien Cassou
  3. ;; Author: Damien Cassou <damien@cassou.me>
  4. ;; Url: https://gitlab.petton.fr/bcel/libbcel
  5. ;; Package-requires: ((emacs "26.1") (request "0.3.1"))
  6. ;; Version: 0.4.0
  7. ;; This program is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; This program is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; Define the structures and their accessors
  19. ;;; Code:
  20. (require 'map)
  21. (cl-defstruct (libbcel-entity
  22. (:constructor libbcel--entity-create)
  23. (:conc-name libbcel-entity-))
  24. (id nil :read-only t)
  25. (name nil :read-only t)
  26. (url nil :read-only t)
  27. (app-url nil :read-only t :alist-key-name app_url)
  28. (alist nil :read-only t)
  29. (comments-count 0 :read-only t :alist-key-name comments_count)
  30. (comments-url 0 :read-only t :alist-key-name comments_url)
  31. (parent nil :read-only t))
  32. (cl-defstruct (libbcel-project
  33. (:include libbcel-entity)
  34. (:constructor libbcel-project-create)
  35. (:conc-name libbcel-project-))
  36. (description nil :read-only t)
  37. (tools nil :read-only t :alist-key-name dock))
  38. (cl-defstruct (libbcel-tool
  39. (:include libbcel-entity
  40. (name nil :alist-key-name title))
  41. (:constructor libbcel-tool-create)
  42. (:conc-name libbcel-tool-))
  43. (enabled nil
  44. :read-only t
  45. :alist-transformer (lambda (data) (not (eq data :json-false))))
  46. (children-url nil :read-only t))
  47. (cl-defstruct (libbcel-message-board
  48. (:include libbcel-tool
  49. (children-url nil :alist-key-name messages_url))
  50. (:constructor libbcel-message-board-create)
  51. (:conc-name libbcel-message-board-)))
  52. (cl-defstruct (libbcel-todoset
  53. (:include libbcel-tool
  54. (children-url nil :alist-key-name todolists_url))
  55. (:constructor libbcel-todoset-create)
  56. (:conc-name libbcel-todoset-)))
  57. (cl-defstruct (libbcel-message
  58. (:include libbcel-entity
  59. (name nil :alist-key-name subject))
  60. (:constructor libbcel-message-create)
  61. (:conc-name libbcel-message-))
  62. (content nil :read-only t))
  63. (cl-defstruct (libbcel-todolist
  64. (:include libbcel-entity)
  65. (:constructor libbcel-todolist-create)
  66. (:conc-name libbcel-todolist-))
  67. (todos-url nil
  68. :read-only t
  69. :alist-key-name todos_url))
  70. (cl-defstruct (libbcel-todo
  71. (:include libbcel-entity
  72. (name nil :alist-key-name title))
  73. (:constructor libbcel-todo-create)
  74. (:conc-name libbcel-todo-))
  75. (description nil :read-only t)
  76. (completed nil
  77. :read-only t
  78. :alist-transformer (lambda (data) (not (eq data :json-false))))
  79. (completion-url nil :read-only t :alist-key-name completion_url))
  80. (cl-defstruct (libbcel-comment
  81. (:include libbcel-entity)
  82. (:constructor libbcel-comment-create)
  83. (:conc-name libbcel-comment-))
  84. (content nil :read-only t)
  85. (created-at nil :read-only t :alist-key-name created_at)
  86. (creator nil
  87. :read-only t
  88. :alist-transformer (lambda (data)
  89. (libbcel-structs-create-instance-from-data data))))
  90. (cl-defstruct (libbcel-person
  91. (:include libbcel-entity)
  92. (:constructor libbcel-person-create)
  93. (:conc-name libbcel-person-)))
  94. (cl-defmethod libbcel-equal ((entity1 libbcel-entity) (entity2 libbcel-entity))
  95. "Return t iff ENTITY1 is the same entity as ENTITY2."
  96. (equal (libbcel-entity-id entity1) (libbcel-entity-id entity2)))
  97. (defun libbcel-structs-create-instance-from-data (entity-data &optional parent)
  98. "Return a structure from ENTITY-DATA.
  99. ENTITY-DATA is an alists.
  100. If PARENT is provided, set the created entity's parent to
  101. PARENT. This can later be retrieved with `libbcel-entity-parent'.
  102. The structure to instanciate is decided `libbcel-structs--infer-struct-type'."
  103. (let ((struct-type (libbcel-structs--infer-struct-type entity-data)))
  104. (when struct-type
  105. (apply
  106. #'record
  107. struct-type
  108. (mapcar
  109. (lambda (slot-info)
  110. (let* ((alist-key (or (plist-get slot-info :alist-key-name)
  111. (car slot-info)))
  112. (alist-value (pcase alist-key
  113. ('alist entity-data)
  114. ('parent parent)
  115. (_ (map-elt entity-data alist-key))))
  116. (transformer (or (plist-get slot-info :alist-transformer)
  117. #'identity)))
  118. (funcall transformer alist-value)))
  119. (cdr (cl-struct-slot-info struct-type)))))))
  120. (defun libbcel-structs-create-instances-from-data (entities-data &optional parent)
  121. "Return a list of structures from ENTITIES-DATA.
  122. ENTITIES-DATA is a list of alists.
  123. If PARENT is provided, set the created entity's parent to
  124. PARENT. This can later be retrieved with `libbcel-entity-parent'.
  125. The structures to instanciate are decided by `libbcel-structs--infer-struct-type'."
  126. (seq-remove #'null
  127. (mapcar (lambda (data) (libbcel-structs-create-instance-from-data data parent))
  128. entities-data)))
  129. (defun libbcel-structs--infer-struct-type (entity-data)
  130. "Return a symbol of a structure type to instanciate for ENTITY-DATA."
  131. (let ((type-name (map-elt entity-data 'type)))
  132. (if type-name
  133. (pcase type-name
  134. ("Message::Board" 'libbcel-message-board)
  135. ("Todoset" 'libbcel-todoset)
  136. ("Project" 'libbcel-project)
  137. ("Todolist" 'libbcel-todolist)
  138. ("Todo" 'libbcel-todo)
  139. ("Comment" 'libbcel-comment)
  140. (_ (message "libbcel-structs: I don't know what the type is for `%s'" type-name)
  141. nil))
  142. (cond
  143. ((map-contains-key entity-data 'dock) 'libbcel-project)
  144. ((map-contains-key entity-data 'personable_type) 'libbcel-person)))))
  145. (provide 'libbcel-structs)
  146. ;;; libbcel-structs.el ends here