Implement reader support (JVM)

src/cybermonday/core.cljc

@@ -1,38 +1,79 @@
 (ns cybermonday.core
   (:require
+   [clojure.string :as string]
    [cybermonday.utils :as utils]
    [cybermonday.lowering :as lowering]
    [cybermonday.ir :as ir]
    #?(:org.babashka/nbb [clojure.core :refer [js->clj] :rename {js->clj ->clj}]
       :cljs [cljs-bean.core :refer [->clj]])
    #?(:clj  [clj-yaml.core :as yaml]
-      :cljs ["yaml" :as yaml])))
+      :cljs ["yaml" :as yaml]))
+  #?(:clj (:import (java.io Reader))))
 
-(def frontmatter-re #"(?ms)(?:^---$(.*)^---$)?(.*)")
+#?(:clj (set! *warn-on-reflection* true))
 
+(def read-ahead-limit 256) ;; Maximum number of bytes to peek when we test for frontmatter
 (def parse-yaml #?(:clj yaml/parse-string
                    :cljs (comp ->clj yaml/parse)))
 
+#?(:clj
+   (defn -parse-front-rdr
+     "Parse frontmatter from a markdown reader, return the frontmatter and the reader to parse the remaining md"
+     [^Reader md-rdr]
+     (.mark  md-rdr read-ahead-limit)
+     (let [lines (line-seq md-rdr)]
+       (if (= (first lines) "---")
+         {:frontmatter (->> (take-while (partial not= "---") (rest lines))
+                            (string/join "\n")
+                            parse-yaml)
+          :body md-rdr}
+         {:frontmatter nil
+          :body (do (.reset md-rdr) md-rdr)}))))
+
+(defn -parse-front-str
+  "Parse frontmatter from a markdown string, return the frontmatter and the substring of the reamining md"
+  [^String md]
+  (if (string/starts-with? md "---\n")
+    (let [idx (string/index-of md "---\n" 4)]
+      {:frontmatter (parse-yaml (subs md 4 idx))
+       :body (subs md idx)})
+    {:frontmatter nil
+     :body md}))
+
 (defn parse-front
   "Parse only the frontmatter of a markdown file."
   [md]
-  (let [[_ fm _] (re-matches frontmatter-re md)]
-    (when fm (parse-yaml fm))))
+  (:frontmatter #?(:clj (if (instance? Reader md)
+                          (-parse-front-rdr md)
+                          (-parse-front-str md))
+                   :cljs (-parse-front-str md))))
 
-(defn parse-body
-  "Parse only the body of a markdown file."
+(defn -parse-body-str
   ([md opts]
-   (let [[_ _ body] (re-matches frontmatter-re md)]
-     (-> body
-         ir/md-to-ir
-         (lowering/to-html-hiccup opts)
-         utils/cleanup)))
-  ([md] (parse-body md nil)))
+   (-> (ir/md-to-ir md)
+       (lowering/to-html-hiccup opts)
+       utils/cleanup))
+  ([md] (-parse-body-str md nil)))
+
+(defn -parse-body-rdr
+  ([md-rdr opts]
+   (-> (ir/md-rdr-to-ir md-rdr)
+       (lowering/to-html-hiccup opts)
+       utils/cleanup))
+  ([md-rdr] (-parse-body-rdr md-rdr nil)))
 
 (defn parse-md
   "Generates HTML hiccup from markdown and associated frontmatter
   See `cybermonday.lowering/to-html-hiccup` for opts map values."
   ([md opts]
-   {:frontmatter (parse-front md)
-    :body (parse-body md opts)})
+   #?(:cljs (update (-parse-front-str md) :body #(-parse-body-str % opts))
+      :clj (if (instance? Reader md)
+             (update (-parse-front-rdr md) :body #(-parse-body-rdr % opts))
+             (update (-parse-front-str md) :body #(-parse-body-str % opts)))))
   ([md] (parse-md md nil)))
+
+(defn parse-body
+  "Parse only the body of a markdown file."
+  ([md opts]
+   (:body (parse-md md opts)))
+  ([md] (parse-body md nil)))

src/cybermonday/ir.cljc

@@ -5,6 +5,8 @@
    [clojure.string :as str]
    [clojure.walk :as walk]))
 
+#?(:clj (set! *warn-on-reflection* true))
+
 ;; HTML Processing
 
 (defn close-tag? [tag]
@@ -79,10 +81,20 @@
 
 ;; IR Generation
 
+(defn ast-to-ir
+  "Trasnforms a backend-native ast to IR"
+  [ast source]
+  (process-inline-html (parser/to-hiccup ast source)))
+
 (defn md-to-ir
   "Given `md` as a string, generates a Cybermonday hiccup IR
   Inline HTML gets folded inplace and excess whitespace is removed"
   [md]
-  (let [document (.parse parser/parser md)]
-    (->> (parser/to-hiccup document md)
-         process-inline-html)))
+  (ast-to-ir (parser/parse md) md))
+
+(defn md-rdr-to-ir
+  "Given `md` as an opened reader, generates a Cybermonday hiccup IR (JVM only)
+  Inline HTML gets folded inplace and excess whitespace is removed"
+  [md-rdr]
+  #?(:clj (ast-to-ir (parser/parse-rdr md-rdr) md-rdr)
+     :cljs (throw (js/Error. "Unimplemented"))))

src/cybermonday/lowering.cljc

@@ -5,6 +5,8 @@
    [clojure.walk :as walk])
   #?(:clj (:import java.lang.Integer)))
 
+#?(:clj (set! *warn-on-reflection* true))
+
 (def default-tags
   "Deafult mappings from IR tags to HTML tags where transformation isn't required"
   {:markdown/hard-line-break :br

src/cybermonday/parser.clj

@@ -4,6 +4,7 @@
    [hickory.core :as h]
    [clojure.string :as str])
   (:import
+   (java.io Reader)
    (com.vladsch.flexmark.util.ast Node Document)
    (com.vladsch.flexmark.parser Parser)
    (com.vladsch.flexmark.util.data MutableDataSet)
@@ -22,6 +23,8 @@
    (com.vladsch.flexmark.ext.gitlab GitLabExtension GitLabInlineMath)
    (com.vladsch.flexmark.ext.toc TocExtension TocBlock)))
 
+(set! *warn-on-reflection* true)
+
 (def options
   "The default options for the Flexmark parser
   There shouldn't be a reason to change this"
@@ -40,6 +43,16 @@
   Can be called like `(.parse parser document-string)` to yeild a `document` Flexmark parse object"
   (.build (Parser/builder options)))
 
+(defn parse
+  "Invoke the native parser"
+  [md]
+  (.parse ^Parser parser ^String md))
+
+(defn parse-rdr
+  "Invoke the native parser, but on a Reader"
+  [md-rdr]
+  (.parseReader ^Parser parser ^Reader md-rdr))
+
 (defn print-ast
   "Utility function to print the AST. Consumes the `document` from the parser"
   [document]
@@ -78,7 +91,7 @@
   (to-hiccup [this _]))
 
 (defn map-children-to-hiccup [node source]
-  (map #(to-hiccup % source) (.getChildren node)))
+  (map #(to-hiccup % source) (.getChildren ^Node node)))
 
 (extend-protocol HiccupRepresentable
   Node

src/cybermonday/parser.cljs

@@ -15,6 +15,11 @@
                 (use math)
                 (use gfm)))
 
+(defn parse
+  "Invoke the native parser"
+  [md]
+  (.parse parser md))
+
 (def node-tags
   "The default mapping from Flexmark AST node to Hiccup tag"
   {"root" :div

src/cybermonday/utils.cljc

@@ -2,6 +2,8 @@
   (:require [clojure.walk :as walk]
             [clojure.string :as str]))
 
+#?(:clj (set! *warn-on-reflection* true))
+
 (defn update-stack-top
   "Update the last element in v with (f (peek v))"
   [v f & rest]