Skip to content

Commit

Permalink
Allow for non-global usage
Browse files Browse the repository at this point in the history
  • Loading branch information
@mitch-kyle
mitch-kyle committed Mar 31, 2018
1 parent af99e59 commit 597b471
Show file tree
Hide file tree
Showing 2 changed files with 80 additions and 63 deletions.
72 changes: 42 additions & 30 deletions src/phrase/alpha.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,32 +29,37 @@
pred)
::mappings @mappings}))

(defn- dispatch [_ {:keys [::normalized-pred ::via]}]
(defn dispatch [_ {:keys [::normalized-pred ::via]}]
(cond-> []
normalized-pred (conj normalized-pred)
(seq via) (conj via)))

(defmulti phrase*
(defmacro defdictionary
"Define a dictionary of phrasers"
{:arglists '([name & [doc-string?]])}
[name & opts]
`(when (defmulti ~name
~@(take 1 opts)
{:arglists '([context problem])}
dispatch)
(defmethod ~name :default
[context# problem#]
(cond
(seq (::via problem#))
(~name context# (update problem# ::via rest))
(::normalized-pred problem#)
(~name context# (dissoc problem# ::normalized-pred))))
~name))

(defdictionary phrase*
"Phrases the given problem for human consumption.
Dispatches on normalized pred and optional via of problem.
Dispatches in this order:
* [normalized-pred via]
* [normalized-pred]"
{:arglists '([context problem])}
dispatch)

;; Realizes the dispatch hierarchy by removing information and calling
;; phrase again.
(defmethod phrase* :default
[context problem]
(cond
(seq (::via problem))
(phrase* context (update problem ::via rest))
(::normalized-pred problem)
(phrase* context (dissoc problem ::normalized-pred))))
* [normalized-pred]")

(defn- phrase-problem [{:keys [pred via] :as problem}]
(merge problem (normalize-pred pred) {::via via}))
Expand All @@ -65,19 +70,23 @@
Returns the phrasers return value or nil if none was found and no default
phraser is defined. Dispatches based on pred and via of the problem. See
phraser macro for details."
[context problem]
(phrase* context (phrase-problem problem)))
([context problem]
(phrase phrase* context problem))
([dictionary context problem]
(dictionary context (phrase-problem problem))))

(defn phrase-first
"Given a spec and a value x, phrases the first problem using context if any.
Returns nil if x is valid or no phraser was found. See phrase for details.
Use phrase directly if you want to phrase more than one problem."
[context spec x]
(some->> (s/explain-data spec x)
::s/problems
first
(phrase context)))
([context spec x]
(phrase-first phrase* context spec x))
([dictionary context spec x]
(some->> (s/explain-data spec x)
::s/problems
first
(phrase dictionary context))))

(defn- unfn [expr]
(if (and (seq? expr)
Expand Down Expand Up @@ -168,23 +177,24 @@
:cljs simple-symbol?)))))

(s/fdef defphraser
:args (s/cat :pred any?
:args (s/cat :dictionary any?
:pred any?
:specifiers (s/? map?)
:args ::defphraser-arg-list
:body (s/* any?)))

(defmacro defphraser
"Defines a phraser. Takes a predicate with possible capture symbols which have
to be also defined in the argument vector."
{:arglists '([pred specifiers? [context-binding-form problem-binding-form
& capture-binding-forms] & body])}
[pred & more]
{:arglists '([dictionary pred specifiers? [context-binding-form problem-binding-form
& capture-binding-forms] & body])}
[dictionary pred & more]
(let [specifiers (when (map? (first more)) (first more))
[[context-binding-form problem-binding-form & capture-binding-forms]
& body]
(if specifiers (rest more) more)]
(if (= :default pred)
`(defmethod phrase* []
`(defmethod ~dictionary []
[~context-binding-form ~problem-binding-form]
~@body)
(let [{:keys [pred mappings]} (replace-syms (res &env pred capture-binding-forms)
Expand All @@ -197,11 +207,13 @@
::mappings ::via)]
(not-empty mappings)
(conj {mappings ::mappings} problem))]
`(defmethod phrase* '~dispatch-val [~context-binding-form ~problem]
`(defmethod ~dictionary '~dispatch-val [~context-binding-form ~problem]
(let ~binding-forms
~@body))))))

(defn remove-default!
"Removes the default phraser."
[]
(remove-method phrase* []))
([]
(remove-default! phrase*))
([dictionary]
(remove-method dictionary [])))
71 changes: 38 additions & 33 deletions test/cljc/phrase/alpha_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,34 +7,38 @@
[clojure.spec.alpha :as s]
[clojure.string :as str]
[clojure.test :refer [deftest are is testing]]
[phrase.alpha :as phrase :refer [defphraser phrase-first]]))
[phrase.alpha :as phrase :refer [defdictionary defphraser phrase-first]]))

#?(:cljs (def format gstr/format))

(defdictionary dictionary)

(s/def ::age
int?)

(defphraser int?
(defphraser dictionary
int?
[_ _]
"Please enter an integer.")

(deftest int-test
(is (= "Please enter an integer." (phrase-first {} ::age "42"))))
(is (= "Please enter an integer." (phrase-first dictionary {} ::age "42"))))

(s/def ::password
#(<= 8 (count %)))

(defphraser #(<= min-length (count %))
(defphraser dictionary
#(<= min-length (count %))
[_ _ min-length]
(format "Please use at least %s chars." min-length))

(deftest password-test
(is (= "Please use at least 8 chars." (phrase-first {} ::password "1234"))))
(is (= "Please use at least 8 chars." (phrase-first dictionary {} ::password "1234"))))

(s/def ::advanced-password
#(<= 8 (count %) 256))

(defphraser #(<= min-length (count %) max-length)
(defphraser dictionary #(<= min-length (count %) max-length)
[_ {:keys [val]} min-length max-length]
(let [args (if (< (count val) min-length)
["less" "minimum" min-length]
Expand All @@ -44,111 +48,111 @@

(deftest advanced-password-test
(is (= "You entered 4 chars which is less than the minimum length of 8 chars."
(phrase-first {} ::advanced-password "1234")))
(phrase-first dictionary {} ::advanced-password "1234")))

(is (= "You entered 257 chars which is more than the maximum length of 256 chars."
(phrase-first {} ::advanced-password (apply str (repeat 257 "x"))))))
(phrase-first dictionary {} ::advanced-password (apply str (repeat 257 "x"))))))

(deftest default-test
(testing "The default is to return nil"
(is (nil? (phrase-first {} string? 1))))
(is (nil? (phrase-first dictionary {} string? 1))))

(testing "The user can define it's own default"
(defphraser :default
(defphraser dictionary :default
[_ _]
"Unknown problem.")
(is (= "Unknown problem." (phrase-first {} string? 1)))
(phrase/remove-default!)))
(is (= "Unknown problem." (phrase-first dictionary {} string? 1)))
(phrase/remove-default! dictionary)))

(s/def ::year
pos-int?)

(s/def ::date
(s/keys :req [::year]))

(defphraser pos-int?
(defphraser dictionary pos-int?
[_ _]
"Please enter a positive integer.")

(defphraser pos-int?
(defphraser dictionary pos-int?
{:via [::year]}
[_ _]
"The year has to be a positive integer.")

(deftest via-dispatching-test
(testing "The default is used for pos-int?"
(is (= "Please enter a positive integer."
(phrase-first {} (s/spec pos-int?) -1))))
(phrase-first dictionary {} (s/spec pos-int?) -1))))

(testing "Via ::year is used."
(is (= "The year has to be a positive integer."
(phrase-first {} ::year -1))))
(phrase-first dictionary {} ::year -1))))

(testing "Via ::year is also used inside ::date."
(is (= "The year has to be a positive integer."
(phrase-first {} ::date {::year -1})))))
(phrase-first dictionary {} ::date {::year -1})))))

(s/def ::identifier
#(re-matches #"[a-z][a-z0-9]*" %))

(defphraser #(re-matches re %)
(defphraser dictionary #(re-matches re %)
[_ _ re]
(format "Invalid identifier! Needs to match %s."
#?(:clj (str "/" re "/") :cljs re)))

(deftest identifier-test
(is (= "Invalid identifier! Needs to match /[a-z][a-z0-9]*/."
(phrase-first {} ::identifier "0"))))
(phrase-first dictionary {} ::identifier "0"))))

(s/def ::barcode
#(re-matches #"[0-9]+" %))

(defphraser #(re-matches #"foo" %)
(defphraser dictionary #(re-matches #"foo" %)
{:via [::barcode]}
[_ _]
"Invalid barcode.")

(deftest barcode-test
(testing "Keeping concrete values is possible, but the value itself doesn't matter."
(is (= "Invalid barcode." (phrase-first {} ::barcode "a")))))
(is (= "Invalid barcode." (phrase-first dictionary {} ::barcode "a")))))

(s/def ::underscore
#(= "_" %))

(defphraser #(= _ %)
(defphraser dictionary #(= _ %)
{:via [::underscore]}
[_ _]
"Invalid underscore.")

(deftest underscore-test
(testing "Keeping concrete values is possible, but the value itself doesn't matter."
(is (= "Invalid underscore." (phrase-first {} ::underscore "a")))))
(is (= "Invalid underscore." (phrase-first dictionary {} ::underscore "a")))))

(def via-test? int?)

(s/def ::via-test
via-test?)

(defphraser via-test?
(defphraser dictionary via-test?
[_ {:keys [via]}]
via)

(deftest via-test
(testing "via is kept"
(is (= [::via-test] (phrase-first {} ::via-test "")))))
(is (= [::via-test] (phrase-first dictionary {} ::via-test "")))))

(s/def ::complex-password
(s/and #(<= 8 (count %) 256)
#(re-find #"\d" %)
#(re-find #"[a-z]" %)
#(re-find #"[A-Z]" %)))

(defphraser #(<= lo (count %) up)
(defphraser dictionary #(<= lo (count %) up)
{:via [::complex-password]}
[_ {:keys [val]} lo up]
(format "Length has to be between %s and %s but was %s." lo up (count val)))

(defphraser #(re-find re %)
(defphraser dictionary #(re-find re %)
[_ _ re]
(format "Has to contain at least one %s."
(case (str/replace (str re) #"/" "")
Expand All @@ -159,19 +163,19 @@
(deftest complex-password-test
(testing "length"
(is (= "Length has to be between 8 and 256 but was 1."
(phrase-first {} ::complex-password "a"))))
(phrase-first dictionary {} ::complex-password "a"))))

(testing "number"
(is (= "Has to contain at least one number."
(phrase-first {} ::complex-password "aaaaaaaa"))))
(phrase-first dictionary {} ::complex-password "aaaaaaaa"))))

(testing "lowercase"
(is (= "Has to contain at least one lowercase letter."
(phrase-first {} ::complex-password "AAAAAAA1"))))
(phrase-first dictionary {} ::complex-password "AAAAAAA1"))))

(testing "uppercase"
(is (= "Has to contain at least one uppercase letter."
(phrase-first {} ::complex-password "aaaaaaa1"))))
(phrase-first dictionary {} ::complex-password "aaaaaaa1"))))

(testing "valid"
(is (s/valid? ::complex-password "aaaaaaA1"))))
Expand All @@ -182,9 +186,10 @@
(s/def ::map-with-port
(s/keys :req-un [::port]))

(defphraser #(contains? % key)
(defphraser dictionary
#(contains? % key)
[_ _ key]
(str "Missing " (name key) "."))

(deftest shadow-capture-syms-test
(is (= "Missing port." (phrase-first {} ::map-with-port {}))))
(is (= "Missing port." (phrase-first dictionary {} ::map-with-port {}))))

0 comments on commit 597b471

Please sign in to comment.