path: root/web/webserver.scm

#!/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://luna.genenetwork.org")


(define (prefix)
  "Build the API URL including version"
  (string-append (base-url) "/api/v" 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" . "This is work in progress (WIP). Note that the final base URL will change! The temporary prefix is:")
  ("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)))