blob: 9c6ec529e15f58283f7267310edcee5d7997a59b (
plain) (
blame)
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
|
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Network.IRC.Client
import Control.Lens
import NLP.POS
import NLP.Types (POSTagger)
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
--------------------------------------------------------------------------------
data Config = Config
{ _nickservPassword :: Text
, _owoChance :: Int
}
deriving stock (Show, Eq, Generic)
deriving anyclass (FromEnv)
makeLenses ''Config
verbs :: POSTagger Tag -> Text -> [Text]
verbs tagger s = mapMaybe pickVerb $ tag tagger s >>= \(TaggedSent ps) -> ps
where
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
randomVerb :: POSTagger Tag -> Text -> IO (Maybe Text)
randomVerb tagger txt = do
let vs = verbs tagger txt
i <- randomRIO (0, length vs - 1)
pure $ vs ^? ix i
owo :: Text -> Text
owo = (<> " me owo")
doOwo :: MonadIO m => Config -> m Bool
doOwo conf = do
n <- liftIO (randomRIO @Int (0, conf ^. owoChance))
liftIO $ putStrLn $ "rolled " <> show n
pure $ n == 0
owothiaHandler :: Config -> IORef Bool -> POSTagger Tag -> EventHandler s
owothiaHandler conf 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
mVerb <- liftIO $ randomVerb tagger m
for_ mVerb $ \verb -> send $ Privmsg "##tvl" $ Right $ owo verb
nickservAuthMsg = "IDENTIFY " <> myNick <> " " <> conf ^. nickservPassword
nickservAuth = send $ Privmsg "NickServ" $ Right nickservAuthMsg
myNick :: Text
myNick = "owothia"
run :: ByteString -> Int -> IO ()
run host port = do
Right conf <- decodeEnv
tagger <- defaultTagger
state <- newIORef False
let conn =
plainConnection host port
& logfunc .~ stdoutLogger
cfg =
defaultInstanceConfig myNick
& channels .~ ["##tvl"]
& handlers %~ (owothiaHandler conf state tagger : )
runClient conn cfg ()
main :: IO ()
main = run "irc.freenode.net" 6667
|
