feat(owothia): Add owothia r/1270

Add owothia, an irc bot that picks a random verb out of a random subset
of messages and replies with a message of the form "<verb> me owo".

it's incredibly messy, full of warnings, includes a *number* of harcoded
things, but also is hilarious.

Change-Id: I73cacd533bbbff9e753d1e542308da25247a7034
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1063
Tested-by: BuildkiteCI
Reviewed-by: lukegb <lukegb@tvl.fyi>

12 files changed, 290 insertions, 0 deletions

diff --git a/ci-builds.nix b/ci-builds.nix
index 64291f4951..8be0953a87 100644
--- a/ci-builds.nix
+++ b/ci-builds.nix
@@ -102,5 +102,6 @@ in lib.fix (self: {
     (systemFor system.system.chupacabra)
     xanthous
     keyboard.layout
+    owothia
   ];
 })
diff --git a/users/glittershark/owothia/.envrc b/users/glittershark/owothia/.envrc
new file mode 100644
index 0000000000..051d09d292
--- /dev/null
+++ b/users/glittershark/owothia/.envrc
@@ -0,0 +1 @@
+eval "$(lorri direnv)"
diff --git a/users/glittershark/owothia/.gitignore b/users/glittershark/owothia/.gitignore
new file mode 100644
index 0000000000..a2f7e636e5
--- /dev/null
+++ b/users/glittershark/owothia/.gitignore
@@ -0,0 +1,29 @@
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.hie
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/
+cabal.project.local
+cabal.project.local~
+.HTF/
+.ghc.environment.*
+
+# from nix-build
+result
+
+# grr
+*_flymake.hs
diff --git a/users/glittershark/owothia/chatter.patch b/users/glittershark/owothia/chatter.patch
new file mode 100644
index 0000000000..c2a6179bfb
--- /dev/null
+++ b/users/glittershark/owothia/chatter.patch
@@ -0,0 +1,19 @@
+diff --git a/src/NLP/POS/LiteralTagger.hs b/src/NLP/POS/LiteralTagger.hs
+index 913bee8..3c2f71d 100644
+--- a/src/NLP/POS/LiteralTagger.hs
++++ b/src/NLP/POS/LiteralTagger.hs
+@@ -1,4 +1,4 @@
+-{-# LANGUAGE OverloadedStrings #-}
++{-# LANGUAGE OverloadedStrings, PackageImports #-}
+ module NLP.POS.LiteralTagger
+     ( tag
+     , tagSentence
+@@ -27,7 +27,7 @@ import NLP.FullStop (segment)
+ import NLP.Types ( tagUNK, Sentence, TaggedSentence(..), applyTags
+                  , Tag, POSTagger(..), CaseSensitive(..), tokens, showTok)
+ import Text.Regex.TDFA
+-import Text.Regex.TDFA.Text (compile)
++import "regex-tdfa" Text.Regex.TDFA.Text (compile)
+ 
+ taggerID :: ByteString
+ taggerID = pack "NLP.POS.LiteralTagger"
diff --git a/users/glittershark/owothia/default.nix b/users/glittershark/owothia/default.nix
new file mode 100644
index 0000000000..2a1b37800b
--- /dev/null
+++ b/users/glittershark/owothia/default.nix
@@ -0,0 +1,6 @@
+{ pkgs ? (import ../../../. {}).third_party
+, lib ? pkgs.lib
+, ...
+}:
+
+(import ./packageSet.nix {}).callPackage (import ./pkg.nix { inherit pkgs; }) {}
diff --git a/users/glittershark/owothia/hie.yaml b/users/glittershark/owothia/hie.yaml
new file mode 100644
index 0000000000..16a6c15262
--- /dev/null
+++ b/users/glittershark/owothia/hie.yaml
@@ -0,0 +1,4 @@
+cradle:
+  cabal:
+    - path: './app'
+      component: 'exe:owothia'
diff --git a/users/glittershark/owothia/owothia.cabal b/users/glittershark/owothia/owothia.cabal
new file mode 100644
index 0000000000..63c438fb8a
--- /dev/null
+++ b/users/glittershark/owothia/owothia.cabal
@@ -0,0 +1,53 @@
+cabal-version:       2.2
+name:                owothia
+version:             0.0.1.0
+
+executable owothia
+  main-is:             Main.hs
+  build-depends:       base
+                     , relude ^>= 0.6.0.0
+                     , irc-client
+                     , lens
+                     , chatter
+                     , containers
+                     , text
+                     , bytestring
+                     , random
+                     , envy
+
+  mixins:              base hiding (Prelude)
+                     , relude (Relude as Prelude)
+
+  hs-source-dirs:
+    src
+
+  default-extensions:
+    BlockArguments
+    ConstraintKinds
+    DataKinds
+    DeriveAnyClass
+    DeriveGeneric
+    DerivingStrategies
+    DerivingVia
+    FlexibleContexts
+    FlexibleInstances
+    FunctionalDependencies
+    GADTSyntax
+    GeneralizedNewtypeDeriving
+    KindSignatures
+    LambdaCase
+    MultiWayIf
+    NoStarIsType
+    OverloadedStrings
+    PolyKinds
+    RankNTypes
+    ScopedTypeVariables
+    TupleSections
+    TypeApplications
+    TypeFamilies
+    TypeOperators
+    ViewPatterns
+
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2
+
+  default-language:    Haskell2010
diff --git a/users/glittershark/owothia/packageSet.nix b/users/glittershark/owothia/packageSet.nix
new file mode 100644
index 0000000000..93812a0830
--- /dev/null
+++ b/users/glittershark/owothia/packageSet.nix
@@ -0,0 +1,20 @@
+{ pkgs ? (import ../../../. {}).third_party, ... }:
+
+let
+
+  hlib = pkgs.haskell.lib;
+
+in
+
+pkgs.haskellPackages.extend (self: super: {
+  regex-tdfa-text = hlib.doJailbreak
+    (hlib.appendPatch
+      super.regex-tdfa-text
+      ./regex-tdfa-text.patch
+    );
+
+  fullstop = hlib.dontCheck super.fullstop;
+
+  chatter = hlib.doJailbreak
+    (hlib.dontCheck (hlib.appendPatch super.chatter ./chatter.patch));
+})
diff --git a/users/glittershark/owothia/pkg.nix b/users/glittershark/owothia/pkg.nix
new file mode 100644
index 0000000000..ef99d4d651
--- /dev/null
+++ b/users/glittershark/owothia/pkg.nix
@@ -0,0 +1,6 @@
+args@{ pkgs ? (import ../../../. {}).third_party }:
+
+import ((import ./packageSet.nix args).haskellSrc2nix {
+  name = "owothia";
+  src = pkgs.gitignoreSource ./.;
+})
diff --git a/users/glittershark/owothia/regex-tdfa-text.patch b/users/glittershark/owothia/regex-tdfa-text.patch
new file mode 100644
index 0000000000..6b2c346543
--- /dev/null
+++ b/users/glittershark/owothia/regex-tdfa-text.patch
@@ -0,0 +1,40 @@
+diff --git a/Text/Regex/TDFA/Text.hs b/Text/Regex/TDFA/Text.hs
+index c4ef9db..9299272 100644
+--- a/Text/Regex/TDFA/Text.hs
++++ b/Text/Regex/TDFA/Text.hs
+@@ -38,13 +38,6 @@ import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))
+ import qualified Text.Regex.TDFA.NewDFA.Engine as Engine(execMatch)
+ import qualified Text.Regex.TDFA.NewDFA.Tester as Tester(matchTest)
+ 
+-instance Extract T.Text where
+-  before = T.take; after = T.drop; empty = T.empty
+-
+-instance Uncons T.Text where
+-  {- INLINE uncons #-}
+-  uncons = T.uncons
+-
+ instance RegexContext Regex T.Text T.Text where
+   match = polymatch
+   matchM = polymatchM
+diff --git a/Text/Regex/TDFA/Text/Lazy.hs b/Text/Regex/TDFA/Text/Lazy.hs
+index 73ca4a0..52958fb 100644
+--- a/Text/Regex/TDFA/Text/Lazy.hs
++++ b/Text/Regex/TDFA/Text/Lazy.hs
+@@ -38,17 +38,10 @@ import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))
+ import qualified Text.Regex.TDFA.NewDFA.Engine as Engine(execMatch)
+ import qualified Text.Regex.TDFA.NewDFA.Tester as Tester(matchTest)
+ 
+-instance Extract L.Text where
+-  before = L.take . toEnum; after = L.drop . toEnum; empty = L.empty
+-
+ instance RegexContext Regex L.Text L.Text where
+   match = polymatch
+   matchM = polymatchM
+ 
+-instance Uncons L.Text where
+-  {- INLINE uncons #-}
+-  uncons = L.uncons
+-
+ instance RegexMaker Regex CompOption ExecOption L.Text where
+   makeRegexOptsM c e source = makeRegexOptsM c e (L.unpack source)
+ 
diff --git a/users/glittershark/owothia/shell.nix b/users/glittershark/owothia/shell.nix
new file mode 100644
index 0000000000..9446a353d5
--- /dev/null
+++ b/users/glittershark/owothia/shell.nix
@@ -0,0 +1,14 @@
+args@{ pkgs ? (import ../../../. {}).third_party, ... }:
+
+((import ./packageSet.nix args).extend (pkgs.haskell.lib.packageSourceOverrides {
+  owothia = pkgs.gitignoreSource ./.;
+})).shellFor {
+  packages = p: [p.owothia];
+  withHoogle = true;
+  doBenchmark = true;
+  buildInputs = with pkgs.haskellPackages; [
+    cabal-install
+    hlint
+    pkgs.haskell-language-server.ghc883
+  ];
+}
diff --git a/users/glittershark/owothia/src/Main.hs b/users/glittershark/owothia/src/Main.hs
new file mode 100644
index 0000000000..315f07492b
--- /dev/null
+++ b/users/glittershark/owothia/src/Main.hs
@@ -0,0 +1,97 @@
+{-# 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.Types.Tree
+import qualified NLP.Corpora.Conll as Conll
+import           NLP.Corpora.Conll (Tag)
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+import           System.Random
+import           System.Envy
+--------------------------------------------------------------------------------
+
+data Config = Config
+  { _nickservPassword :: Text
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (FromEnv)
+makeLenses ''Config
+
+verbs :: POSTagger Tag -> Text -> [Text]
+verbs tagger s = 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")
+
+owoChance = 10
+
+doOwo :: MonadIO m => m Bool
+doOwo = do
+  n <- liftIO (randomRIO @Int (0, owoChance))
+  liftIO $ putStrLn $ "rolled " <> show n
+  pure $ n == 0
+
+owothiaHandler :: Config -> IORef Bool -> POSTagger Tag -> EventHandler s
+owothiaHandler conf 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
+      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 " <> myNick <> " " <> conf ^. nickservPassword
+    nickservAuth = send $ Privmsg "NickServ" $ Right nickservAuthMsg
+
+myNick :: Text
+myNick = "owothia"
+
+run :: ByteString -> Int -> IO ()
+run host port = do
+  Right conf <- decodeEnv
+  tagger <- defaultTagger
+  state <- newIORef False
+  let conn =
+        plainConnection host port
+          & logfunc .~ stdoutLogger
+      cfg =
+        defaultInstanceConfig myNick
+          & channels .~ ["##tvl"]
+          & handlers %~ (owothiaHandler conf state tagger : )
+  runClient conn cfg ()
+
+main :: IO ()
+main = do
+  run "irc.freenode.net" 6667