diff options
Diffstat (limited to 'fig-bridge-irc-discord')
| -rw-r--r-- | fig-bridge-irc-discord/fig-bridge-irc-discord.cabal | 3 | ||||
| -rw-r--r-- | fig-bridge-irc-discord/main/Main.hs | 6 | ||||
| -rw-r--r-- | fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs | 51 | ||||
| -rw-r--r-- | fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord/Utils.hs | 29 |
4 files changed, 74 insertions, 15 deletions
diff --git a/fig-bridge-irc-discord/fig-bridge-irc-discord.cabal b/fig-bridge-irc-discord/fig-bridge-irc-discord.cabal index 6a59f11..4d10b4e 100644 --- a/fig-bridge-irc-discord/fig-bridge-irc-discord.cabal +++ b/fig-bridge-irc-discord/fig-bridge-irc-discord.cabal @@ -37,6 +37,7 @@ library hs-source-dirs: src exposed-modules: Fig.Bridge.IRCDiscord + Fig.Bridge.IRCDiscord.Utils executable fig-bridge-irc-discord import: defaults @@ -44,4 +45,4 @@ executable fig-bridge-irc-discord build-depends: fig-bridge-irc-discord, optparse-applicative hs-source-dirs: main - main-is: Main.hs
\ No newline at end of file + main-is: Main.hs diff --git a/fig-bridge-irc-discord/main/Main.hs b/fig-bridge-irc-discord/main/Main.hs index 8cd1fcb..2c6d2ba 100644 --- a/fig-bridge-irc-discord/main/Main.hs +++ b/fig-bridge-irc-discord/main/Main.hs @@ -5,16 +5,19 @@ import Fig.Prelude import Options.Applicative import Fig.Bridge.IRCDiscord +import Fig.Bridge.IRCDiscord.Utils data Opts = Opts { busHost :: Text , busPort :: Text + , config :: FilePath } 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") + <*> strOption (long "config" <> metavar "PATH" <> help "Path to config file" <> showDefault <> value "fig-bridge-irc-discord.toml") main :: IO () main = do @@ -22,4 +25,5 @@ main = do ( fullDesc <> header "fig-bridge-irc-discord - bridge between IRC and Discord" ) - bridge (opts.busHost, opts.busPort) + cfg <- loadConfig opts.config + bridge cfg (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 index b1e6c43..c3232cb 100644 --- a/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs +++ b/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs @@ -4,11 +4,14 @@ module Fig.Bridge.IRCDiscord where import Fig.Prelude +import qualified Data.List as List + +import Fig.Bridge.IRCDiscord.Utils import Fig.Utils.SExpr import Fig.Bus.Client -bridge :: (Text, Text) -> IO () -bridge busAddr = do +bridge :: Config -> (Text, Text) -> IO () +bridge cfg busAddr = do busClient busAddr (\cmds -> do cmds.subscribe [sexp|(monitor irc chat incoming)|] @@ -16,17 +19,39 @@ bridge busAddr = do ) (\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 - ] + SExprList [ev, tchan, user, _, msg] + | ev == [sexp|(monitor irc chat incoming)|] + , SExprString chan <- tchan -> + case List.find ((== chan) . snd) cfg.mapping of + Nothing -> log $ mconcat + [ "Message on unmapped IRC channel: " <> tshow chan + ] + Just (dchan, _) -> do + log $ mconcat + [ "Incoming message on IRC channel " <> tshow chan + , ", bridging to Discord channel " <> tshow dchan + ] + cmds.publish [sexp|(monitor discord chat outgoing)|] + [ SExprInteger $ fromIntegral dchan + , user + , msg + ] + | ev == [sexp|(monitor discord chat incoming)|] + , SExprInteger chan <- tchan -> + case List.find ((== fromInteger chan) . fst) cfg.mapping of + Nothing -> log $ mconcat + [ "Message on unmapped Discord channel: " <> tshow chan + ] + Just (_, ichan) -> do + log $ mconcat + [ "Incoming message on Discord channel " <> tshow chan + , ", bridging to IRC channel " <> ichan + ] + cmds.publish [sexp|(monitor irc chat outgoing)|] + [ SExprString ichan + , user + , msg + ] _ -> log $ "Invalid message: " <> tshow d ) (pure ()) diff --git a/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord/Utils.hs b/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord/Utils.hs new file mode 100644 index 0000000..00d227d --- /dev/null +++ b/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord/Utils.hs @@ -0,0 +1,29 @@ +{-# Language ApplicativeDo #-} + +module Fig.Bridge.IRCDiscord.Utils + ( FigBridgeIRCDiscordException(..) + , Config(..) + , loadConfig + ) where + +import Fig.Prelude + +import qualified Toml + +newtype FigBridgeIRCDiscordException = FigBridgeIRCDiscordException Text + deriving (Show, Eq, Ord) +instance Exception FigBridgeIRCDiscordException + +newtype Config = Config + { mapping :: [(Int, Text)] + } deriving (Show, Eq, Ord) + +configCodec :: Toml.TomlCodec Config +configCodec = do + mapping <- Toml.list (Toml.pair (Toml.int "discord") (Toml.text "irc")) "mapping" Toml..= (\a -> a.mapping) + pure $ Config{..} + +loadConfig :: FilePath -> IO Config +loadConfig path = Toml.decodeFileEither configCodec path >>= \case + Left err -> throwM . FigBridgeIRCDiscordException $ tshow err + Right config -> pure config |