mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat(owothia): I'm a noun, owo

Browse source 
Change-Id: I793c2c011a12c82d45fab6f72a9578ee07878762
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1501
Tested-by: BuildkiteCI
Reviewed-by: eta <eta@theta.eu.org>
This commit is contained in:
Griffin Smith 2020-07-31 11:17:34 -04:00 • committed by glittershark
parent 37540b3ed7
commit d671195c3b
1 changed files with 45 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
users/glittershark/owothia/src/Main.hs
View file

@ -5,6 +5,7 @@ import Network.IRC.Client
import Control.Lens import Control.Lens
import NLP.POS import NLP.POS
import NLP.Types (POSTagger) import NLP.Types (POSTagger)
import qualified NLP.Types.Tags as Tags
import NLP.Types.Tree import NLP.Types.Tree
import qualified NLP.Corpora.Conll as Conll import qualified NLP.Corpora.Conll as Conll
import NLP.Corpora.Conll (Tag) import NLP.Corpora.Conll (Tag)
@ -45,34 +46,55 @@ stopWord "was" = True
stopWord "be" = True stopWord "be" = True
stopWord _ = False stopWord _ = False
verbs :: POSTagger Tag -> Text -> [Text] pickVerb :: POS Tag -> Maybe Text
verbs tagger s pickVerb (POS Conll.VB (Token verb)) = Just verb
= filter (not . stopWord) pickVerb (POS Conll.VBD (Token verb)) = Just verb
. mapMaybe pickVerb pickVerb (POS Conll.VBG (Token verb)) = Just verb
$ tag tagger s >>= \(TaggedSent ps) -> ps pickVerb (POS Conll.VBN (Token verb)) = Just verb
where pickVerb (POS Conll.VBZ (Token verb)) = Just verb
pickVerb (POS Conll.VB (Token verb)) = Just verb pickVerb _ = Nothing
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) pickNoun :: POS Tag -> Maybe Text
randomVerb tagger txt = do pickNoun (POS Conll.NN (Token noun)) = Just noun
let vs = verbs tagger txt pickNoun _ = Nothing
i <- randomRIO (0, length vs - 1)
pure $ vs ^? ix i
owo :: Text -> Text randomPOS
owo = (<> " me owo") :: 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 :: MonadIO m => Config -> m Bool
doOwo conf = do doOwo conf = do
n <- liftIO (randomRIO @Int (0, conf ^. owoChance)) n <- liftIO (randomRIO @Int (0, conf ^. owoChance))
liftIO $ putStrLn $ "rolled " <> show n
pure $ n == 0 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 = "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 :: Config -> Text -> IORef Bool -> POSTagger Tag -> EventHandler s
owothiaHandler conf nick state tagger = EventHandler Just $ \src ev -> do owothiaHandler conf nick state tagger = EventHandler Just $ \src ev -> do
hasIdentified <- readIORef state hasIdentified <- readIORef state
@ -94,8 +116,9 @@ owothiaHandler conf nick state tagger = EventHandler Just $ \src ev -> do
where where
owoMessage m = do owoMessage m = do
mVerb <- liftIO $ randomVerb tagger m owoType <- liftIO randomIO
for_ mVerb $ \verb -> send $ Privmsg "##tvl" $ Right $ owo verb mWord <- liftIO $ randomOwo owoType tagger m
for_ mWord $ \word -> send $ Privmsg "##tvl" $ Right $ owo owoType word
nickservAuthMsg = "IDENTIFY " <> nick <> " " <> fromJust (conf ^. nickservPassword) nickservAuthMsg = "IDENTIFY " <> nick <> " " <> fromJust (conf ^. nickservPassword)
nickservAuth = send $ Privmsg "NickServ" $ Right nickservAuthMsg nickservAuth = send $ Privmsg "NickServ" $ Right nickservAuthMsg