Apply guix style formatting to files.

1 files changed, 80 insertions, 52 deletions

diff --git a/web/view/markdown.scm b/web/view/markdown.scm
index fd8838f..653596f 100644
--- a/web/view/markdown.scm
+++ b/web/view/markdown.scm
@@ -16,89 +16,117 @@
   #:use-module (web sxml)
   #:use-module (commonmark)
 
-  #:export (markdown-file->sxml
-            markdown-github->sxml
-            fetch-file
-            fetch-raw-file
-            commit-file))
-
+  #:export (markdown-file->sxml markdown-github->sxml fetch-file
+                                fetch-raw-file commit-file))
 
 (define (markdown-file->sxml fn)
   "Parse a local file"
-  (commonmark->sxml
-   (call-with-input-file fn
-     get-string-all)))
+  (commonmark->sxml (call-with-input-file fn
+                      get-string-all)))
 
 (define (fetch-raw-file url)
   (receive (response-status response-body)
-      (http-request url)
-    response-body))
+           (http-request url) response-body))
 
 ;; https://github.com/genenetwork/gn-docs/master/general/brand/aging/home.md
 ;; https://raw.githubusercontent.com/genenetwork/gn-docs/master/general/brand/aging/home.md
 ;; https://github.com/genenetwork/gn-docs/edit/master/general/brand/aging/home.md
 
 (define (form-github-raw-url project repo page)
-  (string-append "https://raw.githubusercontent.com/" project "/" repo "/master/" (string-join page "/")))
+  (string-append "https://raw.githubusercontent.com/"
+                 project
+                 "/"
+                 repo
+                 "/master/"
+                 (string-join page "/")))
 
 (define (form-github-edit-url project repo page)
-  (string-append "https://github.com/" project "/" repo "/edit/master/" (string-join page "/")))
+  (string-append "https://github.com/"
+                 project
+                 "/"
+                 repo
+                 "/edit/master/"
+                 (string-join page "/")))
 
 (define (markdown-github->sxml path)
   "Parse a github markdown file that is formed like genenetwork/gn-docs/general/brand/aging/home.md"
-  (match-let (((project repo page ...) (string-split path #\/)))
-    `(div (@ (class "markdown"))
-          ,(commonmark->sxml
-            (fetch-raw-file (pk (form-github-raw-url project repo (pk page)))))
-          (p
-           (div (@ (class "button-align-right"))
-                (a (@ (href ,(form-github-edit-url project repo page)) (role "button")) "edit")))
-          (br)
-          (br))))
+  (match-let (((project repo page ...)
+               (string-split path #\/)))
+             `(div (@ (class "markdown"))
+                   ,(commonmark->sxml (fetch-raw-file (pk (form-github-raw-url
+                                                           project repo
+                                                           (pk page)))))
+                   (p (div (@ (class "button-align-right"))
+                           (a (@ (href ,(form-github-edit-url project repo
+                                                              page))
+                                 (role "button")) "edit")))
+                   (br)
+                   (br))))
 
 (define (fetch-file repo query-path)
-  (let* ( (abs-path (format #f "~a/~a" repo query-path)))
-    (if (file-exists? abs-path)  (let* ((full-path (canonicalize-path abs-path))
-                                        (content (call-with-input-file full-path get-string-all))
-                                        (commit-sha (get-latest-commit-sha1 repo)))
-                                   `(("file_path" . ,query-path)
-                                     ("content" . ,content)
-                                     ("hash" . ,commit-sha))
-                                   ) (throw 'file-error  (format #f "~a does not exists" abs-path)))))
+  (let* ((abs-path (format #f "~a/~a" repo query-path)))
+    (if (file-exists? abs-path)
+        (let* ((full-path (canonicalize-path abs-path))
+               (content (call-with-input-file full-path
+                          get-string-all))
+               (commit-sha (get-latest-commit-sha1 repo)))
+          `(("file_path" unquote query-path)
+            ("content" unquote content)
+            ("hash" unquote commit-sha)))
+        (throw 'file-error
+               (format #f "~a does not exists" abs-path)))))
 
 (define (git-invoke repo-path . args)
   (apply system* "git" "-C" repo-path args))
 
 (define (git-repository? repo-path)
-  (let ((data (git-invoke repo-path  "rev-parse")))
+  (let ((data (git-invoke repo-path "rev-parse")))
     (zero? data)))
 
 (define (get-latest-commit-sha1 repo-path)
-  (let* ((output-port (open-input-pipe (string-append "git -C " repo-path " log -n 1 --pretty=format:%H HEAD")))
+  (let* ((output-port (open-input-pipe (string-append "git -C " repo-path
+                                        " log -n 1 --pretty=format:%H HEAD")))
          (commit-sha (read-line output-port)))
-    (close-port output-port)
-    commit-sha))
+    (close-port output-port) commit-sha))
 
-(define* (commit-file repo file-path content commit-message username email #:optional (prev-commit ""))
-  (unless (string=? prev-commit (get-latest-commit-sha1 repo))
-    (throw 'system-error (format #f "Commits do no match.Please pull in latest  changes for current * ~a * and prev * ~a * "
-                                 (get-latest-commit-sha1 repo) prev-commit)))
+(define* (commit-file repo
+                      file-path
+                      content
+                      commit-message
+                      username
+                      email
+                      #:optional (prev-commit ""))
+  (unless (string=? prev-commit
+                    (get-latest-commit-sha1 repo))
+    (throw 'system-error
+           (format #f
+            "Commits do no match.Please pull in latest  changes for current * ~a * and prev * ~a * "
+            (get-latest-commit-sha1 repo) prev-commit)))
   (if (git-repository? repo)
       (match (file-exists? (format #f "~a/~a" repo file-path))
-        (#t
-         (with-output-to-file (format #f "~a/~a" repo file-path)
-           (lambda ()
-             (display content)))
+        (#t (with-output-to-file (format #f "~a/~a" repo file-path)
+              (lambda ()
+                (display content)))
          (let* ((git-add-file (git-invoke repo "add" file-path))
-                (git-commit-file
-                 (git-invoke repo "commit"
-                             "-m" commit-message
-                             "-m" " * Commit made via the GN Markdown Editor"
-                             "--author" (format  #f "~a <~a>" username  email)))
+                (git-commit-file (git-invoke repo
+                                  "commit"
+                                  "-m"
+                                  commit-message
+                                  "-m"
+                                  " * Commit made via the GN Markdown Editor"
+                                  "--author"
+                                  (format #f "~a <~a>" username email)))
                 (git-commit-sha (get-latest-commit-sha1 repo)))
            (if (zero? git-commit-file)
-               `(("status" . "201") ("message" . "committed file successfully") ("content" . ,content) ("commit_sha" . ,git-commit-sha) ("commit_message" . ,commit-message) )
-               `(("status" . "200") ("message" . "Nothing to commit, working tree clean") ("commit_sha" . ,git-commit-sha)))))
-        (#f
-         (throw 'system-error (format #f "~a File does not exist error" file-path))))
-      (throw 'system-error (format #f  "~a is no a git repo" repo))))
+               `(("status" . "201")
+                 ("message" . "committed file successfully")
+                 ("content" unquote content)
+                 ("commit_sha" unquote git-commit-sha)
+                 ("commit_message" unquote commit-message))
+               `(("status" . "200")
+                 ("message" . "Nothing to commit, working tree clean")
+                 ("commit_sha" unquote git-commit-sha)))))
+        (#f (throw 'system-error
+                   (format #f "~a File does not exist error" file-path))))
+      (throw 'system-error
+             (format #f "~a is no a git repo" repo))))