diff options
Diffstat (limited to 'fig-bridge-irc-discord/src/Fig/Bridge')
| -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 |
2 files changed, 67 insertions, 13 deletions
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 |
