diff options
| author | LLLL Colonq <llll@colonq> | 2023-11-16 19:06:43 -0500 |
|---|---|---|
| committer | LLLL Colonq <llll@colonq> | 2023-11-16 19:06:43 -0500 |
| commit | dcef0b65069fb38fd0f6c4382353167f603ebff1 (patch) | |
| tree | 45954ffe308c3dd056e6af4f734e6d2af89e5856 /fig-bridge-irc-discord | |
Initial commit
Diffstat (limited to 'fig-bridge-irc-discord')
| -rw-r--r-- | fig-bridge-irc-discord/fig-bridge-irc-discord.cabal | 47 | ||||
| -rw-r--r-- | fig-bridge-irc-discord/main/Main.hs | 25 | ||||
| -rw-r--r-- | fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs | 32 |
3 files changed, 104 insertions, 0 deletions
diff --git a/fig-bridge-irc-discord/fig-bridge-irc-discord.cabal b/fig-bridge-irc-discord/fig-bridge-irc-discord.cabal new file mode 100644 index 0000000..6a59f11 --- /dev/null +++ b/fig-bridge-irc-discord/fig-bridge-irc-discord.cabal @@ -0,0 +1,47 @@ +cabal-version: 3.4 +name: fig-bridge-irc-discord +version: 0.1.0.0 + +common defaults + ghc-options: -Wall + default-language: GHC2021 + default-extensions: NoImplicitPrelude PackageImports LambdaCase MultiWayIf OverloadedStrings OverloadedLists OverloadedRecordDot DuplicateRecordFields RecordWildCards NoFieldSelectors BlockArguments ViewPatterns TypeFamilies DataKinds GADTs + +common deps + build-depends: + base + , aeson + , base64 + , binary + , bytestring + , containers + , data-default-class + , directory + , filepath + , megaparsec + , mtl + , network + , safe-exceptions + , text + , time + , tomland + , transformers + , unordered-containers + , vector + , fig-utils + , fig-bus + +library + import: defaults + import: deps + hs-source-dirs: src + exposed-modules: + Fig.Bridge.IRCDiscord + +executable fig-bridge-irc-discord + import: defaults + import: deps + build-depends: fig-bridge-irc-discord, optparse-applicative + hs-source-dirs: + main + main-is: Main.hs
\ No newline at end of file diff --git a/fig-bridge-irc-discord/main/Main.hs b/fig-bridge-irc-discord/main/Main.hs new file mode 100644 index 0000000..8cd1fcb --- /dev/null +++ b/fig-bridge-irc-discord/main/Main.hs @@ -0,0 +1,25 @@ +module Main where + +import Fig.Prelude + +import Options.Applicative + +import Fig.Bridge.IRCDiscord + +data Opts = Opts + { busHost :: Text + , busPort :: Text + } + +parseOpts :: Parser Opts +parseOpts = Opts + <$> strOption (long "bus-host" <> metavar "HOST" <> help "Address of message bus" <> value "localhost") + <*> strOption (long "bus-port" <> metavar "PORT" <> help "Message bus port" <> showDefault <> value "32050") + +main :: IO () +main = do + opts <- execParser $ info (parseOpts <**> helper) + ( fullDesc + <> header "fig-bridge-irc-discord - bridge between IRC and Discord" + ) + bridge (opts.busHost, opts.busPort) diff --git a/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs b/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs new file mode 100644 index 0000000..b1e6c43 --- /dev/null +++ b/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs @@ -0,0 +1,32 @@ +{-# Language QuasiQuotes #-} + +module Fig.Bridge.IRCDiscord where + +import Fig.Prelude + +import Fig.Utils.SExpr +import Fig.Bus.Client + +bridge :: (Text, Text) -> IO () +bridge busAddr = do + busClient busAddr + (\cmds -> do + cmds.subscribe [sexp|(monitor irc chat incoming)|] + cmds.subscribe [sexp|(monitor discord chat incoming)|] + ) + (\cmds d -> do + case d of + SExprList [ev, user, _, msg] + | ev == [sexp|(monitor irc chat incoming)|] -> + cmds.publish [sexp|(monitor discord chat outgoing)|] + [ user + , msg + ] + | ev == [sexp|(monitor discord chat incoming)|] -> + cmds.publish [sexp|(monitor irc chat outgoing)|] + [ user + , msg + ] + _ -> log $ "Invalid message: " <> tshow d + ) + (pure ()) |
