Refactor: Guile webserver code refactoring.

1 files changed, 57 insertions, 69 deletions

diff --git a/web/webserver.scm b/web/webserver.scm
index a44181c..72984a1 100755
--- a/web/webserver.scm
+++ b/web/webserver.scm
@@ -37,26 +37,25 @@
  (web sxml)
  (web view view)
  (web view doc)
- (web view markdown)
- )
+ (web view markdown))
 
 
 (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 (unless otherwise specified)" . "Affero GNU Public License 3.0 (AGPL3)")
-                ("data (unless otherwise specified)" . "Attribution-NonCommercial-NoDerivatives 4.0 International (CC BY-NC-ND 4.0)")))
-  ("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"))))))
+               ("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 (unless otherwise specified)" . "Affero GNU Public License 3.0 (AGPL3)")
+                             ("data (unless otherwise specified)" . "Attribution-NonCommercial-NoDerivatives 4.0 International (CC BY-NC-ND 4.0)")))
+               ("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")))))
+                    ("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")))))
 
 
 (define (get-id-data id)
@@ -98,19 +97,19 @@ otherwise search for set/group data"
   (let* ((stat (stat file-name #f))
          (modified (and stat
                         (make-time time-utc 0 (stat:mtime stat)))))
-  (list `((content-type . ,(assoc-ref file-mime-types
-                                      (file-extension file-name)))
-          (last-modified . ,(time-utc->date modified)))
-        (call-with-input-file file-name get-bytevector-all))))
+    (list `((content-type . ,(assoc-ref file-mime-types
+                                        (file-extension file-name)))
+            (last-modified . ,(time-utc->date modified)))
+          (call-with-input-file file-name get-bytevector-all))))
 
 (define* (render-static-file path #:optional rec #:key (extra-headers '()))
   (let* ((stat (stat path #f))
          (modified (and stat
                         (make-time time-utc 0 (stat:mtime stat)))))
-  (list `((content-type . ,(assoc-ref file-mime-types
-                                      (file-extension path)))
-          (last-modified . ,(time-utc->date modified)))
-        (call-with-input-file path get-bytevector-all))))
+    (list `((content-type . ,(assoc-ref file-mime-types
+                                        (file-extension path)))
+            (last-modified . ,(time-utc->date modified)))
+          (call-with-input-file path get-bytevector-all))))
 
 (define* (render-doc path page #:optional rec #:key (extra-headers '()))
   (list (append extra-headers
@@ -131,8 +130,8 @@ otherwise search for set/group data"
 
 (define (render-json-string2 json)
   (list '((content-type . (text/plain)))
-	(lambda (port)
-	  (format port "~a" "foo"))))
+        (lambda (port)
+          (format port "~a" "foo"))))
 
 
 (define (build-json-response status_code json)
@@ -141,8 +140,7 @@ otherwise search for set/group data"
     #:code status_code
     #:headers `((content-type . (application/json))))
    (lambda (port)
-     (scm->json json port)))
-  )
+     (scm->json json port))))
 
 (define (decode-query query)
   (if (not query)
@@ -152,7 +150,7 @@ otherwise search for set/group data"
 (define (decode-request-json body)
   (if (not body)
       '()
-    (json-string->scm (utf8->string body))))
+      (json-string->scm (utf8->string body))))
 
 
 (define (decode-query-component component)
@@ -166,52 +164,43 @@ otherwise search for set/group data"
   (catch 'file-error
     (lambda ()
       (let* ((params (decode-query (uri-query (request-uri request)))) (query_path (assoc-ref params 'file_path)))
-	(if query_path
-	    (build-json-response 400 (fetch-file repo query_path))
-	    (throw 'file-error (string-append "Please provide a valid file path in the query")))
-	)
-      ) 
+        (if query_path
+            (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))))     
-      )))
+      (let ((msg (car args))) (build-json-response 400 `(("error" . ,key) ("msg" . ,msg)))))))
 
-(define global-repo (getenv "REPO_PATH"))  ;; handle this better way
+(define global-repo (getenv "REPO_PATH"))
 
 (define (is-invalid-data? data target)
   (if (string? (assoc-ref data target))
       (if (string-null? (assoc-ref data target))
-	  (throw 'system-error (format #f "Value for Key *** ~a  *** Cannot be Empty"  target))
-	  (assoc-ref data target)
-	  )
-      (throw 'system-error (format #f "The Key  *** ~a *** is missing in your  Json Data" target))
-      ))
+          (throw 'system-error (format #f "Value for Key *** ~a  *** Cannot be Empty"  target))
+          (assoc-ref data target))
+      (throw 'system-error (format #f "The Key  *** ~a *** is missing in your  Json Data" target))))
 
 (define (commit-file-handler repo request body)
   (catch 'system-error
     (lambda ()
       (let* ((post-data
-	      (decode-request-json body)
-	      )
-	     (_ (for-each (lambda (target)				
-			    (is-invalid-data?  post-data target)
-			    ) '("filename" "content" "username" "email" "prev_commit"))
-		)
-	     (file-name (assoc-ref post-data "filename"))
-	     (content  (assoc-ref post-data "content")) 
-	     (username (assoc-ref post-data "username"))
-	     (email   (assoc-ref post-data "email"))
-	     (commit-message (assoc-ref post-data "commit_message"))
-	     (prev-commit (assoc-ref post-data "prev_commit"))
-	     )	
-	(build-json-response 200
-			     (commit-file repo
-			     file-name content
-			     commit-message
-			     username email
-			     prev-commit))))
+              (decode-request-json body))
+             (_ (for-each (lambda (target)
+                            (is-invalid-data?  post-data target)
+                            ) '("filename" "content" "username" "email" "prev_commit")))
+             (file-name (assoc-ref post-data "filename"))
+             (content  (assoc-ref post-data "content"))
+             (username (assoc-ref post-data "username"))
+             (email   (assoc-ref post-data "email"))
+             (commit-message (assoc-ref post-data "commit_message"))
+             (prev-commit (assoc-ref post-data "prev_commit")))
+        (build-json-response 200
+                             (commit-file repo
+                                          file-name content
+                                          commit-message
+                                          username email
+                                          prev-commit))))
     (lambda (key . args)
-      (let ((msg (car args))) (build-json-response 400 `(("error" . ,key) ("msg" . ,msg))))     
-      )) )
+      (let ((msg (car args))) (build-json-response 400 `(("error" . ,key) ("msg" . ,msg)))))))
 (define (controller request body)
   (match-lambda
     (('GET)
@@ -232,7 +221,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)))
@@ -243,16 +232,15 @@ otherwise search for set/group data"
     (('GET "edit")
      (edit-file-handler global-repo  request))
     (('POST "commit")
-     (commit-file-handler global-repo  request body))    
+     (commit-file-handler global-repo  request body))
     (('GET id)
      (let ([names (get-species-shortnames (get-expanded-species))])
        (match (string->list id)
-	 [(name ... #\. #\m #\e #\t #\a #\. #\j #\s #\o #\n) (render-json (get-expanded-taxon-meta (list->string name)))]
-	 [(name ... #\. #\j #\s #\o #\n) (render-json
+         [(name ... #\. #\m #\e #\t #\a #\. #\j #\s #\o #\n) (render-json (get-expanded-taxon-meta (list->string name)))]
+         [(name ... #\. #\j #\s #\o #\n) (render-json
                                           (get-id-data (list->string name)))]
-	 [rest (render-json "NOP")])))
-    (_ (not-found (request-uri request)))
-    ))
+         [rest (render-json "NOP")])))
+    (_ (not-found (request-uri request)))))
 
 (define (request-path-components request)
   (split-and-decode-uri-path (uri-path (request-uri request))))