diff options
| -rw-r--r-- | .gitignore | 7 | ||||
| -rw-r--r-- | app/Main.hs | 69 | ||||
| -rw-r--r-- | shupaibot.cabal | 3 | ||||
| -rw-r--r-- | test/Main.hs | 1 |
4 files changed, 77 insertions, 3 deletions
@@ -1 +1,8 @@ dist-newstyle +tgtoken +Dockerfile +deploy.sh +docker-build.sh +rootfs +*.tar.gz +strace.log diff --git a/app/Main.hs b/app/Main.hs index 50d99ad..a427719 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} module Main where -import Shupai + +import Debug.Trace +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Maybe +import Data.Char (isSpace) + + +import Telegram.Bot.API +import Telegram.Bot.Simple +import Telegram.Bot.API.InlineMode.InlineQueryResult +import Telegram.Bot.API.InlineMode.InputMessageContent (defaultInputTextMessageContent) + +import Shupai (shupai) + +type Model = () + +data Action + = InlineEcho InlineQueryId Text + +echoBot :: BotApp Model Action +echoBot = BotApp + { botInitialModel = () + , botAction = updateToAction + , botHandler = handleAction + , botJobs = [] + } + +updateToAction :: Update -> Model -> Maybe Action +updateToAction update _ + | isJust $ updateInlineQuery update = do + query <- updateInlineQuery update + let queryId = inlineQueryId query + let msg = inlineQueryQuery query + if Text.length msg <= 140 || Text.length msg > 0 then + seq msg $ Just $ InlineEcho queryId msg + else Nothing + | otherwise = Nothing + +handleAction :: Action -> Model -> Eff Action Model +handleAction action model = case action of + InlineEcho queryId msg -> model <# do + let result = (defInlineQueryResultGeneric (InlineQueryResultId "000")) + { inlineQueryResultTitle = Just "发送竖排结果" + , inlineQueryResultInputMessageContent = let + shupaiText = Text.pack . shupai . Text.unpack $ msg + in + Just (defaultInputTextMessageContent shupaiText) + } + thumbnail = defInlineQueryResultGenericThumbnail result + article = defInlineQueryResultArticle thumbnail + answerInlineQueryRequest = defAnswerInlineQuery queryId [article] + _ <- runTG answerInlineQueryRequest + return () + +run :: Token -> IO () +run token = do + env <- defaultTelegramClientEnv token + startBot_ echoBot env main :: IO () main = do - putStrLn "Hello, Haskell!" - someFunc + content <- readFile "tgtoken" + let token = Token $ Text.pack $ strip content + run token + +strip :: String -> String +strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace diff --git a/shupaibot.cabal b/shupaibot.cabal index 78d5f57..c830640 100644 --- a/shupaibot.cabal +++ b/shupaibot.cabal @@ -56,6 +56,9 @@ common cmcfg build-depends: base ^>=4.17.2.1 , containers == 0.6.7 , split == 0.2.5 + , text == 2.0.2 + , telegram-bot-api == 7.4.5 + , telegram-bot-simple == 0.14.4 library -- Import common warning flags. diff --git a/test/Main.hs b/test/Main.hs index 668e65c..5b162cf 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -5,3 +5,4 @@ import Shupai main :: IO () main = do putStrLn $ shupai "你好niasl lkansldknal nlkn alkn lkan lkan lan lakn alkn alk n" + putStrLn $ shupai "祇園精舎の鐘の声、諸行無常の響きあり。娑羅双樹の花の色、盛者必衰の理を顕す。" |