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 +++++++++++++++++++++++++++++++ users/grfn/owothia/.envrc | 1 - users/grfn/owothia/.gitignore | 30 ------ users/grfn/owothia/chatter.patch | 19 ---- users/grfn/owothia/default.nix | 12 --- users/grfn/owothia/hie.yaml | 4 - users/grfn/owothia/owothia.cabal | 53 ----------- users/grfn/owothia/pkg.nix | 16 ---- users/grfn/owothia/regex-tdfa-text.patch | 40 -------- users/grfn/owothia/shell.nix | 22 ----- users/grfn/owothia/src/Main.hs | 156 ------------------------------- 20 files changed, 353 insertions(+), 353 deletions(-) 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 delete mode 100644 users/grfn/owothia/.envrc delete mode 100644 users/grfn/owothia/.gitignore delete mode 100644 users/grfn/owothia/chatter.patch delete mode 100644 users/grfn/owothia/default.nix delete mode 100644 users/grfn/owothia/hie.yaml delete mode 100644 users/grfn/owothia/owothia.cabal delete mode 100644 users/grfn/owothia/pkg.nix delete mode 100644 users/grfn/owothia/regex-tdfa-text.patch delete mode 100644 users/grfn/owothia/shell.nix delete mode 100644 users/grfn/owothia/src/Main.hs 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 () diff --git a/users/grfn/owothia/.envrc b/users/grfn/owothia/.envrc deleted file mode 100644 index 051d09d292..0000000000 --- a/users/grfn/owothia/.envrc +++ /dev/null @@ -1 +0,0 @@ -eval "$(lorri direnv)" diff --git a/users/grfn/owothia/.gitignore b/users/grfn/owothia/.gitignore deleted file mode 100644 index 8e850e7a0a..0000000000 --- a/users/grfn/owothia/.gitignore +++ /dev/null @@ -1,30 +0,0 @@ -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/users/grfn/owothia/chatter.patch b/users/grfn/owothia/chatter.patch deleted file mode 100644 index c2a6179bfb..0000000000 --- a/users/grfn/owothia/chatter.patch +++ /dev/null @@ -1,19 +0,0 @@ -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/grfn/owothia/default.nix b/users/grfn/owothia/default.nix deleted file mode 100644 index b70d0525c1..0000000000 --- a/users/grfn/owothia/default.nix +++ /dev/null @@ -1,12 +0,0 @@ -{ 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/users/grfn/owothia/hie.yaml b/users/grfn/owothia/hie.yaml deleted file mode 100644 index 16a6c15262..0000000000 --- a/users/grfn/owothia/hie.yaml +++ /dev/null @@ -1,4 +0,0 @@ -cradle: - cabal: - - path: './app' - component: 'exe:owothia' diff --git a/users/grfn/owothia/owothia.cabal b/users/grfn/owothia/owothia.cabal deleted file mode 100644 index ef5477ea1b..0000000000 --- a/users/grfn/owothia/owothia.cabal +++ /dev/null @@ -1,53 +0,0 @@ -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/users/grfn/owothia/pkg.nix b/users/grfn/owothia/pkg.nix deleted file mode 100644 index d0941a8489..0000000000 --- a/users/grfn/owothia/pkg.nix +++ /dev/null @@ -1,16 +0,0 @@ -{ 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/users/grfn/owothia/regex-tdfa-text.patch b/users/grfn/owothia/regex-tdfa-text.patch deleted file mode 100644 index 6b2c346543..0000000000 --- a/users/grfn/owothia/regex-tdfa-text.patch +++ /dev/null @@ -1,40 +0,0 @@ -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/grfn/owothia/shell.nix b/users/grfn/owothia/shell.nix deleted file mode 100644 index 1ad70c907b..0000000000 --- a/users/grfn/owothia/shell.nix +++ /dev/null @@ -1,22 +0,0 @@ -{ 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/users/grfn/owothia/src/Main.hs b/users/grfn/owothia/src/Main.hs deleted file mode 100644 index 65578f258c..0000000000 --- a/users/grfn/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 () -- cgit 1.4.1