ob-restclient.el (6427B)
1 ;;; ob-restclient.el --- org-babel functions for restclient-mode -*- lexical-binding: t -*- 2 3 ;; Copyright (C) Alf Lervåg 4 5 ;; Author: Alf Lervåg 6 ;; Keywords: literate programming, reproducible research 7 ;; Homepage: https://github.com/alf/ob-restclient.el 8 ;; Version: 0.03 9 ;; Package-Requires: ((restclient "0")) 10 11 ;;; License: 12 13 ;; This program is free software; you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation; either version 3, or (at your option) 16 ;; any later version. 17 ;; 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 ;; 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs; see the file COPYING. If not, write to the 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26 ;; Boston, MA 02110-1301, USA. 27 28 ;;; Commentary: 29 ;; This is a very simple first iteration at integrating restclient.el 30 ;; and org-mode. 31 32 ;;; Requirements: 33 ;; restclient.el 34 35 ;;; Code: 36 (require 'ob) 37 (require 'ob-ref) 38 (require 'ob-comint) 39 (require 'ob-eval) 40 (require 'org-table) 41 (require 'restclient) 42 43 (defvar org-babel-default-header-args:restclient 44 `((:results . "raw")) 45 "Default arguments for evaluating a restclient block.") 46 47 (defcustom org-babel-restclient--jq-path "jq" 48 "The path to `jq', for post-processing. Uses the PATH by default" 49 :type '(string) 50 :group 'org-babel) 51 52 ;;;###autoload 53 (defun org-babel-execute:restclient (body params) 54 "Execute a block of Restclient code with org-babel. 55 This function is called by `org-babel-execute-src-block'" 56 (message "executing Restclient source code block") 57 (with-temp-buffer 58 (let ((results-buffer (current-buffer)) 59 (restclient-same-buffer-response t) 60 (restclient-response-body-only (org-babel-restclient--should-hide-headers-p params)) 61 (restclient-same-buffer-response-name (buffer-name)) 62 (raw-only (org-babel-restclient--raw-payload-p params)) 63 (suppress-response-buffer (fboundp #'restclient-http-send-current-suppress-response-buffer)) 64 (display-buffer-alist 65 (cons 66 '("\\*temp\\*" display-buffer-no-window (allow-no-window . t)) 67 display-buffer-alist))) 68 69 (insert (buffer-name)) 70 (with-temp-buffer 71 (insert 72 (org-babel-expand-body:generic 73 body params 74 (org-babel-variable-assignments:restclient params))) 75 (goto-char (point-min)) 76 (delete-trailing-whitespace) 77 (goto-char (point-min)) 78 (restclient-http-parse-current-and-do 'restclient-http-do raw-only t suppress-response-buffer)) 79 80 (while restclient-within-call 81 (sleep-for 0.05)) 82 83 (goto-char (point-min)) 84 (when (equal (buffer-name) (buffer-string)) 85 (error "Restclient encountered an error")) 86 87 (when-let* ((jq-header (assoc :jq params)) 88 (jq-path "jq") 89 (jq-args (or (cdr (assoc :jq-args params)) ""))) 90 (shell-command-on-region 91 (point-min) 92 (point-max) 93 (format "%s %s--args %s" org-babel-restclient--jq-path 94 (if (assq :jq-args params) (format "%s " jq-args) "") 95 (shell-quote-argument (cdr jq-header))) 96 results-buffer 97 t)) 98 99 ;; widen if jq but not pure payload 100 (when (and (assq :jq params) 101 (not (assq :noheaders params)) 102 (not (org-babel-restclient--return-pure-payload-result-p params))) 103 (widen)) 104 105 (if (member "table" (cdr (assoc :result-params params))) 106 (let* ((separator '(4)) 107 (result 108 (condition-case err 109 (let ((pmax (point-max))) 110 ;; If the buffer is empty, don't bother trying to 111 ;; convert the table. 112 (when (> pmax 1) 113 (org-table-convert-region (point-min) pmax separator) 114 (delq nil 115 (mapcar (lambda (row) 116 (and (not (eq row 'hline)) 117 (mapcar #'org-babel-string-read row))) 118 (org-table-to-lisp))))) 119 (error 120 (display-warning 'org-babel 121 (format "Error reading results: %S" err) 122 :error) 123 nil)))) 124 (pcase result 125 (`((,scalar)) scalar) 126 (`((,_ ,_ . ,_)) result) 127 (`(,scalar) scalar) 128 (_ result))) 129 (when (not (org-babel-restclient--return-pure-payload-result-p params)) 130 (org-babel-restclient--wrap-result)) 131 (buffer-string))))) 132 133 ;;;###autoload 134 (defun org-babel-variable-assignments:restclient (params) 135 "Return a list of statements assigning variables specified in PARAMS." 136 (mapcar 137 (lambda (pair) 138 (let ((name (car pair)) 139 (value (cdr pair)) 140 (format-string ":%s = %s\n")) 141 (when (string-match-p "\n" value) 142 (setq format-string ":%s = <<\n%s\n#\n")) 143 (format format-string name value))) 144 (org-babel--get-vars params))) 145 146 (defun org-babel-restclient--wrap-result () 147 "Wrap the contents of the buffer in an `org-mode' src block." 148 (let ((mode-name (substring (symbol-name major-mode) 0 -5))) 149 (insert (format "#+BEGIN_SRC %s\n" mode-name)) 150 (goto-char (point-max)) 151 (unless (and (bolp) (eolp)) 152 (insert "\n")) 153 (insert "#+END_SRC\n"))) 154 155 (defun org-babel-restclient--should-hide-headers-p (params) 156 "Return `t' if headers should be hidden." 157 (or (org-babel-restclient--return-pure-payload-result-p params) 158 (assq :noheaders params) 159 (assq :jq params))) 160 161 (defun org-babel-restclient--return-pure-payload-result-p (params) 162 "Return `t' if the `:results' key in PARAMS contains `value' or `table'." 163 (let ((result-type (cdr (assoc :results params)))) 164 (when result-type 165 (string-match "value\\|table" result-type)))) 166 167 (defun org-babel-prep-session:restclient (_session _params) 168 "Return an error because restclient does not support sessions." 169 (error "Restclient does not support sessions")) 170 171 (defun org-babel-restclient--raw-payload-p (params) 172 "Return t if the `:results' key in PARAMS contain `file'." 173 (let ((result-type (cdr (assoc :results params)))) 174 (when result-type 175 (and (not (org-babel-restclient--should-hide-headers-p params)) 176 (string-match "file" result-type))))) 177 178 (provide 'ob-restclient) 179 ;;; ob-restclient.el ends here