112 lines
4.2 KiB
Scheme
112 lines
4.2 KiB
Scheme
;;; gemini/sgt.scm
|
|
|
|
;; S-expression representation of Gemtext
|
|
|
|
(define-module (gemini sgt)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-26)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (ice-9 format)
|
|
#:use-module (web uri)
|
|
#:export (sgt->gemtext sgt->sxml))
|
|
|
|
|
|
(define (sgt->gemtext sgt)
|
|
;; Transform SGT, or S-GemText (analogue to SXML) into a string
|
|
;; This SGT is designed to look like SXML, but likely needs modification
|
|
;; before it can be used as such. These are the following elements:
|
|
;; (h1 "primary header")
|
|
;; (h2 "secondary header")
|
|
;; (h3 "tertiary header")
|
|
;; (p "body" ...)
|
|
;; (pre "preformatted text")
|
|
;; (q "quoted text" ...)
|
|
;; (ul (li "list element") ...)
|
|
;; (a uri "link name")
|
|
;; (a uri)
|
|
;; Please note that you probably don't want to use newlines outside of the p
|
|
;; rule; it won't apply things like > or * to the beginning of each line
|
|
(define* (link->string uri #:optional name)
|
|
;; Transform link rules into strings
|
|
(cond ((uri-reference? uri)
|
|
(format #f "=> ~a~@[ ~a~]\n" (uri->string uri) name))
|
|
((and (string? uri) (string->uri-reference uri))
|
|
(format #f "=> ~a~@[ ~a~]\n" uri name))
|
|
(error "Expected a URI in SGT a, but got" uri)))
|
|
|
|
(define (quote->string first . rest)
|
|
;; Transform quotes into strings, where each argument is a single line
|
|
(apply string-append
|
|
(map (lambda (line)
|
|
(format #f "> ~a\n" line))
|
|
(cons first rest))))
|
|
|
|
(define (paragraph->string first . rest)
|
|
;; Transform paragraphs into strings, where each argument is a single line
|
|
(apply string-append
|
|
(map (lambda (line)
|
|
(format #f "~a\n" line))
|
|
(cons first rest))))
|
|
|
|
(define (list->string first . rest)
|
|
;; Transform lists into strings, where each argument is a list element
|
|
(apply string-append
|
|
(map (lambda (element)
|
|
(match element
|
|
(('li body) (format #f "* ~a\n" body))
|
|
(_ (error "Invalid list in SGT: " element))))
|
|
(cons first rest))))
|
|
|
|
(define (sgt->strings sgt)
|
|
(map (lambda (element)
|
|
(match element
|
|
(('h1 body) (format #f "# ~a\n" body))
|
|
(('h2 body) (format #f "## ~a\n" body))
|
|
(('h3 body) (format #f "### ~a\n" body))
|
|
(('pre . body) (format #f "```\n~{~a\n~}```\n" body))
|
|
(('a uri name) (link->string uri name))
|
|
(('a uri) (link->string uri))
|
|
(('q body . rest) (apply quote->string body rest))
|
|
(('ul body . rest) (apply list->string body rest))
|
|
(('p) "\n")
|
|
(('p body . rest) (apply paragraph->string body rest))
|
|
(_ (error "Invalid SGT element: " element))))
|
|
sgt))
|
|
|
|
(apply string-append (sgt->strings sgt)))
|
|
|
|
|
|
(define (sgt->sxml sgt)
|
|
;; Transform SGT into SXML, specifically for use with (X)HTML
|
|
|
|
(define (insert-breaks lines)
|
|
;; Insert a <br/> in between each element
|
|
(drop-right (append-map (lambda (line) `(,line (br))) lines) 1))
|
|
|
|
(define* (link->sxml uri #:optional name)
|
|
;; Transform link rules into SXML links
|
|
(cond ((and (uri-reference? uri) name)
|
|
`(a (@ (href ,(uri->string uri))) ,name))
|
|
((and (string? uri) (string->uri-reference uri) name)
|
|
`(a (@ (href ,uri)) ,name))
|
|
((and (uri-reference? uri))
|
|
`(a (@ (href ,(uri->string uri))) ,(uri->string uri)))
|
|
((and (string? uri) (string->uri-reference uri))
|
|
`(a (@ (href ,uri)) ,uri))
|
|
(else (error "Expected a URI in SGT a, but got" uri))))
|
|
|
|
(map (lambda (element)
|
|
(match element
|
|
(('h1 body) `(h1 ,body))
|
|
(('h2 body) `(h2 ,body))
|
|
(('h3 body) `(h3 ,body))
|
|
(('pre . body) `(pre ,(map (cut string-append <> "\n") body)))
|
|
(('a uri name) `(p ,(link->sxml uri name)))
|
|
(('a uri) `(p ,(link->sxml uri)))
|
|
(('q . body) `(blockquote ,@(insert-breaks body)))
|
|
(('ul . body) `(ul ,@body))
|
|
(('p) '(p (br)))
|
|
(('p "") '(p (br)))
|
|
(('p . body) `(p ,@(insert-breaks body)))
|
|
(_ (error "Invalid SGT element: " element))))
|
|
sgt))
|