Current section

Files

Jump to
lxml src lxml.lfe
Raw

src/lxml.lfe

(defmodule lxml
(export
(find-content 2)
(get-content 2)
(get-data 1)
(get-in 2)
(get-linked 2) (get-linked 3)
(map 2) (map 3) (map 4)
(parse 1) (parse 2)
(start 0)
(stop 0)
(version 0)
(versions 0)))
;;; Options
(defun default-opts ()
'#m(atom-keys? false
file undefined
url undefined
xml undefined
fxml false))
(defun opts (overrides)
(maps:merge (default-opts) overrides))
;;; API functions
(defun start ()
(application:ensure_all_started 'lxml))
(defun stop ()
(application:stop 'lxml))
(defun parse
((opts) (when (is_map opts))
(parse 'undefined opts))
((xml)
(parse xml #m())))
(defun parse (xml overrides)
(parse-with-opts xml (opts overrides)))
(defun parse-with-opts
(('undefined (= `#m(file ,filename) opts)) (when (=/= filename 'undefined))
(case (file:read_file (lutil-file:expand-home-dir filename))
(`#(ok ,data)
(parse-xml data opts))
(x x)))
(('undefined (= `#m(url ,url) opts)) (when (=/= url 'undefined))
(parse-xml (http-get url) opts))
((xml opts)
(parse-xml xml opts)))
(defun get-data
(((= `#(file ,filename) arg))
(get-data (parse arg)))
(((= `#(url ,url) arg))
(get-data (parse arg)))
((`#(xml ,xml))
(get-data (parse-xml xml '())))
((results)
(proplists:get_value 'content results)))
(defun get-in
"get-in assumes that the last element of the three-tuple is the one that holds
the desired data. As this is the 'content' element of the tuple as parsed by
erlsom, this is a reasonable assumption.
To get attributes instead of content, get-in can be used to obtain the
second-to-last nested value and then the attributes may be extracted from last
one.
get-in supports a list of 3-tuples but also a list of 2-tuples which contain
3-tuples."
((keys (= `#(file ,filename) arg))
(get-in keys (get-data arg)))
((keys (= `#(url ,url) arg))
(get-in keys (get-data arg)))
((keys (= `#(xml ,xml) arg))
(get-in keys (get-data arg)))
((keys data) (when (is_tuple data))
(get-in keys (list data)))
;; XXX generalize the following code to a general-purpose map function
;; for this library
(((= `(,first-key . ,rest-keys) keys)
(= `(,first-data . ,rest-data) data))
(cond ((=:= (size first-data) 3)
(get-content keys data))
((=:= (size first-data) 2)
(get-content
rest-keys
(element 2 (lists:keyfind first-key 1 data)))))))
(defun get-parent-in ()
;; XXX use this for get-attr-in as well as get-linked (in other words,
;; generalize th code in get-linked and move it here
'noop)
(defun get-attr-in ()
'noop)
(defun get-content (keys data)
(lists:foldl #'find-content/2 data keys))
(defun find-content
"This is necesary since the proplists module requires 2-tuples only.
This function assumes that the data desired is in the third (last) element
of the three-tuple."
((key data) (when (is_integer key))
(lxml-util:one-or-all
(element 3 (lists:nth key data))))
((key data)
(lxml-util:one-or-all
(element 3 (lists:keyfind key 1 data)))))
(defun get-linked (keys data)
(get-linked keys data '()))
(defun get-linked (keys data options)
"This is a utility function similar to get-in, but instead is intended for use
with linked REST data (i.e., REST relational data).
This function will search nested data, assuming:
* the last key points to a data structure that parsed an XML element with an
'href' attribute (the link to the desired related REST resource)
* all but the last key reference nested data structures that should be
traversed for their contents (i.e., the third element of the 3-tuples) not
their attributes (the second element of the 3-tuples)"
(let* ((`(,all-but-last ,last) (lxml-util:rdecons keys))
(link-data (get-in all-but-last data))
(url (find-link last link-data)))
(http-get url (++ '(#(endpoint false)) options))))
(defun http-get (url)
(http-get url '() '()))
(defun http-get (url opts)
(http-get url
(proplists:get_value 'httpc-options opts '())
(proplists:get_value 'http-options opts '())))
(defun http-get (url http-options options)
(case (httpc:request 'get `#(,url ()) http-options options)
(`#(ok #(,status ,headers ,body)) body)
(err err)))
(defun get-link-in-3tuple (keys data)
(lists:foldl #'find-link/2 data keys))
(defun find-link (key data)
"This is necesary since the proplists module requires 2-tuples only.
This function assumes that the data desired (the href for the link) is in the
second element of the three-tuple."
(let ((`(#(href ,link)) (element 2 (lists:keyfind key 1 data))))
link))
(defun map (content-func data)
(lxml:map #'ident/1 content-func data))
(defun map (attr-func content-func data)
(lxml:map #'ident/1 attr-func content-func data))
(defun map
((tag-func attr-func content-func `#(,tag ,attrs ,content))
(tuple (funcall tag-func tag)
(lists:map attr-func attrs)
(lxml:map tag-func attr-func content-func content)))
((tag-func attr-func content-func `(,head . ,tail))
(cons (lxml:map tag-func attr-func content-func head)
(lxml:map tag-func attr-func content-func tail)))
((_ _ content-func x)
(funcall content-func x)))
(defun ident (x)
"The identity function."
x)
;;; Metadata
(defun version ()
(lxml-vsn:get))
(defun versions ()
(lxml-vsn:all))
;;; Supporting private functions
(defun parse-xml
((xml (= `#m(fxml ,fxml atom-keys? ,keys?) opts))
(cond ((== fxml 'true)
(lxml-fast:parse xml opts))
((== keys? 'true)
(parse-xml-atom-keys xml))
('true
(parse-xml-raw xml)))))
(defun parse-xml-raw (xml)
(erlsom:simple_form xml))
(defun parse-xml-shaped
((`#(ok #(,tag ,attributes ,content) ,tail))
`(#(tag ,tag)
#(attr ,attributes)
#(content #(,tag ,attributes ,content))
#(tail ,tail))))
(defun parse-xml-atom-keys (xml)
(clj:->> xml
(parse-xml-raw)
(parse-xml-shaped)
(convert-keys)))
(defun convert-keys (data)
"Convert property list keys to atoms."
(lxml:map #'list_to_atom/1 #'key->atom/1 #'ident/1 data))
(defun key->atom
((`#(,key ,val)) (when (is_list key))
`#(,(list_to_atom key) ,val))
((x) x))