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
140
141
142
143
144
|
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Network.IRC.Client
import Control.Lens
import NLP.POS
import NLP.Types (POSTagger)
import qualified NLP.Types.Tags as Tags
import NLP.Types.Tree
import qualified NLP.Corpora.Conll as Conll
import NLP.Corpora.Conll (Tag)
import qualified Data.ByteString as BS
import System.Random
import System.Envy
import Data.Maybe
import qualified Data.Text
--------------------------------------------------------------------------------
data Config = Config
{ _owoChance :: Int
, _ircServer :: ByteString
, _ircPort :: Int
, _ircServerPassword :: Maybe Text
, _nickservPassword :: Maybe Text
, _ircNick :: Maybe Text
}
deriving stock (Show, Eq, Generic)
makeLenses ''Config
instance FromEnv Config where
fromEnv _ =
Config <$> env "OWO_CHANCE"
<*> env "IRC_SERVER"
<*> env "IRC_PORT"
<*> envMaybe "IRC_SERVER_PASSWORD"
<*> envMaybe "NICKSERV_PASSWORD"
<*> envMaybe "IRC_NICK"
stopWord :: Text -> Bool
stopWord "'s" = True
stopWord "\"" = True
stopWord "is" = True
stopWord "are" = True
stopWord "am" = True
stopWord "were" = True
stopWord "was" = True
stopWord "be" = True
stopWord _ = False
pickVerb :: POS Tag -> Maybe Text
pickVerb (POS Conll.VB (Token verb)) = Just verb
pickVerb (POS Conll.VBD (Token verb)) = Just verb
pickVerb (POS Conll.VBG (Token verb)) = Just verb
pickVerb (POS Conll.VBN (Token verb)) = Just verb
pickVerb (POS Conll.VBZ (Token verb)) = Just verb
pickVerb _ = Nothing
pickNoun :: POS Tag -> Maybe Text
pickNoun (POS Conll.NN (Token noun)) = Just noun
pickNoun _ = Nothing
randomPOS
:: Tags.Tag tag
=> (POS tag -> Maybe Text)
-> POSTagger tag
-> Text
-> IO (Maybe Text)
randomPOS pickPOS tagger s = do
let candidates
= filter (not . stopWord)
. mapMaybe pickPOS
$ tag tagger s >>= \(TaggedSent ps) -> ps
i <- randomRIO (0, length candidates - 1)
pure $ candidates ^? ix i
doOwo :: MonadIO m => Config -> m Bool
doOwo conf = do
n <- liftIO (randomRIO @Int (0, conf ^. owoChance))
pure $ n == 0
data OwoType = Noun | Verb
deriving stock (Show, Eq)
instance Random OwoType where
random = over _1 (bool Noun Verb) . random
randomR = const random
owo :: OwoType -> Text -> Text
owo Noun n =
if "o" `Data.Text.isSuffixOf` n
then "I'm a " <> n <> "wo"
else "I'm a " <> n <> " owo"
owo Verb v = v <> " me owo"
pickOwo :: OwoType -> POS Tag -> Maybe Text
pickOwo Verb = pickVerb
pickOwo Noun = pickNoun
randomOwo :: OwoType -> POSTagger Tag -> Text -> IO (Maybe Text)
randomOwo = randomPOS . pickOwo
owothiaHandler :: Config -> Text -> IORef Bool -> POSTagger Tag -> EventHandler s
owothiaHandler conf nick state tagger = EventHandler Just $ \src ev -> do
hasIdentified <- readIORef state
when (not hasIdentified) $ do
nickservAuth
send $ Join "##tvl"
writeIORef state True
when ("You are now identified" `BS.isInfixOf` (ev ^. raw)) $
send $ Join "##tvl"
case (src, ev ^. message) of
(Channel "##tvl" nick, Privmsg _ (Right m)) -> do
willOwo <- doOwo conf
when willOwo $ owoMessage m
_ -> pure ()
pure ()
where
owoMessage m = do
owoType <- liftIO randomIO
mWord <- liftIO $ randomOwo owoType tagger m
for_ mWord $ \word -> send $ Privmsg "##tvl" $ Right $ owo owoType word
nickservAuthMsg = "IDENTIFY " <> nick <> " " <> fromJust (conf ^. nickservPassword)
nickservAuth = send $ Privmsg "NickServ" $ Right nickservAuthMsg
main :: IO ()
main = do
conf <- either fail pure =<< decodeEnv
tagger <- defaultTagger
state <- newIORef $ not . isJust $ (conf ^. nickservPassword)
let nick = fromMaybe "owothia" (conf ^. ircNick)
conn =
plainConnection (conf ^. ircServer) (conf ^. ircPort)
& realname .~ "Owothia Revströwö"
& password .~ (conf ^. ircServerPassword)
& logfunc .~ stdoutLogger
cfg =
defaultInstanceConfig nick
& channels .~ ["##tvl"]
& handlers %~ (owothiaHandler conf nick state tagger : )
runClient conn cfg ()
|
