simplex-chat/apps/simplex-bot-advanced/Main.hs
Evgeny Poberezkin 087acd9180
changes to support GHC 8.10.7 (#3512)
* Revert "raise lower bound on mtl to a real version (#3499)"

This reverts commit f94c0311c1.

* Revert "core: expand ranges to fit ghc 8.10 & 9.6 (#3496)"

This reverts commit 9a1c7f41f7.

* update simplexmq

* remove netword-transport fork

* compatibility with GHC 8.10.7

* simplexmq

* fix test

* simplexmq, deps

* update sqlcipher deps in sha256nix

* fix index-state in cabal.project

* index-state

* remove import

* add cabal.project.freeze

* simplexmq

* remove freeze

* simplexmq

* bytestring,simplexmq

* template-haskell, simplexmq

* simplexmq

* simplexmq

* simplexmq

* mtl

* simplexmq

* remove duplicate index-state
2023-12-04 12:29:49 +00:00

58 lines
2.0 KiB
Haskell

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad
import qualified Data.Text as T
import Simplex.Chat.Bot
import Simplex.Chat.Controller
import Simplex.Chat.Core
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Options
import Simplex.Chat.Terminal (terminalChatConfig)
import Simplex.Chat.Types
import System.Directory (getAppUserDataDirectory)
import Text.Read
main :: IO ()
main = do
opts <- welcomeGetOpts
simplexChatCore terminalChatConfig opts mySquaringBot
welcomeGetOpts :: IO ChatOpts
welcomeGetOpts = do
appDir <- getAppUserDataDirectory "simplex"
opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getChatOpts appDir "simplex_bot"
putStrLn $ "SimpleX Chat Bot v" ++ versionNumber
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
pure opts
welcomeMessage :: String
welcomeMessage = "Hello! I am a simple squaring bot.\nIf you send me a number, I will calculate its square"
mySquaringBot :: User -> ChatController -> IO ()
mySquaringBot _user cc = do
initializeBotAddress cc
race_ (forever $ void getLine) . forever $ do
(_, _, resp) <- atomically . readTBQueue $ outputQ cc
case resp of
CRContactConnected _ contact _ -> do
contactConnected contact
sendMessage cc contact welcomeMessage
CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) -> do
let msg = T.unpack $ ciContentToText mc
number_ = readMaybe msg :: Maybe Integer
sendMessage cc contact $ case number_ of
Just n -> msg <> " * " <> msg <> " = " <> show (n * n)
_ -> "\"" <> msg <> "\" is not a number"
_ -> pure ()
where
contactConnected Contact {localDisplayName} = putStrLn $ T.unpack localDisplayName <> " connected"