{-# LANGUAGE RecordWildCards #-}
module Lambdabot.Plugin.Telegram.Shared where

import Control.Concurrent.STM (TBQueue, atomically, readTBQueue, writeTBQueue)
import Data.Text (Text)

import Lambdabot.Module (ModuleT)
import Lambdabot.Monad (LB)

-- | Transport type used to communicate between Telegram and Lambdabot.
data Msg = Msg
  { Msg -> Text
msgChatId :: !Text
  , Msg -> Text
msgMsgId :: !Text
  , Msg -> Text
msgMessage :: !Text
  }
  deriving Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> String
(Int -> Msg -> ShowS)
-> (Msg -> String) -> ([Msg] -> ShowS) -> Show Msg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Msg] -> ShowS
$cshowList :: [Msg] -> ShowS
show :: Msg -> String
$cshow :: Msg -> String
showsPrec :: Int -> Msg -> ShowS
$cshowsPrec :: Int -> Msg -> ShowS
Show

-- | Shared state between Lambdabot and Telegram.
data TelegramState = TelegramState
  { TelegramState -> TBQueue Msg
tgInput :: TBQueue Msg
  , TelegramState -> TBQueue Msg
tgOutput :: TBQueue Msg
  , TelegramState -> Int
tgCurrent :: Int
  , TelegramState -> Text
tgBotName :: Text
  }

-- | Lambdabot Monad with embedded Telegram State.
type Telegram = ModuleT TelegramState LB

-- | Read input message from Telegram bot on Lambdabot side.
readInput :: TelegramState -> IO Msg
readInput :: TelegramState -> IO Msg
readInput TelegramState{Int
Text
TBQueue Msg
tgBotName :: Text
tgCurrent :: Int
tgOutput :: TBQueue Msg
tgInput :: TBQueue Msg
tgBotName :: TelegramState -> Text
tgCurrent :: TelegramState -> Int
tgOutput :: TelegramState -> TBQueue Msg
tgInput :: TelegramState -> TBQueue Msg
..} = STM Msg -> IO Msg
forall a. STM a -> IO a
atomically (STM Msg -> IO Msg) -> STM Msg -> IO Msg
forall a b. (a -> b) -> a -> b
$ TBQueue Msg -> STM Msg
forall a. TBQueue a -> STM a
readTBQueue TBQueue Msg
tgInput

-- | Read output message from Lambdabot on Telegram bot side.
readOutput :: TelegramState -> IO Msg
readOutput :: TelegramState -> IO Msg
readOutput TelegramState{Int
Text
TBQueue Msg
tgBotName :: Text
tgCurrent :: Int
tgOutput :: TBQueue Msg
tgInput :: TBQueue Msg
tgBotName :: TelegramState -> Text
tgCurrent :: TelegramState -> Int
tgOutput :: TelegramState -> TBQueue Msg
tgInput :: TelegramState -> TBQueue Msg
..} = STM Msg -> IO Msg
forall a. STM a -> IO a
atomically (STM Msg -> IO Msg) -> STM Msg -> IO Msg
forall a b. (a -> b) -> a -> b
$ TBQueue Msg -> STM Msg
forall a. TBQueue a -> STM a
readTBQueue TBQueue Msg
tgOutput

-- | Send input message to Lambdabot from Telegram bot side.
writeInput :: Msg -> TelegramState -> IO ()
writeInput :: Msg -> TelegramState -> IO ()
writeInput Msg
msg TelegramState{Int
Text
TBQueue Msg
tgBotName :: Text
tgCurrent :: Int
tgOutput :: TBQueue Msg
tgInput :: TBQueue Msg
tgBotName :: TelegramState -> Text
tgCurrent :: TelegramState -> Int
tgOutput :: TelegramState -> TBQueue Msg
tgInput :: TelegramState -> TBQueue Msg
..} = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TBQueue Msg -> Msg -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue Msg
tgInput Msg
msg

-- | Send output message to Telegram bot from Lambdabot side.
writeOutput :: Msg -> TelegramState -> IO ()
writeOutput :: Msg -> TelegramState -> IO ()
writeOutput Msg
msg TelegramState{Int
Text
TBQueue Msg
tgBotName :: Text
tgCurrent :: Int
tgOutput :: TBQueue Msg
tgInput :: TBQueue Msg
tgBotName :: TelegramState -> Text
tgCurrent :: TelegramState -> Int
tgOutput :: TelegramState -> TBQueue Msg
tgInput :: TelegramState -> TBQueue Msg
..} = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TBQueue Msg -> Msg -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue Msg
tgOutput Msg
msg