-
Notifications
You must be signed in to change notification settings - Fork 65
/
pirate.clj
139 lines (122 loc) 路 3.73 KB
/
pirate.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
(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
#"([.!?]*)\s*$"
(fn [[_ punc]]
(format ", %s%s" flavor punc)))))
(def slur-re #"[alr](?![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.45
fuzz (rand 0.5)
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)