diff --git a/deps.edn b/deps.edn index 963ccdf4..d129aa93 100644 --- a/deps.edn +++ b/deps.edn @@ -76,7 +76,8 @@ version-clj/version-clj {:mvn/version "2.0.1"} gaka/gaka {:mvn/version "0.3.0"} failjure/failjure {:mvn/version "2.1.1"} - io.helins/binf {:mvn/version "1.1.0-beta0"}} + io.helins/binf {:mvn/version "1.1.0-beta0"} + rm-hull/jasentaa {:mvn/version "0.2.5"}} :classpath-overrides {org.clojure/clojure nil org.clojure/spec.alpha nil org.clojure/core.specs.alpha nil}} diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj index f021a764..49207f12 100644 --- a/test-resources/lib_tests/babashka/run_all_libtests.clj +++ b/test-resources/lib_tests/babashka/run_all_libtests.clj @@ -200,6 +200,13 @@ (test-namespaces 'selmer.core-test) +(test-namespaces 'jasentaa.position-test + 'jasentaa.worked-example-1 + 'jasentaa.worked-example-2 + 'jasentaa.collections-test + 'parser.basic-test + 'parser.combinators-test) + ;;;; final exit code (let [{:keys [:test :fail :error] :as m} @status] diff --git a/test-resources/lib_tests/jasentaa/collections_test.cljc b/test-resources/lib_tests/jasentaa/collections_test.cljc new file mode 100644 index 00000000..6d520c63 --- /dev/null +++ b/test-resources/lib_tests/jasentaa/collections_test.cljc @@ -0,0 +1,26 @@ +(ns jasentaa.collections-test + (:require + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [jasentaa.collections :refer [join]] + [jasentaa.position :refer [augment-location]])) + +(deftest check-join-on-lists + (is (= [1 2] (join 1 2))) + (is (= [3 4] (join [3] 4))) + (is (= [5 6] (join 5 [6]))) + (is (= [7 8] (join [7] [8]))) + (is (= [9] (join 9 nil))) + (is (= [0] (join nil 0))) + (is (= [] (join nil nil)))) + +(deftest check-join-on-records + (let [[a b] (augment-location "ab")] + (is (= [a] (join a nil))) + (is (= [b] (join nil b))) + (is (= [a b] (join a b))))) + +(deftest check-join-on-strings + (is (= "ab" (join "a" "b"))) + (is (= "a" (join "a" nil))) + (is (= "b" (join nil "b")))) diff --git a/test-resources/lib_tests/jasentaa/parser/basic_test.cljc b/test-resources/lib_tests/jasentaa/parser/basic_test.cljc new file mode 100644 index 00000000..add2ab14 --- /dev/null +++ b/test-resources/lib_tests/jasentaa/parser/basic_test.cljc @@ -0,0 +1,30 @@ +(ns jasentaa.parser.basic-test + (:require + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [jasentaa.test-helpers :as th] + [jasentaa.monad :as m] + [jasentaa.parser.basic :as pb])) + +(deftest check-any + (is (= [[\a "pple"]] (th/test-harness pb/any "apple"))) + (is (= [[\a ""]] (th/test-harness pb/any "a"))) + (is (= (m/failure) (th/test-harness pb/any []))) + (is (= (m/failure) (th/test-harness pb/any nil))) + (is (= (m/failure) (th/test-harness pb/any "")))) + +(deftest check-match + (is (= [[\a "pple"]] (th/test-harness (pb/match "a") "apple"))) + (is (= [[\a ""]] (th/test-harness (pb/match "a") "a"))) + (is (= (m/failure) (th/test-harness (pb/match "a") "banana")))) + +(deftest check-none-of + (is (= [[\b "anana"]] (th/test-harness (pb/none-of "a") "banana"))) + (is (= [[\b ""]] (th/test-harness (pb/none-of "a") "b"))) + (is (= (m/failure) (th/test-harness (pb/none-of "b") "banana")))) + +(deftest check-from-re + (is (= [[\a "pple"]] (th/test-harness (pb/from-re #"[a-z]") "apple"))) + (is (= [[\b "anana"]] (th/test-harness (pb/from-re #"[a-z]") "banana"))) + (is (= [[\p "ear"]] (th/test-harness (pb/from-re #"[a-z]") "pear"))) + (is (= (m/failure) (th/test-harness (pb/from-re #"[a-z]") "Tomtato")))) diff --git a/test-resources/lib_tests/jasentaa/parser/combinators_test.cljc b/test-resources/lib_tests/jasentaa/parser/combinators_test.cljc new file mode 100644 index 00000000..adf0fe06 --- /dev/null +++ b/test-resources/lib_tests/jasentaa/parser/combinators_test.cljc @@ -0,0 +1,28 @@ +(ns jasentaa.parser.combinators-test + (:require + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [jasentaa.monad :as m] + [jasentaa.test-helpers :as th] + [jasentaa.parser.basic :as pb] + [jasentaa.parser.combinators :as pc])) + +(deftest check-and-then + (let [parser (pc/and-then (pb/match "a") (pb/match "b"))] + (is (= [[[\a \b] "el"]] (th/test-harness parser "abel"))) + (is (= (m/failure) (th/test-harness parser "apple"))) + (is (= (m/failure) (th/test-harness parser ""))))) + +(deftest check-or-else + (let [parser (pc/or-else (pb/match "a") (pb/match "b"))] + (is (= [[\a "pple"]] (th/test-harness parser "apple"))) + (is (= [[\b "anana"]] (th/test-harness parser "banana"))) + (is (= (m/failure) (th/test-harness parser "orange"))))) + +(deftest check-many + (let [parser (pc/many (pb/match "a"))] + (is (= [[\a] ""] (first (th/test-harness parser "a")))) + (is (= [[\a \a \a] "bbb"] (first (th/test-harness parser "aaabbb")))) + (is (= [[] nil] (first (th/test-harness parser "")))) + (is (= [[\a] "pple"] (first (th/test-harness parser "apple")))) + (is (= [[] "orange"] (first (th/test-harness parser "orange")))))) diff --git a/test-resources/lib_tests/jasentaa/position_test.cljc b/test-resources/lib_tests/jasentaa/position_test.cljc new file mode 100644 index 00000000..946e42f9 --- /dev/null +++ b/test-resources/lib_tests/jasentaa/position_test.cljc @@ -0,0 +1,57 @@ +(ns jasentaa.position-test + (:require + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [jasentaa.position :as pos #?@(:cljs [:refer [Location]])]) + #?(:clj (:import + [jasentaa.position Location]))) + +(deftest check-augment-then-strip + (is (= "the quick brown fox" + (pos/strip-location + (pos/augment-location + "the quick brown fox"))))) + +(deftest check-augment-location-plain-string + (is (nil? (pos/augment-location ""))) + (is (= (pos/augment-location "Hello\nWorld!") + (list + (Location. \H 1 1 0 "Hello\nWorld!") + (Location. \e 1 2 1 "Hello\nWorld!") + (Location. \l 1 3 2 "Hello\nWorld!") + (Location. \l 1 4 3 "Hello\nWorld!") + (Location. \o 1 5 4 "Hello\nWorld!") + (Location. \newline 1 6 5 "Hello\nWorld!") + (Location. \W 2 1 6 "Hello\nWorld!") + (Location. \o 2 2 7 "Hello\nWorld!") + (Location. \r 2 3 8 "Hello\nWorld!") + (Location. \l 2 4 9 "Hello\nWorld!") + (Location. \d 2 5 10 "Hello\nWorld!") + (Location. \! 2 6 11 "Hello\nWorld!"))))) + +(deftest check-strip-location + (is (= \h (pos/strip-location (Location. \h 1 1 0 "help")))) + (is (= nil (pos/strip-location nil))) + (is (= "Hello" (pos/strip-location "Hello")))) + +(deftest check-exception + (is (thrown-with-msg? #?(:clj java.text.ParseException + :cljs js/Error) + #"Unable to parse text" + (throw (pos/parse-exception nil)))) + (is (thrown-with-msg? #?(:clj java.text.ParseException + :cljs js/Error) + #"Failed to parse text at line: 6, col: 31" + (throw (pos/parse-exception (Location. \Y 6 31 321 "Makes no sense")))))) + +(deftest check-show-error + (let [text "We choked on street tap water well I'm gonna have to try the real thing\n +I took your laugh by the collar and it knew not to swing\n +Anytime I tried an honest job well the till had a hole and ha-ha\n +We laughed about payin' rent 'cause the county jails they're free" + loc (vec (pos/augment-location text))] + (is (= (pos/show-error (get loc 10)) "We choked on street tap water well I'm gonna have to try the real thing\n ^\n")) + (is (= (pos/show-error (get loc 110)) "I took your laugh by the collar and it knew not to swing\n ^\n")) + (is (= (pos/show-error (get loc 210)) "We laughed about payin' rent 'cause the county jails they're free\n ^\n")) + (is (nil? (pos/show-error nil))) + (is (nil? (pos/show-error (Location. \h 1 1 1000 "wut?")))))) diff --git a/test-resources/lib_tests/jasentaa/runner.cljs b/test-resources/lib_tests/jasentaa/runner.cljs new file mode 100644 index 00000000..1f0423c7 --- /dev/null +++ b/test-resources/lib_tests/jasentaa/runner.cljs @@ -0,0 +1,15 @@ +(ns jasentaa.runner + (:require [doo.runner :refer-macros [doo-tests]] + [jasentaa.parser.basic-test] + [jasentaa.parser.combinators-test] + [jasentaa.collections-test] + [jasentaa.position-test] + [jasentaa.worked-example-1] + [jasentaa.worked-example-2])) + +(doo-tests 'jasentaa.parser.basic-test + 'jasentaa.parser.combinators-test + 'jasentaa.collections-test + 'jasentaa.position-test + 'jasentaa.worked-example-1 + 'jasentaa.worked-example-2) diff --git a/test-resources/lib_tests/jasentaa/test_helpers.cljc b/test-resources/lib_tests/jasentaa/test_helpers.cljc new file mode 100644 index 00000000..d69583ef --- /dev/null +++ b/test-resources/lib_tests/jasentaa/test_helpers.cljc @@ -0,0 +1,12 @@ +(ns jasentaa.test-helpers + (:require [jasentaa.monad :as m] + [jasentaa.position :as p])) + +(defn test-harness [parser input] + (let [result (first (parser (p/augment-location input)))] + (if (empty? result) + (m/failure) + (list [(if (char? (-> result first :char)) + (-> result first :char) + (mapv :char (first result))) + (p/strip-location (fnext result))])))) diff --git a/test-resources/lib_tests/jasentaa/worked_example_1.cljc b/test-resources/lib_tests/jasentaa/worked_example_1.cljc new file mode 100644 index 00000000..ba71a9eb --- /dev/null +++ b/test-resources/lib_tests/jasentaa/worked_example_1.cljc @@ -0,0 +1,89 @@ +(ns jasentaa.worked-example-1 + (:require + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [jasentaa.monad :as m :refer [do*]] + [jasentaa.position :refer [strip-location]] + [jasentaa.parser :refer [parse-all]] + [jasentaa.parser.basic :refer [from-re match]] + [jasentaa.parser.combinators :refer [token symb separated-by any-of plus optional]])) + +; BNF Grammar, based at that described in: 'Getting Started with PyParsing' +; (http://shop.oreilly.com/product/9780596514235.do) +; +; searchExpr ::= searchAnd [ OR searchAnd ]... +; searchAnd ::= searchTerm [ AND searchTerm ]... +; searchTerm ::= [NOT] ( singleWord | quotedString | '(' searchExpr ')' ) + +(def digit (from-re #"[0-9]")) +(def letter (from-re #"[a-z]")) +(def alpha-num (any-of letter digit)) + +(declare search-expr) + +(def single-word + (m/do* + (w <- (token (plus alpha-num))) + (m/return (strip-location w)))) + +(def quoted-string + (m/do* + (symb "\"") + (t <- (plus (any-of digit letter (match " ")))) + (symb "\"") + (m/return (strip-location t)))) + +(def bracketed-expr + (m/do* + (symb "(") + (expr <- (token search-expr)) + (symb ")") + (m/return expr))) + +(def search-term + (m/do* + (neg <- (optional (symb "not"))) + (term <- (any-of single-word quoted-string bracketed-expr)) + (m/return (if (empty? neg) term (list :NOT term))))) + +(def search-and + (m/do* + (lst <- (separated-by search-term (symb "and"))) + (m/return (if (= (count lst) 1) + (first lst) + (cons :AND lst))))) + +(def search-expr + (m/do* + (lst <- (separated-by search-and (symb "or"))) + (m/return (if (= (count lst) 1) + (first lst) + (cons :OR lst))))) + +(deftest check-grammar + (is (= [:OR [:AND "wood" "blue"] "red"] + (parse-all search-expr "wood and blue or red"))) + + (is (= [:AND "wood" [:OR "blue" "red"]] + (parse-all search-expr "wood and (blue or red)"))) + + (is (= [:AND [:OR "steel" "iron"] "lime green"] + (parse-all search-expr "(steel or iron) and \"lime green\""))) + + (is (= [:OR [:NOT "steel"] [:AND "iron" "lime green"]] + (parse-all search-expr "not steel or iron and \"lime green\""))) + + (is (= [:AND [:NOT [:OR "steel" "iron"]] "lime green"] + (parse-all search-expr "not(steel or iron) and \"lime green\""))) + + (is (thrown-with-msg? + #?(:clj java.text.ParseException + :cljs js/Error) + #"Failed to parse text at line: 1, col: 7\nsteel iron\n \^" + (parse-all search-expr "steel iron"))) + + (is (thrown-with-msg? + #?(:clj java.text.ParseException + :cljs js/Error) + #"Unable to parse text" + (parse-all search-expr "")))) diff --git a/test-resources/lib_tests/jasentaa/worked_example_2.cljc b/test-resources/lib_tests/jasentaa/worked_example_2.cljc new file mode 100644 index 00000000..cf8e7d1b --- /dev/null +++ b/test-resources/lib_tests/jasentaa/worked_example_2.cljc @@ -0,0 +1,80 @@ +(ns jasentaa.worked-example-2 + (:require + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [jasentaa.monad :as m :refer [do*]] + [jasentaa.position :refer [strip-location]] + [jasentaa.parser :as p] + [jasentaa.parser.basic :refer [sat #?(:clj fwd)]] + [jasentaa.parser.combinators :refer [token symb optional chain-left chain-right choice]]) + #?(:cljs (:require-macros + [jasentaa.parser.basic :refer [fwd]]))) + +; BNF Grammar, based at that described in: 'FUNCTIONAL PEARLS: Monadic Parsing in Haskell' +; (http://www.cs.uwyo.edu/~jlc/courses/3015/parser_pearl.pdf) +; +; expr ::= expr addop term | term +; term ::= term mulop factor | factor +; factor ::= digit | ( expr ) +; digit ::= 0 | 1 | . . . | 9 +; +; addop ::= + | - +; mulop ::= * | / + +(declare expr) + +(defn- digit? [c] + (re-find #"[0-9]" (str c))) + +(def digit + (m/do* + (x <- (token (sat digit?))) + (m/return (- (byte (strip-location x)) (byte \0))))) + +(def factor + (choice + digit + (m/do* + (symb "(") + (n <- (fwd expr)) + (symb ")") + (m/return n)))) + +(def addop + (choice + (m/do* + (symb "+") + (m/return +)) + (m/do* + (symb "-") + (m/return -)))) + +(def mulop + (choice + (m/do* + (symb "*") + (m/return *)) + (m/do* + (symb "/") + (m/return /)))) + +(def term + (chain-left factor mulop)) + +(def expr + (chain-left term addop)) + +(deftest check-evaluate-expr + (let [expected (+ 4 (- 1 (* 2 3)))] ; => -1 + (is (= [[expected ()]] (take 1 (p/apply expr " 1 - 2 * 3 + 4 ")))))) + +;; Now use chain-right: +(def term' + (chain-right factor mulop)) + +(def expr' + (chain-right term addop)) + +(deftest check-evaluate-expr' + (let [expected (- 1 (+ 4 (* 2 3)))] + (is (= [[expected ()]] (take 1 (p/apply expr' " 1 - 2 * 3 + 4 "))))))