path: root/users/glittershark/owothia/src/Main.hs

{-# 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 "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 ()