Re: [PATCH 1/1] reader: Add Gemtext reader.

[indieterminacy]

Cool!

Out of interest how are making use of the symbol '<=' in this section?

```
+     ((let ((heading-level (heading-level line)))
+        (and heading-level
+             (<= heading-level level)))
```

Given the context, it makes a delicious inversion of GemText's symbol for
a link.

Also, can you clarify your the repeated use of the symbol '=>' in the function 
read-gemtext-element port?


Jonathan

Arun Isaac <arunisaac@systemreboot.net> writes:

> * src/guile/skribilo/reader/gemtext.scm: New file.
> * src/guile/Makefile.am (readers): Register it.
> * doc/user/syntax.skb (The Gemtext Syntax): New section.
> ---
>  doc/user/syntax.skb                   |  21 ++-
>  src/guile/Makefile.am                 |   3 +-
>  src/guile/skribilo/reader/gemtext.scm | 220 ++++++++++++++++++++++++++
>  3 files changed, 242 insertions(+), 2 deletions(-)
>  create mode 100644 src/guile/skribilo/reader/gemtext.scm
>
> diff --git a/doc/user/syntax.skb b/doc/user/syntax.skb
> index 9a4070c..2de7cbd 100644
> --- a/doc/user/syntax.skb
> +++ b/doc/user/syntax.skb
> @@ -211,7 +211,26 @@ documents that can be output in variety of formats (see 
> ,(numref :text
>  [Chapter] :ident "engines")).  The downside is that, being a very simple
>  markup-less document format, there are many things that cannot be done
>  using it, most notably tables, bibliographies, and cross-references.]))
> -   
> +
> +   (section :title [The Gemtext Syntax] :ident "gemtext-syntax"
> +     (p [,(ref
> +:url "https://gemini.circumlunar.space/docs/gemtext.gmi";
> +:text "Gemtext"), the lightweight markup language used by the ,(ref
> +:url "https://gemini.circumlunar.space"; :text "Gemini protocol"), is
> +supported as an input syntax. To use it, just pass ,(tt
> +[--reader=gemtext]) to the compiler. When used programmatically, the
> +Gemtext reader can be customized using the following options.])
> +
> +     (doc-markup 'make-gemtext-reader
> +                 '((:join-lines? [If ,(code "#t"), lines which are not
> +separated by a blank line are joined into a single paragraph. This is
> +a relaxation of the Gemtext standard, and is not done by default.])
> +                   (:section-numbers? [If ,(code "#t"), sections are
> +numbered. Else, they are not.]))
> +                 :common-args '()
> +                 :source "skribilo/reader/gemtext.scm"
> +              :idx *function-index*))
> +
>     (section :title [The RSS 2.0 Syntax]
>              :ident "rss2-syntax"
>        
> diff --git a/src/guile/Makefile.am b/src/guile/Makefile.am
> index 98f2873..0a66a88 100644
> --- a/src/guile/Makefile.am
> +++ b/src/guile/Makefile.am
> @@ -47,7 +47,8 @@ SOURCES =                                                   
>         \
>  SOURCES += $(readers) $(packages) $(engines)
>  
>  readers =                                                    \
> -  skribilo/reader/skribe.scm skribilo/reader/outline.scm
> +  skribilo/reader/skribe.scm skribilo/reader/outline.scm     \
> +  skribilo/reader/gemtext.scm
>  
>  if BUILD_RSS2_READER
>  
> diff --git a/src/guile/skribilo/reader/gemtext.scm 
> b/src/guile/skribilo/reader/gemtext.scm
> new file mode 100644
> index 0000000..06bfe70
> --- /dev/null
> +++ b/src/guile/skribilo/reader/gemtext.scm
> @@ -0,0 +1,220 @@
> +;;; gemtext.scm  --  A reader for the Gemini protocol's Gemtext markup
> +;;;
> +;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
> +;;;
> +;;;
> +;;; This file is part of Skribilo.
> +;;;
> +;;; Skribilo is free software: you can redistribute it and/or modify
> +;;; it under the terms of the GNU General Public License as published by
> +;;; the Free Software Foundation, either version 3 of the License, or
> +;;; (at your option) any later version.
> +;;;
> +;;; Skribilo is distributed in the hope that it will be useful,
> +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +;;; GNU General Public License for more details.
> +;;;
> +;;; You should have received a copy of the GNU General Public License
> +;;; along with Skribilo.  If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (skribilo reader gemtext)
> +  #:use-module (rnrs io ports)
> +  #:use-module (srfi srfi-26)
> +  #:use-module (srfi srfi-71)
> +  #:use-module (srfi srfi-171)
> +  #:use-module (ice-9 match)
> +  #:use-module ((ice-9 textual-ports) #:select (unget-char unget-string))
> +  #:use-module (skribilo reader)
> +  #:export (reader-specification
> +            make-gemtext-reader))
> +
> +(skribilo-module-syntax)
> +
> +;;; Author:  Arun Isaac
> +;;;
> +;;; Commentary:
> +;;;
> +;;; A reader for gemtext, the lightweight markup language used by the
> +;;; Gemini protocol
> +;;;
> +;;; Code:
> +
> +(define %join-lines?
> +  (make-parameter #f))
> +
> +(define %section-numbers?
> +  (make-parameter #f))
> +
> +(define (string-blank? str)
> +  "Return #t if STR contains only whitespace characters.  Else, return
> +#f."
> +  (string-every char-set:whitespace str))
> +
> +(define (string-remove-prefix prefix str)
> +  "Return STR with PREFIX removed.  If PREFIX is not a prefix of STR,
> +return #f."
> +  (and (string-prefix? prefix str)
> +       (substring str (string-length prefix))))
> +
> +(define (string-partition str char-pred)
> +  "Return the part of STR before and after the first occurrence of
> +CHAR-PRED as two values."
> +  (let ((partition-index (string-index str char-pred)))
> +    (if partition-index
> +        (values (substring str 0 partition-index)
> +                (substring str partition-index))
> +        (values str #f))))
> +
> +(define (unget-line port line)
> +  "Place the string LINE in PORT so that subsequent read operations
> +will read LINE followed by a newline character."
> +  (unget-char port #\newline)
> +  (unget-string port line))
> +
> +(define (read-preformatted-text in out)
> +  "Read preformatted text from port IN and write it to port OUT."
> +  (let ((line (get-line in)))
> +    (unless (or (eof-object? line)
> +                (string-prefix? "```" line))
> +      (put-string out line)
> +      (newline out)
> +      (read-preformatted-text in out))))
> +
> +(define (heading-level line)
> +  "Return the level of the heading in LINE. If LINE is not a heading,
> +return #f."
> +  (cond
> +   ((string-prefix? "### " line) 3)
> +   ((string-prefix? "## " line) 2)
> +   ((string-prefix? "# " line) 1)
> +   (else #f)))
> +
> +(define (read-section-children level port)
> +  "Read section elements of LEVEL from PORT. Return as a list."
> +  (let ((line (get-line port)))
> +    (cond
> +     ;; End of file
> +     ((eof-object? line) (list))
> +     ;; If another heading of same or higher level begins, unget line
> +     ;; and end section.
> +     ((let ((heading-level (heading-level line)))
> +        (and heading-level
> +             (<= heading-level level)))
> +      (unget-line port line)
> +      (list))
> +     ;; If blank line, continue.
> +     ((string-blank? line)
> +      (read-section-children level port))
> +     ;; Else, add element and continue.
> +     (else
> +      (unget-line port line)
> +      (cons (read-gemtext-element port)
> +            (read-section-children level port))))))
> +
> +(define (paragraph-line? line)
> +  "Return #t if LINE is a paragraph line. Else, return #f."
> +  (not (or (string-blank? line)
> +           (heading-level line)
> +           (string-prefix? "* " line)
> +           (string-prefix? ">" line)
> +           (string-prefix? "=>" line)
> +           (string-prefix? "```" line))))
> +
> +(define (read-gemtext-element port)
> +  "Read next gemtext element from PORT."
> +  (let ((line (get-line port)))
> +    (cond
> +     ;; End of file
> +     ((eof-object? line) line)
> +     ;; Section
> +     ((heading-level line)
> +      => (lambda (level)
> +           `(,(case level
> +                ((1) 'section)
> +                ((2) 'subsection)
> +                ((3) 'subsubsection))
> +             #:title ,(substring line (1+ level))
> +             #:number ,(%section-numbers?)
> +             ,@(read-section-children level port))))
> +     ;; List
> +     ((string-remove-prefix "* " line)
> +      => (lambda (first-item)
> +           `(itemize
> +             ,@(port-transduce (compose (ttake-while (cut string-prefix? "* 
> " <>)
> +                                                     (lambda (result line)
> +                                                       (unget-line port line)
> +                                                       result))
> +                                        (tmap (lambda (line)
> +                                                `(item 
> ,(string-remove-prefix "* " line)))))
> +                               rcons
> +                               (list `(item ,first-item))
> +                               get-line
> +                               port))))
> +     ;; Blockquote
> +     ((string-remove-prefix ">" line)
> +      => (lambda (first-line)
> +           (list 'blockquote
> +                 (if (%join-lines?)
> +                     (string-join
> +                      (port-transduce (compose (ttake-while (cut 
> string-prefix? ">" <>)
> +                                                            (lambda (result 
> line)
> +                                                              (unget-line 
> port line)
> +                                                              result))
> +                                               (tmap (cut 
> string-remove-prefix ">" <>)))
> +                                      rcons
> +                                      (list first-line)
> +                                      get-line
> +                                      port)
> +                      " ")
> +                     line))))
> +     ;; Link
> +     ((string-remove-prefix "=>" line)
> +      => (lambda (line)
> +           (let* ((trimmed-line (string-trim line))
> +                  (url text (string-partition trimmed-line (char-set #\space 
> #\tab))))
> +             `(paragraph ,(if text
> +                              `(ref #:url ,url #:text ,(string-trim text))
> +                              `(ref #:url ,url))))))
> +     ;; Preformatted text
> +     ((string-remove-prefix "```" line)
> +      => (lambda (alt-text)
> +           ;; We don't use the alt text.
> +           `(pre ,(call-with-output-string
> +                    (cut read-preformatted-text port <>)))))
> +     ;; Ignore blank lines.
> +     ((string-blank? line) (read-gemtext-element port))
> +     ;; Paragraph
> +     (else
> +      (list 'paragraph
> +            (if (%join-lines?)
> +                (string-join
> +                 (port-transduce (ttake-while paragraph-line?
> +                                              (lambda (result line)
> +                                                (unget-line port line)
> +                                                result))
> +                                 rcons
> +                                 (list line)
> +                                 get-line
> +                                 port)
> +                 " ")
> +                line))))))
> +
> +(define* (make-gemtext-reader :key join-lines? section-numbers?)
> +  "Return a gemtext reader.
> +
> +If JOIN-LINES? is #t, lines which are not separated by a blank line
> +are joined into a single paragraph.
> +
> +If SECTION-NUMBERS? is #t, sections are numbered. Else, they are not."
> +  (lambda (port)
> +    (parameterize ((%join-lines? join-lines?)
> +                   (%section-numbers? section-numbers?))
> +      (match (port-transduce (tmap identity)
> +                             rcons
> +                             read-gemtext-element
> +                             port)
> +        (() (eof-object))
> +        (elements `(document ,@elements))))))
> +
> +(define-reader gemtext "0.1" make-gemtext-reader)