Avast ye string handlers

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"}

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"]

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 <string> # translate string into proper pirate, yar <string>"
+  {: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)

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)