#!/usr/bin/env guile \ -e main -s !# ;; Minimal web server can be started from command line. Current example routes: ;; ;; localhost:8080/ ;; (use-modules (json) (ice-9 match) (ice-9 format) (ice-9 iconv) (ice-9 receive) (ice-9 string-fun) ;; (ice-9 debugger) ;; (ice-9 breakpoints) ;; (ice-9 source) (srfi srfi-1) (srfi srfi-11) ; let-values (srfi srfi-26) (web http) (web client) (web request) (web response) (web uri) (fibers web server) (gn cache memoize) (gn db sparql)) (define get-version "2.0") (define (base-url) "https://genenetwork.org") (define (prefix) "Build the API URL including version" (string-append (base-url) "/api/" get-version)) (define* (mk-url postfix #:optional (ext "")) "Add the path to the API URL" (string-append (prefix) "/" postfix ext)) (define (mk-html path) "Create a pointer to HTML documentation" (string-append (base-url) "/" path ".html")) (define (mk-doc path) "Create a pointer to HTML documentation" (mk-html (string-append "doc/" path))) (define (mk-meta path) "Create a meta URL for the API path" (mk-url path ".meta.json")) (define (mk-rec path) "Create a JSON URL for the API path" (mk-url path ".json")) (define (mk-term postfix) (mk-html (string-append "term" "/" postfix))) (define (mk-id postfix) (mk-html (string-append "id" "/" postfix))) (define (mk-predicate postfix) (mk-html (string-append "predicate" "/" postfix))) (define info `( ("name" . "GeneNetwork REST API") ("version" . ,get-version) ("comment" . "This is the official REST API for the GeneNetwork service hosted at https://genenetwork.org/") ("license" . (("source code" . "AGPL"))) ("note" . "work in progress (WIP)") ("prefix" . ,(prefix)) ("links". (("species" . ,(mk-meta "species")))))) (define info-meta `( ("doc" . ,(mk-html "info")) ("API" . ((,(mk-url "species")."Get a list of all species") (,(mk-url "mouse")."Get information on mouse") (,(mk-url "datasets")."Get a list of datasets"))))) ;; result should be a vector of list of pair (define (species-digest recs) (map (lambda (r) (let* ([k (car r)] [v (cdr r)]) ; with key use (cons k (map (lambda (i) (cons (car i) (car (cdr i)))) v)) (map (lambda (i) (cons (url-parse-id (car i)) (car (cdr i)))) v) )) recs ) ) (define (get-species) (receive (names res) (memo-sparql-species-meta) (let* ([table (get-rows names res)] [recs '()] [h (compile-species recs table)]) (species-digest h)) )) ; (define (wd-species-info wd) ; ) (define (url-parse-id uri) (if uri (car (reverse (string-split uri #\057))) "unknown" )) (define (strip-lang s) "Strip quotes and language tag (@en) from RDF entries" (list->string (match (string->list s) [(#\"rest ... #\") rest] [(#\"rest ... #\" #\@ #\e #\n) rest] [rest rest])) ) (define (normalize-id str) ;; (string-replace-substring (string-downcase str) " " "_") (string-replace-substring str " " "_") ) (define (get-expanded-taxon id) "Get information on a specific species, e.g. mouse" #f ) (define (get-expanded-species) "Here we add information related to each species" (map (lambda (rec) (let ([wd-id (url-parse-id (assoc-ref rec "22-rdf-syntax-ns#isDefinedBy"))] [short-name (normalize-id (assoc-ref rec "name"))]) (if (string=? wd-id "unknown") rec ; wikidata query: (receive (names row) (tsv->scm (memo-sparql-wd-species-info wd-id)) (match (pk (car row)) ((taxonomy-name ncbi descr) (let ([ncbi-id (strip-lang ncbi)] [taxonomy-lnk (string-replace-substring (strip-lang taxonomy-name) " " "_")]) (cons `("id" . ,short-name) (cons `("wikidata" . ,wd-id) (cons `("taxonomy-id" . ,ncbi-id) (cons `("ncbi-url" . ,(string-append "https://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?mode=Info&id=" ncbi-id)) (cons `("uniprot-url" . ,(string-append "https://www.uniprot.org/taxonomy/" ncbi-id)) (cons `("wikidata-url" . ,(string-append "http://www.wikidata.org/entity/" wd-id)) (cons `("wikispecies-url" . ,(string-append "https://species.wikimedia.org/wiki/" taxonomy-lnk)) (cons `("taxonomy-name" . ,(strip-lang taxonomy-name)) ; (cons `("shortname" . ,shortname) - problematic (cons `("description" . ,(strip-lang descr)) rec))))))))))) ) ))) ) (get-species) )) (define (get-species-api-str) (scm->json-string #("https://genenetwork.org/api/v2/mouse/" "https://genenetwork.org/api/v2/rat/"))) (define (get-species-shortnames recs) (map (lambda r (assoc-ref (car r) "shortName")) recs)) (define (get-species-links recs) "Return a list of short names and expand them to URIs" (map (lambda r (let ([shortname (assoc-ref (car r) "shortName")]) (cons shortname (mk-rec shortname)))) recs) ) (define (get-species-rec) (list->vector (get-expanded-species))) (define (get-species-meta) (let ([recs (get-expanded-species)]) `(("comment" . "Get information on species") ("doc" . ,(mk-doc "species")) ("meta" . ,(mk-meta "species")) ("rec" . ,(mk-rec "species")) ("links" . ,(get-species-links recs))))) ;; ---- REST API web server handler (define (not-found2 request) (values (build-response #:code 404) (string-append "Resource X not found: " (uri->string (request-uri request))))) (define (not-found uri) (list (build-response #:code 404) (string-append "Resource not found: " (uri->string uri)))) (define (render-json json) (list '((content-type . (application/json))) (lambda (port) (scm->json json port)))) (define (render-json-string2 json) (list '((content-type . (text/plain))) (lambda (port) ;; (display "ThthxST" port) (format port "~a" "foo") ))) (define (controller request body) (match-lambda (('GET) (render-json info)) (('GET "version") (render-json get-version)) (('GET "species.json") (render-json (get-species-rec))) (('GET "species.meta.json") (render-json (get-species-meta))) (('GET "species") (render-json (get-species-meta))) (('GET id) (let ([names (get-species-shortnames (get-expanded-species))]) (match (string->list id) [(name ... #\. #\j #\s #\o #\n) (render-json (list->string name))] [rest (render-json "WIP")]))) (_ (not-found (request-uri request))) )) (define (request-path-components request) (split-and-decode-uri-path (uri-path (request-uri request)))) (define (handler request body) (format #t "~a ~a\n" (request-method request) (uri-path (request-uri request))) (apply values ((controller request body) (cons (request-method request) (request-path-components request))))) (define (start-web-server address port) (format (current-error-port) "GN REST API web server listening on http://~a:~a/~%" address port) ;; Wrap handler in another function to support live hacking via the ;; REPL. If handler is passed as is and is then redefined via the ;; REPL, the web server will still be using the old handler. The ;; only way to update the handler reference held by the web server ;; would be to restart the web server. (run-server (cut handler <> <>) #:addr (inet-pton AF_INET address) #:port port)) (define (main args) (write (string-append "Starting Guile REST API " get-version " server!")) (write args) (newline) (let ((listen (inexact->exact (string->number (car (cdr args)))))) (display `("listening on" ,listen)) ;; (write listen) ;; (run-server hello-world-handler 'http `(#:port ,listen)))) (start-web-server "127.0.0.1" listen)))