feat(owothia): Add owothia

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>
This commit is contained in:
Griffin Smith 2020-07-11 21:32:12 -04:00 committed by glittershark
parent 7e0b2cd3f3
commit 2eb90cbca1
12 changed files with 290 additions and 0 deletions

View file

@ -102,5 +102,6 @@ in lib.fix (self: {
(systemFor system.system.chupacabra)
xanthous
keyboard.layout
owothia
];
})

View file

@ -0,0 +1 @@
eval "$(lorri direnv)"

29
users/glittershark/owothia/.gitignore vendored Normal file
View file

@ -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

View file

@ -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"

View file

@ -0,0 +1,6 @@
{ pkgs ? (import ../../../. {}).third_party
, lib ? pkgs.lib
, ...
}:
(import ./packageSet.nix {}).callPackage (import ./pkg.nix { inherit pkgs; }) {}

View file

@ -0,0 +1,4 @@
cradle:
cabal:
- path: './app'
component: 'exe:owothia'

View file

@ -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

View file

@ -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));
})

View file

@ -0,0 +1,6 @@
args@{ pkgs ? (import ../../../. {}).third_party }:
import ((import ./packageSet.nix args).haskellSrc2nix {
name = "owothia";
src = pkgs.gitignoreSource ./.;
})

View file

@ -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)

View file

@ -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
];
}

View file

@ -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