My personal blog's source repository.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

264 lines
7.6 KiB

# Utils
(defn tpl/join
"Joins the fragments of a template"
[& frags]
(string/join ;frags "\n"))
(defn slugify
"Slugifies the given string value"
[v]
(get (->> v
(string/trim)
(string/ascii-lower)
(peg/match
~{:main (cmt (any (+ (<- :w+) :W))
,|(string/join $& "-"))})
)
0))
(defn pp-ast
"Pretty prints the Gemini AST (as provided by (peg/match gemini-syntax))"
[ast]
(if ast
(do
(print "[")
(map |(printf "\t%q" $0) ast)
(print "]"))))
# Parser
(def gemini-syntax
"The gemini syntax, following the format [:type value meta] where value and meta are optional depending on the symbol"
~{# Symbols
:paragraph (some (if-not "\n" 1))
:white (any " ")
# Lines
:shebang (* "#!" :paragraph (? "\n"))
:line (cmt (<- :paragraph) ,|[:line $0])
:empty-lines (cmt (some "\n") ,|[:empty])
:heading (cmt
(* (<- (between 1 3 "#")) :white (<- :paragraph))
,|[:heading (string/trim $1) (slugify $1) (length $0)])
:link (cmt
(* "=>" :white (<- (some :S)) (? (* :white (<- :paragraph))))
,(fn [link &opt alt]
(default alt link)
[:link link alt]))
:list-item (* "* " (cmt (<- :paragraph) ,string/trim))
:quote (+
(cmt (* ">" (<- :paragraph)) ,|[:quote (string/trim $0)])
(cmt ">" ,|[:quote ""]))
## Custom HTML-mapped syntax
:hr (cmt "---" ,|[:hr])
# Aggregates
:blockquote (cmt
(* "```" (? (<- :paragraph)) "\n"
(<- (some (if-not "\n```" 1)))
"\n```" (any (if-not "\n" 1)))
,|(let [l (length $&)]
[:blockquote (get $& (- l 1)) (get $& (- l 2))]))
:list (cmt
(*
:list-item
(any (* "\n" :list-item)))
,|[:list $&])
:multiline-quote (cmt
(*
:quote
(any (* "\n" :quote)))
,|[:multiline-quote $&])
:block (+ :link
:blockquote
:heading
:multiline-quote
:list
:hr
:empty-lines
:line)
:main (*
(? :shebang)
(some (* :block (? "\n"))))})
(defn htmlspecialchars
"Same as PHP's method"
[value]
(->> value
(string/replace "&" "&amp;")
(string/replace "<" "&lt;")
(string/replace ">" "&gt;")
(string/replace "\"" "&quot;")
(string/replace "'" "&apos;")))
(defn html-compatible-link
"Transforms a Gemini-file-pointing link to a HTML-file-pointing link"
[link]
(if-let [r-parts (reverse (string/split "." link))
ext (first r-parts)
base (reverse (slice r-parts 1))]
(string/join [;base (if (= ext "gmi") "html" ext)] ".")
link))
(defn to-html
"Transforms the Gemini AST (as provided by (peg/match gemini-syntax)) into HTML"
[ast &opt sep]
(default sep "\n")
(if ast
(string/join
(map
|(match $0
[:blockquote value alt]
(string "<pre><code"
(if alt (string " class='language-" alt "'"))
">" (htmlspecialchars value) "</code></pre>")
[:heading value slug level]
(string "<h" level " id='" slug
"'><a href='#" slug "' class='heading'>::</a> " (htmlspecialchars value) "</h" level ">")
[:multiline-quote value]
(string "<blockquote>\n"
(string/join (map |(string "<p>" (htmlspecialchars (get $0 1)) "</p>") value) "\n")
"\n</blockquote>")
[:empty]
"<div class='empty'></div>"
[:hr]
"<hr/>"
[:line value]
(string "<p>" (htmlspecialchars value) "</p>")
[:list items]
(string/join @["<ul>"
;(map |(string "<li>" (htmlspecialchars $0) "</li>") items)
"</ul>"] "\n")
[:link value alt]
(string "<a href='" (html-compatible-link value) "'>" (htmlspecialchars alt) "</a>")
_
(error (string "Invalid symbol: " (get $0 0))))
ast)
sep)))
(defn to-gmi
"Transforms the Gemini AST (as provided by (peg/match gemini-syntax)) into Gemini"
[ast &opt sep]
(default sep "\n")
(if ast
(string/join
(map
|(match $0
[:blockquote value alt]
(if (= nil alt)
(string "```\n" value "\n```")
(string "```" alt "\n" value "\n```"))
[:heading value _ level]
(string
(string/join (map (fn [_] "#") (range level)))
" " value)
[:quote value]
(string "> " value)
[:hr]
"---"
[:empty]
""
[:line value]
value
[:list items]
(string/join |(string "* " $0) items)
[:link value alt]
(if (= value alt)
(string "=> " value)
(string "=> " value alt))
_
(error (string "Invalid symbol: " (get $0 0))))
ast)
sep)))
(defn to-rss
"Transforms the Gemini AST (as provided by (peg/match gemini-syntax)) into RSS2"
[ast &opt sep]
(default sep "\n")
(error "NOT IMPLEMENTED"))
(defn- ast/ltrim
[ast]
(reduce
|(if (and
(= 0 (length $0)) # acc is empty (no content yet) ..
(match $1 [:empty] true [:hr] true)) # .. and item isn't yet to take
$0 # we ignore
[;$0 $1]) # we concat
[] ast))
(defn- ast/rtrim
[ast]
(-> ast
reverse
ast/ltrim
reverse))
(defn- is-blank [node]
(match node [:empty] true [:hr] true _ false))
(defn- extract-title
"the title value if the first node is H1, else nil"
[ast]
(match (get ast 0)
[:heading value _ 1] (htmlspecialchars value)))
(defn- extract-excerpt
"the first paragraph block before empty node or EOF"
[ast]
(let [ast (if (extract-title ast)
(array/slice ast 1)
ast)]
(take-until is-blank (ast/ltrim ast))))
(defn extract-meta
"Extract metadata from a gemini document (title, excerpt, links) into a structure"
[ast]
{:title (extract-title ast)
:excerpt (extract-excerpt ast)})
(defn escape-bash-value
[v]
(->> v
(string/replace-all "\"" "&quot;")
(string/replace-all "\n" "")))
(defn dump-bash-eval
"Dumps the metadata table into a bash-eval-compatible format, for easy loading"
[meta]
(loop [[key value] :in (pairs meta)]
(let [final (cond
(= :string (type value)) value
(= :tuple (type value)) (to-html value))]
(print "export " (string/ascii-upper key) "=\"" (escape-bash-value final) "\";"))))
# Main
(defn parse-doc
[mode path]
(if (= :file
(os/stat path :mode))
(let [value (slurp path)
ast (peg/match gemini-syntax value)]
(cond
(= mode :ast) (pp-ast ast)
(= mode :html) (print (to-html ast))
(= mode :meta) (dump-bash-eval (extract-meta ast))
(= mode :gmi) (print (to-gmi ast))
(= mode :rss) (print (to-rss ast))
(error (string/format "unknown mode: %q" mode))))
(file/write
stderr
(string/format "file not found: %s\n" path))))
(defn usage [bin]
(file/write
stderr
(string/format "usage: %s {--html|--meta|--rss} FILE\n" bin))
(os/exit 1))
(defn main [bin & args]
(match args
["--ast" file] (parse-doc :ast file)
["--html" file] (parse-doc :html file)
["--meta" file] (parse-doc :meta file)
["--rss" file] (parse-doc :rss file)
_ (usage bin)))