(define-module (web view markdown) #:use-module (json) #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module (ice-9 iconv) #:use-module (ice-9 receive) #:use-module (ice-9 string-fun) #:use-module (ice-9 textual-ports) #:use-module (sxml simple) #: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-raw-file) ) (define (markdown-file->sxml fn) "Parse a local file" (commonmark->sxml (call-with-input-file fn get-string-all))) ;; --- fetch github style URLs (define (fetch-raw-file url) (receive (response-status 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 "/"))) (define (form-github-edit-url project repo 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))))