From 506ac77c2288696413baab4a44c3c2de93995c82 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 11 Jun 2024 19:32:31 +0200
Subject: Echo bot for direct message service
---
main/Main.hs | 26 ++++++++++++++++++++------
1 file changed, 20 insertions(+), 6 deletions(-)
(limited to 'main')
diff --git a/main/Main.hs b/main/Main.hs
index a226c6b..f52e22a 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -20,9 +20,10 @@ import Data.Char
import Data.List
import Data.Maybe
import Data.Ord
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.IO as T
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
+import Data.Text.IO qualified as T
import Data.Time.LocalTime
import Data.Typeable
@@ -58,6 +59,7 @@ import Version
data Options = Options
{ optServer :: ServerOptions
, optServices :: [ServiceOption]
+ , optDmBotEcho :: Maybe Text
, optShowHelp :: Bool
, optShowVersion :: Bool
}
@@ -73,6 +75,7 @@ defaultOptions :: Options
defaultOptions = Options
{ optServer = defaultServerOptions
, optServices = availableServices
+ , optDmBotEcho = Nothing
, optShowHelp = False
, optShowVersion = False
}
@@ -101,6 +104,9 @@ options =
, Option ['s'] ["silent"]
(NoArg (so $ \opts -> opts { serverLocalDiscovery = False }))
"do not send announce packets for local discovery"
+ , Option [] ["dm-bot-echo"]
+ (ReqArg (\prefix -> \opts -> opts { optDmBotEcho = Just (T.pack prefix) }) "<prefix>")
+ "automatically reply to direct messages with the same text prefixed with <prefix>"
, Option ['h'] ["help"]
(NoArg $ \opts -> opts { optShowHelp = True })
"show this help and exit"
@@ -185,7 +191,7 @@ main = do
serviceDesc ServiceOption {..} = padService (" " <> soptName) <> soptDescription
padTo n str = str <> replicate (n - length str) ' '
- padOpt = padTo 28
+ padOpt = padTo 37
padService = padTo 16
if | optShowHelp opts -> putStr $ usageInfo header options <> unlines
@@ -264,8 +270,16 @@ interactiveLoop st opts = runInputT inputSettings $ do
_ <- liftIO $ do
tzone <- getCurrentTimeZone
- watchReceivedMessages erebosHead $
- extPrintLn . formatDirectMessage tzone . fromStored
+ watchReceivedMessages erebosHead $ \smsg -> do
+ let msg = fromStored smsg
+ extPrintLn $ formatDirectMessage tzone msg
+ case optDmBotEcho opts of
+ Nothing -> return ()
+ Just prefix -> do
+ res <- runExceptT $ flip runReaderT erebosHead $ sendDirectMessage (msgFrom msg) (prefix <> msgText msg)
+ case res of
+ Right reply -> extPrintLn $ formatDirectMessage tzone $ fromStored reply
+ Left err -> extPrintLn $ "Failed to send dm echo: " <> err
server <- liftIO $ do
startServer (optServer opts) erebosHead extPrintLn $
--
cgit v1.2.3