diff --git a/resources/pirate/dict.edn b/resources/pirate/dict.edn new file mode 100644 index 00000000..a2f85db9 --- /dev/null +++ b/resources/pirate/dict.edn @@ -0,0 +1,113 @@ +;; Dictionary initially lifted from +;; https://github.com/stevehodges/talk_like_a_pirate + +{"address" "port 'o call" + "admin" "helm" + "am" "be" + "an" "a" + "and" "n'" + "are" "be" + "award" "prize" + "beer" "grog" + "before" "afore" + "belief" "creed" + "between" "betwixt" + "big" "vast" + "boy" "lad" + "boys" "laddies" + "boss" "admiral" + "bourbon" "rum" + "box" "barrel" + "business" "company" + "businesses" "companies" + "calling" "callin'" + "canada" "Great North" + "cash" "doubloons" + "cheat" "hornswaggle" + "comments" "yer words" + "country" "land" + "dashboard" "shanty" + "disconnect" "keelhaul" + "do" "d'" + "dollar" "doubloon" + "dude" "pirate" + "employee" "crew" + "everyone" "all hands" + "eye" "eye-patch" + "family" "kin" + "fee" "debt" + "female" "wench" + "for" "fer" + "friend" "shipmate" + "gin" "rum" + "girl" "lass" + "girls" "lassies" + "go" "sail" + "good" "jolly good" + "group" "maties" + "hand" "hook" + "hello" "ahoy" + "hey" "ahoy" + "hotel" "inn" + "i'm" "i be" + "internet" "series o' tubes" + "invalid" "sunk" + "is" "be" + "island" "isle" + "isn't" "be not" + "it's" "'tis" + "jail" "brig" + "kill" "keelhaul" + "leg" "peg" + "lady" "lass" + "logout" "walk the plank" + "male" "brigand" + "man" "scallwag" + "manager" "admiral" + "money" "doubloons" + "month" "moon" + "my" "me" + "never" "nary" + "no" "nay" + "of" "o'" + "over" "o'er" + "page" "parchment" + "person" "pirate" + "posted" "tacked to the yardarm" + "president" "king" + "prison" "brig" + "quickly" "smartly" + "really" "verily" + "relatives" "kin" + "religion" "creed" + "role" "job" + "say" "cry" + "seconds" "ticks o' tha clock" + "shipping" "cargo" + "small" "puny" + "soldier" "sailor" + "sorry" "yarr" + "spouse" "ball 'n' chain" + "state" "land" + "supervisor" "Cap'n" + "that's" "that be" + "the" "tha" + "them" "'em" + "this" "dis" + "to" "t'" + "vodka" "rum" + "we" "our jolly crew" + "we're" "we's" + "wine" "grog" + "whiskey" "rum" + "whisky" "rum" + "with" "wit'" + "woman" "wench" + "work" "duty" + "yah" "aye" + "yeah" "aye" + "yes" "aye" + "you" "ye" + "you're" "you be" + "you've" "ye" + "your" "yer"} diff --git a/resources/pirate/flavor.edn b/resources/pirate/flavor.edn new file mode 100644 index 00000000..f2765243 --- /dev/null +++ b/resources/pirate/flavor.edn @@ -0,0 +1,35 @@ +;; Flavor initially lifted from +;; https://github.com/stevehodges/talk_like_a_pirate + +["avast" + "splice the mainbrace" + "shiver me timbers" + "ahoy" + "arrrrr" + "arrgh" + "yo ho ho" + "yarrr" + "eh" + "arrrghhh" + "arrr" + "ahoy matey" + "prepare to be boarded" + "hoist the mizzen" + "blow me down" + "swab the poop deck" + "ye landlubber" + "bring 'er alongside" + "hang 'im from the yardarm" + "blow the man down" + "let go and haul" + "heave to" + "take no prisoners" + "belay that" + "me bucko" + "lock 'im in irons" + "and a bottle 'o rum" + "and donae spare the whip" + "pass the grog" + "and swab the deck" + "fire the cannon" + "sleep with t' fishes"] diff --git a/src/yetibot/commands/pirate.clj b/src/yetibot/commands/pirate.clj new file mode 100644 index 00000000..12ac355c --- /dev/null +++ b/src/yetibot/commands/pirate.clj @@ -0,0 +1,138 @@ +(ns yetibot.commands.pirate + (:require + [yetibot.core.hooks :refer [cmd-hook]] + [clojure.java.io :as io] + [clojure.edn :as edn] + [clojure.string :as str] + [clj-time.core :as t])) + +;; TODO - Let's derive this from properties of the requesting user. I +;; think this is pretty straightforward with Slack but I have to give +;; IRC some more thought. TZ might be an input to how we sort +;; recommended locations, for Issue #740 - Weather API migration. +(def local-tz "America/New_York") + +;; TODO - We'll use this in Issue #740, too. Should probably move to +;; yetibot.core.util or similar... +(defn get-var + [resource-file] + (-> (io/resource resource-file) + slurp + edn/read-string)) + +(def dict (get-var "pirate/dict.edn")) +(def flavor (get-var "pirate/flavor.edn")) + +(defn wrap-punctuation + "Expects a fn, f, and returns a fn taking one arg: a string. We strip + trailing punctuation before calling the wrapped fn f, replacing on + the return of f." + [f] + (fn [s] + (let [[_ text punc] (re-matches #"(.*?)?([.!?,:]+)?" s)] + (str (f text) punc)))) + +(defn wrap-capitalization + "Expects a fn, f, and returns a fn taking one arg: a string. We + upper-case the first char of the return of the wrapped fn, f, if the + string had an initial upper-case char." + [f] + (fn [s] + (if (Character/isUpperCase (first s)) + (str/replace-first (f s) #"." str/upper-case) + (f s)))) + +(defn sub-word + [s] + (get dict (str/lower-case s) s)) + +(defn to-pirate + [s] + (->> (str/split s #"\b") + (map + (-> sub-word + wrap-punctuation + wrap-capitalization)) + (apply str))) + +;; +;; Add some extra flavor +;; +(defn probability + "Return probability, by hour, for configured TZ." + [] + (let [hour (-> (t/to-time-zone (t/now) (t/time-zone-for-id local-tz)) + t/hour)] + (nth (concat (repeat 8 0.95) + (repeat 8 0.25) + (repeat 8 0.75)) + hour))) + +(defn suffix-flavor + "Suffix random pirate flavor." + [s] + (let [flavor (rand-nth flavor)] + (str/replace-first s + #"[.!?]*$" + #(format ", %s%s" flavor %)))) + +(def slur-re #"[alr]") + +(defn- mk-slur-map + "Return randomly ordered v of true and nil. The number of trues is a + configurable percentage of n, plus some fuzz. The balance of n are + nils." + [n] + (let [perc 0.7 + fuzz (rand 0.3) + min-t (* perc n) + max-f (- n min-t) + t (-> (* fuzz max-f) (+ min-t) Math/round) + f (- n t)] + (shuffle (concat (repeat t true) + (repeat f nil))))) + +(defn- slurrable? + "Return s if it's slurrable, nil if not." + [s] + (if (re-find slur-re s) s nil)) + +(defn- slur-word + [s] + (str/replace s + slur-re + (fn [c] + (apply str (repeat (rand-nth [2 3]) c))))) + +(defn slurrr + "I'm not drunk, you're drunk." + [s] + (let [words (str/split s #"\b") + sm (mk-slur-map (count (filter slurrable? words)))] + (loop [[word & tail] words, sm sm, accum []] + (if (nil? word) + (apply str accum) + (if (slurrable? word) + (if (nil? (first sm)) + (recur tail (rest sm) (conj accum word)) + (recur tail (rest sm) (conj accum (slur-word word)))) + (recur tail sm (conj accum word))))))) + +(defn if-prob + "Optionally apply fn f to string s, based on probability prob." + [s f prob] + (if (< (rand) prob) + (f s) + s)) + +(defn pirate-cmd + "pirate # translate string into proper pirate, yar " + {:yb/cat #{:info}} + [{:keys [match]}] + (let [prob (probability)] + (-> (to-pirate match) + (if-prob suffix-flavor prob) + (if-prob slurrr prob)))) + +(cmd-hook #"pirate" + #".+" pirate-cmd) diff --git a/test/yetibot/test/commands/pirate.clj b/test/yetibot/test/commands/pirate.clj new file mode 100644 index 00000000..3b5bba82 --- /dev/null +++ b/test/yetibot/test/commands/pirate.clj @@ -0,0 +1,37 @@ +(ns yetibot.test.commands.pirate + (:require + [midje.sweet :refer [facts fact =>]] + [clojure.string :as str] + [yetibot.commands.pirate :refer :all])) + +(facts "about lower-level wrapper fns" + (fact "wrap-punctuation preserves punctuation even when wrapped fn alters str" + ((wrap-punctuation (fn [_] "foo")) "bar!") => "foo!") + (fact "wrap-capitalization preserves captilization when when wrapped fn lower-cases str" + ((wrap-capitalization str/lower-case) "Foo") => "Foo")) + +(fact "to-pirate translates strings, preserving captilization and punctuation" + (to-pirate "jello world") => "jello world" + (to-pirate "hello world") => "ahoy world" + (to-pirate "hello world admin") => "ahoy world helm" + (to-pirate "hello world admin!") => "ahoy world helm!" + (to-pirate "hello world admin!?.,:") => "ahoy world helm!?.,:" + (to-pirate "!?.,:") => "!?.,:" + (to-pirate "Hello world admin") => "Ahoy world helm" + (to-pirate "Hello World Admin") => "Ahoy World Helm" + (to-pirate "HeLlO WoRlD admin") => "Ahoy WoRlD helm" + (to-pirate "HeLlO WoRlD admin!!") => "Ahoy WoRlD helm!!" + (to-pirate "hello world admin") => "ahoy world helm") + +(fact "suffix-flavor suffixes something" + (suffix-flavor "foo") => #"^foo,\s+[^\s]+" + (suffix-flavor "foo.") => #"^foo,\s+.+\.$") + +(def test-str "the quick brown fox jumps over the lazy dog") + +(fact "slurrr permutes text" + (slurrr test-str) => #"([alr])\1") + +(fact "if-prob respects probability constant" + (if-prob 0 inc 0) => 0 + (if-prob 0 inc 1) => 1)