about summary refs log tree commit diff
diff options
context:
space:
mode:
-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)