How to read POST data in the Guile web server - guile

In Guile's web server I can't seem to find any documentation on reading POST data. It seems to be sent to my entrypoint function as "body" along with the "request". It looks like body is encoded as a bytevector and I can decode it into a string:
(use-modules (rnrs bytevectors))
(utf8->string body)
So from here I could proceed to parse the string, but that seems rather tedious and error prone. Is there no way to read the POST data as a list of some kind?

Here is the code of decode procedure which will convert a BODY into an association list of lists where the key is the name of the form field and the value is a list of values associated with that key. Mind the fact that the "value" associated with a given key in the assoc returned by decode is always a list.
(define-module (web decode))
(use-modules (ice-9 match))
(use-modules (rnrs bytevectors))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-26))
(use-modules (web uri))
;;;
;;; decode
;;;
(define (acons-list k v alist)
"Add V to K to alist as list"
(let ((value (assoc-ref alist k)))
(if value
(let ((alist (alist-delete k alist)))
(acons k (cons v value) alist))
(acons k (list v) alist))))
(define (list->alist lst)
"Build a alist of list based on a list of key and values.
Multiple values can be associated with the same key"
(let next ((lst lst)
(out '()))
(if (null? lst)
out
(next (cdr lst) (acons-list (caar lst) (cdar lst) out)))))
(define-public (decode bv)
"Convert BV querystring or form data to an alist"
(define string (utf8->string bv))
(define pairs (map (cut string-split <> #\=)
;; semi-colon and amp can be used as pair separator
(append-map (cut string-split <> #\;)
(string-split string #\&))))
(list->alist (map (match-lambda
((key value)
(cons (uri-decode key) (uri-decode value)))) pairs)))

Related

Replacement for rest in Scheme?

Is there a way in which I can make this work without using rest (I tried to put cdr lst wherever rest is but it gives me an error) plus how can I remove the if condition - (if (> N 0) - because all I want display to do is output the list - (list N E)?
(define (count lst)
(if (null? lst) '()
(let ((display (lambda (N E)
(if (> N 0) (list N E) (list N E)))))
(let loop ((rest (cdr lst))
(E (car lst))
(N 1))
(cond ((null? rest)
(list (display N E)))
((eq? E (car rest))
(loop (cdr rest) E (+ N 1)))
(else
(cons (display N E) (loop (cdr rest) (car rest) 1))))))))
Note that all procedures are just bound to variables in the global scope.
Example:
(let ((rest 5))
(rest '(1 2 3)))
In R6RS and later you should get an exception saying that the number 5 is not a procedure. The reason is that you have overridden the binding rest in this scope and shoudl use the variable rest as the binding to 5 and not try to call it as a procedure. In R5RS and earlier the result is undefined since it's not valid Scheme code but most implementations will perhaps have a similar error as R6RS is required to have.
You have done the same with display but this time display is a procedure that does something else than the global display. It's OK in R6RS but it's not ok in R5RS and earlier. An implementation is free to replace it with the global for all supported types. display supports all types and thus your code might not work in all implementations since it is invalid R5RS.

Common lisp hashtable

Task is to read N string like "name phone" and store in. Then find stored data with requests like "name".
My code stores names and numbers in hashtable, but after it doesn't find any values. Stored values checks with maphash (it shows all pairs key-value).
Function split-by-one-space is just utility.
(defparameter data (make-hash-table))
(defun split-by-one-space (string) ; to split string: "aaa bbb" -> (aaa bbb)
(loop for i = 0 then (1+ j)
as j = (position #\Space string :start i)
collect (subseq string i j)
while j))
(dotimes (i (read)) ; input data
(let* ((inp (read-line))
(raw (split-by-one-space inp))
(name (string (car raw)))
(phone (cadr raw)))
(format t "Adding: ~W ~W~%" name phone) ; debug
(setf (gethash name data) phone)))
(maphash #'(lambda (k v) (format t "~a => ~a~%" k v)) data) ; this show all stored data
(loop for line = (read-line *standard-input* nil :eof)
until (or (eq line :eof) (eq line nil))
do
(let ((key (gethash line data))) ; it cannot find anything. Why?
(format t "Searching: ~W~%" line) ; debug
(if (null key)
(format t "Not found~%")
(format t "~A=~A~%" (car key) (cdr key)))))
Sample input:
3
sam 99912222
tom 11122222
harry 12299933
sam
edward
harry
Unless you specify a test function, hash tables will use eql to determine "is this key identical to that key".
(defvar *s1* "a string")
(defvar *s2* "a string")
(loop for pred in '(eq eql equal equalp)
do (format t "Using ~a, the result is ~a~%"
pred (funcall pred *s1* *s2*)))
This generates the output:
Using EQ, the result is NIL
Using EQL, the result is NIL
Using EQUAL, the result is T
Using EQUALP, the result is T
In this case, the main difference between equal and equalp is that the latter is case-insensitive, while the former is not. To use another test function, use the :test keyword and one of the found "standard" test functions. If you don't need case-insensitive matches, you would simply create your hash table like this: (make-hash-table :test #'equal).

Scheme function using association lists and Mapping

I'm trying to create a function in scheme that's called allAssociation. It takes in 2 parameters, a list of symbols and an assoc-list. Calling this function should return a list of data with elements that correspond to the keys of the assoc-list.
Here is an example:
Input:
(allAssociation '(a c d) '((a allen)(b bob)(c (carl cooper))(d doug)))
Output:
(allen (carl cooper) doug).
I am trying to use map and lambda to implement this function, but I am a little stumped.
Currently I have this snippet of code:
(define AllAssociation
(lambda (key alist)
(if (null? alist)
'()
[insert rest of logic]
)))
But I am struggling with implementing the logic of using map to match up each of the elements of the key with the association list. Any help would be much appreciated, for I am very new to scheme. Thank you.
Basically you iterate over the keys list, and use assoc to retrieve the first matching element in list lst.
If you need to use map (as your text suggests), then something like this will do:
(define all-association
(lambda (keys lst)
(map (lambda (key) (cadr (assoc key lst)))
keys)))
If you have to do it without map (as your code suggests), the equivalent would be:
(define all-association
(lambda (keys lst)
(if (null? keys)
'()
(cons (cadr (assoc (car keys) lst))
(all-association (cdr keys) lst)))))
Testing:
> (all-association '(a c d) '((a allen)(b bob)(c (carl cooper))(d doug)))
'(allen (carl cooper) doug)

Wheres-waldo function in LISP

I am trying to solve problems on LISP and I am stuck with this problem for many days.
"Write a function, called wheres-waldo, that takes a lisp object (i.e., a data structure built from conses) as argument and returns a Lisp expression that extracts the symbol waldo from this object, if it is present"
For example,
E.g: (wheres-waldo '(emerson ralph waldo)) =
OUTPUT: (FIRST (REST (REST '(EMERSON RALPH WALDO))))
E.g: (wheres-waldo '(mentor (ralph waldo emerson) (henry david thoreau))) =
OUTPUT: (FIRST (REST (FIRST (REST
'(MENTOR (RALPH WALDO EMERSON)
(HENRY DAVID THOREAU))))))
I have written some recursion for example,
(defun wheres-waldo(lispOBJ)
(cond ((null lispOBJ) nil)
(equalp (first lispOBJ) waldo)
( t (***stuck here how to write recursion for this***))
)
I found this question from http://ai.eecs.umich.edu/people/wellman/courses/eecs492/f94/MP1.html wheres-waldo.
Any help would be appreciated. Thank you.
You need to loop over a list, and if an element is a list, recurse into the sublist, exactly as you would implement a deep search. The only difference is that, in order to produce the required output, you need to carry on the s-expression retracing the functions you used to get there.
Here is one possible implementation. Note that I have used the more traditional car and cdr instead of first and rest - they are equivalent.
(defun whereis (who obj &optional (sexp (list 'quote obj)))
(cond
; we found the object - return the s-expr
((eq obj who) sexp)
; try car and the cdr
((and obj (listp obj))
(or (whereis who (car obj) (list 'car sexp))
(whereis who (cdr obj) (list 'cdr sexp))))))
then:
? (whereis 'waldo '(emerson ralph waldo))
(CAR (CDR (CDR '(EMERSON RALPH WALDO))))
? (whereis 'waldo '(mentor (ralph waldo emerson) (henry david thoreau)))
(CAR (CDR (CAR (CDR '(MENTOR (RALPH WALDO EMERSON) (HENRY DAVID THOREAU))))))
? (whereis 'thoreau '(mentor (ralph waldo emerson) (henry david thoreau)))
(CAR (CDR (CDR (CAR (CDR (CDR '(MENTOR (RALPH WALDO EMERSON) (HENRY DAVID THOREAU))))))))
? (whereis 'scotty '(beam me up . scotty))
(CDR (CDR (CDR '(BEAM ME UP . SCOTTY))))
? (whereis 'waldo '(emerson ralph))
NIL
If your element can appear more than once, you could also build a list of results:
? (whereis 'c '(a b c d c b a))
((CAR (CDR (CDR '(A B C D C B A)))) (CAR (CDR (CDR (CDR (CDR '(A B C D C B A)))))))
with this code:
(defun whereis (who obj)
(let ((res nil)) ; the final result
(labels
; sub-function: walks the whole list recursively
((sub (obj sexp)
; found it - add to result list
(when (eq obj who) (setf res (cons sexp res)))
; try car and cdr
(when (and obj (listp obj))
(sub (cdr obj) (list 'cdr sexp))
(sub (car obj) (list 'car sexp)))))
; call sub-function
(sub obj (list 'quote obj)))
res))
The main problem with your approach is that if first elements equals waldo, how are you suppose to generate the answer? There may be many possible paths waldo might be in so we need a way to indicate in the iteration what path we are on and we need to backtrack if we are at a dead end.
(defun wheres-waldo (o)
(labels ; labels is to make local functions
((aux (cur acc) ; define loacl function aux with args cur and acc
(or ; or stops at the first non NIL value
(and (eq cur 'waldo) acc) ; if (eq cur 'waldo) we return acc
(and (consp cur) ; (else) if object is a cons
(or ; then one of the followin
(aux (car cur) (list 'first acc)) ; answer might be in the car
(aux (cdr cur) (list 'rest acc))))))) ; or the cdr of the cons
(aux o (list 'quote o)))) ; call aux with original object and the same object quoted. (list 'quote x) ==> 'x (as data)
As you see, main work is done by aux that has an object and an accumuolator idicating the path and the quotes data. If you find waldo then the result is the accumulator.
If waldo exists in several locations it always do car first so not necessarily the shortest answer but the first it finds.
I use and/or here. These are similar to if except it's the value of the expression that gets returned. Eg (and (eq cur 'waldo) acc) will make sure we return acc if cur is waldo since and evaluates to the last true value. If there is one NIL value it becomes the result of the form. For or it will evaluate to the first true value (everything not NIL) or NIL if all expressions mounts to NIL. In Exercise 2 of your link you were to rewrite a function in a similar way.
That is not where you are stuck. You are stuck at devising a strategy, not at writing code.
You will have to do a tree search (the thing you call a "lisp object" is actually just a cons tree—"lisp object" is a misleading term because in Lisp, a lot of things are objects, not just conses). Decide whether to do a breadth-first or depth-first search, how to accumulate the accessor path, and how to communicate the match or mismatch up the call tree.
Sometimes it's a bit easier to approach a slightly more general problem, and then figure out how to specialize it to the particular problem at hand. In this case, you're handed a structure of some sort, along with a number of accessors that can access substructures of that structure. Given an element to find, and a thing to search, you can search by checking whether the thing is the element, and if is, then returning the path so far (in an appropriate format), and if it's not, then if it's a structure that you can decompose with the accessors, try each decomposed part.
(defun find-element (element structure structure-p accessors &key (test 'eql))
(labels ((fe (thing path)
"If THING and ELEMENT are the same (under TEST), then
return PATH. Otherwise, if THING is a structure (as
checked with STRUCTURE-P), then iterate through
ACCESSORS and recurse on the result of each one
applied to THING."
(if (funcall test thing element)
;; return from the top level FIND-ELEMENT
;; call, not just from FE.
(return-from find-element path)
;; When THING is a structure, see what
;; each of the ACCESSORS returns, and
;; make a recursive call with it.
(when (funcall structure-p thing)
(dolist (accessor accessors)
(fe (funcall accessor thing)
(list* accessor path)))))))
;; Call the helper function
;; with an initial empty path
(fe structure '())))
This will return the sequence of accessors that we need, in reverse order that they need to be applied to structure. For instance:
(find-element 'waldo '(ralph waldo emerson) 'consp '(car cdr))
;=> (CAR CDR)
because (car (cdr '(ralph waldo emerson))) is waldo. Similarly
(find-element 'emerson '(ralph (waldo emerson)) 'consp '(first rest))
;=> (FIRST REST FIRST REST)
because (first (rest (first (rest '(ralph (waldo emerson)))))) is emerson. So we've solved the problem of getting a list of accessor functions. Now we need to build up the actual expression. This is actually a fairly simple task using reduce:
(defun build-expression (accessor-path structure)
(reduce 'list accessor-path
:initial-value (list 'quote structure)
:from-end t))
This works in the way we need it to, as long as we also provide a the structure. For instance:
(build-expression '(frog-on bump-on log-on hole-in bottom-of) '(the sea))
;=> (FROG-ON (BUMP-ON (LOG-ON (HOLE-IN (BOTTOM-OF '(THE SEA))))))
(build-expression '(branch-on limb-on tree-in bog-down-in) '(the valley o))
;=> (BRANCH-ON (LIMB-ON (TREE-IN (BOG-DOWN-IN '(THE VALLEY O)))))
Now we just need to put these together:
(defun where-is-waldo? (object)
(build-expression
(find-element 'waldo object 'consp '(first rest))
object))
This works like we want:
(where-is-waldo? '(ralph waldo emerson))
;=> (FIRST (REST '(RALPH WALDO EMERSON)))
(where-is-waldo? '(mentor (ralph waldo emerson) (henry david thoreau)))
;=> (FIRST (REST (FIRST (REST '(MENTOR (RALPH WALDO EMERSON) (HENRY DAVID THOREAU))))))

Encrypt Scheme: [() is not a pair]

Define a procedure encrypt that takes three strings: a message to be encrypted and two alphabets, which we will call regular and encrypted. The alphabet strings are both the same length and they do not contain duplicates. For each character in the message, look it up in regular and, if you find it, convert it to the character in the corresponding location of encrypted. For example, if the regular is abc and the encrypted is def, that means that an a in the message will encode as a d, a b encodes as an e, and a c encodes as an f.
i wrote my code as follow:
(define encrypt
(lambda (message regular encrypted)
(define help
(lambda (ls1 ls2 ls3)
(if (null? ls1) '()
(if (and (null? ls2) (null? ls3)) ls1
(if (equal? (car ls1) (car ls2))
(cons (car ls3) (help (cdr ls1) ls2 ls3))
(help ls1 (cdr ls2) (cdr ls3))))))
(list->string (help
(string->list message)
(string->list regular)
(string->list encrypted)))))
I have been trying to get a running. but the result returns Exception in car: () is not a pair
I quite check it many times, but I didn't what I should change. is there anyone can help me?
Óscar López's answer pointed out some of the problems that you might be having in this code, but I think it's important to specifically address the error message that you mentioned: () is not a pair. This means that you're calling a function that expects a pair (so typical candidates would be car and cdr on an empty list. Let's take a look at your code and see where this could happen:
(define help
(lambda (ls1 ls2 ls3)
(if (null? ls1) '() ; a
(if (and (null? ls2) (null? ls3)) ls1 ; b
(if (equal? (car ls1) (car ls2)) ; c
(cons (car ls3) (help (cdr ls1) ls2 ls3)) ; d
(help ls1 (cdr ls2) (cdr ls3)))))) ; e
Lines a and b don't call any functions that expect a pair, so you shouldn't run into this problem there.
In line c, you do (car ls1) and (car ls2). Line a ensured that ls1 isn't (), but ls2 still could be, since b only checked that it's not the case that both ls2 and ls3 are (); either one alone still could be.
In line d, you've got (car ls3) and (cdr ls1). Line a ensured that ls1 isn't (), but ls2 still could be for the same reason given in the previous case.
Line e has (cdr ls2) and (cdr ls3), and both of these could cause a problem, because either one of them (but not both) could be ().
Though your title didn't say it, your question mentioned that this is actually happening with car, which means that it's not happening in e, which leaves c and d. It's either happening in (car ls2) in c or in (car ls3) in d.
If you're using Dr. Racket to run your code, the IDE should highlight the place where the bad call happened (something like what's shown in the screenshot in this answer).
The help function is not doing what you imagine, you actually need two helpers:
One for iterating over the message and "encrypting" each character in it, for that it uses the next function as helper
And one for "encrypting" a single character, that takes care of finding the encrypted character corresponding to a plaintext character
If you don't do the above, you'll discover that not all the characters are being replaced, because you're traversing the regular/encrypted lists only once, but for the algorithm to work you have to traverse them once for each character in the input message.
(define (encrypt message regular encrypted)
(letrec ((key
(lambda (reg enc)
(if (null? reg)
'()
(cons (cons (car reg) (car enc))
(key (cdr reg) (cdr enc))))))
(keys (key (string->list regular)
(string->list encrypted))))
(list->string
(let loop ((message (string->list message)))
(if (null? message)
'()
(cons (cdr (assoc (car message) keys))
(loop (cdr message))))))))

Resources