aboutsummaryrefslogtreecommitdiff
path: root/web
diff options
context:
space:
mode:
Diffstat (limited to 'web')
-rwxr-xr-xweb/webserver.scm47
1 files changed, 45 insertions, 2 deletions
diff --git a/web/webserver.scm b/web/webserver.scm
index 05e842c..f9fc8a7 100755
--- a/web/webserver.scm
+++ b/web/webserver.scm
@@ -13,6 +13,7 @@
(ice-9 iconv)
(ice-9 receive)
(ice-9 string-fun)
+ (ice-9 exceptions)
;; (ice-9 debugger)
;; (ice-9 breakpoints)
;; (ice-9 source)
@@ -34,7 +35,9 @@
(gn data group)
(web sxml)
(web view view)
- (web view doc))
+ (web view doc)
+ (web view markdown)
+ )
(define info `(
@@ -130,6 +133,44 @@ otherwise search for set/group data"
(lambda (port)
(format port "~a" "foo"))))
+
+(define (build-json-response status_code json)
+ (list
+ (build-response
+ #:code status_code
+ #:headers `((content-type . (application/json))))
+ (lambda (port)
+ (scm->json json port)))
+ )
+
+(define (decode-query query)
+ (if (not query)
+ '()
+ (map decode-query-component (string-split query #\&))))
+
+(define (decode-query-component component)
+ (let* ([index (string-index component #\=)]
+ [key (if index (substring component 0 index) component)]
+ [value (if index (substring component (1+ index)) "")])
+ (cons (string->symbol (uri-decode key))
+ (uri-decode value))))
+
+
+
+(define (edit-file-handler repo request)
+ (catch 'file-error
+ (lambda ()
+ (let* ((params (decode-query (uri-query (request-uri request)))) (query_path (assoc-ref params 'file_path)))
+ (if query_path
+ ;;add check for is repo
+ (build-json-response 400 (fetch-file repo query_path))
+ (throw 'file-error (string-append "Please provide a valid file path in the query"))
+ )
+ )
+ )
+ (lambda (key . args)
+ (let ((msg (car args))) (build-json-response 400 `(("error" . ,key) ("msg" . ,msg))))
+ )))
(define (controller request body)
(match-lambda
(('GET)
@@ -150,7 +191,7 @@ otherwise search for set/group data"
(match (string->list taxon)
[(name ... #\. #\h #\t #\m #\l)
(render-doc "doc" taxon (get-expanded-taxon-meta (list->string name)))]))
- (('GET "doc" path ... page) ; serve documents from /doc/
+ (('GET "doc" path ... page) ; serve documents from /doc/
(render-doc path page))
(('GET "species.json")
(render-json (get-species-data)))
@@ -158,6 +199,8 @@ otherwise search for set/group data"
(render-json (get-species-meta)))
(('GET "species")
(render-json (get-species-meta)))
+ (('GET "edit")
+ (edit-file-handler "/home/kabui/test_repo" request))
(('GET id)
(let ([names (get-species-shortnames (get-expanded-species))])
(match (string->list id)