diff options
author | Griffin Smith <grfn@gws.fyi> | 2020-07-12T01·32-0400 |
---|---|---|
committer | glittershark <grfn@gws.fyi> | 2020-07-13T17·31+0000 |
commit | 2eb90cbca1c5a45243008912684cd9ea71d304c6 (patch) | |
tree | c0426248df4b5e4c6741c65647d2acee68b479e7 /users/glittershark/owothia/src | |
parent | 7e0b2cd3f36fd1bd0ef8fc0191f5887792c6d3a6 (diff) |
feat(owothia): Add owothia r/1270
Add owothia, an irc bot that picks a random verb out of a random subset of messages and replies with a message of the form "<verb> me owo". it's incredibly messy, full of warnings, includes a *number* of harcoded things, but also is hilarious. Change-Id: I73cacd533bbbff9e753d1e542308da25247a7034 Reviewed-on: https://cl.tvl.fyi/c/depot/+/1063 Tested-by: BuildkiteCI Reviewed-by: lukegb <lukegb@tvl.fyi>
Diffstat (limited to 'users/glittershark/owothia/src')
-rw-r--r-- | users/glittershark/owothia/src/Main.hs | 97 |
1 files changed, 97 insertions, 0 deletions
diff --git a/users/glittershark/owothia/src/Main.hs b/users/glittershark/owothia/src/Main.hs new file mode 100644 index 000000000000..315f07492b94 --- /dev/null +++ b/users/glittershark/owothia/src/Main.hs @@ -0,0 +1,97 @@ +{-# 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.Types.Tree +import qualified NLP.Corpora.Conll as Conll +import NLP.Corpora.Conll (Tag) +import qualified Data.ByteString as BS +import qualified Data.Text as T +import System.Random +import System.Envy +-------------------------------------------------------------------------------- + +data Config = Config + { _nickservPassword :: Text + } + 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") + +owoChance = 10 + +doOwo :: MonadIO m => m Bool +doOwo = do + n <- liftIO (randomRIO @Int (0, 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 + 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 = do + run "irc.freenode.net" 6667 |