Skip to content

Instantly share code, notes, and snippets.

@jeroenvandijk

jeroenvandijk/php.clj Secret

Last active Feb 13, 2020
Embed
What would you like to do?
CLJ php style POC
(ns clj-php
(:require [sci.core :as sci]
[edamame.core :as edamame]))
(defn tag-mapping [^String tag]
(let [chars (seq tag)]
(reduce (fn [acc ch]
(fn [ch0]
(when (identical? ch ch0)
acc)))
-1
(map int (reverse chars)))))
;;; TODO need to fix things like (balanced? "{ [ }")
(defn code-shape? [form]
(if (clojure.string/blank? form)
:empty
(try
(edamame/parse-string form {:all true})
:ok
(catch Exception e
(let [msg (ex-message e)]
(if (clojure.string/starts-with? msg "EOF")
(case (subs msg 0 40)
("EOF while reading, expected ) to match ("
"EOF while reading, expected ] to match ["
"EOF while reading, expected } to match {"
) :eof
(throw e))
(throw e)
#_(case (subs msg 0 22)
("Unmatched delimiter: )"
"Unmatched delimiter: ]"
"Unmatched delimiter: }") false
(throw e))))))))
;; ([{ compensate for open brackets (code highlighting)
(defn parser [{:keys [open-tag close-tag]}]
(fn [in out]
(let [eval-code (fn [code bindings]
;(println "EVAL" code (pr-str bindings))
(let [shape (code-shape? code)]
(case shape
:ok [(sci/eval-string code {:bindings bindings}) nil]
:eof [nil code]
:empty ["" nil] ;; FIXME can more optimal
)))
open-tag-mapping (tag-mapping open-tag)
close-tag-mapping (tag-mapping close-tag)]
(with-open [r (java.io.BufferedReader. (java.io.InputStreamReader. in (java.nio.charset.Charset/defaultCharset)))]
(loop [state :plain
tag-mapping open-tag-mapping
code-buffer nil
tag-buffer nil
buffer nil
bindings nil]
(let [c (.read r)]
(if (= c -1)
(case state
:plain :done
:parsing-open-tag (.write out (.toCharArray tag-buffer))
:parsing-code (ex-info (str "Unclosed open tag " state) {:state state})
:plain-buffered (let [sym (gensym)]
(sci/eval-string (str code-buffer " " sym) {:bindings (assoc bindings sym buffer)}))
(throw (ex-info (str "Unexpected state " state) {:state state})))
(let [next-tag-mapping (tag-mapping c)]
(case state
:plain
(if next-tag-mapping
(recur :parsing-open-tag next-tag-mapping nil (str (char c)) nil nil)
(do
(.write out c)
(recur :plain tag-mapping nil nil nil nil)))
:parsing-open-tag
(if next-tag-mapping
(if (= next-tag-mapping -1)
(recur :parsing-code close-tag-mapping nil nil nil nil)
(recur :parsing-open-tag next-tag-mapping nil (str tag-buffer (char c)) nil nil))
;; Check if current char isn't a candidate anyway
(if-let [next-tag-mapping (open-tag-mapping c)]
(do
;; write old tag-buffer and continue with new one
(recur :parsing-open-tag next-tag-mapping nil (str (char c)) nil nil))
(do
#_(.write out c)
(recur :plain open-tag-mapping nil nil nil nil))))
:parsing-code
(if next-tag-mapping
(recur :parsing-close-tag next-tag-mapping code-buffer (str (char c)) nil nil)
(recur :parsing-code close-tag-mapping (str code-buffer (char c)) nil nil nil))
:parsing-close-tag
(if next-tag-mapping
(if (= next-tag-mapping -1)
(let [[evaluated left-buffer] (eval-code code-buffer {})]
(if evaluated
(do
(.write out (str evaluated))
(recur :plain open-tag-mapping nil nil nil nil))
(recur :plain-buffered open-tag-mapping left-buffer nil nil nil)))
(recur :parsing-close-tag open-tag-mapping nil (str tag-buffer (char c)) nil nil))
;; Failed
(recur :plain close-tag-mapping (str code-buffer tag-buffer (char c)) nil nil nil))
;; --- Buffered mode ---
:plain-buffered
(if next-tag-mapping
(let [sym (gensym)]
(recur :parsing-open-tag-buffered next-tag-mapping (str code-buffer " " sym) (str (char c)) nil (assoc bindings sym buffer)))
(recur :plain-buffered open-tag-mapping code-buffer nil (str buffer (char c)) bindings))
:parsing-open-tag-buffered
(if next-tag-mapping
(if (= next-tag-mapping -1)
(recur :parsing-code-buffered close-tag-mapping code-buffer nil buffer bindings)
(recur :parsing-open-tag-buffered next-tag-mapping code-buffer (str tag-buffer (char c)) buffer bindings))
(let [buffer (str buffer tag-buffer)]
(if-let [next-tag-mapping (open-tag-mapping c)]
(recur :parsing-open-tag-buffered next-tag-mapping code-buffer (str (char c)) buffer bindings)
(recur :plain-buffered open-tag-mapping code-buffer nil (str buffer (char c)) bindings))))
:parsing-code-buffered
(if next-tag-mapping
(recur :parsing-close-tag-buffered next-tag-mapping code-buffer (str (char c)) buffer bindings)
(recur :parsing-code-buffered close-tag-mapping (str code-buffer (char c)) nil buffer bindings))
:parsing-close-tag-buffered
(if next-tag-mapping
(if (= next-tag-mapping -1)
(let [[evaluated left-buffer] (eval-code code-buffer bindings)]
(if evaluated
(do
(.write out (str evaluated))
(recur :plain open-tag-mapping nil nil nil nil))
(recur :plain-buffered open-tag-mapping left-buffer nil nil bindings)))))
)))))))))
(do
(let [f (parser {:open-tag "<?clj"
:close-tag "?>"})
s "plain only"
s "plain only <?clj" ;; Exception
s "plain only <?clj ?> bb" ;;
s "plain only <?clj ?> bb" ;;
s "plain only <?clj 2 ?> bb" ;; prints 2
s "plain only <?clj (pr-str \"a\") ?> bb" ;;
s "plain only <?clj (+ 10 10) ?> bb" ;; skips buffer
s "plain only <?clj (if 10 10) ?> bb" ;; skips buffer
s "plain only <?clj (if 10 10 ?> bb <?clj ) ?>" ;; skips buffer
s "plain only <?clj (if 10 10 ?> bb <?clj ) ?>" ;; skips buffer
s "plain only <?clj (if false 10 ?> bb <?clj (if false ?> ignored <?clj ?> hello <?clj ?>" ;; ;; TODO fix line numbers
s "plain only <?clj (if false 10 ?> bb <?clj (if true ?> ignored <?clj ?> hello <?clj )) ?>" ;; ;; TODO fix if arity in Sci
s "plain only <?clj (if false ?> bb <?clj (if false ?> ignored <?clj ?> hello <?clj )) ?>" ;; ;; WORK as expected
in (java.io.ByteArrayInputStream. (.getBytes s "UTF-8"))
out *out*]
(f in out)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment