Browse files

arbitrary predicate support

  • Loading branch information...
1 parent 68dfced commit 26653f29bb127af81e97e1c313886379bc0664e9 @hiredman committed Nov 1, 2009
Showing with 24 additions and 5 deletions.
  1. +24 −5 hiredman/clojurebot/factoids.clj
View
29 hiredman/clojurebot/factoids.clj
@@ -30,11 +30,26 @@
(def indexed-lookup (fp/semantics (fp/conc literal spaces (fp/lit \[) number (fp/lit \]) spaces (fp/semantics text (partial apply str))) (fn [[_ _ _ number _ _ term]] (vary-meta {:number number :term term} assoc :type :indexed-look-up))))
(def index-count (fp/semantics (fp/conc literal spaces (fp/lit \[) (fp/lit \?) (fp/lit \]) spaces (fp/semantics text (partial apply str))) (fn [[_ _ _ number _ _ term]] (vary-meta {:term term} assoc :type :count))))
(def index (fp/alt index-count indexed-lookup))
+
+(def predicate (fp/semantics (fp/conc (fp/lit \|) (fp/rep+ (fp/except character (fp/lit \|))) (fp/conc (fp/lit \|)))
+ (fn [[_ pred _]] (.trim (apply str pred)))))
+
+(def subject (fp/semantics (fp/rep+ (fp/except character (fp/lit \|)))
+ (fn [d] (.trim (apply str d)))))
+
+(def object (fp/semantics (fp/rep+ character)
+ (fn [o] (.trim (apply str o)))))
+
+(def predicate-style-definition (fp/semantics (fp/conc subject predicate object)
+ (fn [[subject predicate object]]
+ #^{:type :predicate-style-definition}
+ {:subject subject :object object :predicate predicate})))
+
;;END GARBAGE
;;parse a string into some kind of factoid related something or other
;;takes arguments in the style of fnparse {:remainder (seq some-string)}
-(def factoid-command (fp/alt index-count indexed-lookup definition-add definition))
+(def factoid-command (fp/alt index-count indexed-lookup definition-add definition predicate-style-definition))
;;this should be ditched
(defn simple-lookup [term]
@@ -76,6 +91,10 @@
(trip/store-triple (trip/derby (db-name (:bot (meta bag)))) {:s (:term bag) :o (:definition bag) :p "is"})
(core/new-send-out (:bot (meta bag)) :msg (:message (meta bag)) (core/ok)))
+(defmethod factoid-command-processor :predicate-style-definition [bag]
+ (trip/store-triple (trip/derby (db-name (:bot (meta bag)))) {:s (:subject bag) :o (:object bag) :p (:predicate bag)})
+ (core/new-send-out (:bot (meta bag)) :msg (:message (meta bag)) (core/ok)))
+
;;(defmethod factoid-command-processor :def-add [bag]
;; (trip/store-triple (trip/derby (db-name (:bot (meta bag)))) {:s (:term bag) :o (:definition bag) :p "is"})
;; (core/new-send-out (:bot (meta bag)) :msg (:message (meta bag)) (core/ok)))
@@ -105,11 +124,11 @@
(defn prep-reply
"preps a reply, does substituion of stuff like <reply> and #who"
- [sender term defi bot]
+ [sender term pred defi bot]
(replace-with
(if (re-find #"^<reply>" defi)
(.trim (core/remove-from-beginning (str defi) "<reply>"))
- (str term " is " defi))
+ (format "%s %s %s" term pred defi))
{"#who" sender "#someone" (core/random-person bot)}))
;(core/remove-dispatch-hook ::lookup)
@@ -119,15 +138,15 @@
(defmethod befuddled-or-pick-random false [x]
(-> x
((fn [x] (x (rand-int (count x)))))
- ((fn [{:keys [subject object predicate]}] (prep-reply (:sender (:msg (meta x))) subject object (:bot (meta x)))))))
+ ((fn [{:keys [subject object predicate]}] (prep-reply (:sender (:msg (meta x))) subject predicate object (:bot (meta x)))))))
(defmethod befuddled-or-pick-random true [x] (core/befuddled))
(core/defresponder ::lookup 20
(core/dfn (and (:addressed? (meta msg)) (not (:quit msg))))
(-> (core/extract-message bot msg)
fuzzer
- ((partial mapcat #(trip/query (trip/derby (db-name bot)) % "is" :y)))
+ ((partial mapcat #(trip/query (trip/derby (db-name bot)) % :x :y)))
vec
(vary-meta assoc :msg msg :bot bot)
befuddled-or-pick-random

0 comments on commit 26653f2

Please sign in to comment.