add label node and improve output tree; alpha release

README.md

@@ -4,19 +4,19 @@ Lilac parser
 
 > A toy combinator parser with better failure reasons.
 
-Demo of `(def a (add 1 2))` or `{"json": [1, 2]` http://repo.mvc-works.org/lilac-parser/
+Demo of `(def a (add 1 2))` or `{"json": [1, 2]}` http://repo.mvc-works.org/lilac-parser/
 
 ### Usage
 
 [![Clojars Project](https://img.shields.io/clojars/v/mvc-works/lilac-parser.svg)](https://clojars.org/mvc-works/lilac-parser)
 
 ```edn
-[mvc-works/lilac-parser "0.0.2-a2"]
+[mvc-works/lilac-parser "0.0.2-a3"]
 ```
 
 ```clojure
 (require '[lilac-parser.core :refer
-            [parse-lilac defparser is+ many+ one-of+ some+ combine+ interleave+ other-than+]])
+            [parse-lilac defparser is+ many+ one-of+ some+ combine+ interleave+ other-than+ label+]])
 
 (parse-lilac "aaaa" (many+ (is+ "a")))
 ```

package.json

@@ -1,6 +1,6 @@
 {
   "name": "@mvc-works/lilac-parser",
-  "version": "0.0.2-a2",
+  "version": "0.0.2-a3",
   "description": "Toy parser in cljs",
   "main": "index.js",
   "scripts": {

release.edn

@@ -1,4 +1,4 @@
-{:version "0.0.2-a2"
+{:version "0.0.2-a3"
  :group-id "mvc-works"
  :artifact-id "lilac-parser"
  :skip-tag true

src/lilac_parser/comp/container.cljs

@@ -25,12 +25,13 @@
   {:font-family ui/font-code,
    :color (hsl 0 0 100),
    :display :inline-block,
-   :line-height "24px",
+   :line-height "22px",
    :padding "0 4px",
    :border-radius "4px",
    :margin-right 8,
    :white-space :pre,
-   :min-height 14})
+   :min-height 14,
+   :font-size 13})
 
 (defcomp
  comp-node
@@ -62,25 +63,27 @@
         (fn [e d!] )))
      (if (:ok? node)
        (<>
-        "OK"
+        "Ok"
         (merge style-label {:background-color (hsl 200 80 70), :font-family ui/font-fancy}))
        (<>
-        "Failure"
-        (merge style-label {:background-color (hsl 60 80 40), :font-family ui/font-fancy})))
+        "Fail"
+        (merge style-label {:background-color (hsl 20 80 50), :font-family ui/font-fancy})))
+     (<>
+      (name (:parser-node node))
+      (merge style-label {:background-color (hsl 200 80 76), :font-family ui/font-fancy}))
+     (if (or (= :label (:parser-node node)) (= :component (:parser-node node)))
+       (<> (:label node) (merge style-label {:background-color (hsl 200 90 60)})))
      (if-not (:ok? node)
-       (<>
-        (:message node)
-        (merge style-label {:background-color (hsl 0 80 60), :font-family ui/font-normal})))
-     (<> (:parser-node node) (merge style-label {:background-color (hsl 200 80 70)}))
-     (if (= :is (:parser-node node))
+       (<> (:message node) (merge style-label {:background-color (hsl 0 80 60)})))
+     (if (and (:ok? node) (= :is (:parser-node node)))
        (<> (:value node) (merge style-label {:background-color (hsl 200 80 70)})))
      (if (:ok? node)
        (<>
         (pr-str (:value node))
         (merge style-label {:background-color (hsl 200 80 80), :font-size 10})))
      (<>
       (->> (:rest node) (take 10) (string/join ""))
-      (merge style-label {:background-color (hsl 100 10 60), :font-size 10, :min-height 16})))
+      (merge style-label {:background-color (hsl 100 10 70), :font-size 10, :min-height 16})))
     (if (and has-children? (not (:folded? state)))
       (div
        {}
@@ -135,7 +138,7 @@
        :on-input (fn [e d!] (d! cursor (assoc state :code (:value e))))})
      (if (:gui? state)
        (div
-        {:style (merge ui/expand {:padding-bottom 600})}
+        {:style (merge ui/expand {:padding-bottom 400})}
         (comp-node (>> states :tree-viewer) (:result state)))
        (textarea
         {:style (merge

src/lilac_parser/core.cljs

@@ -5,6 +5,8 @@
             [cirru-edn.core :as cirru-edn]
             [lilac-parser.config :refer [dev?]]))
 
+(declare parse-label)
+
 (declare parse-interleave)
 
 (declare parse-some)
@@ -37,6 +39,8 @@
   ([x] (is+ x identity))
   ([x transform] {:parser-node :is, :item x, :transform transform}))
 
+(defn label+ [label item] {:parser-node :label, :label label, :item item})
+
 (defn many+ [item] {:parser-node :many, :item item})
 
 (defn one-of+
@@ -80,7 +84,11 @@
        :rest (:rest strip-result),
        :parser-node :is}
       {:ok? false,
-       :message (str "failed to match " item " in " (take 10 xs) "...."),
+       :message (str
+                 "expects "
+                 (pr-str item)
+                 " but got "
+                 (pr-str (string/join "" (take (count item) xs)))),
        :parser-node :is,
        :rest xs})))
 
@@ -91,7 +99,13 @@
        :value (let [v (first xs)] (if (some? transform) (transform v) v)),
        :rest (rest xs),
        :parser-node :one-of}
-      {:ok? false, :message "not in list", :parser-node :one-of, :rest xs})))
+      {:ok? false,
+       :message (str
+                 (pr-str (first xs))
+                 " is not in "
+                 (pr-str (if (string? items) items (string/join "" items)))),
+       :parser-node :one-of,
+       :rest xs})))
 
 (defn parse-other-than [xs rule]
   (if (empty? xs)
@@ -102,7 +116,11 @@
     (let [items (:items rule), transform (:transform rule), x0 (first xs)]
       (if (if (string? items) (string/includes? items x0) (contains? items x0))
         {:ok? false,
-         :message (str (pr-str x0) "is in not expected item in other-than+"),
+         :message (str
+                   (pr-str x0)
+                   " among "
+                   (pr-str (if (string? items) items (string/join "" items)))
+                   " is invalid"),
          :parser-node :other-than,
          :rest xs}
         {:ok? true,
@@ -128,7 +146,7 @@
     (loop [rules items, failures []]
       (if (empty? rules)
         {:ok? false,
-         :message "No more rules to try",
+         :message (str "all " (count items) " rules missed"),
          :parser-node :or,
          :results failures,
          :rest xs}
@@ -159,7 +177,7 @@
           (recur (conj acc result) (:rest result))
           (if (empty? acc)
             {:ok? false,
-             :message "no match in many",
+             :message "no match",
              :parser-node :many,
              :peek-result result,
              :rest xs}
@@ -183,8 +201,25 @@
     :one-of (parse-one-of xs rule)
     :interleave (parse-interleave xs rule)
     :other-than (parse-other-than xs rule)
+    :label (parse-label xs rule)
     (do (js/console.warn "Unknown node" rule) nil)))
 
+(defn parse-label [xs rule]
+  (let [result (parse-lilac xs (:item rule))]
+    (if (:ok? result)
+      {:ok? true,
+       :parser-node :label,
+       :label (:label rule),
+       :value (:value result),
+       :rest (:rest result),
+       :result result}
+      {:ok? false,
+       :message nil,
+       :parser-node :label,
+       :label (:label rule),
+       :result result,
+       :rest (:rest result)})))
+
 (defn parse-interleave [xs0 rule]
   (let [x0 (:x rule), y0 (:y rule), transform (:transform rule)]
     (loop [acc [], xs xs0, x x0, y y0]
@@ -193,7 +228,7 @@
           (recur (conj acc result) (:rest result) y x)
           (if (empty? acc)
             {:ok? false,
-             :message "no match in interleave",
+             :message "no match",
              :parser-node :interleave,
              :peek-result result,
              :rest xs}
@@ -214,11 +249,13 @@
       {:ok? true,
        :value (value-fn (:value result)),
        :rest (:rest result),
-       :parser-node rule-name,
+       :parser-node :component,
+       :label rule-name,
        :result (if blackbox? nil result)}
       {:ok? false,
-       :message "failed to parse component",
-       :parser-node rule-name,
+       :message "failed branch",
+       :parser-node :component,
+       :label rule-name,
        :result (if blackbox? nil result),
        :rest xs})))
 
@@ -228,7 +265,7 @@
       (cond
         (and (empty? xs) (not (empty? ys)))
           {:ok? false,
-           :message "unexpected end of file",
+           :message "unexpected EOF",
            :parser-node :combine,
            :results acc,
            :rest xs}
@@ -244,7 +281,7 @@
               (recur (conj acc result) (:rest result) (rest ys))
               {:ok? false,
                :parser-node :combine,
-               :message "not matched during combine",
+               :message "failed to combine",
                :result result,
                :previous-results acc,
                :rest xs}))))))

src/lilac_parser/demo/json.cljs

@@ -11,7 +11,8 @@
               one-of+
               some+
               or+
-              defparser]]
+              defparser
+              label+]]
             [clojure.string :as string]))
 
 (declare value-parser+)
@@ -21,29 +22,34 @@
 (declare object-parser+)
 
 (def boolean-parser
-  (or+ [(is+ "true") (is+ "false")] (fn [x] (if (= x "true") true false))))
+  (label+ "boolean" (or+ [(is+ "true") (is+ "false")] (fn [x] (if (= x "true") true false)))))
 
 (def space-parser (some+ (is+ " ") (fn [x] nil)))
 
-(def comma-parser (combine+ [space-parser (is+ ",") space-parser] (fn [x] nil)))
+(def comma-parser
+  (label+ "comma" (combine+ [space-parser (is+ ",") space-parser] (fn [x] nil))))
 
 (def digit-parser (one-of+ "1234567890"))
 
-(def nil-parser (or+ [(is+ "null") (is+ "undefined")] (fn [x] nil)))
+(def nil-parser (label+ "nil" (or+ [(is+ "null") (is+ "undefined")] (fn [x] nil))))
 
 (def number-parser
-  (combine+
-   [(optional+ (is+ "-"))
-    (many+ digit-parser)
-    (optional+ (combine+ [(is+ ".") (many+ digit-parser)]))]
-   (fn [xs] (js/Number (string/join "" (nth xs 1))))))
+  (label+
+   "number"
+   (combine+
+    [(optional+ (is+ "-"))
+     (many+ digit-parser)
+     (optional+ (combine+ [(is+ ".") (many+ digit-parser)]))]
+    (fn [xs] (js/Number (string/join "" (nth xs 1)))))))
 
 (def string-parser
-  (combine+
-   [(is+ "\"")
-    (some+ (or+ [(other-than+ "\"\\") (is+ "\\\"") (is+ "\\\\") (is+ "\\n")]))
-    (is+ "\"")]
-   (fn [xs] (string/join "" (nth xs 1)))))
+  (label+
+   "string"
+   (combine+
+    [(is+ "\"")
+     (some+ (or+ [(other-than+ "\"\\") (is+ "\\\"") (is+ "\\\\") (is+ "\\n")]))
+     (is+ "\"")]
+    (fn [xs] (string/join "" (nth xs 1))))))
 
 (defparser
  value-parser+