blob: fac9a98fb7acdbb6cbcf648e3e5278aa251a749f (
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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
(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 (ice-9 exceptions)
#: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-file
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))))
(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))
)
`(("path" . ,query_path)
("content" . ,content)
("hash" . "commit hash here"))
) (throw 'file-error (string-append "the file path " abs_path " does not exists")))
))
|
