blob: 941c9adfc378416096cebca7d50702b2ef7822da (
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
{-# 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
import Data.Maybe
--------------------------------------------------------------------------------
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
verbs :: POSTagger Tag -> Text -> [Text]
verbs tagger s
= filter (not . stopWord)
. 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 -> 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
mVerb <- liftIO $ randomVerb tagger m
for_ mVerb $ \verb -> send $ Privmsg "##tvl" $ Right $ owo verb
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 ()
|
