11 files changed, 349 insertions, 0 deletions
diff --git a/users/glittershark/owothia/.envrc b/users/glittershark/owothia/.envrc
new file mode 100644
index 000000000000..051d09d292a8
--- /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 000000000000..8e850e7a0af2
--- /dev/null
+++ b/users/glittershark/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/users/glittershark/owothia/chatter.patch b/users/glittershark/owothia/chatter.patch
new file mode 100644
index 000000000000..c2a6179bfbbf
--- /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 000000000000..2a1b37800b0d
--- /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 000000000000..16a6c1526259
--- /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 000000000000..ef5477ea1bf2
--- /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
+                     , 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 000000000000..93812a08302d
--- /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 000000000000..ef99d4d6518f
--- /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 000000000000..6b2c34654382
--- /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 000000000000..9446a353d5f9
--- /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 000000000000..65578f258c1a
--- /dev/null
+++ b/users/glittershark/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 ()