diff options
| -rw-r--r-- | gn/cache/memoize.scm | 33 | ||||
| -rw-r--r-- | web/.guix-shell | 2 | ||||
| -rwxr-xr-x | web/webserver.scm | 37 |
3 files changed, 41 insertions, 31 deletions
diff --git a/gn/cache/memoize.scm b/gn/cache/memoize.scm new file mode 100644 index 0000000..e7ccc33 --- /dev/null +++ b/gn/cache/memoize.scm @@ -0,0 +1,33 @@ +;; Defines simple memoization functions. Currently it uses an alist - +;; we should change that to a hash. Also we want the cache to expire +;; after some time. memoize2 is now a separate function to deal +;; specifically with two return values. That is not ideal either. + +;; Basically lifted from +;; https://lispdreams.wordpress.com/2016/04/08/lisp-memoization-techniques/ + +(define-module (gn cache memoize) + #:export (memoize + memoize2)) + +(define (memoize f) + "Simple memoize just uses alists at this point and does not expire" + (let ((result-table '())) + (lambda (. args) + (let ((cache-value (assoc args (pk result-table)))) + (if (pk cache-value) + (cdr cache-value) + (let ((result (apply f args))) + (set! result-table + (alist-cons args result result-table)) result)))))) + +(define (memoize2 f) + "Simple memoize functions that returns values pair and uses alists at this point and does not expire" + (let ((result-table '())) + (lambda (. args) + (let ((c (assoc args (pk result-table)))) + (if (pk c) + (values (car (cdr c)) (car (cdr (cdr c)))) + (let-values (((r1 r2) (apply f args))) + (set! result-table + (alist-cons args (list r1 r2) result-table)) (values r1 r2))))))) diff --git a/web/.guix-shell b/web/.guix-shell index 2be81ce..7a2f30a 100644 --- a/web/.guix-shell +++ b/web/.guix-shell @@ -1,7 +1,7 @@ #!/bin/bash # # run with options '-- ./webserver.scm 8091' e.g. -# . .guix-shell -- guile --listen=1970 -e main ./webserver.scm 8091 +# . .guix-shell -- guile -L .. --listen=1970 -e main ./webserver.scm 8091 echo "Note run: running web-server" diff --git a/web/webserver.scm b/web/webserver.scm index ce754d8..910024f 100755 --- a/web/webserver.scm +++ b/web/webserver.scm @@ -25,31 +25,8 @@ (web request) (web response) (web uri) - (fibers web server)) - -;; basically lifted from https://lispdreams.wordpress.com/2016/04/08/lisp-memoization-techniques/ - -(define (memoize f) - "Simple memoize just uses alists at this point and does not expire" - (let ((result-table '())) - (lambda (. args) - (let ((cache-value (assoc args (pk result-table)))) - (if (pk cache-value) - (cdr cache-value) - (let ((result (apply f args))) - (set! result-table - (alist-cons args result result-table)) result)))))) - -(define (memoize2 f) - "Simple memoize functions that returns values pair and uses alists at this point and does not expire" - (let ((result-table '())) - (lambda (. args) - (let ((c (assoc args (pk result-table)))) - (if (pk c) - (values (car (cdr c)) (car (cdr (cdr c)))) - (let-values (((r1 r2) (apply f args))) - (set! result-table - (alist-cons args (list r1 r2) result-table)) (values r1 r2))))))) + (fibers web server) + (gn cache memoize)) (define get-version "2.0") @@ -107,7 +84,7 @@ ("prefix" . ,(prefix)) ("links". (("species" . ,(mk-meta "species")))))) -(define info-meta `( +(define info-meta `( ("doc" . ,(mk-html "info")) ("API" . ((,(mk-url "species")."Get a list of all species") @@ -119,7 +96,7 @@ "Execute raw SPARQL query returning response as a UTF8 string" (bytevector->string (receive (response-status response-body) (http-request (string-append endpoint-url "?default-graph-uri=&query=" (uri-encode query) "&format=application%2Fsparql-results%2Bjson")) - + response-body) "UTF-8")) (define (sparql-tsv endpoint-url query) @@ -201,7 +178,7 @@ SELECT DISTINCT * where { wd:Q158695 wdt:P225 ?o . } limit 10 " (sparql-tsv (wd-sparql-endpoint-url) (string-append " -SELECT DISTINCT ?taxon ?ncbi ?descr where { +SELECT DISTINCT ?taxon ?ncbi ?descr where { wd:" species " " (wdt-taxon-name) " ?taxon ; wdt:P685 ?ncbi ; schema:description ?descr . @@ -263,7 +240,7 @@ SELECT ?species ?p ?o WHERE { (define (get-rows names results) "Format results as a list of values ordered by names" (map (lambda (row) (get-values names row)) (array->list results))) - + ;; from the triples first harvest the species URIs, followed by creating records of information (define (compile-species recs rows) @@ -406,7 +383,7 @@ SELECT ?species ?p ?o WHERE { ;; (display "ThthxST" port) (format port "~a" "foo") ))) - + (define (controller request body) (match-lambda (('GET) |