diff options
Diffstat (limited to 'web/view/markdown.scm')
| -rw-r--r-- | web/view/markdown.scm | 89 |
1 files changed, 41 insertions, 48 deletions
diff --git a/web/view/markdown.scm b/web/view/markdown.scm index 1220898..d147a8f 100644 --- a/web/view/markdown.scm +++ b/web/view/markdown.scm @@ -13,17 +13,16 @@ #:use-module (web client) #:use-module (web uri) #:use-module (web request) - + #:use-module (web sxml) #:use-module (commonmark) #:export (markdown-file->sxml - markdown-github->sxml - fetch-file - fetch-raw-file - commit-file - is-repo?) - ) + markdown-github->sxml + fetch-file + fetch-raw-file + commit-file + is-repo?)) (define (markdown-file->sxml fn) @@ -43,44 +42,42 @@ ;; 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)))) + ,(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 (string-append 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)) - ) - `(("path" . ,query_path) - ("content" . ,content) - ("hash" . ,commit-sha)) - ) (throw 'file-error (string-append "the file path " abs_path " does not exists"))))) + (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))) + `(("path" . ,query_path) + ("content" . ,content) + ("hash" . ,commit-sha)) + ) (throw 'file-error (string-append "the file path " abs_path " does not exists"))))) (define (git-invoke repo-path . args) (apply system* "git" "-C" repo-path args)) (define (is-repo? repo-path) - (let ((data (git-invoke repo-path "rev-parse")) ) - (zero? data)) -) + (let ((data (git-invoke repo-path "rev-parse"))) + (zero? data))) (define (get-latest-commit-sha1 repo-path) @@ -94,27 +91,23 @@ (if (string=? prev-commit (get-latest-commit-sha1 repo)) #t (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)) - ) + (get-latest-commit-sha1 repo) prev-commit))) (if (is-repo? repo) (match (file-exists? (string-append repo "/" file-path)) - (#t - (with-output-to-file (string-append 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-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 (string-append file-path " File does not exist Error")))) + (#t + (with-output-to-file (string-append 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-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 (string-append file-path " File does not exist Error")))) (throw 'system-error (string-append repo " Is not a git repo.")))) |