telegram-bot 0.5.1.0 → 0.5.4.0
raw patch · 6 files changed
+55/−53 lines, 6 files
Files
- examples/Hello.hs +6/−4
- src/Web/Telegram/Bot.hs +1/−2
- src/Web/Telegram/Bot/Internal.hs +28/−25
- src/Web/Telegram/Bot/Story.hs +6/−7
- src/Web/Telegram/Bot/Types.hs +13/−14
- telegram-bot.cabal +1/−1
examples/Hello.hs view
@@ -14,7 +14,7 @@ toMessage $ "Hello, " <> name <> " " <> surname <> "!\n" <> "You lost " <> (pack $ show age) <> " years =)" -helloStory :: Story+helloStory :: Story MyBot helloStory _ = hello <$> question "How your name?" <*> question "How your surname?" <*> question "How old are you?"@@ -22,8 +22,10 @@ helpMessage :: Text helpMessage = "Hello, I'm hello bot!" +data MyBot = MyBot+instance BotConfig MyBot where+ authToken = const $ Token "bot..."+ main :: IO ()-main = runBot config $ do+main = runBot MyBot $ do storyBot helpMessage [("/hello", helloStory)]- where config = defaultConfig- { token = Token "bot..." }
src/Web/Telegram/Bot.hs view
@@ -24,8 +24,8 @@ -- ** Story types , ToBotMessage(..) , BotMessage(..)+ , BotConfig(..) , Answer(..)- , Config(..) , Token(..) , StoryT , Story@@ -35,7 +35,6 @@ , question -- ** Bot runners , sendMessageBot- , defaultConfig , storyBot , forkBot , runBot
src/Web/Telegram/Bot/Internal.hs view
@@ -11,11 +11,11 @@ -- module Web.Telegram.Bot.Internal (runBot, storyBot, sendMessageBot, forkBot) where +import Control.Concurrent (forkIO, forkFinally, killThread, ThreadId) import Control.Monad.Trans.Reader (runReaderT, ask) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Client (newManager, Manager)-import Control.Concurrent (forkIO, ThreadId)-import Control.Exception (throwIO, finally)+import Control.Exception (throwIO) import Data.IntMap.Strict as I import Control.Concurrent.Chan import Control.Concurrent.MVar@@ -37,16 +37,17 @@ putStrLn $ "Hello! I'm " ++ show (user_first_name u) -- | Infinity loop for getting updates from API-updateLoop :: (Update -> Bot ())+updateLoop :: BotConfig a+ => (Update -> Bot a ()) -- ^ Update handler- -> Bot ()+ -> Bot a () updateLoop handler = go 0 where updates o t = getUpdates t (Just o) Nothing . Just go offset = do (manager, config) <- ask -- Take updates upd <- liftIO $- updates offset (token config) (timeout config) manager+ updates offset (authToken config) (pollTimeout config) manager -- Check for errors case result <$> upd of Left e -> liftIO (throwIO e)@@ -66,27 +67,29 @@ toSender sender = forever $ await >>= lift . sender -- | Chat ID based message splitter-storyHandler :: MVar (IntMap (Chan Message))- -> Map Text Story+storyHandler :: BotConfig a+ => MVar (IntMap (Chan Message, ThreadId))+ -> Map Text (Story a) -> BotMessage -> Update- -> Bot ()+ -> Bot a () storyHandler chats stories help = go- where go (Update { message = Just msg }) = do+ where go (Update{message =+ Just msg@(Message {from = Just user})}) = do -- Get a chat id let cid = chat_id (chat msg)- newStory chan = modifyMVar_ chats (return . I.insert cid chan)+ newStory item = modifyMVar_ chats (return . I.insert cid item) deleteStory = modifyMVar_ chats (return . I.delete cid) chatMap <- liftIO (readMVar chats) -- Lookup chat id in the map case I.lookup cid chatMap of -- Chat exist => story is run now- Just chan -> do- -- Want to cancel it?+ Just (chan, tid) -> do+ -- Want to cancel it? case text msg of Just "/cancel" -> do- liftIO deleteStory+ liftIO (killThread tid) sendMessageBot (chat msg) help _ -> liftIO (writeChan chan msg)@@ -99,13 +102,12 @@ -- Story exist Just story -> do- -- Create chan and update chanMap+ -- Create chan chan <- liftIO newChan- liftIO (newStory chan) -- Story pipeline let pipeline = fromChan chan- >-> (story (chat msg) >>= yield)+ >-> (story (user, chat msg) >>= yield) >-> toSender (sendMessageBot (chat msg)) -- Story effect@@ -114,15 +116,16 @@ (manager, config) -- Run story in separate thread- _ <- liftIO $ forkIO $ do- runStory `finally` deleteStory- return ()+ tid <- liftIO $ forkFinally runStory+ (const deleteStory)+ -- Update chanMap+ liftIO (newStory (chan, tid)) go _ = return () -sendMessageBot :: Chat -> BotMessage -> Bot ()+sendMessageBot :: BotConfig a => Chat -> BotMessage -> Bot a () sendMessageBot c msg = do (manager, config) <- ask- liftIO $ send (textChatId c) (token config) manager msg+ liftIO $ send (textChatId c) (authToken config) manager msg where textChatId = pack . show . chat_id send cid tok mgr BotTyping =@@ -144,7 +147,7 @@ in sendMessage tok r mgr >> return () -- | User story handler-storyBot :: ToBotMessage help => help -> Map Text Story -> Bot ()+storyBot :: (BotConfig a, ToBotMessage help) => help -> Map Text (Story a) -> Bot a () storyBot help stories = do -- Create map from user to it story chats <- liftIO (newMVar I.empty)@@ -152,15 +155,15 @@ updateLoop (storyHandler chats stories $ toMessage help) -- | Run bot monad-runBot :: Config -> Bot a -> IO a+runBot :: BotConfig a => a -> Bot a b -> IO b runBot config bot = do -- Init connection manager manager <- newManager tlsManagerSettings -- Check connection- trySelf (token config) manager+ trySelf (authToken config) manager -- Run bot runReaderT bot (manager, config) -- Fork bot thread-forkBot :: Bot () -> Bot ThreadId+forkBot :: BotConfig a => Bot a () -> Bot a ThreadId forkBot bot = ask >>= liftIO . forkIO . runReaderT bot
src/Web/Telegram/Bot/Story.hs view
@@ -25,17 +25,17 @@ module Web.Telegram.Bot.Story where import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)-import Web.Telegram.API.Bot (Message, Chat, text)+import Web.Telegram.API.Bot (Message, Chat, User, text) import Data.Text.Read (signed, decimal, double) import Control.Monad.IO.Class (MonadIO)-import Pipes (Pipe, await, yield, lift) import Web.Telegram.Bot.Types (Bot)+import Pipes (Pipe, await, yield) import qualified Data.Text as T import Data.Text (Text, pack) -- | Story is a pipe from user message to bot message -- and result is a final message bot.-type Story = Chat -> StoryT Bot BotMessage+type Story a = (User, Chat) -> StoryT (Bot a) BotMessage type StoryT = Pipe Message BotMessage -- | Bot message data.@@ -73,9 +73,8 @@ t <- parse x case signed double t of Left e -> throwE (pack e)- Right (v, x) -> if T.null x- then return v- else throwE "Please use only 0-9 and '.' chars."+ Right (v, "") -> return v+ Right _ -> throwE "Please use only 0-9 and '.' chars." instance Answer Integer where parse x = do@@ -112,7 +111,7 @@ replica :: (ToBotMessage a, MonadIO m, Answer b) => a -> StoryT m b replica msg = do yield (toMessage msg)- res <- lift . runExceptT . parse =<< await+ res <- runExceptT . parse =<< await yield BotTyping case res of Left e -> replica e
src/Web/Telegram/Bot/Types.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-} -- | -- Module : Web.Telegram.Bot.Types -- Copyright : Alexander Krupenkin 2016@@ -6,29 +7,27 @@ -- -- Maintainer : mail@akru.me -- Stability : experimental--- Portability : portable+-- Portability : noportable ----- Bot types and helper instances.+-- Bot types. -- module Web.Telegram.Bot.Types where import Control.Monad.Trans.Reader (ReaderT)-import Web.Telegram.API.Bot (Token(..))+import Web.Telegram.API.Bot (Token) import Network.HTTP.Client (Manager) type Timeout = Int -data Config = Config- { timeout :: Timeout- -- ^ Polling timeout in seconds- , token :: Token- -- ^ Telegram Bot API private token- } deriving Show+-- | Telegram bot config+class BotConfig a where+ pollTimeout :: a -> Timeout+ pollTimeout = const 10+ -- ^ Updates poll timeout in seconds --- | Default bot config-defaultConfig :: Config-defaultConfig = Config 10 (Token "")+ authToken :: a -> Token+ -- ^ BotFather authentification token -- | Telegram bot monad-type BotT = ReaderT (Manager, Config)-type Bot = BotT IO+type BotT a = ReaderT (Manager, a)+type Bot a = BotT a IO
telegram-bot.cabal view
@@ -1,5 +1,5 @@ name: telegram-bot-version: 0.5.1.0+version: 0.5.4.0 synopsis: Telegram Bot microframework for Haskell description: Please see README.md homepage: https://github.com/akru/telegram-bot#readme