dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

ob-restclient.el (5198B)


      1 ;;; ob-restclient.el --- org-babel functions for restclient-mode
      2 
      3 ;; Copyright (C) Alf Lervåg
      4 
      5 ;; Author: Alf Lervåg
      6 ;; Keywords: literate programming, reproducible research
      7 ;; Package-Version: 20230301.1951
      8 ;; Package-Commit: ded3b7eb7b0592328a7a08ecce6f25278cba4a1d
      9 ;; Homepage: https://github.com/alf/ob-restclient.el
     10 ;; Version: 0.02
     11 ;; Package-Requires: ((restclient "0"))
     12 
     13 ;;; License:
     14 
     15 ;; This program is free software; you can redistribute it and/or modify
     16 ;; it under the terms of the GNU General Public License as published by
     17 ;; the Free Software Foundation; either version 3, or (at your option)
     18 ;; any later version.
     19 ;;
     20 ;; This program is distributed in the hope that it will be useful,
     21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     23 ;; GNU General Public License for more details.
     24 ;;
     25 ;; You should have received a copy of the GNU General Public License
     26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
     27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
     28 ;; Boston, MA 02110-1301, USA.
     29 
     30 ;;; Commentary:
     31 ;; This is a very simple first iteration at integrating restclient.el
     32 ;; and org-mode.
     33 
     34 ;;; Requirements:
     35 ;; restclient.el
     36 
     37 ;;; Code:
     38 (require 'ob)
     39 (require 'ob-ref)
     40 (require 'ob-comint)
     41 (require 'ob-eval)
     42 (require 'restclient)
     43 
     44 (defvar org-babel-default-header-args:restclient
     45   `((:results . "raw"))
     46   "Default arguments for evaluating a restclient block.")
     47 
     48 (defcustom org-babel-restclient--jq-path "jq"
     49   "The path to `jq', for post-processing. Uses the PATH by default")
     50 
     51 ;;;###autoload
     52 (defun org-babel-execute:restclient (body params)
     53   "Execute a block of Restclient code with org-babel.
     54 This function is called by `org-babel-execute-src-block'"
     55   (message "executing Restclient source code block")
     56   (with-temp-buffer
     57     (let ((results-buffer (current-buffer))
     58           (restclient-same-buffer-response t)
     59           (restclient-response-body-only (org-babel-restclient--should-hide-headers-p params))
     60           (restclient-same-buffer-response-name (buffer-name))
     61           (display-buffer-alist
     62            (cons
     63             '("\\*temp\\*" display-buffer-no-window (allow-no-window . t))
     64             display-buffer-alist)))
     65 
     66       (insert (buffer-name))
     67       (with-temp-buffer
     68         (dolist (p params)
     69           (let ((key (car p))
     70                 (value (cdr p)))
     71             (when (eql key :var)
     72               (insert (format ":%s = <<\n%s\n#\n" (car value) (cdr value))))))
     73         (insert body)
     74         (goto-char (point-min))
     75         (delete-trailing-whitespace)
     76         (goto-char (point-min))
     77         (restclient-http-parse-current-and-do
     78          'restclient-http-do (org-babel-restclient--raw-payload-p params) t))
     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          (current-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       (when (not (org-babel-restclient--return-pure-payload-result-p params))
    106         (org-babel-restclient--wrap-result))
    107 
    108       (buffer-string))))
    109 
    110 ;;;###autoload
    111 (defun org-babel-variable-assignments:restclient (params)
    112   "Return a list of restclient statements assigning the block's variables specified in PARAMS."
    113   (mapcar
    114    (lambda (pair)
    115      (let ((name (car pair))
    116            (value (cdr pair)))
    117        (format ":%s = %s" name value)))
    118    (org-babel--get-vars params)))
    119 
    120 (defun org-babel-restclient--wrap-result ()
    121   "Wrap the contents of the buffer in an `org-mode' src block."
    122   (let ((mode-name (substring (symbol-name major-mode) 0 -5)))
    123     (insert (format "#+BEGIN_SRC %s\n" mode-name))
    124     (goto-char (point-max))
    125     (insert "#+END_SRC\n")))
    126 
    127 (defun org-babel-restclient--should-hide-headers-p (params)
    128   "Return `t' if headers should be hidden."
    129   (or (org-babel-restclient--return-pure-payload-result-p params)
    130                 (assq :noheaders params)
    131                 (assq :jq params)))
    132 
    133 (defun org-babel-restclient--return-pure-payload-result-p (params)
    134   "Return `t' if the `:results' key in PARAMS contains `value' or `table'."
    135   (let ((result-type (cdr (assoc :results params))))
    136     (when result-type
    137       (string-match "value\\|table" result-type))))
    138 
    139 
    140 (defun org-babel-restclient--raw-payload-p (params)
    141   "Return t if the `:results' key in PARAMS contain `file'."
    142   (let ((result-type (cdr (assoc :results params))))
    143     (when result-type
    144       (string-match "file" result-type))))
    145 
    146 (provide 'ob-restclient)
    147 ;;; ob-restclient.el ends here