Pico Lisp and JSON
Update: I now use this code for JSON which is based on Alex’s Rosetta Code example, the below should just be seen as a programming exercise.
Yet again I have to do some documenting so I know what the hell I’m doing since I’m all over the place at the moment. Doing something here and then moving over to do something over there and then coming back to coding this and that. If you’re this unstructured you need crutches and this documentation is that, it will enable me to get back to this and do easy debugging in the future, it will trigger memories.
Therefore this code is very rough and untested, a work in progress, you have been warned…
If you somehow landed on this page without any background on Pico Lisp or Lisp you probably need to start from the beginning.
Let’s start with the tests for a change. This is an example of converting a proper database object to JSON. The code will determine the relations and use them to build the JSON, nothing else that might be in there:
(load "lib/str.l")
(load "lib/json.l")
(class +Product +Entity)
(rel name (+Need +String))
(rel id (+Need +Number))
(rel descr (+String))
(rel attributes (+List +String))
(setq Product (new '(+Product) 'name "A \"PC\"" 'id 123 'attributes '("black" "laptop")))
(println (to> '+Json 'encObj> Product))Output:
"{\"attributes\": [\"black\", \"laptop\"], \"id\": 123, \"name\": \"A \\\"PC\\\"\", \"descr\": false}"Associative structure, it will also be encoded as object:
(setq Pairs '((key1 . hello) (key2 . world) (false . NIL) (someArr . (1 2 "hello quote: \"quote\"" 4))))
(println (to> '+Json 'encPair> Pairs))"{\"key1\": \"hello\", \"key2\": \"world\", \"false\": false, \"someArr\": [1, 2, \"hello quote: \\\"quote\\\"\", 4]}"2D structure will be an array of objects:
(setq Pair1 '((key1 . hello) (key2 . world) (false . NIL) (someArr . (1 2 "hello" 4))))
(setq Pair2 '((key1 . hello) (key2 . world) (false . NIL) (someArr . (1 2 "world" 4))))
(setq Tst (list Pair1 Pair2))
(println (to> '+Json 'encTable> Tst))"[{\"key1\": \"hello\", \"key2\": \"world\", \"false\": false, \"someArr\": [1, 2, \"hello\", 4]},
{\"key1\": \"hello\", \"key2\": \"world\", \"false\": false, \"someArr\": [1, 2, \"world\", 4]}]"Simple case of nested list:
(setq Tst (list 1 2 "hello" (1 2 3) 3 4 "world"))
(println (to> '+Json 'encArr> Tst))"[1, 2, \"hello\", [1, 2, 3], 3, 4, \"world\"]"From JSON:
(setq Json "{\"hello1\": {\"subObj\": [123, 456, true, NIL]}, \"b\": true}")
(setq Result (from> '+Json Json))
(show Result)
(show (get Result 'hello1))$385543015 NIL
b
hello1 $385543062
$385543062 NIL
subObj (123 456 T NIL)The lib:
(class +Json)
(dm from> (J)
(=: L (chop J))
(let C (pop (:: L))
(let R (if (= C "[") (pre> This 'pArr>) (pre> This 'pObj>))
(parse> This R))))This is where the coding from JSON to Pico structure begins.
(dm pre> (Type)
(let (R (list Type) InStr NIL)
(catch NIL
(while (: L)
(let C (pop (:: L))
(cond
((= C "[") (queue 'R (pre> This 'pArr>)))
((= C "{") (queue 'R (pre> This 'pObj>)))
((and (or (= C "]") (= C "}")) (nT InStr)) (throw))
(T (when (= C "\"")
(setq InStr (not InStr)))
(queue 'R C)))))) R ))Here we are creating an intermediary list that will be easy to execute. We do this by inserting the names of functions to use in later steps into this list. But what is really happening? Well as you saw from the prior listing we begin with either pArr> or pObj> depending on if we are to begin parsing to an object or an array. InStr will keep track of whether the characters {, }, [, ] are inside a string or not, if they are they should not count of course.
So while we still have characters in our chopped up list we will loop through them by destructively popping, if we have a “[” we will put pArr> on the list instead of the caracter, if we have “{” we put pObj>. If we have the respective closing character, and it is not inside a string, we exit by throwing NIL.
(dm any> (L)
(let R (any (pack L))
(if (= R "true") T (if (= R "false") NIL R))))
(dm parse> (L)
(apply (car L) (list This (cdr L))))
(dm pObj> (L)
(let (R (new) L (split L ","))
(for El L
(let Pair (split El ":")
(put R
(any (any (pack (car Pair))))
(let Value (cdadr Pair)
(if (lst? (car Value))
(parse> This (car Value))
(any> This Value)))))) R ))We begin by applying either pObj> or pArr> in parse>.
The pObj> method will begin with creating the empty result object, R and a list of sublists looking something like this: (“k” “e” “y” “:” “v” “a” “l” “u” “e”) in L by splitting by “,”.
We continue by splitting by “:” to get the key and the value. The key is then retrieved, the value will be further examined to determine if we should apply recursion to get a sub-object/array or simply return the result through any>.
(dm pArr> (L)
(make
(for El (mapcar 'clip (split L ","))
(if (lst? (car El))
(link (parse> This (car El)))
(link (any> This El))))))To JSON:
(dm to> (F L)
(pack (make (apply F (list This L)))))As you know from the tests above the behavior has to be explicitly set by passing the function name to be used to generate the result when going from Pico to Javascript. It’s pretty obvious actually since it’s impossible to determine from the structure of various types of lists how to treat them. We can’t infer whether a list is a normal nested list or a paired list, for all intents and purposes they are identical. However the output will be radically different. Note make, that is why we are able to use link all over the place below.
(dm encTable> (Tbl)
(link "[")
(let F T
(mapc
'((L)
(link (comma> This F))
(encPair> This L)
(setq F NIL)) Tbl))
(link "]"))
(dm encPair> (L)
(link "{")
(let F T
(mapc
'((El)
(link (pack (comma> This F) "\"" (car El) "\"" ":" " "))
(setq F NIL)
(enc> This (if (pair El) (cdr El) NIL))) L ))
(link "}"))
(dm comma> (First)
(unless First ", "))Some redundant code here, it might benefit from refactoring, or we could just leave it like it is and call it a day, yeah let’s do that. When encoding a table each element will in turn be encoded with encPair>, if we have the first element we do not prepend the “, “.
A paired list will be encoded as an object with encPair>.
(dm encArr> (L)
(link "[")
(let F T
(mapc
'((El)
(link (pack (comma> This F)))
(setq F NIL)
(enc> This El)) L ))
(link "]"))Redundancy again! List -> array is easier though than paired list -> object.
(dm encObj> (O)
(encPair> This
(make
(mapc
'((Prop)
(when (isa '+Relation (car Prop))
(let Key (cdr Prop)
(link (cons Key (get O Key)))))) (getl (car (type O)))))))Finally something clever, in case of object we will get all the properties of the object through the getl function. Every property that is a relation will get the “treatment”. We get the name of the relation as Key and use that name on the original object to retrieve the value. The resultant array is now a paired list that can be encoded with encObj>.
(dm enc> (L)
(cond
((=T L) (link "true"))
((not L) (link "false"))
((sym? L) (link (pack "\"" (esc> '+Str L '("\"")) "\"")))
((num? L) (link L))
((lst? L) (encArr> This L))
((or (box? L) (ext? L)) (encObj> This L))))The main engine, constantly testing various structures and acting accordingly, notice the escaping with +Str. It’s the genesis of some kind of general string library, not much in there yet though:
(dm fChr> (Lst Chr)
(find '((C)(= C Chr)) Lst))
#S = hello, Lst = '("\"")
(dm esc> (S Lst)
(pack
(mapcar
'((C)
(if (fChr> This Lst C) (pack "\\" C) C )) (chop S))))Every character in the passed list (in this case only one) will be escaped.