From 259cbfd0b271990639b0a02d83453acc0c18da1c Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Tue, 11 May 2021 15:46:03 +0200 Subject: chore(owothia): move to //fun/owothia Owothia graduates, or something. Mostly I don't want infrastructure to depend on stuff in //users. Does anyone know where owothia is running anyways? Change-Id: I198c7ac935736c7aee3ba4fbda1453b82aa10283 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3103 Tested-by: BuildkiteCI Reviewed-by: grfn --- fun/owothia/.envrc | 1 + fun/owothia/.gitignore | 30 ++++++++ fun/owothia/chatter.patch | 19 +++++ fun/owothia/default.nix | 12 +++ fun/owothia/hie.yaml | 4 + fun/owothia/owothia.cabal | 53 +++++++++++++ fun/owothia/pkg.nix | 16 ++++ fun/owothia/regex-tdfa-text.patch | 40 ++++++++++ fun/owothia/shell.nix | 22 ++++++ fun/owothia/src/Main.hs | 156 ++++++++++++++++++++++++++++++++++++++ 10 files changed, 353 insertions(+) create mode 100644 fun/owothia/.envrc create mode 100644 fun/owothia/.gitignore create mode 100644 fun/owothia/chatter.patch create mode 100644 fun/owothia/default.nix create mode 100644 fun/owothia/hie.yaml create mode 100644 fun/owothia/owothia.cabal create mode 100644 fun/owothia/pkg.nix create mode 100644 fun/owothia/regex-tdfa-text.patch create mode 100644 fun/owothia/shell.nix create mode 100644 fun/owothia/src/Main.hs (limited to 'fun') diff --git a/fun/owothia/.envrc b/fun/owothia/.envrc new file mode 100644 index 0000000000..051d09d292 --- /dev/null +++ b/fun/owothia/.envrc @@ -0,0 +1 @@ +eval "$(lorri direnv)" diff --git a/fun/owothia/.gitignore b/fun/owothia/.gitignore new file mode 100644 index 0000000000..8e850e7a0a --- /dev/null +++ b/fun/owothia/.gitignore @@ -0,0 +1,30 @@ +dist +dist-* +build/ +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/fun/owothia/chatter.patch b/fun/owothia/chatter.patch new file mode 100644 index 0000000000..c2a6179bfb --- /dev/null +++ b/fun/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/fun/owothia/default.nix b/fun/owothia/default.nix new file mode 100644 index 0000000000..b70d0525c1 --- /dev/null +++ b/fun/owothia/default.nix @@ -0,0 +1,12 @@ +{ depot ? (import ../../../. {}) +, pkgs ? depot.third_party.nixpkgs +, ... }: + +let + basePkg = pkgs.haskellPackages.callPackage ./pkg.nix { }; +in + +pkgs.haskell.lib.overrideSrc basePkg { + src = depot.third_party.gitignoreSource ./.; + version = "canon"; +} diff --git a/fun/owothia/hie.yaml b/fun/owothia/hie.yaml new file mode 100644 index 0000000000..16a6c15262 --- /dev/null +++ b/fun/owothia/hie.yaml @@ -0,0 +1,4 @@ +cradle: + cabal: + - path: './app' + component: 'exe:owothia' diff --git a/fun/owothia/owothia.cabal b/fun/owothia/owothia.cabal new file mode 100644 index 0000000000..ef5477ea1b --- /dev/null +++ b/fun/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 + , 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/fun/owothia/pkg.nix b/fun/owothia/pkg.nix new file mode 100644 index 0000000000..d0941a8489 --- /dev/null +++ b/fun/owothia/pkg.nix @@ -0,0 +1,16 @@ +{ mkDerivation, base, bytestring, chatter, containers, envy +, irc-client, lens, lib, random, relude, text +}: +mkDerivation { + pname = "owothia"; + version = "0.0.1.0"; + src = ./.; + isLibrary = false; + isExecutable = true; + executableHaskellDepends = [ + base bytestring chatter containers envy irc-client lens random + relude text + ]; + license = "unknown"; + hydraPlatforms = lib.platforms.none; +} diff --git a/fun/owothia/regex-tdfa-text.patch b/fun/owothia/regex-tdfa-text.patch new file mode 100644 index 0000000000..6b2c346543 --- /dev/null +++ b/fun/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/fun/owothia/shell.nix b/fun/owothia/shell.nix new file mode 100644 index 0000000000..1ad70c907b --- /dev/null +++ b/fun/owothia/shell.nix @@ -0,0 +1,22 @@ +{ pkgs ? (import ../../../. {}).third_party, ... }: + +let + inherit (pkgs) + haskellPackages + haskell + gitignoreSource + ; +in + +(haskellPackages.extend (haskell.lib.packageSourceOverrides { + owothia = gitignoreSource ./.; +})).shellFor { + packages = p: [ p.owothia ]; + withHoogle = true; + doBenchmark = true; + buildInputs = with haskellPackages; [ + cabal-install + hlint + haskell-language-server + ]; +} diff --git a/fun/owothia/src/Main.hs b/fun/owothia/src/Main.hs new file mode 100644 index 0000000000..65578f258c --- /dev/null +++ b/fun/owothia/src/Main.hs @@ -0,0 +1,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 () -- cgit 1.4.1