about summary refs log tree commit diff
path: root/users/glittershark/owothia/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/glittershark/owothia/src/Main.hs')
-rw-r--r--users/glittershark/owothia/src/Main.hs156
1 files changed, 0 insertions, 156 deletions
diff --git a/users/glittershark/owothia/src/Main.hs b/users/glittershark/owothia/src/Main.hs
deleted file mode 100644
index 65578f258c1a..000000000000
--- a/users/glittershark/owothia/src/Main.hs
+++ /dev/null
@@ -1,156 +0,0 @@
-{-# 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 ()