aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPjotr Prins2023-08-06 10:51:13 +0200
committerPjotr Prins2023-08-06 10:51:13 +0200
commita00edcbc54026ea956ca41029474ff0e6a838616 (patch)
treebe37fe002c23b59626391657a6c56e9665f4e0bd
parentdedcfeee0ce72539f0789923229c54b00f23605d (diff)
downloadgn-guile-a00edcbc54026ea956ca41029474ff0e6a838616.tar.gz
memoize: created separate module
-rw-r--r--gn/cache/memoize.scm33
-rw-r--r--web/.guix-shell2
-rwxr-xr-xweb/webserver.scm37
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)