chore(owothia): move to //fun/owothia
Owothia graduates, or something. Mostly I don't want infrastructure to depend on stuff in //users. Does anyone know where owothia is running anyways? Change-Id: I198c7ac935736c7aee3ba4fbda1453b82aa10283 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3103 Tested-by: BuildkiteCI Reviewed-by: grfn <grfn@gws.fyi>
This commit is contained in:
parent
13336c6057
commit
259cbfd0b2
10 changed files with 0 additions and 0 deletions
156
fun/owothia/src/Main.hs
Normal file
156
fun/owothia/src/Main.hs
Normal file
|
@ -0,0 +1,156 @@
|
|||
{-# 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
|
||||
|
||||
vowels :: [Char]
|
||||
vowels = "aeiou"
|
||||
|
||||
article :: Text -> Text
|
||||
article (x :< _) | x `elem` vowels = "an"
|
||||
article _ = "a"
|
||||
|
||||
owo :: OwoType -> Text -> Text
|
||||
owo Noun n = mconcat
|
||||
[ "I'm "
|
||||
, article n
|
||||
, " "
|
||||
, n
|
||||
, if "o" `Data.Text.isSuffixOf` n
|
||||
then "wo"
|
||||
else " 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 ()
|
Loading…
Add table
Add a link
Reference in a new issue