aboutsummaryrefslogtreecommitdiff
path: root/web/view/markdown.scm
blob: b7c8a58329858f1e0beee6816471e848d97fba94 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
(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 "https://raw.githubusercontent.com/genenetwork/gn-docs/master/general/brand/aging/home.md")
    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 (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 #\/)))
    (commonmark->sxml
     (fetch-raw-file (form-github-raw-url project repo page)))))