parser.clj

(ns my-clerk.parser
  (:require
   [nextjournal.clerk.viewer :as clerk.viewer]
   [nextjournal.markdown :as md]
   [nextjournal.markdown.parser :as md.parser]
   [fr.jeremyschoffen.prose.alpha.reader.core :as reader]
   [fr.jeremyschoffen.prose.alpha.eval.common :as eval-common]
   [clojure.string :as str]
   [clojure.walk :as walk]))

;; Add [io.github.pfeodrippe/prose "0.1.0"] as a dependency (as `lein` does not have`
;; great support for git deps) or use https://github.com/JeremS/prose directly. 

(defn adapt-content
  [_opts content]
  (mapv (fn [el]
          (if (string? el)
            {:type :text
             :text el}
            el))
        content))

(defmulti prose->output
  "Converts a Prose tag to some format. If inexistent, `(str (list tag-name args))`
  will be used.

  It checks for `:output-format` and `:tag-name` keys, you can extend it to
  your prefered format using

  (defmethod prose->output [:md :my-tag]
    [_ & args]
    (str (list tag-name args)))"
  (fn [opts & _]
    ((juxt :output-format :tag-name) opts)))

;; By default, a tag just returns a stringfied list.
(defmethod prose->output :default
  [{:keys [tag-name]} & args]
  (str (list tag-name args)))

(defmethod prose->output [:md :hard-break]
  [_opts & _args]
  ::hard-break)

(defn prose-parser
  "Called when a keyword tag is found.

  E.g. `◊:my-keyword{my text}` would give us a `:tag-name` of `:my-keyword` and
  the text as args."
  [opts & args]
  (let [result (apply prose->output (assoc opts :output-format :md) args)]
    (if (string? result)
      {:type :text
       :text result}
      result)))

(defn- eval-clojurized
  [match]
  (->> (eval-common/eval-forms match)
       (adapt-content {})))

(defn- auto-resolves [ns]
  (as-> (ns-aliases ns) $
    (assoc $ :current (ns-name *ns*))
    (zipmap (keys $)
            (map ns-name (vals $)))))

;; Override :tag dispatcher so we can collect all tags.
(def ^:dynamic **tags-collector* (atom []))

(defmethod reader/clojurize* :tag [node]
  (let [tag (->> node
                 :content
                 (into [] (mapcat reader/clojurize))
                 seq)]
    (swap! **tags-collector* conj tag)
    tag))

;; Override :tag-name dispatcher so we can dispatch on keywords.
(defmethod reader/clojurize* :tag-name [node]
  (let [node-value (-> node :content first reader/read-string*)]
    (if (keyword? node-value)
      [`my-clerk.parser/prose-parser {:tag-name node-value}]
      [node-value])))

;; Alter main parser so are able to accept Prose markup.
(alter-var-root #'md/parse
                (fn [_f]
                  (fn [markdown-text]
                    (let [parsed (reader/parse markdown-text)]
                      (if (and (= (:tag parsed) :doc)
                               (= (count (:content parsed)) 1))
                        ;; For the case where there is no `◊`, just parse the
                        ;; text as Markdown.
                        (-> markdown-text md/tokenize md.parser/parse)
                        {:type :prose-unevaluated
                         ;; Trim first character of each new line as they are just
                         ;; noise generated by the usage `;; ...`.
                         :content (-> (->> (str/split-lines markdown-text)
                                           (mapv #(if (= (first %) \space)
                                                    (subs % 1)
                                                    %))
                                           (str/join "\n"))
                                      ;; Hard breaks are used to build
                                      ;; paragraphs later.
                                      (str/replace #"\n\n" "◊:hard-break{}"))})))))

(defn- remove-hard-breaks
  [evaluated-result]
  (loop [[el & rest-list] evaluated-result
         acc []
         current-paragraph {:type :paragraph
                            :content []}]
    (if el
      (cond
        ;; If it's a ::hard-break, remove it and add
        ;; the current paragraph (if existent).
        (= el ::hard-break)
        (if (seq (:content current-paragraph))
          (recur rest-list
                 (conj acc current-paragraph)
                 (assoc current-paragraph :content []))
          (recur rest-list
                 acc
                 current-paragraph))

        ;; If it's a :plain, it means that it's some kind
        ;; of heading, we add the current paragraph (if existent)
        ;; and then the plain element.
        (contains? #{:plain} (:type el))
        (if (seq (:content current-paragraph))
          (recur rest-list
                 (conj acc current-paragraph el)
                 (assoc current-paragraph :content []))
          (recur rest-list
                 (conj acc el)
                 current-paragraph))

        ;; Otherwise, the element is part of a paragraph.
        :else
        (recur rest-list
               acc
               (update current-paragraph :content conj el)))
      ;; Remove any nested remaining ::hard-break
      (walk/prewalk (fn [v]
                      (if (vector? v)
                        (vec (remove #{::hard-break} v))
                        v))
                    (if (seq (:content current-paragraph))
                      (conj acc current-paragraph)
                      acc)))))

(defn process-blocks [viewers {:as doc :keys [ns]}]
  (let [updated-doc
        (-> doc
            (update :blocks
                    #(mapv (fn [block]
                             ;; Evaluate Prose strings, adding a `:toc` field so
                             ;; it can be used to build the table of contents.
                             (if (= (-> block :doc :type) :prose-unevaluated)
                               (let [*collector (atom [])
                                     content
                                     (binding [**tags-collector* *collector
                                               reader/*reader-options*
                                               (merge reader/*reader-options*
                                                      ;; `*ns` belongs to the evaluated
                                                      ;; namespace, here we auto-resolve
                                                      ;; our aliases, see
                                                      ;; https://github.com/borkdude/edamame#auto-resolve
                                                      {:auto-resolve (auto-resolves *ns*)})]
                                       (let [parsed (reader/parse (-> block :doc :content))
                                             result (->> (reader/clojurize parsed)
                                                         eval-clojurized
                                                         remove-hard-breaks)]
                                         result))]
                                 {:type :markdown
                                  :doc {:type :doc
                                        :content content}
                                  :toc (remove nil? (mapv :toc content))
                                  :tags @*collector})
                               block))
                           %)))

        ;; Create toc for Prose if Prose is used, otherwise keep the
        ;; existing one.
        toc (or (some->> (:blocks updated-doc)
                         (mapcat :toc)
                         seq
                         (remove nil?)
                         (reduce (fn [acc [level title]]
                                   ;; Store level count in metadata.
                                   (-> (vary-meta acc update [level :count] (fnil inc 0))
                                       ;; Compute path based on level.
                                       (update-in (->> (range 1 level)
                                                       (mapcat (fn [idx]
                                                                 [(or (some-> (get (meta acc) [idx :count])
                                                                              dec)
                                                                      0)
                                                                  :children]))
                                                       (concat [:children])
                                                       vec)
                                                  (comp vec conj)
                                                  {:type :toc
                                                   :content title
                                                   :heading-level level})))
                                 {:type :toc
                                  :children []}))
                (:toc updated-doc))]
    (-> updated-doc
        (update :blocks (partial into [] (comp (mapcat (partial clerk.viewer/with-block-viewer doc))
                                               (map (comp clerk.viewer/process-wrapped-value
                                                          clerk.viewer/apply-viewers*
                                                          (partial clerk.viewer/ensure-wrapped-with-viewers viewers))))))
        (select-keys [:blocks :toc :toc-visibility :title])
        (assoc :toc toc)
        (cond-> ns (assoc :scope (clerk.viewer/datafy-scope ns))))))

(def notebook-viewer
  {:name :clerk/notebook
   :render-fn (quote v/notebook-viewer)
   :transform-fn (fn [{:as wrapped-value :nextjournal/keys [viewers]}]
                   (-> wrapped-value
                       (update :nextjournal/value (partial process-blocks viewers))
                       clerk.viewer/mark-presented))})

(def ^:private updated-viewers
  (clerk.viewer/update-viewers
   (clerk.viewer/get-default-viewers)
   {(comp #{:clerk/notebook} :name)
    (constantly notebook-viewer)}))

(clerk.viewer/reset-viewers! :default updated-viewers)

;; TODO:
;; - [x] Return sexp if function inexistent
;; - [x] Create multimethod for keywords
;; - [x] Add global viewer
;; - [x] Fix tokenizer for new lines
;; - [x] Make namespaced symbols work (don't eval while parsing)
;; - [x] Make functions look for symbols on the right namespace
;; - [x] Make `::` work
;; - [x] Make ToC minimally work
;; - [x] Collect tags
;; - [x] Check if things are working when publishing
;; - [x] Modify Portal notebook to use Prose
;; - [x] Add `p` to "standalone" paragraphs
;; - [x] Handle multiple lines like Markdown
;; - [ ] Collect commands
;; - [ ] Collect code
;; - [ ] Create view at the bottom with commands + code used
;;       just to show what's possible (or maybe a Recap section?)
;; - [ ] Ability to hide tags
;; - [ ] Add ability to query tags?
;;   - [ ] Can we add the response to the "DB"?
;; - [ ] Revisit ToC

;; Some `prose->output` examples.
(defmethod prose->output [:md :em]
  [opts & args]
  {:type :em
   :content (adapt-content opts args)})

(defmethod prose->output [:md :strong]
  [opts & args]
  {:type :strong
   :content (adapt-content opts args)})

(defmethod prose->output [:md :section]
  [opts & args]
  {:type :paragraph, :content (adapt-content opts args)})

portal.clj

^{:nextjournal.clerk/visibility {:code :hide}
  :nextjournal.clerk/toc true
  :nextjournal.clerk/no-cache true}
(ns my-ns.notebook.portal
  {:nextjournal.clerk/visibility {:code :fold}}
  (:require
   [nextjournal.clerk :as clerk]
   [user.portal]
   [user.clerk.portal :as clerk.portal]
   [my-log :as log]
   [portal.api :as portal]
   [user]
   [clojure.datafy :as datafy]
   [my-clerk.parser :refer [prose->output adapt-content]]))

{::clerk/visibility {:code :hide :result :hide}}

(defmethod prose->output [:md :page-name]
  [opts & content]
  {:type :plain
   :content [{:type :heading
              :content (adapt-content opts content)
              :heading-level 1}]
   :toc [1 (adapt-content opts content)]})

(defmethod prose->output [:md :title]
  [opts & content]
  {:type :plain
   :content [{:type :heading
              :content (adapt-content opts content)
              :heading-level 2}]
   :toc [2 (adapt-content opts content)]})

(defmethod prose->output [:md :subtitle]
  [opts & content]
  {:type :plain
   :content [{:type :heading
              :content (adapt-content opts content)
              :heading-level 3}]
   :toc [3 (adapt-content opts content)]})

(defmethod prose->output [:md :link]
  [opts & content]
  {:type :link
   :content (adapt-content opts content)
   :attrs {:href (first content)}})

(defmethod prose->output [:md :command]
  [opts & content]
  {:type :monospace
   :content (adapt-content opts content)})

(defmethod prose->output [:md :code]
  [opts & content]
  {:type :monospace
   :content (adapt-content opts content)})

(def portal-url
  "https://cljdoc.org/d/djblue/portal")

{::clerk/visibility {:code :fold :result :show}}

;; ◊:page-name{Portal 🔮}

;; Let's learn what you can do with Portal.

;; ◊:title{What's Portal?}

;; Take a look at ◊:link[portal-url] for more
;; information, Portal has excellent guides.

;; ◊:title{Malli Schemas 🕶️}

;; For any Malli schema that you find in Portal, you can generate some
;; samples for it, for this you use the exercise schema command, click
;; in one of the schemas in the Portal window below, open the commands panel
;; by pressing ◊:command{CMD + SHIFT + p} or by clicking at ◊:em{>_} in the bottom
;; right and type ◊:em{exercise}.

;; You will see a map with ◊:code{:malli/generated} as the key and the
;; various samples on the right. If you double click (or press
;; ◊:command{ENTER}) on ◊:code{:malli/generated}, you will see that you are able to
;; generate even more samples, this is a easy way to visualize ◊:strong{any}
;; schema you meet in Portal, from any source.
^{::clerk/viewer clerk.portal/portal-viewer}
[(user.portal/pprint
  [:map
   [:a :int]
   [:b :string]
   [:c [:maybe :date]]])
 (user.portal/pprint
  [:map
   [:transactions
    [:vector
     [:map
      [:id :int]
      [:vendor :string]
      [:date :date]
      [:amount :bigdec]
      [:balance :bigdec]
      [:requested_number_of_payments [:maybe :int]]]]]])]

;; ◊:title{◊:em{tap>} and ◊:em{user/debug} 🐛}
^{::clerk/viewer clerk.portal/portal-viewer}
[]

;; Here we are calling some taps and the custom macro ◊:code{user/debug}
;; (the messages should appear above), ◊:code{user/debug} is different than ◊:code{tap>}
;; because it keeps metadata about the form (click on ◊:em{metadata} for
;; ◊:code{{:a 10}}) and where this was called from, but you can use both
;; interchangeably.
(clerk/example
 (tap> 2)
 (tap> {:a 10})
 (tap> [:map
        [:a :string]
        [:b :string]
        [:c [:maybe :date]]])
 (user/debug {:a 20}))

;; ◊:title{Logs and Exceptions 🪵}
^{::clerk/viewer clerk.portal/portal-viewer}
@user.portal/*portal-logs

^{::clerk/viewer :html}
[:a {:href (portal/url @user.portal/*portal-logs)}
 "Portal Logs"]

;; You can also see logs in the Portal logs window, including exceptions.
(clerk/example
 (log/info "My Log" {:my-own-log? true})
 (log/error (ex-info "BLOW" {:POW :BOOM}) "Oh no" {:some-error ::happened}))

;; ◊:title{Pathom ⛷}

;; You can also analyze queries with the
;; ◊:code{clerk.portal/pathom-trace-viewer} viewer, a description of the
;; query (a trace) will be shown in Portal.

{::clerk/visibility {:code :show}}

;; Let's start with a simple query, you can see that it shows you the
;; resolvers used, so you can learn about the system and ask questions
;; (e.g. am I able to get the member first name from the member
;; external id?)