CLJ php style POC

php.clj

(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)))