~subsetpark/bagatto

c837492a435914ac4a44b3141e93be74314baf30 — Zach Smith 4 months ago a592bd3 split-phases
Add some documentation to examples
M bagatto.janet => bagatto.janet +5 -0
@@ 1,6 1,7 @@
(import sh)
(import temple)
(import moondown)
(import path)

(defn *
  ``


@@ 23,6 24,10 @@
       (string/replace-all "_" "-")
       (string/trim)))

(defn shift-up
  "Given a path to a file, return a new path that goes up one then follows the same path."
  [path] (path/join ".." path))

(defn markdown->html
  "Render a markdown string into HTML."
  [md] (moondown/render (string md)))

M demo/index.janet => demo/index.janet +82 -5
@@ 1,9 1,29 @@
### `index.janet`

### A demo index file for Bagatto.

### This simple module demonstrates the basic functionality of the
### Bagatto program, by defining a simple website.

## We can keep our code organized by splitting it out into multiple
## files. We can then import modules from our index file in the
## normal fashion.
(import helpers)

#
# Data Helpers
#

## An `attrs` function is called for every source file that's loaded
## by Bagatto. It takes two arguments: the contents of the file, and
## some pre-generated attributes that are present for every file.
##
## The attributes available by default are:
## * :path - The path of the file from the index
## * :src - The contents of the file
##
## (Thus providing the source as the first argument is a little
## unnecessary, but slightly more convenient.)
(defn post-attrs [_src attrs]
  (let [seq (helpers/int)]
    (put attrs :title (string "Blog Post " seq))


@@ 13,12 33,39 @@
# Content Helpers
#

(defn post-path [_site attrs]
  (string "site/posts/" (bagatto/slugify (attrs :title)) ".html"))
## To render a new file, Bagatto calls two functions on the attributes
## that were generated in the data step.
##
## The *path* function takes two arguments - the data generated for
## the whole site in the first step, followed by the attributes for
## the specific source file in question. Since data sources can and
## often will refer to multiple files (as we'll see below), these
## functions will be called for each file, and the second argument
## will change each time.
##
## The *path* function should return the file path that the generated
## file should be placed in.
(defn post-path [_site post]
  (string "site/posts/" (bagatto/slugify (post :title)) ".html"))

(defn post-content [site attrs]
  (bagatto/render "templates/post" site attrs))
## The *contents* function has the same argument signature as the
## *path* function. It is also called once for each source file. It
## should return the contents of the new file.
##
## In this case we call `bagatto/render`, which renders a template,
## and takes three arguments:
## * The path to the template
## * The site data
## * (optionally) The attributes of the individual source file, if
##   we're iterating over a data source of multiple files.
(defn post-content [site post]
  (bagatto/render "templates/post" site post))

## The Posts index is generated from the site data and lists out all
## the posts. Therefore, it isn't rendered out of a specific source
## file. We will only call it once, with the site data as the only
## argument, since there is no series of items that are all being
## rendered.
(defn post-index [site]
  (bagatto/render "templates/posts" site))



@@ 26,12 73,42 @@
# Bagatto API
#

## A Bagatto index module has to define to variables:
## * `data` is a struct mapping data entry *names* to data *specifications*.
## * `site` is a struct describing all of the files that are to be
##   generated, given the input from `data`. Each site specification
##   also has a *name*, though in this case the names are just to make
##   it easier to read by a human author.

## Our `data` struct has two entries:
## * `config` is a static *attrs* struct, containing arbitrary values
##   to be used in rendering the site.
## * `posts` is a specification using `bagatto/*`, which accepts a
##   file path wildcard and will stream back all the files that match
##   it. Since it will stream multiple files, `post-attrs` is a
##   function which will be called on each file.
(def data {:config {:attrs {:blog-title "A Demo Bagatto Config"}}
           :posts {:src (bagatto/* "posts/*.md")
                   :attrs post-attrs}})

(def index-path "site/index.html")
## Likewise, our `site` struct has two entries (though they don't map
## cleanly to the two data entries):
## * `post-index` is a single file that lists all the posts. Its path
##   is static; its contents are rendered by the `post-index`
##   function, which takes as a single argument the entire output of
##   the data step, and returns the contents of the new file.
## * `posts` is a site specification which will result in multiple
##   files: one for each element of the `posts` site data. To map it
##   back to that site data, we include an additional attribute,
##   `:each`, which refers to an entry found in the site data table.
##
##   Since we've specified an `:each` attribute, both `post-path` and
##   `post-content` will take two arguments: the overall site data, as
##   well as the attributes of the specific data entry from `posts`
##   being rendered in that call.
(def site
  {:post-index {:path "site/index.html"
  {:post-index {:path index-path
                :contents post-index}
   :posts {:each :posts
           :path post-path

M demo/posts/post.md => demo/posts/post.md +5 -2
@@ 1,2 1,5 @@
# blog post
Now in markdown.
## A Post That You Might Be Interested In.

I'm writing this in *Markdown*. Therefore, in my page template, I'll
call `bagatto/markdown->html` in order to render this markdown into
HTML.

M demo/posts/post2.md => demo/posts/post2.md +16 -3
@@ 1,4 1,17 @@
# second blog post
Pretty boring blog[^1].
## The Other Post on My Blog.

[^1]: Do footnotes work?
This post is very similar to the other post. 

However, it contains footnotes[^1].

[^1]: Bagatto has built-in support for Markdown via the
    [moondown](https://github.com/joy-framework/moondown)
    library. However, moondown doesn't have support for footnotes, so
    we should use multimarkdown to render this instead. Bagatto has
    the `mmarkdown->html` (notice the extra `m`!) function which
    shells out to the multimarkdown application. So if you install
    that, you can take advantage of more features.

    Of course, if you want to use some other markup or text processing
    application, you can write your own function, either in your index
    or a helper module, and use that instead.

M demo/templates/base_bottom.temple => demo/templates/base_bottom.temple +3 -0
@@ 1,3 1,6 @@
        </div>
{$ (import hypertext) $}
{$ (def dest (bagatto/shift-up index-path)) $}
{% (print (hypertext/markup (li (a :href dest "All posts")))) %}
  </body>
</html>

M demo/templates/posts.temple => demo/templates/posts.temple +31 -1
@@ 1,8 1,38 @@
{$ (import ./base_top) $}
{% (base_top/render-dict args) %}

{$
### The posts index.

### We see here the use of functions from three different places:
### 1. the index file that `bag` was called with. In this case that's
###    the `post-path` function. This allows us to use the index module
###    as the source of truth for things like link destinations, rather
###    than having to write them out twice.
### 2. The `bagatto/` namespace. This is the same "standard library"
###    that's made available in the index module and constitutes the
###    loaders, renderers, and utilities provided by the bagatto
###    application.
### 3. Arbitrary, author-managed libraries. In addition to the bagatto
###    library, we've vendored the `hypertext` library in our demo
###    directory (ie, not as a part of bagatto proper). In this case it
###    was installed by `jpm install`, but we could just as easily manage
###    our own `project.janet` file in our site directory.

###    Since temple allows us to run arbitrary Janet code, we can then
###    `import` that library here and then use it to generate HTML,
###    instead of printing out HTML strings directly. `bag` will look for
###    the `JANET_PATH` system environment variable; therefore, if we run
###    `JANET_PATH=vendor bag index.janet` we can access any libraries we
###    ourselves would like to manage. $}

{$ (import hypertext) $}
<ul>
{% (seq [x :range [0 10]] (print (string "<li>" x "</li>"))) %}
{% (loop [post :in (args :posts)]
     (def dest (-> (post-path args post) (bagatto/shift-up)))
     (print (hypertext/markup
            (li (a :href dest
                   [(post :title)]))))) %}
</ul>

{$ (import ./base_bottom :as base_bottom) $}

A demo/vendor/.cache/https___gitlab.com_louis.jackman_janet-hypertext => demo/vendor/.cache/https___gitlab.com_louis.jackman_janet-hypertext +1 -0
@@ 0,0 1,1 @@
Subproject commit ca43fefc27a1ddc06da2fac4c2b328ca1cd4457d

A demo/vendor/.manifests/hypertext.jdn => demo/vendor/.manifests/hypertext.jdn +1 -0
@@ 0,0 1,1 @@
{:sha "ca43fefc27a1ddc06da2fac4c2b328ca1cd4457d" :paths @["/home/zax/code-src/bagatto/demo/vendor/hypertext.janet"] :repo "https://gitlab.com/louis.jackman/janet-hypertext" :dependencies @[]}

A demo/vendor/hypertext.janet => demo/vendor/hypertext.janet +439 -0
@@ 0,0 1,439 @@
#
# janet-hypertext
#

(defn- nop [])

(defmacro- flip [x]
  ~(set ,x (not ,x)))

(defn- pretty-format []
  (dyn :pretty-format "%q"))

(defn- map-pairs [f xs &keys {:output output}]
  (default output struct)

  (def mapped
    (->> xs
         pairs
         (map (fn [[k v]]
                (f k v)))))

  (output ;(array/concat @[] ;mapped)))

#
# Element Types
#

(def- tag string)
(def- text-node string)

#
# Elements
#

(defn elem
  "Produces a HTML element, where the first argument is a struct of attributes
  and the seconds is a tuple of child elements (which can be strings for text
  nodes). Drop arguments for sane defaults, except for the mandatory `tag`."
  [tag &opt arg rest]
  (unless (symbol? tag)
    (errorf (string "tags for elements must be symbols, e.g. 'p, not "
                    (pretty-format))
            tag))
  (def [attrs children]
    (case (type arg)
      :tuple [{} arg]
      :nil [{} []]
      :struct [arg (if (nil? rest)
                     []
                     rest)]
      (errorf (string "after the tag, the next item must be either a struct of attributes or a tuple of children, not "
                      (pretty-format))
              arg)))
  {:tag tag
   :attrs attrs
   :children children})

#
# Doctypes
#

# Credit to Joy, from which this function was adapted:
# https://github.com/joy-framework/joy/blob/master/src/joy/html.janet
(defn- doctype-string [version &opt style]
  (let [key [version (or style "")]
        doctypes {[:html5 ""] "html"
                  [:html4 :strict] `HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd"`
                  [:html4 :transitional] `HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"`
                  [:html4 :frameset] `HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd"`
                  [:xhtml1.0 :strict] `html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"`
                  [:xhtml1.0 :transitional] `html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"`
                  [:xhtml1.0 :frameset] `html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"`
                  [:xhtml1.1 ""] `html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"`
                  [:xhtml1.1 :basic] `html PUBLIC "-//W3C//DTD XHTML Basic 1.1//EN" "http://www.w3.org/TR/xhtml-basic/xhtml-basic11.dtd"`}
        doctype (doctypes key)]
    (when (nil? doctype)
      (errorf (string "unknown doctype for "
                      (dyn :pretty-format "%q")
                      "; try :html5")
              key))
    doctype))

(defn doctype
  "Produce a doctype with a version such as `:html5` and an _optional_ style
  like `:frameset`"
  [version &opt style]
  {:version version
   :style style})

(defn doctype-to-string [{:version version :style style}]
  (string "<!DOCTYPE " (doctype-string version style) ">"))

#
# Pages: a Doctype and a Root Document Element
#

(defn page
  "Produces a page with a provided doctype and a document root element. If the
  doctype is omitted, HTML5 is assumed."
  [arg1 &opt document]
  (if (nil? document)
    {:doctype (doctype :html5)
     :document arg1}
    (if (struct? arg1)
      {:doctype arg1
       :document document}
      (errorf "expecting a doctype struct; did you type `:html5` where you meant `(hypertext/doctype :html5)`?"))))

(defn- resembles-page [x]
  (def missing (gensym))
  (def finding (get x :doctype missing))
  (not= finding missing))

#
# Escaping
#

(defn- escapes [codes]
  (pairs (map-pairs (fn [char code]
                      [char (string "&" code ";")])
                    codes)))

(defn- escaper [escapes]
  (fn [s]
    (reduce (fn [result [char replacement]]
              (string/replace-all char replacement result))
            s
            escapes)))

(def- text-node-escapes (escapes {"<" "lt"
                                  ">" "gt"
                                  "&" "amp"
                                  "\"" "quot"
                                  "/" "#x2F"
                                  "'" "#x27"
                                  "%" "#37"}))

(def- attr-name-escapes text-node-escapes)

(def- attr-value-escapes (escapes {"\"" "quot"}))

(def- escape-text-node (escaper text-node-escapes))
(def- escape-attr-name (escaper attr-name-escapes))
(def- escape-attr-value (escaper attr-value-escapes))

#
# Marshalling Formatters
#
# Marshalling formatters consist of two actions: indent and newline. They
# implement these according to their overall formatting strategy and take an
# emitter on construction.
#

(defn pretty
  "Format with indents and newlines."
  [emit]
  {:newline (fn (_)
              (emit "\n"))
   :indent (fn (_ indent-level)
             (for _ 0 indent-level
               (emit "  ")))})

(defn no-indents
  "Indent without indents but with newlines."
  [emit]
  {:newline (fn (_)
              (emit "\n"))
   :indent (fn (_ _))})

(defn minified
  "Neither indent nor add newlines."
  [_]
  {:newline (fn (_))
   :indent (fn (_ _))})

(def default-formatter
  "The symbol of the dynamic variable representing the default formatter to use.
  It is used if one is not explicitly passed in to a function."
  (gensym))

(setdyn default-formatter pretty)

#
# Element Marshalling
#

(defn element-marshaller
  "Creates an element marshaller, a function that emits HTML string fragments for an
  element, each string fragment going out via `emit`. No guarantee is made about
  the content or size of the fragments; they are only guaranteed to be a valid
  HTML document if all combined together."
  [emit &keys {:formatter formatter}]
  (default formatter (dyn default-formatter pretty))

  (def formatter (formatter emit))

  (defn quote-attr-value [s]
    (emit "\"")
    (emit (escape-attr-value s))
    (emit "\""))

  (defn attrs-to-str [attrs]
    (loop [[name value] :pairs attrs]
      (emit " ")
      (emit (escape-attr-name name))
      (emit "=")
      (quote-attr-value value)))

  (var elem-to-string nil)

  (defn children-to-str [children indent-level]
    (for i 0 (length children)
      (def child (children i))
      (def previous-child (get children (dec i)))
      (def sequenced-text (and (string? child)
                               (string? previous-child)))
      (def fold-whitespace (or (string? child)
                               (string? previous-child)))

      (when sequenced-text
        (emit " "))

      (unless fold-whitespace
        (:newline formatter)
        (:indent formatter indent-level))

      (case (type child)
        :string (emit (escape-text-node child))
        :struct (elem-to-string child indent-level)
        (errorf (string "expecting either a text node (string) or a child element (struct), but received a "
                        (pretty-format))
                child))))

  (set elem-to-string (fn [elem indent-level &opt top-level]
                        (default top-level false)
                        (emit "<")
                        (emit (elem :tag))
                        (when (elem :attrs)
                          (attrs-to-str (elem :attrs)))
                        (emit ">")
                        (unless (empty? (elem :children))
                          (children-to-str (elem :children) (inc indent-level))
                          (unless (string? (last (elem :children)))
                           (:newline formatter)
                           (:indent formatter indent-level)))
                        (emit "</")
                        (emit (elem :tag))
                        (emit ">")))

  (defn to-string [x]
    (if (string? x)
      x
      (if (resembles-page x)
        (do
          (emit (doctype-to-string (x :doctype)))
          (:newline formatter)
          (elem-to-string (x :document) 0 true))
        (elem-to-string x 0 true))))

  to-string)

#
# Marshalling Producers
#
# Constructors of tables with at least an `:emit` member function. They are used
# to accumulate resulting HTML strings.
#

(defn in-memory-producer
  "Emits string fragments into an in-memory buffer, which can later be
  \"collected\" into a string."
  [&opt buffer]
  (default buffer @"")

  {:emit (fn [_ s]
           (buffer/push-string buffer s))
   :collect (fn [_]
              (string buffer))})

(defn streaming-producer
  "Streams string fragments into the provided function."
  [f]
  {:emit (fn [_ s] (f s))})

(defn to-string
  "Converts an element into a HTML string eagerly in memory, returning a
  string."
  [elem &keys {:formatter formatter}]
  (let [producer (in-memory-producer)
        emit (fn [s]
               (:emit producer s))
        marshal-element (element-marshaller emit
                                            :formatter formatter)]
    (marshal-element elem)
    (:collect producer)))

(defn emit-as-string-fragments
  "Converts an element into a HTML string lazily, streaming the string fragments
  out via the provided function."
  [elem emit &keys {:formatter formatter}]
  (let [producer (streaming-producer emit)
        emit (fn [s]
               (:emit producer s))
        marshal-element (element-marshaller emit
                                            :formatter formatter)]
    (marshal-element elem)))

#
# DSL Constructors
#
# Using `elem` is a bit raw. Provide a data-oriented wrapper around it,
# and provide a macro wrapper around that. Each one trades off more flexibility
# for succinctness.
#

(var from-data
  "Turns a data representation of elements into an in-memory element. See
  `README.md` for an example of the data's structure."
  nil)

(defn- html-from-tuple [t]
  (when (empty? t)
    (error "an empty tuple isn't enough to describe a HTML element; either use a standalone symbol, or a tuple with at least two elements for one including attributes and/or children"))
  (when (= 1 (length t))
    (error "for elements without attributes and children, just use them standalone outside of a tuple"))
  (if (< 3 (length t))
    (error "a HTML tuple can have a maximum of three items: a tag, an attributes struct, and a children tuple; did you forget the wrap all of the children nodes in `[` and `]`, or forget to put the attributes straight after the tag?"))

  (def [tag arg rest] t)
  (def [attrs children]
    (case (type arg)
      :tuple [{} arg]
      :struct [arg (if (nil? rest)
                     []
                     rest)]
      [{} (tuple/slice t 1)]))
  (def converted-attrs @{})

  # Autoconvert attribute names into keywords.
  (eachp [name value] attrs
    (set (converted-attrs (keyword name))
         (string value)))

  (elem tag
        (table/to-struct converted-attrs)
        (tuple/slice (map from-data children))))

(set from-data (fn [data]
                 (case (type data)
                   :symbol (elem data)
                   :tuple (html-from-tuple data)
                   :struct data

                   # Autoconvert Janet values into strings for text nodes.
                   (string data))))

(defn- html-attrs [args]
  (def result @{})
  (var on-key true)
  (var pending-key nil)
  (var rest [])
  (for i 0 (length args)
    (def arg (args i))
    (if on-key
      (if (keyword? arg)
        (set pending-key arg)
        (do
          (set rest (tuple/slice args i))
          (break)))
      (set (result pending-key)
           (if (symbol? arg)
             ['unquote arg]
             arg)))
    (flip on-key))
  (def attrs (table/to-struct result))
  [attrs rest])

(defn- html-body [body]
  (if (tuple? body)
    (if (= (tuple/type body) :brackets)
      (do
        (unless (= (length body)
                   1)
          (errorf (string "escaped Janet values wrapped in `[` and `]` within hypertext templates can only contain one value, not "
                          (dyn :pretty-format "%q"))
                  body))
        ['unquote (body 0)])
      (let [[tag arg] body
            rest (tuple/slice body 1)
            [attrs children] (if (keyword? arg)
                               (html-attrs rest)
                               [{} rest])
            transformed-children (tuple/slice (map html-body children))]
        [tag attrs transformed-children]))
    body))

(defn- from-gen [body]

  (if (< 3 (length body))
    (error "up to 3 elements can be provided: a doctype, a doctype variant, and a document, and only the document element is mandatory"))

  (if (and (< 1 (length body))
           (not (keyword? (body 0))))
    (error "only a single root element can be passed to `hypertext/markup`; if you want to specify doctypes, ensure keywords are being used and that they come before the root document element"))

  (let [[first second rest] body]
    (if (keyword? first)
      (let [[version style document] (if (keyword? second)
                                       [first
                                        second
                                        rest]
                                       [first
                                        nil
                                        second])]
        (def data (html-body document))
        {:doctype (doctype version style)
         :document ~(,from-data (,'quasiquote ,data))})
      (do
        (def data (html-body first))
        ~(,from-data (,'quasiquote ,data))))))

(defmacro from
  "Produces a HTML element or a whole page from a lightweight representation
  based on Janet syntax. Whether it's an element or a whole page depends on
  whether it starts with doctype-related keywords. See README.md for an
  example."
  [& body]
  (from-gen body))

(defmacro markup
  "Produces a HTML string or a whole page string from a lightweight
  representation based on Janet syntax. Whether it's an element or a whole page
  depends on whether it starts with doctype-related keywords. See README.md for
  an example. There is no formatter argument; formatting can only be changed by
  setting `hypertext/default-formatter`."
  [& body]

  ~(,to-string ,(from-gen body)))


M main.janet => main.janet +6 -0
@@ 2,6 2,7 @@
(import path)
(import util)


(def bagatto
  ``
  An environment populated by the "stdlib" we want to expose to


@@ 81,7 82,12 @@
    writers))

(defn main [& [_ index]]
  (match (os/getenv "JANET_PATH")
    nil :ok
    janet-path (put root-env :syspath janet-path))

  (let [env (load-file index)
        _ (merge-into temple/base-env env)
        data-spec ((env 'data) :value)
        data (load-data data-spec)
        site ((env 'site) :value)