Passing a callback through cl-function - emacs

I'm trying to use the excellent request.el library request data from a REST API:
(request
"http://httpbin.org/get"
:params '(("key" . "value") ("key2" . "value2"))
:parser 'json-read
:success (function*
(lambda (&key data &allow-other-keys)
(message "I sent: %S" (assoc-default 'args data)))))
Which works nicely. Being a lisp-newbie I don't really know what the function* does here, I just got that from the request.el-examples.
I then tried to wrap this call in a function to reduce boilerplate like so:
(defun my/do-request (callback)
(request
"http://httpbin.org/get"
:params '(("key" . "value") ("key2" . "value2"))
:parser 'json-read
:success callback))
(my/do-request (lambda (data)
(message "got data: %s" data)))
But the callback is not being called? I also tried passing the callback like this:
(defun my/do-request (callback)
(request
"http://httpbin.org/get"
:params '(("key" . "value") ("key2" . "value2"))
:parser 'json-read
:success (function*
(lambda (&key data &allow-other-keys)
(callback data)))))
with the same result. I thought I might need lexical binding here, but that also didn't help.
How can I reduce the boilerplate code here?

When calling the new function, it is generally a good practice to try it with the exact same value you originally had:
(my/do-request
(function*
(lambda (&key data &allow-other-keys)
(message "I sent: %S" (assoc-default 'args data)))))
The above prints the desired message.
First approach
You called the code as follows, and nothing was printed:
(my/do-request (lambda (data)
(message "got data: %s" data)))
It turns out there is an error, but unfortunately it does not reach the user. In case of doubt, you should enable the debugger:
(setf debug-on-error t)
You can eval the above in the *scratch* buffer or in the minibuffer after doing M-: (eval-expression).
Then, when you reevaluate the call, the following should be displayed:
Debugger entered--Lisp error: (wrong-number-of-arguments (lambda (data) (message "got data: %s" data)) 8)
(lambda (data) (message "got data: %s" data))(:data ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . .....) (url . "http://httpbin.org/get?key=value&key2=value2")) :symbol-status success :error-thrown nil :response [cl-struct-request-response 200 nil ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . .....) (url . "http://httpbin.org/get?key=value&key2=value2")) nil success "http://httpbin.org/get?key=value&key2=value2" nil (:params (("key" . "value") ("key2" . "value2")) :parser json-read :success (lambda (data) (message "got data: %s" data)) :error #[128 "\302\300\303\301\"\"\207" [request-default-error-callback ("http://httpbin.org/get") apply append] 6 "\n\n(fn &rest ARGS2)"] :url "http://httpbin.org/get?key=value&key2=value2" :response #0) #<killed buffer> "HTTP/1.1 200 OK\nConnection: keep-alive\nServer: gunicorn/19.8.1\nDate: Thu, 05 Jul 2018 11:44:15 GMT\nContent-Type: application/json\nContent-Length: 249\nAccess-Control-Allow-Origin: *\nAccess-Control-Allow-Credentials: true\nVia: 1.1 vegur\n" nil curl nil])
apply((lambda (data) (message "got data: %s" data)) (:data ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . ...) (url . "http://httpbin.org/get?key=value&key2=value2")) :symbol-status success :error-thrown nil :response [cl-struct-request-response 200 nil ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . ...) (url . "http://httpbin.org/get?key=value&key2=value2")) nil success "http://httpbin.org/get?key=value&key2=value2" nil (:params (("key" . "value") ("key2" . "value2")) :parser json-read :success (lambda (data) (message "got data: %s" data)) :error #[128 "\302\300\303\301\"\"\207" [request-default-error-callback ("http://httpbin.org/get") apply append] 6 "\n\n(fn &rest ARGS2)"] :url "http://httpbin.org/get?key=value&key2=value2" :response #1) #<killed buffer> "HTTP/1.1 200 OK\nConnection: keep-alive\nServer: gunicorn/19.8.1\nDate: Thu, 05 Jul 2018 11:44:15 GMT\nContent-Type: application/json\nContent-Length: 249\nAccess-Control-Allow-Origin: *\nAccess-Control-Allow-Credentials: true\nVia: 1.1 vegur\n" nil curl nil]))
apply(apply (lambda (data) (message "got data: %s" data)) (:data ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . ...) (url . "http://httpbin.org/get?key=value&key2=value2")) :symbol-status success :error-thrown nil :response [cl-struct-request-response 200 nil ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . ...) (url . "http://httpbin.org/get?key=value&key2=value2")) nil success "http://httpbin.org/get?key=value&key2=value2" nil (:params (("key" . "value") ("key2" . "value2")) :parser json-read :success (lambda (data) (message "got data: %s" data)) :error #[128 "\302\300\303\301\"\"\207" [request-default-error-callback ("http://httpbin.org/get") apply append] 6 "\n\n(fn &rest ARGS2)"] :url "http://httpbin.org/get?key=value&key2=value2" :response #1) #<killed buffer> "HTTP/1.1 200 OK\nConnection: keep-alive\nServer: gunicorn/19.8.1\nDate: Thu, 05 Jul 2018 11:44:15 GMT\nContent-Type: application/json\nContent-Length: 249\nAccess-Control-Allow-Origin: *\nAccess-Control-Allow-Credentials: true\nVia: 1.1 vegur\n" nil curl nil]))
request--safe-apply((lambda (data) (message "got data: %s" data)) (:data ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . ...) (url . "http://httpbin.org/get?key=value&key2=value2")) :symbol-status success :error-thrown nil :response [cl-struct-request-response 200 nil ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . ...) (url . "http://httpbin.org/get?key=value&key2=value2")) nil success "http://httpbin.org/get?key=value&key2=value2" nil (:params (("key" . "value") ("key2" . "value2")) :parser json-read :success (lambda (data) (message "got data: %s" data)) :error #[128 "\302\300\303\301\"\"\207" [request-default-error-callback ("http://httpbin.org/get") apply append] 6 "\n\n(fn &rest ARGS2)"] :url "http://httpbin.org/get?key=value&key2=value2" :response #1) #<killed buffer> "HTTP/1.1 200 OK\nConnection: keep-alive\nServer: gunicorn/19.8.1\nDate: Thu, 05 Jul 2018 11:44:15 GMT\nContent-Type: application/json\nContent-Length: 249\nAccess-Control-Allow-Origin: *\nAccess-Control-Allow-Credentials: true\nVia: 1.1 vegur\n" nil curl nil]))
request--callback(#<killed buffer> :params (("key" . "value") ("key2" . "value2")) :parser json-read :success (lambda (data) (message "got data: %s" data)) :error #[128 "\302\300\303\301\"\"\207" [request-default-error-callback ("http://httpbin.org/get") apply append] 6 "\n\n(fn &rest ARGS2)"] :url "http://httpbin.org/get?key=value&key2=value2" :response [cl-struct-request-response 200 nil ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . ...) (url . "http://httpbin.org/get?key=value&key2=value2")) nil success "http://httpbin.org/get?key=value&key2=value2" nil (:params (("key" . "value") ("key2" . "value2")) :parser json-read :success (lambda (data) (message "got data: %s" data)) :error #[128 "\302\300\303\301\"\"\207" [request-default-error-callback ("http://httpbin.org/get") apply append] 6 "\n\n(fn &rest ARGS2)"] :url "http://httpbin.org/get?key=value&key2=value2" :response #0) #<killed buffer> "HTTP/1.1 200 OK\nConnection: keep-alive\nServer: gunicorn/19.8.1\nDate: Thu, 05 Jul 2018 11:44:15 GMT\nContent-Type: application/json\nContent-Length: 249\nAccess-Control-Allow-Origin: *\nAccess-Control-Allow-Credentials: true\nVia: 1.1 vegur\n" nil curl nil])
apply(request--callback #<killed buffer> (:params (("key" . "value") ("key2" . "value2")) :parser json-read :success (lambda (data) (message "got data: %s" data)) :error #[128 "\302\300\303\301\"\"\207" [request-default-error-callback ("http://httpbin.org/get") apply append] 6 "\n\n(fn &rest ARGS2)"] :url "http://httpbin.org/get?key=value&key2=value2" :response [cl-struct-request-response 200 nil ((args (key . "value") (key2 . "value2")) (headers (Accept . "*/*") (Accept-Encoding . "deflate, gzip") (Connection . "close") (Host . "httpbin.org") (User-Agent . "curl/7.55.1")) (origin . ...) (url . "http://httpbin.org/get?key=value&key2=value2")) nil success "http://httpbin.org/get?key=value&key2=value2" nil #0 #<killed buffer> "HTTP/1.1 200 OK\nConnection: keep-alive\nServer: gunicorn/19.8.1\nDate: Thu, 05 Jul 2018 11:44:15 GMT\nContent-Type: application/json\nContent-Length: 249\nAccess-Control-Allow-Origin: *\nAccess-Control-Allow-Credentials: true\nVia: 1.1 vegur\n" nil curl nil]))
request--curl-callback(#<process request curl> "finished\n")
Based on the documentation, the callback function should be variadic, which means the following works:
(lambda (&rest args) (message "got data: %s" args))
But then, you will see too much data.
Arguments are passed as key/values pairs. In order to get the data associated with the :data symbol, you would have to do:
(lambda (&rest args)
(message "got data: %s" (getf args :data)))
The resulting value is an association list, from which you can access the 'args entry like done above (i.e. (assoc-default 'args data)).
But, instead of doing (getf args :data), you can also write:
(lambda (&key data) ...)
The special &key symbol is used to automatically access the value associated with :data in the implicit list of arguments. But, keyword parameters are from Common Lisp, Emacs Lisp does not know how to handle &key out of the box. That's why there is a (function* ...) macro that wraps around the lambda. You then have the choice of using the function* macro or deal with the argument list by yourself, as shown above. It depends on what you need. As suggested by the documentation, if you use &key, you should also use &allow-other-keys.
Second approach
In your second approach, having debug-on-entry set to t indicates that callback is not a known function:
Debugger entered--Lisp error: (void-function callback)
This is due to Emacs Lisp being a Lisp-2, i.e. you cannot call a function given in argument simply by putting it as the first element of a function call. Emacs Lisp understands the syntax as "call the function named callback", not "call the function object bound to variable callback". You'd need to use funcall:
(function*
(lambda (&key data &allow-other-keys)
(funcall callback data)))
But with the above, now the error is that callback is an undefined variable. And now, this is due to dynamic scoping. If you evalute the following line and reevaluate the defun, the code works as expected:
(setf lexical-binding t)
Alternatively, you can put the following as the first line of you file:
;; -*- lexical-binding: t -*-

Related

Why isn't my macro functioning in the same way as handwritten code?

So I have 2 router functions for learning to work with clack in common lisp. One is written without macros, and the other is written with macros that expand to match the first function, but only the non-macro version is working. The code below has (:use :trivia) from (ql:quickload 'trivia).
This one is written without any macros, and works:
(defun router (env)
(match env
((guard (property :path-info path)
(equalp "/" path))
(home env))
((guard (property :path-info path)
(equalp "/live/clicked" path))
(live-clicked env))
((property :path-info path)
`(404 nil (,(format nil "404 page not found"))))))
I decided I didn't like those guard clauses taking up so much space in the function definition, so I rewrote the function:
(defun router (env)
(match env
(route "/" (home env))
(route "/live/clicked" (live-clicked env))
((property :path-info path)
`(404 nil (,(format nil "404 page not found"))))))
route is defined as so:
(defmacro route (valid-path &body body)
(let ((path (gensym)))
`((guard (property :path-info ,path)
(equalp ,valid-path ,path))
,#body)))
With this new router function and macro, the function is always short-circuiting on the first clause. When macroexpanding the 2 (route ...) clauses, I receive this output, matching the function I wrote:
* `(defun router (env)
(match env
,(macroexpand '(route "/" (home env)))
,(macroexpand '(route "/live/clicked" (live-clicked env)))
((property :path-info path)
`(404 nil (,(format nil "404")))))))
(DEFUN ROUTER (ENV)
(MATCH ENV
((GUARD (PROPERTY :PATH-INFO #:G120) (EQUALP "/" #:G120)) (HOME ENV))
((GUARD (PROPERTY :PATH-INFO #:G121) (EQUALP "/live/clicked" #:G121)) (LIVE-CLICKED ENV))
((PROPERTY :PATH-INFO PATH) `(404 NIL (,(FORMAT NIL "404")))))
(home env) and (live-clicked env) are functions that return something similar to (backquote (200 nil (,(*form generating html*)))). env is the state of the web request, but in this instance it only needs to be (list :path-info "/live/clicked")
First of all, macroexpand should be
used for interactive debugging rather than in production code.
Its use inside defun (almost) never makes sense.
Second, to understand your second router, you should macroexpand its body
rather than the defun, i.e.,
(macroexpand '(match env
(route "/" (home env))
(route "/live/clicked" (live-clicked env))
((property :path-info path)
`(404 nil (,(format nil "404"))))))
You will see that route is not expanded because it is not in a "function position".
What you need to expand your route before match is expanded, i.e., you probably want a
wrapper around match (I removed gensym because you indicated in the comments that it is really
not necessary):
(defmacro my-match (what &body clauses)
(labels ((handle-clause (clause)
(if (eq (car clause) 'route)
(apply #'route (rest clause))
clause))
(route (valid-path &rest body)
`((guard (property :path-info path)
(equalp ,valid-path path))
,#body)))
`(match ,what ,#(mapcar #'handle-clause clauses))))
and then
(defun router (env)
(my-match env
(route "/" (home env))
(route "/live/clicked" (live-clicked env))
((property :path-info path)
`(404 nil (,(format nil "404 page not found"))))))
Testing:
(macroexpand '(my-match env
(route "/" (home env))
(route "/live/clicked" (live-clicked env))
((property :path-info path)
`(404 nil (,(format nil "404"))))))
==>
(MATCH ENV ((GUARD (PROPERTY :PATH-INFO PATH) (EQUALP "/" PATH)) (HOME ENV))
((GUARD (PROPERTY :PATH-INFO PATH) (EQUALP "/live/clicked" PATH))
(LIVE-CLICKED ENV))
((PROPERTY :PATH-INFO PATH) `(404 NIL (,(FORMAT NIL "404")))))
T
The pattern matcher you are using, Trivia, has a defpattern macro. That's what you must use to define a macro against the pattern language itself, rather than defmacro.

Org Babel Source Block Native Fontification

I'm trying to get org-babel source blocks to do native syntax highlighting. I've set org-src-fontify-natively to true, but am still not seeing anything.
Here's my related config:
(setq org-babel-default-header-args
'((:session . "none")
(:results . "replace")
(:exports . "code")
(:cache . "no")
(:noweb . "yes")
(:hlines . "yes")
(:tangle . "yes")
(:padnewline . "yes")))
(org-babel-do-load-languages
'org-babel-load-languages
'((emacs-lisp . t)
(R . t)
(js . t)
(clojure . t)
(org . t)
(sh . t)
(python . t)
(dot . t)
(prolog . t)
(lisp . t)
))
(setq org-edit-src-content-indentation 0
org-src-tab-acts-natively t
org-src-fontify-natively t
org-confirm-babel-evaluate nil
org-src-window-setup 'current-window
org-src-preserve-indentation t
org-src-strip-leading-and-trailing-blank-lines t
)
And here's the org-babel-view-src-block-info (C-c C-v I):
Lang: emacs-lisp
Properties:
:header-args nil
:header-args:emacs-lisp nil
Header Arguments:
:cache no
:exports code
:hlines yes
:lexical no
:noweb yes
:padnewline yes
:results none
:session none
:tangle yes
And my (emacs-version):
GNU Emacs 25.1.50.1 (x86_64-apple-darwin13.4.0, NS appkit-1265.21 Version 10.9.5 (Build 13F1603))
of 2016-04-03

Sending email in emacs w/ request package and mailgun

I am trying to write an elisp function to send email using a mailgun account.
Here is what I have tried:
(require 'request)
(defun send-mail (api-key from-url to-name to-address subject message)
"Sends an email using Mailgun account"
(request
(concat "https://api.mailgun.net/v3/" from-url "/messages")
:type "POST"
:data '(("from" . (concat "Mailgun Sandbox <postmaster#" from-url ">"))
("to" . (concat to-name " <" to-address ">"))
("subject" . subject)
("text" . message))
:headers '(("api" . api-key))
:parser 'json-read
:success (function*
(lambda (&key data &allow-other-keys)
(message "I sent: %S" (assoc-default 'form data))))))
I am getting the error "Wrong type argument: integerp, concat" from the "from" section in :data. Not sure what I am doing wrong, or if this is even the correct approach to be taking.
In this section:
:data '(("from" . (concat "Mailgun Sandbox <postmaster#" from-url ">"))
("to" . (concat to-name " <" to-address ">"))
("subject" . subject)
("text" . message))
you are quoting the entire list literally with a single quote ('), but you actually want the concat function calls to be evaluated before that.
You can use a backquote instead, and put a comma before the parts that should be evaluated:
:data `(("from" . ,(concat "Mailgun Sandbox <postmaster#" from-url ">"))
("to" . ,(concat to-name " <" to-address ">"))
("subject" . subject)
("text" . message))
The question lawlist linked to in the comments explains this in more detail.

ring redirect after login

(ns ...
(:require [ring.util.response :refer [ response redirect]))
My original code be-all-like
(-> (response "You are now logged in! communist party time!")
(assoc :session new-session)
(assoc :headers {"Content-Type" "text/html"}))
Which worked well, but the user still has to navigate elsewhere manually.
Trying to use http://ring-clojure.github.io/ring/ring.util.response.html#var-redirect
(-> (redirect requri)
(assoc :session new-session)
(assoc :headers {"Content-Type" "text/html"}))
doesn't do anything (aside from returning a blank page).
How can I achieve a redirect to a known uri using ring?
response is return a body.
you code is (response requri),but the param of the funtion reponse is html body,not a uri,you can use the this function
like this
(ns foo
(:require [ring.util.response :as response]))
(def requi "/")
(-> (response/redirect requri)
(assoc :session new-session)
(assoc :headers {"Content-Type" "text/html"}))
ps: if you are writing a web site.the lib-noir is a good way to control the session and other.
ipaomian has the answer.
Wanted to share a nice redirect hack:
(ns foo
(:require [ring.util.response :as response]))
(defn redirect
"Like ring.util.response/redirect but also accepts key value pairs
to assoc to response."
[url & kvs]
(let [resp (response/redirect url)]
(if kvs (apply assoc resp kvs) resp)))
(redirect "/" :session new-session :headers {"Content-Type" "text/html"})
ipaomian is right however mine worked by removing the headers. This is my code:
(:require
[ring.util.response :refer [redirect]])
(defn set-user! [id {session :session}]
(-> (redirect "/home")
(assoc :session (assoc session :user id))))

Receiving data through LISP USOCKET

I'm trying to send data over USOCKET. When the data reaches the server, the server should reply back. However, stream-read (as defined below) only returns the data when it's echoed back with the original data it sent. For example, if I send hello and the server replies with the same data, hello, then stream-read returns, but if the server replies with hi, stream-read doesn't return until the server sends the exact buffer it received.
Here's the code: (I've found most of it online.)
;; Load USocket
(load #P"/usr/share/common-lisp/source/cl-asdf/asdf.lisp")
(asdf:operate 'asdf:load-op :usocket)
(defun stream-read (stream)
(socket-listen (usocket:socket-stream stream)))
(defun stream-print (string stream)
(write-line string (usocket:socket-stream stream))
(force-output (usocket:socket-stream stream)))
;; Define a stream
(defparameter my-stream
(usocket:socket-connect "127.0.0.1" 6003))
;; Use the stream
(stream-print "random" my-stream)
(print (stream-read my-stream))
As for the server, I'm using a slightly modified version of the boost blocking server example. (c++) The full code can be found here: http://www.boost.org/doc/libs/1_53_0/doc/html/boost_asio/example/echo/blocking_tcp_echo_server.cpp
...
void session(socket_ptr sock)
{
try
{
for (;;)
{
char data[max_length];
boost::system::error_code error;
size_t length = sock->read_some(boost::asio::buffer(data), error);
if (error == boost::asio::error::eof)
break; // Connection closed cleanly by peer.
else if (error)
throw boost::system::system_error(error); // Some other error.
std::vector<char> v(data,data+length);
std::string theStr;
for(unsigned int i=0;i<v.size();i++)
{
if(v[i]<32 || v[i]>=0x7f);//Remove non-ascii char
else theStr.insert(theStr.end(),v[i]);
}
std::cout<<"|"<<theStr<<"|"<<std::endl;
boost::asio::write(*sock, boost::asio::buffer(data, length)); //works
boost::asio::write(*sock, boost::asio::buffer("some", 4)); //doesn't work
}
}
catch (std::exception& e)
{
std::cerr << "Exception in thread: " << e.what() << "\n";
}
}
...
Without seeing the code for your server it's hard to answer without a bit of speculation. But:
You use the same socket for each call from the client to the server. If the server isn't expecting that, it won't behave as you want it to.
Your definition of stream-read calls socket-listen. Did you mean usocket:socket-listen? This is a server-side function (and takes different arguments). I'm probably not looking at the exact code you were running.
Advisory notes: (a) my-stream is actually a socket, not a stream; (b) I encourage you to manage external libraries using Quicklisp.
Here's a full working example. This is on LispWorks; I've used LW internals for the server to make it utterly clear which is server and which is client.
CL-USER 1 > (ql:quickload :usocket)
To load "usocket":
Load 1 ASDF system:
usocket
; Loading "usocket"
(:USOCKET)
CL-USER 2 > (comm:start-up-server
:service 6003
:function (lambda (handle)
(let* ((stream (make-instance 'comm:socket-stream
:socket handle
:direction :io
:element-type 'base-char))
(line (read-line stream)))
(format stream "Hello: ~a~%" line)
(force-output stream))))
#<MP:PROCESS Name "6003 server" Priority 85000000 State "Running">
CL-USER 3 > (defun socket-read (socket)
(read-line (usocket:socket-stream socket)))
SOCKET-READ
CL-USER 4 > (defun socket-print (string socket)
(write-line string (usocket:socket-stream socket))
(force-output (usocket:socket-stream socket)))
SOCKET-PRINT
CL-USER 5 > (defun test (thing)
(let ((socket (usocket:socket-connect "127.0.0.1" 6003)))
(socket-print thing socket)
(socket-read socket)))
TEST
CL-USER 6 > (test "Buttered toast")
"Hello: Buttered toast"
NIL
CL-USER 7 > (test "A nice cup of tea")
"Hello: A nice cup of tea"
NIL
If you're still having difficulties, post again with source for your server and your actual stream-read.