diff --git a/ci-builds.nix b/ci-builds.nix index 64291f495..8be0953a8 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 000000000..051d09d29 --- /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 000000000..a2f7e636e --- /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 000000000..c2a6179bf --- /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 000000000..2a1b37800 --- /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 000000000..16a6c1526 --- /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 000000000..63c438fb8 --- /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 000000000..93812a083 --- /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 000000000..ef99d4d65 --- /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 000000000..6b2c34654 --- /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 000000000..9446a353d --- /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 000000000..315f07492 --- /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