about summary refs log tree commit diff
path: root/users/glittershark/owothia/src/Main.hs
blob: 65578f258c1a174b36febe2907464d5d934175d0 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
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 ()