module Lambdabot.Plugin.Telegram.Message where

import Data.Text
import qualified Data.Text as Text

import Lambdabot.IRC
import Lambdabot.Monad
import Lambdabot.Logging

import Lambdabot.Plugin.Telegram.Shared

-- * IRC Messaging

-- | IRC communicating model consists of the core and plugins which are sending messages to each other.
--
-- @Telegram module <---> Lambdabot core module <------> Haskell/Telegram module@
--
-- In order to pass Telegram-related necessary information for responding, we are embedding Telegram metadata into 'IrcMessage' inside 'ircMsgPrefix': @"null!n=user\@" + chatId + "/" + msgId@
--
makeIrcMessage :: Text -> Text -> Text -> IrcMessage
makeIrcMessage :: Text -> Text -> Text -> IrcMessage
makeIrcMessage Text
chatId Text
msgId Text
msg = IrcMessage :: String -> String -> String -> String -> [String] -> IrcMessage
IrcMessage
  { ircMsgServer :: String
ircMsgServer  = String
"telegramrc"
  , ircMsgLBName :: String
ircMsgLBName  = String
"telegram"
  , ircMsgPrefix :: String
ircMsgPrefix  = String
"null!n=user@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
chatId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
msgId
  , ircMsgCommand :: String
ircMsgCommand = String
"TGMSG"
  , ircMsgParams :: [String]
ircMsgParams  = [String
"telegram", String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Text -> String
Text.unpack Text
msg)) ]
  }

-- | To extract Telegram @chatId@ from 'IrcMessage'.
getTgChatId :: IrcMessage -> Text
getTgChatId :: IrcMessage -> Text
getTgChatId
  = (Char -> Bool) -> Text -> Text
Text.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (Text -> Text) -> (IrcMessage -> Text) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
1 (Text -> Text) -> (IrcMessage -> Text) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@') (Text -> Text) -> (IrcMessage -> Text) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (IrcMessage -> String) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> String
ircMsgPrefix

-- | To extract Telegram @msgId@ from 'IrcMessage'.
getTgMsgId :: IrcMessage -> Text
getTgMsgId :: IrcMessage -> Text
getTgMsgId
  = Int -> Text -> Text
Text.drop Int
1 (Text -> Text) -> (IrcMessage -> Text) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/')
  (Text -> Text) -> (IrcMessage -> Text) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
1 (Text -> Text) -> (IrcMessage -> Text) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@')
  (Text -> Text) -> (IrcMessage -> Text) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (IrcMessage -> String) -> IrcMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> String
ircMsgPrefix 

-- | Send privileged IRC Message across modules.
tgIrcPrivMsg :: Text -> Text -> Text -> LB ()
tgIrcPrivMsg :: Text -> Text -> Text -> LB ()
tgIrcPrivMsg Text
chatId Text
msgId Text
txt = IrcMessage -> LB ()
send (IrcMessage -> LB ()) -> IrcMessage -> LB ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> IrcMessage
makeIrcMessage Text
chatId Text
msgId Text
txt

-- | Debug helper function.
ldebug :: String -> Telegram ()
ldebug :: String -> Telegram ()
ldebug String
msg = String -> Telegram ()
forall (m :: * -> *). MonadLogging m => String -> m ()
debugM (String
"lambdabot : " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
msg)