~pepe/pan.earth

a3621624e4f69dd9eac349f2306b9f4264606239 — Josef Pospíšil 2 years ago a164e0b
Add mendoza files just for render
A mendoza/markup-env.janet => mendoza/markup-env.janet +77 -0
@@ 0,0 1,77 @@
###
### mendoza/markup-env.janet
### Copyright © Calvin Rose 2019
###

# This file contains declarations for the core
# markup tags available from within a markup file.
# This defines shorthands for many basic HTML tags,
# codeblocks, and more.

(each tag ["ul" "ol" "li" "p" "em" "strong" "u" "pre"
           "sub" "sup" "tr" "td" "th"]
  (defglobal tag (fn [content] {:tag tag :content content})))

(defn tag
  "Wrap some content in an html tag. If you need attributes or other properties,
  you may want to use raw HTML via the html function."
  [name content]
  {:tag name :content content})

(defn hr
  "Add a horizontal rule"
  []
  {:no-escape "<hr>"})

(defn bigger [content]
  {:tag "span" "style" "font-size:1.61803398875em;" :content content})

(defn smaller [content]
  {:tag "span" "style" "font-size:0.61803398875em;" :content content})

(defn code [content]
  {:tag "code"
   "class" "mendoza-code"
   :content content})

(defn anchor
  "Create an in-page anchor for a local link."
  [name & content]
  {:tag "a" "name" name :content content})

(defn codeblock
  "Inline code or codeblock"
  [lang &opt source]
  (def source2 (or source lang))
  (def lang2 (if source lang nil))
  (def highlighter (if lang2 (require (string lang2 ".syntax"))))
  {:tag "pre"
   "class" "mendoza-codeblock"
   :content {:tag "code"
             :content source2
             :language highlighter
             "data-language" lang2}})
(defn link
  "Create an anchor link"
  [url &opt content]
  {:tag "a" "href" url :content (or content url)})

(defn section
  "Create a section. Usually used to embed different parts of the content
  document into different parts of the main page."
  [name content]
  {:tag "section" "name" name :content content})

(defn blockquote
  "Define a block quote"
  [content]
  {:tag "blockquote" :content content})

(defn image
  [src alt]
  {:tag "img" "src" src :content alt})

(defn html
  "Embed some raw html"
  [source]
  {:no-escape source})

A mendoza/markup.janet => mendoza/markup.janet +169 -0
@@ 0,0 1,169 @@
###
### mendoza/markup.janet
### Copyright © Calvin Rose 2019
###

(def- base-env (require "./markup-env"))
(table/setproto base-env root-env)

(defn- capture-front
  "Capture the front matter"
  [chunk]
  (def p (parser/new))
  (parser/consume p chunk)
  (parser/eof p)
  (def ret @[])
  (while (parser/has-more p) (array/push ret (parser/produce p)))
  ret)

(defn- capture-value
  "Parse a janet value capture in a pattern. At this point, we
  should already know that the source is valid."
  [chunk]
  (def p (parser/new))
  (parser/consume p chunk)
  (parser/eof p)
  (parser/produce p))

(defn- capture-node
  "Capture a node in the grammar."
  [name & params]
  ~(,(symbol name) ,;params))

(def- symchars
  "peg for valid symbol characters."
  '(+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_")))

(def- value-grammar
  "Grammar to get the source for a valid janet value. As it
  doesn't parse the source, it can be a bit shorter and simpler."
  ~{:ws (set " \v\t\r\f\n\0")
    :readermac (set "';~,|")
    :symchars ,symchars
    :token (some :symchars)
    :hex (range "09" "af" "AF")
    :escape (* "\\" (+ (set "ntrvzf0e\"\\") (* "x" :hex :hex)))
    :comment (* "#" (any (if-not (+ "\n" -1) 1)))
    :symbol (if-not (range "09") :token)
    :bytes (* (? "@") "\"" (any (+ :escape (if-not "\"" 1))) "\"")
    :long-bytes {:delim (some "`")
                 :open (capture :delim :n)
                 :close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
                 :main (drop (* (? "@") :open (any (if-not :close 1)) :close))}
    :number (drop (cmt ':token ,scan-number))
    :raw-value (+ :comment :number :bytes :long-bytes
                  :ptuple :btuple :struct :symbol)
    :value (* (any (+ :ws :readermac)) :raw-value)
    :root (any :value)
    :root2 (any (* :value :value))
    :ptuple (* (? "@") "(" :root (any :ws) ")")
    :btuple (* (? "@") "[" :root (any :ws) "]")
    :struct (* (? "@") "{" :root2 (any :ws) "}")
    :main (/ ':value ,capture-value)})

# Some capture functions to make markup a bit
# more like markdown. This is useful in the common
# case.

(defn- capp [& content]
  (unless (empty? content)
    {:tag "p" :content (array/slice content)}))

(defn- caph [n & content]
  {:tag (string "h" (length n)) :content
   (array/slice content)})

(def- markup-grammar
  "Grammar for markdown -> document AST parser."
  ~{# basic character classes
    :wsnl (set " \t\r\v\f\n")
    :ws (set " \t\r\v\f")

    # A span of markup that is not line delimited (most markup)
    :char (+ (* "\\" 1) (if-not (set "@}") 1))
    :leaf (/ '(some :char) ,(partial string/replace "\\" ""))
    :root (some (+ :node :leaf))

    # A span or markup that is line delimited (headers, etc). @ expressions
    # can still cross line boundaries.
    :char-line (+ (* "\\" 1) (if-not (set "@}\n\r") 1))
    :leaf-line (/ '(* (some :char-line) (? "\r") (? "\n"))
                  ,(partial string/replace "\\" ""))
    :root-line (some (+ (* :node (? '"\n")) :leaf-line))

    # An @ expression (a node)
    :node {:paren-params (* "(" (any :wsnl)
                            (any (* :janet-value (any :wsnl))) ")")
           :string-param (* (> 0 "\"") :janet-value)
           :longstring-param (* (> 0 "`") :janet-value)
           :curly-params (* "{" (/ (any :root) ,array) "}")
           :bracket-params (* "[" '(any (if-not "]" 1)) "]")
           :params (any (* (any :wsnl) (+ :bracket-params :curly-params
                                          :paren-params :string-param
                                          :longstring-param)))
           :name '(if-not (range "09") (some ,symchars))
           :main (/ (* "@" :name :params) ,capture-node)}

    # Pretty errors
    :err (error (/ (* '1 (position))
                   ,(fn [x p] (string "unmatched character "
                                      (describe x)
                                      " at byte " p))))

    # Front matter
    :front (/ '(any (if-not "---" 1)) ,capture-front)

    :janet-value ,value-grammar

    # Headers (only at top level)
    :header (/ (* '(between 1 6 "#") (any :ws) :root-line) ,caph)

    # Main rule: Front matter -> Top level nodes and markup
    :main (* :front "---" (any (+ '(some :wsnl)
                                  (* :node (any :wsnl))
                                  :header
                                  (/ :root-line ,capp)
                                  "}"))
             (+ -1 :err))})

(def- markup-peg
  "A peg that converts markdown to html."
  (peg/compile markup-grammar))

(defn markup
  "Parse mendoza markup and evaluate it returning a document tree."
  [source]
  (def env (table/setproto @{} base-env))
  # Inherit dyns
  (let [current-env (fiber/getenv (fiber/current))]
    (loop [[k v] :pairs current-env :when (keyword? k)]
      (put env k v)))
  (def matches (peg/match markup-peg source))
  (unless matches (error "bad markdown"))
  (def front-matter (matches 0))
  (defn do-contents []
    (loop [ast :in (tuple/slice front-matter 0 -2)]
      (eval ast))
    (def matter
      (merge (eval (last front-matter))
             {:content (seq [ast :in (tuple/slice matches 1)]
                         (eval ast))}))
    (def template (matter :template))
    (when (bytes? template))
    (put matter :template (require (string template))))
  (def f (fiber/new do-contents :))
  (fiber/setenv f env)
  (resume f))

#
# Module loading
#

(defn add-loader
  "Adds the custom markup loader to Janet's module/loaders."
  []
  (put module/loaders :mendoza-markup (fn [x &]
                                        (with-dyns [:current-file x]
                                          (markup (slurp x)))))
  (array/insert module/paths 0 [":all:" :mendoza-markup ".mdz"])
  (array/insert module/paths 1 ["./content/:all:" :mendoza-markup ".mdz"]))

A mendoza/render.janet => mendoza/render.janet +81 -0
@@ 0,0 1,81 @@
###
### mendoza/render.janet
### Copyright © Calvin Rose 2019
###

(import ./syntax :as syntax)

(def- html-escape-chars
  "Characters to escape for HTML"
  {("&" 0) "&amp;"
   ("<" 0) "&lt;"
   (">" 0) "&gt;"})

(def- attribute-escape-chars
  "Characters to escape for HTML"
  {("\"" 0) "&quot;"
   ("'" 0) "&#39;"})

(defn- escape
  "Escape a string into buf."
  [str buf escapes]
  (each byte str
    (if-let [e (escapes byte)]
      (buffer/push-string buf e)
      (buffer/push-byte buf byte))))

(defn- highlight-genhtml
  "Paint syntax highlighting colors for HTML"
  [buf tokens]
  (each token tokens
    (if (bytes? token)
      (escape token buf html-escape-chars)
      (let [[class bytes] token]
        (buffer/push-string buf "<span class=\"mdzsyn-" class "\">")
        (escape bytes buf html-escape-chars)
        (buffer/push-string buf "</span>")))))

(defn render
  "Render a document node into HTML. Returns a buffer."
  [node buf]
  (cond
    (bytes? node) (escape node buf html-escape-chars)
    (indexed? node) (each c node (render c buf))
    (dictionary? node)
    (let [tag (node :tag)
          no-escape (node :no-escape)]

      # tag open
      (when tag
        (buffer/push-string buf "<" tag)
        (loop [k :keys node :when (string? k) :let [v (node k)]]
          (if (= v true) # No value, just attribute
            (buffer/push-string buf " " k)
            (do
              (buffer/push-string buf " " k "=\"")
              (escape (node k) buf attribute-escape-chars)
              (buffer/push-string buf "\""))))
        (buffer/push-string buf ">"))

      # syntax highlighting
      (if-let [lang (node :language)]
        (let [content (node :content)
              matches (peg/match lang content)]
          (highlight-genhtml buf matches))
        (if-let [temp (node :template)]
          (temp buf)
          (render (node :content) buf)))

      # Literals
      (when no-escape
        (if (indexed? no-escape)
          (each e no-escape
            (buffer/push-string buf e))
          (buffer/push-string buf no-escape)))

      # tag close
      (when (and tag (not (node :no-close)))
        (buffer/push-string buf "</" tag ">")))

    (number? node) (buffer/push-string buf (string node)))
  buf)

A mendoza/syntax.janet => mendoza/syntax.janet +58 -0
@@ 0,0 1,58 @@
###
### mendoza/syntax.janet
### Copyright © Calvin Rose 2019
###

# Provides syntax highlighting utilities
# for Janet. The majority of the logic is in
# the pegs themselves.

(def- syntax-classes
  "A set of classes for syntax elements. We want to try and unify
  classes, even between different languages to make highlighting work
  better."
  {:number true
   :keyword true
   :string true
   :coresym true
   :constant true
   :string true
   :character true
   :identifier true
   :comment true
   :operator true
   :type true
   :line true})

(defn span
  "Create a replacer function for a peg grammar that is used to capture
  and color output."
  [class]
  (if (not (syntax-classes class))
    (error (string "invalid class " class))
    (fn [text] [class text])))

#
# Module loading
#

(def- syntax-dir (module/expand-path "" ":cur:/syntax"))
(def- suffix ".syntax")
(defn add-loader
  "Adds the custom syntax loader to Janet's module/loaders."
  []
  (defn loader [x args]
    (print "Loading syntax " x)
    (def env ((module/loaders :source) x args))
    (def grammar ((env 'grammar) :value))
    (unless grammar
      (error "module needs to export 'grammar symbol"))
    (def peg
      (if (= :core/peg (type grammar))
        grammar
        (peg/compile grammar))))
  (put module/loaders :mendoza-syntax loader)
  (array/push
    module/paths
    [(string syntax-dir "/:all:.janet") :mendoza-syntax suffix]
    ["./syntax/:all:.janet" :mendoza-syntax suffix]))

M panearth/acts.janet => panearth/acts.janet +7 -7
@@ 2,8 2,8 @@
(import shawn/act :prefix "")
(import shawn/cocoon)
(import chidi)
(import mendoza/markup)
(import mendoza/render)
(import /mendoza/markup)
(import /mendoza/render)
(import spork/temple)
(import spork/path)
(import ./app)


@@ 96,11 96,11 @@
                      (if index?
                        {:markups ms
                         :posts (as-> bfiles fs
                                     (filter |(not (index? $)) fs)
                                     (sort fs
                                       (fn [a b]
                                             (let [mad (get-in ms [a :date])
                                                   mbd (get-in ms [b :date])]
                                      (filter |(not (index? $)) fs)
                                      (sort fs
                                            (fn [a b]
                                              (let [mad (get-in ms [a :date])
                                                    mbd (get-in ms [b :date])]
                                                (> mad mbd)))))}
                        {}))))
           (save-content file fc))

M project.janet => project.janet +0 -2
@@ 6,7 6,5 @@
  :repo "https://git.sr.ht/~pepe/panearth"
  :url "https://pan.earth"
  :dependencies ["spork"
                 "mendoza"
                 "https://git.sr.ht/~pepe/shawn"
                 "https://git.sr.ht/~pepe/chidi"])