diff --git a/apps/dog-food/Main.hs b/apps/dog-food/Main.hs deleted file mode 100644 index 8899d41690..0000000000 --- a/apps/dog-food/Main.hs +++ /dev/null @@ -1,61 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Main where - -import ChatOptions -import Control.Concurrent.STM -import Control.Logger.Simple -import Control.Monad.IO.Unlift -import Control.Monad.Reader -import Simplex.Chat -import Simplex.Chat.Controller -import Simplex.Input -import Simplex.Messaging.Agent (getSMPAgentClient) -import Simplex.Messaging.Agent.Env.SQLite -import Simplex.Messaging.Client (smpDefaultConfig) -import Simplex.Terminal -import System.Directory (getAppUserDataDirectory) -import UnliftIO.Async (race_) - -cfg :: AgentConfig -cfg = - AgentConfig - { tcpPort = undefined, -- agent does not listen to TCP - smpServers = undefined, -- filled in from options - rsaKeySize = 2048 `div` 8, - connIdBytes = 12, - tbqSize = 16, - dbFile = "smp-chat.db", - smpCfg = smpDefaultConfig - } - -logCfg :: LogConfig -logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} - -main :: IO () -main = do - ChatOpts {dbFile, smpServers} <- welcomeGetOpts - ct <- newChatTerminal - a <- getSMPAgentClient cfg {dbFile, smpServers} - cc <- atomically $ newChatController a ct $ tbqSize cfg - -- setLogLevel LogInfo -- LogError - -- withGlobalLogging logCfg $ do - runReaderT simplexChat cc - -welcomeGetOpts :: IO ChatOpts -welcomeGetOpts = do - appDir <- getAppUserDataDirectory "simplex" - opts@ChatOpts {dbFile} <- getChatOpts appDir - putStrLn "SimpleX chat prototype v0.3.1" - putStrLn $ "db: " <> dbFile - putStrLn "type \"/help\" or \"/h\" for usage info" - pure opts - -simplexChat :: (MonadUnliftIO m, MonadReader ChatController m) => m () -simplexChat = race_ runTerminalInput runChatController diff --git a/apps/dog-food/ChatOptions.hs b/apps/simplex-chat/ChatOptions.hs similarity index 100% rename from apps/dog-food/ChatOptions.hs rename to apps/simplex-chat/ChatOptions.hs diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index e6d0f30cdd..858ee83faf 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -1,45 +1,92 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Main where -import Control.Concurrent (threadDelay) -import Control.Concurrent.STM (readTVarIO, retry) -import Control.Monad (forever, void) -import Simplex.Demo (chatLayoutDemo) +import ChatOptions +import Control.Concurrent.STM +import Control.Logger.Simple +import Control.Monad.IO.Unlift +import Control.Monad.Reader +import Simplex.Chat +import Simplex.Chat.Controller +import Simplex.Input +import Simplex.Messaging.Agent (getSMPAgentClient) +import Simplex.Messaging.Agent.Env.SQLite +import Simplex.Messaging.Client (smpDefaultConfig) import Simplex.Store (createStore) -import System.IO (hFlush, stdout) -import System.Terminal (putStringLn, runTerminalT, withTerminal) -import qualified System.Terminal as C -import qualified System.Terminal.Internal as C +import Simplex.Terminal +import System.Directory (getAppUserDataDirectory) +import UnliftIO.Async (race_) -defaultSettings :: C.Size -> C.VirtualTerminalSettings -defaultSettings size = - C.VirtualTerminalSettings - { C.virtualType = "xterm", - C.virtualWindowSize = pure size, - C.virtualEvent = retry, - C.virtualInterrupt = retry +cfg :: AgentConfig +cfg = + AgentConfig + { tcpPort = undefined, -- agent does not listen to TCP + smpServers = undefined, -- filled in from options + rsaKeySize = 2048 `div` 8, + connIdBytes = 12, + tbqSize = 16, + dbFile = "smp-chat.db", + smpCfg = smpDefaultConfig } +logCfg :: LogConfig +logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} + main :: IO () main = do + ChatOpts {dbFile, smpServers} <- welcomeGetOpts void $ createStore "simplex-chat.db" 4 + ct <- newChatTerminal + a <- getSMPAgentClient cfg {dbFile, smpServers} + cc <- atomically $ newChatController a ct $ tbqSize cfg + -- setLogLevel LogInfo -- LogError + -- withGlobalLogging logCfg $ do + runReaderT simplexChat cc - hFlush stdout - -- ChatTerminal {termSize} <- newChatTerminal - -- pos <- C.withVirtualTerminal (defaultSettings termSize) $ - -- \t -> runTerminalT (C.setAlternateScreenBuffer True >> C.putString "a" >> C.flush >> C.getCursorPosition) t - -- print pos - -- race_ (printEvents t) (updateTerminal t) - void . withTerminal . runTerminalT $ chatLayoutDemo >> C.flush >> C.awaitEvent +welcomeGetOpts :: IO ChatOpts +welcomeGetOpts = do + appDir <- getAppUserDataDirectory "simplex" + opts@ChatOpts {dbFile} <- getChatOpts appDir + putStrLn "SimpleX chat prototype v0.3.1" + putStrLn $ "db: " <> dbFile + putStrLn "type \"/help\" or \"/h\" for usage info" + pure opts -printEvents :: C.VirtualTerminal -> IO () -printEvents t = forever $ do - event <- withTerminal . runTerminalT $ C.flush >> C.awaitEvent - runTerminalT (putStringLn $ show event) t +simplexChat :: (MonadUnliftIO m, MonadReader ChatController m) => m () +simplexChat = race_ runTerminalInput runChatController -updateTerminal :: C.VirtualTerminal -> IO () -updateTerminal t = forever $ do - threadDelay 10000 - win <- readTVarIO $ C.virtualWindow t - withTerminal . runTerminalT $ mapM_ C.putStringLn win >> C.flush +-- defaultSettings :: C.Size -> C.VirtualTerminalSettings +-- defaultSettings size = +-- C.VirtualTerminalSettings +-- { C.virtualType = "xterm", +-- C.virtualWindowSize = pure size, +-- C.virtualEvent = retry, +-- C.virtualInterrupt = retry +-- } + +-- main :: IO () +-- main = do +-- void $ createStore "simplex-chat.db" 4 + +-- hFlush stdout +-- -- ChatTerminal {termSize} <- newChatTerminal +-- -- pos <- C.withVirtualTerminal (defaultSettings termSize) $ +-- -- \t -> runTerminalT (C.setAlternateScreenBuffer True >> C.putString "a" >> C.flush >> C.getCursorPosition) t +-- -- print pos +-- -- race_ (printEvents t) (updateTerminal t) +-- void . withTerminal . runTerminalT $ chatLayoutDemo >> C.flush >> C.awaitEvent + +-- printEvents :: C.VirtualTerminal -> IO () +-- printEvents t = forever $ do +-- event <- withTerminal . runTerminalT $ C.flush >> C.awaitEvent +-- runTerminalT (putStringLn $ show event) t + +-- updateTerminal :: C.VirtualTerminal -> IO () +-- updateTerminal t = forever $ do +-- threadDelay 10000 +-- win <- readTVarIO $ C.virtualWindow t +-- withTerminal . runTerminalT $ mapM_ C.putStringLn win >> C.flush diff --git a/apps/dog-food/Simplex/Chat.hs b/apps/simplex-chat/Simplex/Chat.hs similarity index 100% rename from apps/dog-food/Simplex/Chat.hs rename to apps/simplex-chat/Simplex/Chat.hs diff --git a/apps/dog-food/Simplex/Chat/Controller.hs b/apps/simplex-chat/Simplex/Chat/Controller.hs similarity index 100% rename from apps/dog-food/Simplex/Chat/Controller.hs rename to apps/simplex-chat/Simplex/Chat/Controller.hs diff --git a/apps/dog-food/Simplex/Help.hs b/apps/simplex-chat/Simplex/Help.hs similarity index 100% rename from apps/dog-food/Simplex/Help.hs rename to apps/simplex-chat/Simplex/Help.hs diff --git a/apps/dog-food/Simplex/Input.hs b/apps/simplex-chat/Simplex/Input.hs similarity index 100% rename from apps/dog-food/Simplex/Input.hs rename to apps/simplex-chat/Simplex/Input.hs diff --git a/apps/dog-food/Simplex/Terminal.hs b/apps/simplex-chat/Simplex/Terminal.hs similarity index 100% rename from apps/dog-food/Simplex/Terminal.hs rename to apps/simplex-chat/Simplex/Terminal.hs diff --git a/apps/dog-food/Simplex/View.hs b/apps/simplex-chat/Simplex/View.hs similarity index 100% rename from apps/dog-food/Simplex/View.hs rename to apps/simplex-chat/Simplex/View.hs diff --git a/apps/dog-food/Types.hs b/apps/simplex-chat/Types.hs similarity index 100% rename from apps/dog-food/Types.hs rename to apps/simplex-chat/Types.hs diff --git a/package.yaml b/package.yaml index 6941856819..1084dac95a 100644 --- a/package.yaml +++ b/package.yaml @@ -24,28 +24,6 @@ library: source-dirs: src executables: - dog-food: - source-dirs: apps/dog-food - main: Main.hs - dependencies: - - simplex-chat - - async == 2.2.* - - bytestring == 0.10.* - - composition == 1.0.* - - directory == 1.3.* - - filepath == 1.4.* - - mtl == 2.2.* - - optparse-applicative == 0.15.* - - simple-logger == 0.1.* - - simplexmq == 0.3.* - - stm == 2.5.* - - terminal == 0.2.* - - time == 1.9.* - - unliftio == 0.2.* - - unliftio-core == 0.2.* - ghc-options: - - -threaded - simplex-chat: source-dirs: apps/simplex-chat main: Main.hs @@ -54,14 +32,17 @@ executables: - async == 2.2.* - bytestring == 0.10.* - composition == 1.0.* - - cryptonite == 0.27.* + - directory == 1.3.* - file-embed == 0.0.14.* - filepath == 1.4.* - mtl == 2.2.* + - optparse-applicative == 0.15.* + - simple-logger == 0.1.* - simplexmq == 0.3.* - sqlite-simple == 0.4.* - stm == 2.5.* - terminal == 0.2.* + - time == 1.9.* - unliftio == 0.2.* - unliftio-core == 0.2.* ghc-options: