terminal: refactor chat core used in terminal app and in bot examples (#516)

* terminal: refactor chat core used in terminal app and in bot examples

* fix tests

* refactor

src/Simplex/Chat/Bot.hs

@@ -7,40 +7,17 @@ module Simplex.Chat.Bot where
 
 import Control.Concurrent.Async
 import Control.Concurrent.STM
-import Control.Logger.Simple
 import Control.Monad.Reader
 import qualified Data.ByteString.Char8 as B
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
-import Simplex.Chat
 import Simplex.Chat.Controller
+import Simplex.Chat.Core
 import Simplex.Chat.Messages
-import Simplex.Chat.Options (ChatOpts (..))
 import Simplex.Chat.Store
 import Simplex.Chat.Types (Contact (..), User (..))
 import Simplex.Messaging.Encoding.String (strEncode)
 import System.Exit (exitFailure)
 
-simplexChatBot :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
-simplexChatBot cfg@ChatConfig {dbPoolSize, yesToMigrations} opts chatBot
-  | logAgent opts = do
-    setLogLevel LogInfo -- LogError
-    withGlobalLogging logCfg initRun
-  | otherwise = initRun
-  where
-    initRun = do
-      let f = chatStoreFile $ dbFilePrefix opts
-      st <- createStore f dbPoolSize yesToMigrations
-      u <- getCreateActiveUser st
-      cc <- newChatController st (Just u) cfg opts (const $ pure ())
-      runSimplexChatBot u cc chatBot
-
-runSimplexChatBot :: User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
-runSimplexChatBot u cc chatBot = do
-  a1 <- async $ chatBot u cc
-  a2 <- runReaderT (startChatController u) cc
-  waitEither_ a1 a2
-
 chatBotRepl :: String -> (String -> String) -> User -> ChatController -> IO ()
 chatBotRepl welcome answer _user cc = do
   initializeBotAddress cc
@@ -55,23 +32,20 @@ chatBotRepl welcome answer _user cc = do
         void . sendMsg contact $ answer msg
       _ -> pure ()
   where
-    sendMsg Contact {contactId} msg = sendCmd cc $ "/_send @" <> show contactId <> " text " <> msg
+    sendMsg Contact {contactId} msg = sendChatCmd cc $ "/_send @" <> show contactId <> " text " <> msg
     contactConnected Contact {localDisplayName} = putStrLn $ T.unpack localDisplayName <> " connected"
 
 initializeBotAddress :: ChatController -> IO ()
 initializeBotAddress cc = do
-  sendCmd cc "/show_address" >>= \case
+  sendChatCmd cc "/show_address" >>= \case
     CRUserContactLink uri _ -> showBotAddress uri
     CRChatCmdError (ChatErrorStore SEUserContactLinkNotFound) -> do
       putStrLn $ "No bot address, creating..."
-      sendCmd cc "/address" >>= \case
+      sendChatCmd cc "/address" >>= \case
         CRUserContactLinkCreated uri -> showBotAddress uri
         _ -> putStrLn "can't create bot address" >> exitFailure
     _ -> putStrLn "unexpected response" >> exitFailure
   where
     showBotAddress uri = do
       putStrLn $ "Bot's contact address is: " <> B.unpack (strEncode uri)
-      void $ sendCmd cc "/auto_accept on"
-
-sendCmd :: ChatController -> String -> IO ChatResponse
-sendCmd cc s = runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc
+      void $ sendChatCmd cc "/auto_accept on"

src/Simplex/Chat/Core.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Chat.Core where
+
+import Control.Logger.Simple
+import Control.Monad.Reader
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Simplex.Chat
+import Simplex.Chat.Controller
+import Simplex.Chat.Options (ChatOpts (..))
+import Simplex.Chat.Store
+import Simplex.Chat.Types
+import UnliftIO.Async
+
+simplexChatCore :: ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> (User -> ChatController -> IO ()) -> IO ()
+simplexChatCore cfg@ChatConfig {dbPoolSize, yesToMigrations} opts sendToast chat
+  | logAgent opts = do
+    setLogLevel LogInfo -- LogError
+    withGlobalLogging logCfg initRun
+  | otherwise = initRun
+  where
+    initRun = do
+      let f = chatStoreFile $ dbFilePrefix opts
+      st <- createStore f dbPoolSize yesToMigrations
+      u <- getCreateActiveUser st
+      cc <- newChatController st (Just u) cfg opts sendToast
+      runSimplexChat u cc chat
+
+runSimplexChat :: User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
+runSimplexChat u cc chat = do
+  a1 <- async $ chat u cc
+  a2 <- runReaderT (startChatController u) cc
+  waitEither_ a1 a2
+
+sendChatCmd :: ChatController -> String -> IO ChatResponse
+sendChatCmd cc s = runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc

src/Simplex/Chat/Mobile.hs

@@ -73,7 +73,7 @@ chatInit dbFilePrefix = do
   let f = chatStoreFile dbFilePrefix
   chatStore <- createStore f (dbPoolSize defaultMobileConfig) (yesToMigrations (defaultMobileConfig :: ChatConfig))
   user_ <- getActiveUser_ chatStore
-  newChatController chatStore user_ defaultMobileConfig mobileChatOpts {dbFilePrefix} (const $ pure ())
+  newChatController chatStore user_ defaultMobileConfig mobileChatOpts {dbFilePrefix} Nothing
 
 chatSendCmd :: ChatController -> String -> IO JSONString
 chatSendCmd cc s = LB.unpack . J.encode . APIResponse Nothing <$> runReaderT (execChatCommand $ B.pack s) cc

src/Simplex/Chat/Terminal.hs

@@ -3,43 +3,23 @@
 
 module Simplex.Chat.Terminal where
 
-import Control.Logger.Simple
 import Control.Monad.Except
-import Control.Monad.Reader
-import Simplex.Chat
 import Simplex.Chat.Controller
+import Simplex.Chat.Core
 import Simplex.Chat.Help (chatWelcome)
 import Simplex.Chat.Options
-import Simplex.Chat.Store
 import Simplex.Chat.Terminal.Input
 import Simplex.Chat.Terminal.Notification
 import Simplex.Chat.Terminal.Output
-import Simplex.Chat.Types (User)
 import Simplex.Messaging.Util (raceAny_)
-import UnliftIO (async, waitEither_)
 
-simplexChat :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
-simplexChat cfg@ChatConfig {dbPoolSize, yesToMigrations} opts t
-  | logAgent opts = do
-    setLogLevel LogInfo -- LogError
-    withGlobalLogging logCfg initRun
-  | otherwise = initRun
-  where
-    initRun = do
-      sendNotification' <- initializeNotifications
-      let f = chatStoreFile $ dbFilePrefix opts
-      st <- createStore f dbPoolSize yesToMigrations
-      u <- getCreateActiveUser st
-      ct <- newChatTerminal t
-      cc <- newChatController st (Just u) cfg opts sendNotification'
-      runSimplexChat u ct cc
-
-runSimplexChat :: User -> ChatTerminal -> ChatController -> IO ()
-runSimplexChat u ct cc = do
-  when (firstTime cc) . printToTerminal ct $ chatWelcome u
-  a1 <- async $ runChatTerminal ct cc
-  a2 <- runReaderT (startChatController u) cc
-  waitEither_ a1 a2
+simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
+simplexChatTerminal cfg opts t = do
+  sendToast <- initializeNotifications
+  simplexChatCore cfg opts (Just sendToast) $ \u cc -> do
+    ct <- newChatTerminal t
+    when (firstTime cc) . printToTerminal ct $ chatWelcome u
+    runChatTerminal ct cc
 
 runChatTerminal :: ChatTerminal -> ChatController -> IO ()
 runChatTerminal ct cc = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc, runInputLoop ct cc]