{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Simplex.Chat.Terminal.Input where

import Control.Applicative (optional, (<|>))
import Control.Concurrent (forkFinally, forkIO, killThread, mkWeakThreadId, threadDelay)
import Control.Monad
import Control.Monad.Reader
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (second)
import qualified Data.ByteString.Char8 as B
import Data.Char (isAlpha, isAlphaNum, isAscii)
import Data.Either (fromRight)
import Data.List (dropWhileEnd, foldl', sort)
import Data.Maybe (isJust, isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import GHC.Weak (deRefWeak)
import Simplex.Chat.Controller
import Simplex.Chat.Library.Commands
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Styled
import Simplex.Chat.Terminal.Output
import Simplex.Chat.Types (User (..))
import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Util (catchAll_, safeDecodeUtf8, whenM)
import System.Exit (exitSuccess)
import System.Terminal hiding (insertChars)
import UnliftIO.STM
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query, ToRow)
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), Query, ToRow)
import Database.SQLite.Simple.QQ (sql)
#endif

getKey :: MonadTerminal m => m (Key, Modifiers)
getKey :: forall (m :: * -> *). MonadTerminal m => m (Key, Modifiers)
getKey =
  m ()
forall (m :: * -> *). MonadPrinter m => m ()
flush m () -> m (Either Interrupt Event) -> m (Either Interrupt Event)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Either Interrupt Event)
forall (m :: * -> *). MonadInput m => m (Either Interrupt Event)
awaitEvent m (Either Interrupt Event)
-> (Either Interrupt Event -> m (Key, Modifiers))
-> m (Key, Modifiers)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Interrupt
Interrupt -> IO (Key, Modifiers) -> m (Key, Modifiers)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Key, Modifiers)
forall a. IO a
exitSuccess
    Right (KeyEvent Key
key Modifiers
ms) -> (Key, Modifiers) -> m (Key, Modifiers)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key
key, Modifiers
ms)
    Either Interrupt Event
_ -> m (Key, Modifiers)
forall (m :: * -> *). MonadTerminal m => m (Key, Modifiers)
getKey

runInputLoop :: ChatTerminal -> ChatController -> IO ()
runInputLoop :: ChatTerminal -> ChatController -> IO ()
runInputLoop ct :: ChatTerminal
ct@ChatTerminal {TVar TerminalState
termState :: TVar TerminalState
termState :: ChatTerminal -> TVar TerminalState
termState, TVar (Maybe LiveMessage)
liveMessageState :: TVar (Maybe LiveMessage)
liveMessageState :: ChatTerminal -> TVar (Maybe LiveMessage)
liveMessageState} ChatController
cc = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  String
s <- STM String -> IO String
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM String -> IO String)
-> (TBQueue String -> STM String) -> TBQueue String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TBQueue String -> STM String
forall a. TBQueue a -> STM a
readTBQueue (TBQueue String -> IO String) -> TBQueue String -> IO String
forall a b. (a -> b) -> a -> b
$ ChatController -> TBQueue String
inputQ ChatController
cc
  Maybe UserId
rh <- TVar (Maybe UserId) -> IO (Maybe UserId)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar (Maybe UserId) -> IO (Maybe UserId))
-> TVar (Maybe UserId) -> IO (Maybe UserId)
forall a b. (a -> b) -> a -> b
$ ChatController -> TVar (Maybe UserId)
currentRemoteHost ChatController
cc
  let bs :: ByteString
bs = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
      cmd :: Either String ChatCommand
cmd = ByteString -> Either String ChatCommand
parseChatCommand ByteString
bs
      rh' :: Maybe UserId
rh' = if (String -> Bool)
-> (ChatCommand -> Bool) -> Either String ChatCommand -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False) ChatCommand -> Bool
allowRemoteCommand Either String ChatCommand
cmd then Maybe UserId
rh else Maybe UserId
forall a. Maybe a
Nothing
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Either String ChatCommand -> Bool
forall {a}. Either a ChatCommand -> Bool
isMessage Either String ChatCommand
cmd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
echo String
s
  Either ChatError ChatResponse
r <- Maybe UserId
-> ByteString -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand Maybe UserId
rh' ByteString
bs Int
0 CM' (Either ChatError ChatResponse)
-> ChatController -> IO (Either ChatError ChatResponse)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` ChatController
cc
  case Either ChatError ChatResponse
r of
    Right ChatResponse
r' -> Either String ChatCommand -> Maybe UserId -> ChatResponse -> IO ()
processResp Either String ChatCommand
cmd Maybe UserId
rh ChatResponse
r'
    Left ChatError
_ -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either String ChatCommand -> Bool
forall {a}. Either a ChatCommand -> Bool
isMessage Either String ChatCommand
cmd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
echo String
s
  ChatTerminal
-> ChatController
-> Bool
-> Maybe UserId
-> Either ChatError ChatResponse
-> IO ()
printRespToTerminal ChatTerminal
ct ChatController
cc Bool
False Maybe UserId
rh Either ChatError ChatResponse
r
  (ChatResponse -> IO ()) -> Either ChatError ChatResponse -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Either String ChatCommand -> ChatResponse -> IO ()
forall a. Either a ChatCommand -> ChatResponse -> IO ()
startLiveMessage Either String ChatCommand
cmd) Either ChatError ChatResponse
r
  where
    echo :: String -> IO ()
echo String
s = ChatTerminal -> [StyledString] -> IO ()
printToTerminal ChatTerminal
ct [String -> StyledString
forall a. StyledFormat a => a -> StyledString
plain String
s]
    processResp :: Either String ChatCommand -> Maybe UserId -> ChatResponse -> IO ()
processResp Either String ChatCommand
cmd Maybe UserId
rh = \case
      CRActiveUser User
u -> case Maybe UserId
rh of
        Maybe UserId
Nothing -> ChatTerminal -> String -> IO ()
setActive ChatTerminal
ct String
""
        Just UserId
rhId -> ChatTerminal -> User -> UserId -> IO ()
updateRemoteUser ChatTerminal
ct User
u UserId
rhId
      CRChatItems User
u Maybe ChatName
chatName_ [AChatItem]
_ -> ChatController -> User -> IO () -> IO ()
whenCurrUser ChatController
cc User
u (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (ChatName -> IO ()) -> Maybe ChatName -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ChatTerminal -> String -> IO ()
setActive ChatTerminal
ct (String -> IO ()) -> (ChatName -> String) -> ChatName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatName -> String
chatActiveTo) Maybe ChatName
chatName_
      CRNewChatItems User
u ((AChatItem SChatType c
_ SMsgDirection d
SMDSnd ChatInfo c
cInfo ChatItem c d
_) : [AChatItem]
_) -> ChatController -> User -> IO () -> IO ()
whenCurrUser ChatController
cc User
u (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ChatTerminal -> ChatInfo c -> IO ()
forall (c :: ChatType). ChatTerminal -> ChatInfo c -> IO ()
setActiveChat ChatTerminal
ct ChatInfo c
cInfo
      CRChatItemUpdated User
u (AChatItem SChatType c
_ SMsgDirection d
SMDSnd ChatInfo c
cInfo ChatItem c d
_) -> ChatController -> User -> IO () -> IO ()
whenCurrUser ChatController
cc User
u (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ChatTerminal -> ChatInfo c -> IO ()
forall (c :: ChatType). ChatTerminal -> ChatInfo c -> IO ()
setActiveChat ChatTerminal
ct ChatInfo c
cInfo
      CRChatItemsDeleted User
u ((ChatItemDeletion (AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
cInfo ChatItem c d
_) Maybe AChatItem
_) : [ChatItemDeletion]
_) Bool
_ Bool
_ -> ChatController -> User -> IO () -> IO ()
whenCurrUser ChatController
cc User
u (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ChatTerminal -> ChatInfo c -> IO ()
forall (c :: ChatType). ChatTerminal -> ChatInfo c -> IO ()
setActiveChat ChatTerminal
ct ChatInfo c
cInfo
      CRContactDeleted User
u Contact
c -> ChatController -> User -> IO () -> IO ()
whenCurrUser ChatController
cc User
u (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ChatTerminal -> Contact -> IO ()
unsetActiveContact ChatTerminal
ct Contact
c
      CRGroupDeletedUser User
u GroupInfo
g -> ChatController -> User -> IO () -> IO ()
whenCurrUser ChatController
cc User
u (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ChatTerminal -> GroupInfo -> IO ()
unsetActiveGroup ChatTerminal
ct GroupInfo
g
      CRSentGroupInvitation User
u GroupInfo
g Contact
_ GroupMember
_ -> ChatController -> User -> IO () -> IO ()
whenCurrUser ChatController
cc User
u (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ChatTerminal -> GroupInfo -> IO ()
setActiveGroup ChatTerminal
ct GroupInfo
g
      CRCmdOk Maybe User
_ -> case Either String ChatCommand
cmd of
        Right APIDeleteUser {} -> ChatTerminal -> String -> IO ()
setActive ChatTerminal
ct String
""
        Either String ChatCommand
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ChatResponse
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    isMessage :: Either a ChatCommand -> Bool
isMessage = \case
      Right SendMessage {} -> Bool
True
      Right SendLiveMessage {} -> Bool
True
      Right SendFile {} -> Bool
True
      Right SendMessageQuote {} -> Bool
True
      Right ForwardMessage {} -> Bool
True
      Right ForwardLocalMessage {} -> Bool
True
      Right SendGroupMessageQuote {} -> Bool
True
      Right ForwardGroupMessage {} -> Bool
True
      Right SendMessageBroadcast {} -> Bool
True
      Either a ChatCommand
_ -> Bool
False
    startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO ()
    startLiveMessage :: forall a. Either a ChatCommand -> ChatResponse -> IO ()
startLiveMessage (Right (SendLiveMessage ChatName
chatName Text
msg)) (CRNewChatItems {chatItems :: ChatResponse -> [AChatItem]
chatItems = [AChatItem SChatType c
cType SMsgDirection d
SMDSnd ChatInfo c
_ ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {UserId
itemId :: UserId
itemId :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UserId
itemId}}]}) = do
      IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Maybe LiveMessage -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe LiveMessage -> Bool) -> IO (Maybe LiveMessage) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Maybe LiveMessage) -> IO (Maybe LiveMessage)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe LiveMessage)
liveMessageState) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let s :: String
s = Text -> String
T.unpack Text
msg
            int :: Int
int = case SChatType c
cType of SChatType c
SCTGroup -> Int
5000000; SChatType c
_ -> Int
3000000 :: Int
        Weak ThreadId
liveThreadId <- ThreadId -> IO (Weak ThreadId)
mkWeakThreadId (ThreadId -> IO (Weak ThreadId))
-> IO ThreadId -> IO (Weak ThreadId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO ()
runLiveMessage Int
int IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
`forkFinally` IO () -> Either SomeException () -> IO ()
forall a b. a -> b -> a
const (STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe LiveMessage) -> Maybe LiveMessage -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe LiveMessage)
liveMessageState Maybe LiveMessage
forall a. Maybe a
Nothing)
        Weak ThreadId
promptThreadId <- ThreadId -> IO (Weak ThreadId)
mkWeakThreadId (ThreadId -> IO (Weak ThreadId))
-> IO ThreadId -> IO (Weak ThreadId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO () -> IO ThreadId
forkIO IO ()
blinkLivePrompt
        STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          let lm :: LiveMessage
lm = LiveMessage {ChatName
chatName :: ChatName
chatName :: ChatName
chatName, chatItemId :: UserId
chatItemId = UserId
itemId, livePrompt :: Bool
livePrompt = Bool
True, sentMsg :: String
sentMsg = String
s, typedMsg :: String
typedMsg = String
s, Weak ThreadId
liveThreadId :: Weak ThreadId
liveThreadId :: Weak ThreadId
liveThreadId, Weak ThreadId
promptThreadId :: Weak ThreadId
promptThreadId :: Weak ThreadId
promptThreadId}
          TVar (Maybe LiveMessage) -> Maybe LiveMessage -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe LiveMessage)
liveMessageState (LiveMessage -> Maybe LiveMessage
forall a. a -> Maybe a
Just LiveMessage
lm)
          TVar TerminalState -> (TerminalState -> TerminalState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar TerminalState
termState ((TerminalState -> TerminalState) -> STM ())
-> (TerminalState -> TerminalState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \TerminalState
ts -> TerminalState
ts {inputString = s, inputPosition = length s, inputPrompt = liveInputPrompt lm}
      where
        liveInputPrompt :: LiveMessage -> String
liveInputPrompt LiveMessage {chatName :: LiveMessage -> ChatName
chatName = ChatName
n, Bool
livePrompt :: LiveMessage -> Bool
livePrompt :: Bool
livePrompt} =
          String
"> " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChatName -> String
chatNameStr ChatName
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" [" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (if Bool
livePrompt then String
"LIVE" else String
"    ") String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"] "
        runLiveMessage :: Int -> IO ()
        runLiveMessage :: Int -> IO ()
runLiveMessage Int
int = do
          Int -> IO ()
threadDelay Int
int
          TerminalState {inputString :: TerminalState -> String
inputString = String
s} <- TVar TerminalState -> IO TerminalState
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar TerminalState
termState
          TVar (Maybe LiveMessage) -> IO (Maybe LiveMessage)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe LiveMessage)
liveMessageState
            IO (Maybe LiveMessage) -> (Maybe LiveMessage -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LiveMessage -> IO ()) -> Maybe LiveMessage -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\LiveMessage
lm -> String -> LiveMessage -> IO ()
updateLiveMessage String
s LiveMessage
lm IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
runLiveMessage Int
int)
        blinkLivePrompt :: IO ()
blinkLivePrompt = TVar (Maybe LiveMessage) -> IO (Maybe LiveMessage)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe LiveMessage)
liveMessageState IO (Maybe LiveMessage) -> (Maybe LiveMessage -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LiveMessage -> IO ()) -> Maybe LiveMessage -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LiveMessage -> IO ()
updateLivePrompt
          where
            updateLivePrompt :: LiveMessage -> IO ()
updateLivePrompt LiveMessage
lm = do
              STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ LiveMessage -> STM ()
updatePrompt LiveMessage
lm
              ChatTerminal -> IO ()
updateInputView ChatTerminal
ct
              Int -> IO ()
threadDelay Int
1000000
              IO ()
blinkLivePrompt
            updatePrompt :: LiveMessage -> STM ()
updatePrompt LiveMessage
lm = do
              TVar (Maybe LiveMessage) -> Maybe LiveMessage -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe LiveMessage)
liveMessageState (Maybe LiveMessage -> STM ()) -> Maybe LiveMessage -> STM ()
forall a b. (a -> b) -> a -> b
$ LiveMessage -> Maybe LiveMessage
forall a. a -> Maybe a
Just LiveMessage
lm {livePrompt = not $ livePrompt lm}
              TVar TerminalState -> (TerminalState -> TerminalState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar TerminalState
termState (\TerminalState
ts -> TerminalState
ts {inputPrompt = liveInputPrompt lm})
        liveMessageToSend :: String -> LiveMessage -> Maybe String
liveMessageToSend String
t LiveMessage {String
sentMsg :: LiveMessage -> String
sentMsg :: String
sentMsg, String
typedMsg :: LiveMessage -> String
typedMsg :: String
typedMsg} =
          let s :: String
s = if String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
typedMsg then String -> String
truncateToWords String
t else String
t
           in if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
sentMsg then String -> Maybe String
forall a. a -> Maybe a
Just String
s else Maybe String
forall a. Maybe a
Nothing
        updateLiveMessage :: String -> LiveMessage -> IO ()
updateLiveMessage String
typedMsg LiveMessage
lm = case String -> LiveMessage -> Maybe String
liveMessageToSend String
typedMsg LiveMessage
lm of
          Just String
sentMsg ->
            ChatController
-> String
-> LiveMessage
-> Bool
-> IO (Either ChatError ChatResponse)
sendUpdatedLiveMessage ChatController
cc String
sentMsg LiveMessage
lm Bool
True IO (Either ChatError ChatResponse)
-> (Either ChatError ChatResponse -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Right CRChatItemUpdated {} -> LiveMessage -> IO ()
setLiveMessage LiveMessage
lm {sentMsg, typedMsg}
              Either ChatError ChatResponse
_ -> do
                -- TODO print error
                LiveMessage -> IO ()
setLiveMessage LiveMessage
lm {typedMsg}
          Maybe String
_ -> LiveMessage -> IO ()
setLiveMessage LiveMessage
lm {typedMsg}
        setLiveMessage :: LiveMessage -> IO ()
        setLiveMessage :: LiveMessage -> IO ()
setLiveMessage = STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ())
-> (LiveMessage -> STM ()) -> LiveMessage -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Maybe LiveMessage) -> Maybe LiveMessage -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe LiveMessage)
liveMessageState (Maybe LiveMessage -> STM ())
-> (LiveMessage -> Maybe LiveMessage) -> LiveMessage -> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiveMessage -> Maybe LiveMessage
forall a. a -> Maybe a
Just
        truncateToWords :: String -> String
truncateToWords = (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Char -> (String, String))
-> (String, String) -> String -> (String, String)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (String, String) -> Char -> (String, String)
acc (String
"", String
"")
          where
            acc :: (String, String) -> Char -> (String, String)
acc (String
s, String
w) Char
c
              | Char -> Bool
isAlphaNum Char
c = (String
s, Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
w)
              | Bool
otherwise = (String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. [a] -> [a]
reverse (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
w), String
"")
    startLiveMessage Either a ChatCommand
_ ChatResponse
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

sendUpdatedLiveMessage :: ChatController -> String -> LiveMessage -> Bool -> IO (Either ChatError ChatResponse)
sendUpdatedLiveMessage :: ChatController
-> String
-> LiveMessage
-> Bool
-> IO (Either ChatError ChatResponse)
sendUpdatedLiveMessage ChatController
cc String
sentMsg LiveMessage {ChatName
chatName :: LiveMessage -> ChatName
chatName :: ChatName
chatName, UserId
chatItemId :: LiveMessage -> UserId
chatItemId :: UserId
chatItemId} Bool
live = do
  let cmd :: ChatCommand
cmd = ChatName -> UserId -> Bool -> Text -> ChatCommand
UpdateLiveMessage ChatName
chatName UserId
chatItemId Bool
live (Text -> ChatCommand) -> Text -> ChatCommand
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
sentMsg
  ChatCommand -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand' ChatCommand
cmd Int
0 CM' (Either ChatError ChatResponse)
-> ChatController -> IO (Either ChatError ChatResponse)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` ChatController
cc

runTerminalInput :: ChatTerminal -> ChatController -> IO ()
runTerminalInput :: ChatTerminal -> ChatController -> IO ()
runTerminalInput ChatTerminal
ct ChatController
cc = ChatTerminal
-> (forall {t}. WithTerminal t => TerminalT t IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
ChatTerminal
-> (forall t. WithTerminal t => TerminalT t m a) -> m a
withChatTerm ChatTerminal
ct ((forall {t}. WithTerminal t => TerminalT t IO ()) -> IO ())
-> (forall {t}. WithTerminal t => TerminalT t IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ChatTerminal -> TerminalT t IO ()
forall (m :: * -> *). MonadTerminal m => ChatTerminal -> m ()
updateInput ChatTerminal
ct
  ChatController -> ChatTerminal -> TerminalT t IO ()
forall (m :: * -> *).
MonadTerminal m =>
ChatController -> ChatTerminal -> m ()
receiveFromTTY ChatController
cc ChatTerminal
ct

receiveFromTTY :: forall m. MonadTerminal m => ChatController -> ChatTerminal -> m ()
receiveFromTTY :: forall (m :: * -> *).
MonadTerminal m =>
ChatController -> ChatTerminal -> m ()
receiveFromTTY cc :: ChatController
cc@ChatController {TBQueue String
inputQ :: ChatController -> TBQueue String
inputQ :: TBQueue String
inputQ, TVar (Maybe User)
currentUser :: TVar (Maybe User)
currentUser :: ChatController -> TVar (Maybe User)
currentUser, TVar (Maybe UserId)
currentRemoteHost :: ChatController -> TVar (Maybe UserId)
currentRemoteHost :: TVar (Maybe UserId)
currentRemoteHost, DBStore
chatStore :: DBStore
chatStore :: ChatController -> DBStore
chatStore} ct :: ChatTerminal
ct@ChatTerminal {Size
termSize :: Size
termSize :: ChatTerminal -> Size
termSize, TVar TerminalState
termState :: ChatTerminal -> TVar TerminalState
termState :: TVar TerminalState
termState, TVar (Maybe LiveMessage)
liveMessageState :: ChatTerminal -> TVar (Maybe LiveMessage)
liveMessageState :: TVar (Maybe LiveMessage)
liveMessageState, TVar String
activeTo :: TVar String
activeTo :: ChatTerminal -> TVar String
activeTo} =
  m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m (Key, Modifiers)
forall (m :: * -> *). MonadTerminal m => m (Key, Modifiers)
getKey m (Key, Modifiers) -> ((Key, Modifiers) -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Key, Modifiers) -> IO ()) -> (Key, Modifiers) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Modifiers) -> IO ()
processKey m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ChatTerminal -> m () -> m ()
forall (m :: * -> *).
MonadTerminal m =>
ChatTerminal -> m () -> m ()
withTermLock ChatTerminal
ct (ChatTerminal -> m ()
forall (m :: * -> *). MonadTerminal m => ChatTerminal -> m ()
updateInput ChatTerminal
ct)
  where
    processKey :: (Key, Modifiers) -> IO ()
    processKey :: (Key, Modifiers) -> IO ()
processKey (Key, Modifiers)
key = case (Key, Modifiers)
key of
      (Key
EnterKey, Modifiers
ms)
        | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
forall a. Monoid a => a
mempty -> Bool -> IO ()
submit Bool
False
        | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
altKey -> Bool -> IO ()
submit Bool
True
        | Bool
otherwise -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (CharKey Char
c, Modifiers
ms)
        | (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'l' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'L') Bool -> Bool -> Bool
&& Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
ctrlKey -> Bool -> IO ()
submit Bool
True
        | Bool
otherwise -> (Key, Modifiers) -> IO ()
update (Key, Modifiers)
key
      (Key, Modifiers)
_ -> (Key, Modifiers) -> IO ()
update (Key, Modifiers)
key
    submit :: Bool -> IO ()
submit Bool
live = do
      TerminalState
ts <- TVar TerminalState -> IO TerminalState
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar TerminalState
termState
      Bool
isLive <- Maybe LiveMessage -> Bool
forall a. Maybe a -> Bool
isJust (Maybe LiveMessage -> Bool) -> IO (Maybe LiveMessage) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Maybe LiveMessage) -> IO (Maybe LiveMessage)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe LiveMessage)
liveMessageState
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TerminalState -> String
inputString TerminalState
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
|| Bool
isLive) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        STM (Maybe (String, LiveMessage))
-> IO (Maybe (String, LiveMessage))
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (Bool -> TerminalState -> STM (Maybe (String, LiveMessage))
submitInput Bool
live TerminalState
ts) IO (Maybe (String, LiveMessage))
-> (Maybe (String, LiveMessage) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((String, LiveMessage) -> IO ())
-> Maybe (String, LiveMessage) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> LiveMessage -> IO ()) -> (String, LiveMessage) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> LiveMessage -> IO ()
endLiveMessage)
    update :: (Key, Modifiers) -> IO ()
update (Key, Modifiers)
key = do
      String
chatPrefix <- TVar String -> IO String
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar String
activeTo
      Bool
live <- Maybe LiveMessage -> Bool
forall a. Maybe a -> Bool
isJust (Maybe LiveMessage -> Bool) -> IO (Maybe LiveMessage) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Maybe LiveMessage) -> IO (Maybe LiveMessage)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe LiveMessage)
liveMessageState
      TerminalState
ts <- TVar TerminalState -> IO TerminalState
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar TerminalState
termState
      Maybe User
user_ <- TVar (Maybe User) -> IO (Maybe User)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe User)
currentUser
      TerminalState
ts' <- Maybe User
-> DBStore
-> String
-> Bool
-> Int
-> (Key, Modifiers)
-> TerminalState
-> IO TerminalState
updateTermState Maybe User
user_ DBStore
chatStore String
chatPrefix Bool
live (Size -> Int
width Size
termSize) (Key, Modifiers)
key TerminalState
ts
      STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar TerminalState -> TerminalState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TerminalState
termState (TerminalState -> STM ()) -> TerminalState -> STM ()
forall a b. (a -> b) -> a -> b
$! TerminalState
ts'

    endLiveMessage :: String -> LiveMessage -> IO ()
    endLiveMessage :: String -> LiveMessage -> IO ()
endLiveMessage String
sentMsg LiveMessage
lm = do
      (LiveMessage -> Weak ThreadId) -> IO ()
kill LiveMessage -> Weak ThreadId
liveThreadId
      (LiveMessage -> Weak ThreadId) -> IO ()
kill LiveMessage -> Weak ThreadId
promptThreadId
      STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe LiveMessage) -> Maybe LiveMessage -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe LiveMessage)
liveMessageState Maybe LiveMessage
forall a. Maybe a
Nothing
      Either ChatError ChatResponse
r <- ChatController
-> String
-> LiveMessage
-> Bool
-> IO (Either ChatError ChatResponse)
sendUpdatedLiveMessage ChatController
cc String
sentMsg LiveMessage
lm Bool
False
      Maybe UserId
rh <- TVar (Maybe UserId) -> IO (Maybe UserId)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe UserId)
currentRemoteHost -- XXX: should be inherited from live message state
      ChatTerminal
-> ChatController
-> Bool
-> Maybe UserId
-> Either ChatError ChatResponse
-> IO ()
printRespToTerminal ChatTerminal
ct ChatController
cc Bool
False Maybe UserId
rh Either ChatError ChatResponse
r
      where
        kill :: (LiveMessage -> Weak ThreadId) -> IO ()
kill LiveMessage -> Weak ThreadId
sel = Weak ThreadId -> IO (Maybe ThreadId)
forall v. Weak v -> IO (Maybe v)
deRefWeak (LiveMessage -> Weak ThreadId
sel LiveMessage
lm) IO (Maybe ThreadId) -> (Maybe ThreadId -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ThreadId -> IO ()) -> Maybe ThreadId -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ThreadId -> IO ()
killThread

    submitInput :: Bool -> TerminalState -> STM (Maybe (String, LiveMessage))
    submitInput :: Bool -> TerminalState -> STM (Maybe (String, LiveMessage))
submitInput Bool
live TerminalState
ts = do
      let s :: String
s = TerminalState -> String
inputString TerminalState
ts
      Maybe LiveMessage
lm_ <- TVar (Maybe LiveMessage) -> STM (Maybe LiveMessage)
forall a. TVar a -> STM a
readTVar TVar (Maybe LiveMessage)
liveMessageState
      case Maybe LiveMessage
lm_ of
        Just LiveMessage {ChatName
chatName :: LiveMessage -> ChatName
chatName :: ChatName
chatName}
          | Bool
live -> do
              TVar TerminalState -> TerminalState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TerminalState
termState TerminalState
ts' {previousInput}
              TBQueue String -> String -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue String
inputQ (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ String
"/live " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChatName -> String
chatNameStr ChatName
chatName
          | Bool
otherwise ->
              TVar TerminalState -> TerminalState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TerminalState
termState TerminalState
ts' {inputPrompt = "> ", previousInput}
          where
            previousInput :: String
previousInput = ChatName -> String
chatNameStr ChatName
chatName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s
        Maybe LiveMessage
_
          | Bool
live -> Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
isSend String
s) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
              TVar TerminalState -> TerminalState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TerminalState
termState TerminalState
ts' {previousInput = s}
              TBQueue String -> String -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue String
inputQ (String -> STM ()) -> String -> STM ()
forall a b. (a -> b) -> a -> b
$ String
"/live " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s
          | Bool
otherwise -> do
              TVar TerminalState -> TerminalState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TerminalState
termState TerminalState
ts' {inputPrompt = "> ", previousInput = s}
              TBQueue String -> String -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue String
inputQ String
s
      Maybe (String, LiveMessage) -> STM (Maybe (String, LiveMessage))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (String, LiveMessage) -> STM (Maybe (String, LiveMessage)))
-> Maybe (String, LiveMessage) -> STM (Maybe (String, LiveMessage))
forall a b. (a -> b) -> a -> b
$ (String
s,) (LiveMessage -> (String, LiveMessage))
-> Maybe LiveMessage -> Maybe (String, LiveMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LiveMessage
lm_
      where
        isSend :: String -> Bool
isSend String
s = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& (String -> Char
forall a. HasCallStack => [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' Bool -> Bool -> Bool
|| String -> Char
forall a. HasCallStack => [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
        ts' :: TerminalState
ts' = TerminalState
ts {inputString = "", inputPosition = 0, autoComplete = mkAutoComplete}

data AutoComplete
  = ACContact Text
  | ACContactRequest Text
  | ACMember Text Text
  | ACGroup Text
  | ACCommand Text
  | ACNone

updateTermState :: Maybe User -> DBStore -> String -> Bool -> Int -> (Key, Modifiers) -> TerminalState -> IO TerminalState
updateTermState :: Maybe User
-> DBStore
-> String
-> Bool
-> Int
-> (Key, Modifiers)
-> TerminalState
-> IO TerminalState
updateTermState Maybe User
user_ DBStore
st String
chatPrefix Bool
live Int
tw (Key
key, Modifiers
ms) ts :: TerminalState
ts@TerminalState {inputString :: TerminalState -> String
inputString = String
s, inputPosition :: TerminalState -> Int
inputPosition = Int
p, autoComplete :: TerminalState -> AutoCompleteState
autoComplete = AutoCompleteState
acp} = case Key
key of
  CharKey Char
c
    | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
|| Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
shiftKey -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TerminalState -> IO TerminalState)
-> TerminalState -> IO TerminalState
forall a b. (a -> b) -> a -> b
$ String -> TerminalState
insertChars (String -> TerminalState) -> String -> TerminalState
forall a b. (a -> b) -> a -> b
$ String -> String
charsWithContact [Char
c]
    | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
altKey Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'b' -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TerminalState -> IO TerminalState)
-> TerminalState -> IO TerminalState
forall a b. (a -> b) -> a -> b
$ Int -> TerminalState
setPosition Int
prevWordPos
    | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
altKey Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'f' -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TerminalState -> IO TerminalState)
-> TerminalState -> IO TerminalState
forall a b. (a -> b) -> a -> b
$ Int -> TerminalState
setPosition Int
nextWordPos
    | Bool
otherwise -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalState
ts
  Key
TabKey -> do
    (String
pfx, [String]
vs) <- Maybe User -> IO (String, [String])
autoCompleteVariants Maybe User
user_
    let sv :: ACShowVariants
sv = AutoCompleteState -> ACShowVariants
acShowVariants AutoCompleteState
acp
        sv' :: ACShowVariants
sv'
          | Bool -> Bool
not (AutoCompleteState -> Bool
acTabPressed AutoCompleteState
acp) = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pfx Bool -> Bool -> Bool
|| ACShowVariants
sv ACShowVariants -> ACShowVariants -> Bool
forall a. Eq a => a -> a -> Bool
/= ACShowVariants
SVNone then ACShowVariants
SVSome else ACShowVariants
SVNone
          | ACShowVariants
sv ACShowVariants -> ACShowVariants -> Bool
forall a. Eq a => a -> a -> Bool
== ACShowVariants
SVNone = ACShowVariants
SVSome
          | ACShowVariants
sv ACShowVariants -> ACShowVariants -> Bool
forall a. Eq a => a -> a -> Bool
== ACShowVariants
SVSome Bool -> Bool -> Bool
&& [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
vs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 = ACShowVariants
SVAll
          | Bool
otherwise = ACShowVariants
SVNone
        acp' :: AutoCompleteState
acp' = AutoCompleteState
acp {acVariants = vs, acInputString = s, acShowVariants = sv', acTabPressed = True}
    TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TerminalState -> IO TerminalState)
-> TerminalState -> IO TerminalState
forall a b. (a -> b) -> a -> b
$ (String -> TerminalState
insertChars String
pfx) {autoComplete = acp'}
  Key
BackspaceKey -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalState
backDeleteChar
  Key
DeleteKey -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalState
deleteChar
  Key
HomeKey -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TerminalState -> IO TerminalState)
-> TerminalState -> IO TerminalState
forall a b. (a -> b) -> a -> b
$ Int -> TerminalState
setPosition Int
0
  Key
EndKey -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TerminalState -> IO TerminalState)
-> TerminalState -> IO TerminalState
forall a b. (a -> b) -> a -> b
$ Int -> TerminalState
setPosition (Int -> TerminalState) -> Int -> TerminalState
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
  ArrowKey Direction
d -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TerminalState -> IO TerminalState)
-> TerminalState -> IO TerminalState
forall a b. (a -> b) -> a -> b
$ case Direction
d of
    Direction
Leftwards -> Int -> TerminalState
setPosition Int
leftPos
    Direction
Rightwards -> Int -> TerminalState
setPosition Int
rightPos
    Direction
Upwards
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s -> let s' :: String
s' = String -> String
upArrowCmd (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ TerminalState -> String
previousInput TerminalState
ts in (String, Int) -> TerminalState
ts' (String
s', String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s')
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
forall a. Monoid a => a
mempty -> let p' :: Int
p' = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tw in if Int
p' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> TerminalState
setPosition Int
p' else TerminalState
ts
      | Bool
otherwise -> TerminalState
ts
    Direction
Downwards
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
forall a. Monoid a => a
mempty -> let p' :: Int
p' = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tw in if Int
p' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s then Int -> TerminalState
setPosition Int
p' else TerminalState
ts
      | Bool
otherwise -> TerminalState
ts
  Key
_ -> TerminalState -> IO TerminalState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalState
ts
  where
    autoCompleteVariants :: Maybe User -> IO (String, [String])
autoCompleteVariants Maybe User
Nothing = (String, [String]) -> IO (String, [String])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
"", [String -> String
charsWithContact String
"    "])
    autoCompleteVariants (Just User {UserId
userId :: UserId
userId :: User -> UserId
userId, UserId
userContactId :: UserId
userContactId :: User -> UserId
userContactId}) =
      AutoComplete -> IO (String, [String])
getAutoCompleteChars (AutoComplete -> IO (String, [String]))
-> AutoComplete -> IO (String, [String])
forall a b. (a -> b) -> a -> b
$ AutoComplete -> Either String AutoComplete -> AutoComplete
forall b a. b -> Either a b -> b
fromRight AutoComplete
ACNone (Either String AutoComplete -> AutoComplete)
-> Either String AutoComplete -> AutoComplete
forall a b. (a -> b) -> a -> b
$ Parser AutoComplete -> ByteString -> Either String AutoComplete
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser AutoComplete
autoCompleteP (ByteString -> Either String AutoComplete)
-> ByteString -> Either String AutoComplete
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
      where
        autoCompleteP :: Parser AutoComplete
autoCompleteP =
          [Parser AutoComplete] -> Parser AutoComplete
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
            [ Text -> AutoComplete
ACContact (Text -> AutoComplete)
-> Parser ByteString Text -> Parser AutoComplete
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
contactPfx Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayName Parser ByteString Text
-> Parser ByteString () -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput),
              Text -> AutoComplete
ACContactRequest (Text -> AutoComplete)
-> Parser ByteString Text -> Parser AutoComplete
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
contactReqPfx Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayName Parser ByteString Text
-> Parser ByteString () -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput),
              Text -> Text -> AutoComplete
ACMember (Text -> Text -> AutoComplete)
-> Parser ByteString Text
-> Parser ByteString (Text -> AutoComplete)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
groupMemberPfx Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayName) Parser ByteString (Text -> AutoComplete)
-> Parser ByteString Char
-> Parser ByteString (Text -> AutoComplete)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> AutoComplete)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> AutoComplete)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
'@') Parser ByteString (Text -> AutoComplete)
-> Parser ByteString Text -> Parser AutoComplete
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayName Parser AutoComplete -> Parser ByteString () -> Parser AutoComplete
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput,
              Text -> AutoComplete
ACGroup (Text -> AutoComplete)
-> Parser ByteString Text -> Parser AutoComplete
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
groupPfx Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayName Parser ByteString Text
-> Parser ByteString () -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput),
              Text -> AutoComplete
ACCommand (Text -> AutoComplete)
-> (ByteString -> Text) -> ByteString -> AutoComplete
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> AutoComplete)
-> Parser ByteString ByteString -> Parser AutoComplete
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) (ByteString -> ByteString -> ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"/" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
alphaP) Parser ByteString (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> ByteString -> ByteString
B.cons (Char -> ByteString -> ByteString)
-> Parser ByteString Char
-> Parser ByteString (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
A.space Parser ByteString (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
alphaP Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"")) Parser AutoComplete -> Parser ByteString () -> Parser AutoComplete
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput
            ]
        displayName :: Parser ByteString Text
displayName = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ByteString -> ByteString
B.cons (Char -> ByteString -> ByteString)
-> Parser ByteString Char
-> Parser ByteString (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString Char
A.satisfy Char -> Bool
refChar Parser ByteString (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"")
        refChar :: Char -> Bool
refChar Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@'
        alphaP :: Parser ByteString ByteString
alphaP = (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile ((Char -> Bool) -> Parser ByteString ByteString)
-> (Char -> Bool) -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c
        contactPfx :: Parser ByteString ByteString
contactPfx =
          [Parser ByteString ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice ([Parser ByteString ByteString] -> Parser ByteString ByteString)
-> [Parser ByteString ByteString] -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
            Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
ops Char
'@' [Parser ByteString ByteString
">>", Parser ByteString ByteString
">", Parser ByteString ByteString
"!", Parser ByteString ByteString
"\\"]
              [Parser ByteString ByteString]
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall a. Semigroup a => a -> a -> a
<> Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd Char
'@' [Parser ByteString ByteString
"t", Parser ByteString ByteString
"tail", Parser ByteString ByteString
"?", Parser ByteString ByteString
"search", Parser ByteString ByteString
"set voice", Parser ByteString ByteString
"set delete", Parser ByteString ByteString
"set disappear"]
              [Parser ByteString ByteString]
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall a. Semigroup a => a -> a -> a
<> Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd_ Char
'@' [Parser ByteString ByteString
"i ", Parser ByteString ByteString
"info ", Parser ByteString ByteString
"f ", Parser ByteString ByteString
"file ", Parser ByteString ByteString
"clear", Parser ByteString ByteString
"d ", Parser ByteString ByteString
"delete ", Parser ByteString ByteString
"code ", Parser ByteString ByteString
"verify "]
              [Parser ByteString ByteString]
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall a. Semigroup a => a -> a -> a
<> [Parser ByteString ByteString
"@"]
        contactReqPfx :: Parser ByteString ByteString
contactReqPfx = [Parser ByteString ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice ([Parser ByteString ByteString] -> Parser ByteString ByteString)
-> [Parser ByteString ByteString] -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd_ Char
'@' [Parser ByteString ByteString
"ac", Parser ByteString ByteString
"accept", Parser ByteString ByteString
"rc", Parser ByteString ByteString
"reject"]
        groupPfx :: Parser ByteString ByteString
groupPfx =
          [Parser ByteString ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice ([Parser ByteString ByteString] -> Parser ByteString ByteString)
-> [Parser ByteString ByteString] -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
            Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
ops Char
'#' [Parser ByteString ByteString
">", Parser ByteString ByteString
"!", Parser ByteString ByteString
"\\\\", Parser ByteString ByteString
"\\"]
              [Parser ByteString ByteString]
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall a. Semigroup a => a -> a -> a
<> Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd Char
'#' [Parser ByteString ByteString
"t", Parser ByteString ByteString
"tail", Parser ByteString ByteString
"?", Parser ByteString ByteString
"search", Parser ByteString ByteString
"i", Parser ByteString ByteString
"info", Parser ByteString ByteString
"f", Parser ByteString ByteString
"file", Parser ByteString ByteString
"clear", Parser ByteString ByteString
"d", Parser ByteString ByteString
"delete", Parser ByteString ByteString
"code", Parser ByteString ByteString
"verify", Parser ByteString ByteString
"set voice", Parser ByteString ByteString
"set delete", Parser ByteString ByteString
"set disappear", Parser ByteString ByteString
"set direct"]
              [Parser ByteString ByteString]
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall a. Semigroup a => a -> a -> a
<> Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd_ Char
'#' [Parser ByteString ByteString
"a", Parser ByteString ByteString
"add", Parser ByteString ByteString
"j", Parser ByteString ByteString
"join", Parser ByteString ByteString
"rm", Parser ByteString ByteString
"remove", Parser ByteString ByteString
"l", Parser ByteString ByteString
"leave", Parser ByteString ByteString
"ms", Parser ByteString ByteString
"members", Parser ByteString ByteString
"mr", Parser ByteString ByteString
"member role"]
              [Parser ByteString ByteString]
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall a. Semigroup a => a -> a -> a
<> [Parser ByteString ByteString
"#"]
        groupMemberPfx :: Parser ByteString ByteString
groupMemberPfx =
          [Parser ByteString ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice ([Parser ByteString ByteString] -> Parser ByteString ByteString)
-> [Parser ByteString ByteString] -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
            Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
ops Char
'#' [Parser ByteString ByteString
">", Parser ByteString ByteString
"\\\\"]
              [Parser ByteString ByteString]
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall a. Semigroup a => a -> a -> a
<> Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd Char
'#' [Parser ByteString ByteString
"i", Parser ByteString ByteString
"info", Parser ByteString ByteString
"code", Parser ByteString ByteString
"verify"]
              [Parser ByteString ByteString]
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall a. Semigroup a => a -> a -> a
<> Char
-> [Parser ByteString ByteString] -> [Parser ByteString ByteString]
forall {a}. Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd_ Char
'#' [Parser ByteString ByteString
"rm", Parser ByteString ByteString
"remove", Parser ByteString ByteString
"l", Parser ByteString ByteString
"leave", Parser ByteString ByteString
"mr", Parser ByteString ByteString
"member role"]
        ops :: Char -> [Parser ByteString a] -> [Parser ByteString a]
ops Char
c = (Parser ByteString a -> Parser ByteString a)
-> [Parser ByteString a] -> [Parser ByteString a]
forall a b. (a -> b) -> [a] -> [b]
map (Parser ByteString a
-> Parser ByteString (Maybe Char) -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Char
A.space Parser ByteString (Maybe Char)
-> Parser ByteString Char -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
c))
        cmd :: Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd Char
c = (Parser ByteString a -> Parser ByteString a)
-> [Parser ByteString a] -> [Parser ByteString a]
forall a b. (a -> b) -> [a] -> [b]
map ((Parser ByteString a -> Parser ByteString a)
 -> [Parser ByteString a] -> [Parser ByteString a])
-> (Parser ByteString a -> Parser ByteString a)
-> [Parser ByteString a]
-> [Parser ByteString a]
forall a b. (a -> b) -> a -> b
$ \Parser ByteString a
t -> Char -> Parser ByteString Char
A.char Char
'/' Parser ByteString Char
-> Parser ByteString a -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
t Parser ByteString a
-> Parser ByteString Char -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString a
-> Parser ByteString Char -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
c
        cmd_ :: Char -> [Parser ByteString a] -> [Parser ByteString a]
cmd_ Char
c = (Parser ByteString a -> Parser ByteString a)
-> [Parser ByteString a] -> [Parser ByteString a]
forall a b. (a -> b) -> [a] -> [b]
map ((Parser ByteString a -> Parser ByteString a)
 -> [Parser ByteString a] -> [Parser ByteString a])
-> (Parser ByteString a -> Parser ByteString a)
-> [Parser ByteString a]
-> [Parser ByteString a]
forall a b. (a -> b) -> a -> b
$ \Parser ByteString a
t -> Char -> Parser ByteString Char
A.char Char
'/' Parser ByteString Char
-> Parser ByteString a -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
t Parser ByteString a
-> Parser ByteString Char -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString a
-> Parser ByteString (Maybe Char) -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
c)
        getAutoCompleteChars :: AutoComplete -> IO (String, [String])
getAutoCompleteChars = \case
          ACContact Text
pfx -> Text -> [String] -> (String, [String])
common Text
pfx ([String] -> (String, [String]))
-> IO [String] -> IO (String, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO [String]
getContactSfxs Text
pfx
          ACContactRequest Text
pfx -> Text -> [String] -> (String, [String])
common Text
pfx ([String] -> (String, [String]))
-> IO [String] -> IO (String, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> Text -> IO [String]
getNameSfxs Query
"contact_requests" Text
pfx
          ACGroup Text
pfx -> Text -> [String] -> (String, [String])
common Text
pfx ([String] -> (String, [String]))
-> IO [String] -> IO (String, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> Text -> IO [String]
getNameSfxs Query
"groups" Text
pfx
          ACMember Text
gName Text
pfx -> Text -> [String] -> (String, [String])
common Text
pfx ([String] -> (String, [String]))
-> IO [String] -> IO (String, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> IO [String]
getMemberNameSfxs Text
gName Text
pfx
          ACCommand Text
pfx -> (String, [String]) -> IO (String, [String])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, [String]) -> IO (String, [String]))
-> (String, [String]) -> IO (String, [String])
forall a b. (a -> b) -> a -> b
$ ([String] -> [String]) -> (String, [String]) -> (String, [String])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
:)) ((String, [String]) -> (String, [String]))
-> (String, [String]) -> (String, [String])
forall a b. (a -> b) -> a -> b
$ Text -> [String] -> (String, [String])
common Text
pfx ([String] -> (String, [String])) -> [String] -> (String, [String])
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [String]
hasPfx Text
pfx [Text]
commands
          AutoComplete
ACNone -> (String, [String]) -> IO (String, [String])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
"", [String -> String
charsWithContact String
""])
          where
            getMemberNameSfxs :: Text -> Text -> IO [String]
getMemberNameSfxs Text
gName Text
pfx =
              Text -> (UserId, UserId, Text, Text) -> Query -> IO [String]
forall p. ToRow p => Text -> p -> Query -> IO [String]
getNameSfxs_
                Text
pfx
                (UserId
userId, UserId
userContactId, Text
gName, Text
pfx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%")
                [sql|
                  SELECT m.local_display_name
                  FROM group_members m
                  JOIN groups g USING (group_id)
                  WHERE g.user_id = ?
                    AND (m.contact_id IS NULL OR m.contact_id != ?)
                    AND g.local_display_name = ?
                    AND m.local_display_name LIKE ?
                |]
            getContactSfxs :: Text -> IO [String]
getContactSfxs Text
pfx =
              Text -> (UserId, Text) -> Query -> IO [String]
forall p. ToRow p => Text -> p -> Query -> IO [String]
getNameSfxs_
                Text
pfx
                (UserId
userId, Text
pfx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%")
                Query
"SELECT local_display_name FROM contacts WHERE is_user = 0 AND user_id = ? AND local_display_name LIKE ?"
            getNameSfxs :: Query -> Text -> IO [String]
getNameSfxs Query
table Text
pfx =
              Text -> (UserId, Text) -> Query -> IO [String]
forall p. ToRow p => Text -> p -> Query -> IO [String]
getNameSfxs_ Text
pfx (UserId
userId, Text
pfx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%") (Query -> IO [String]) -> Query -> IO [String]
forall a b. (a -> b) -> a -> b
$
                Query
"SELECT local_display_name FROM " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
table Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE user_id = ? AND local_display_name LIKE ?"
            getNameSfxs_ :: ToRow p => Text -> p -> Query -> IO [String]
            getNameSfxs_ :: forall p. ToRow p => Text -> p -> Query -> IO [String]
getNameSfxs_ Text
pfx p
ps Query
q =
              DBStore -> (Connection -> IO [String]) -> IO [String]
forall a. DBStore -> (Connection -> IO a) -> IO a
withTransaction DBStore
st (\Connection
db -> Text -> [Text] -> [String]
hasPfx Text
pfx ([Text] -> [String])
-> ([Only Text] -> [Text]) -> [Only Text] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only Text -> Text) -> [Only Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Only Text -> Text
forall a. Only a -> a
fromOnly ([Only Text] -> [String]) -> IO [Only Text] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> p -> IO [Only Text]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
q p
ps) IO [String] -> IO [String] -> IO [String]
forall a. IO a -> IO a -> IO a
`catchAll_` [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            commands :: [Text]
commands =
              [Text
"connect", Text
"search", Text
"tail", Text
"info", Text
"clear", Text
"delete", Text
"code", Text
"verify"]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"file", Text
"freceive", Text
"fcancel", Text
"fstatus", Text
"fforward", Text
"image", Text
"image_forward"]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"address", Text
"delete_address", Text
"show_address", Text
"auto_accept", Text
"accept @", Text
"reject @"]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"group", Text
"groups", Text
"members #", Text
"member role #", Text
"add #", Text
"join #", Text
"remove #", Text
"leave #"]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"create link #", Text
"set link role #", Text
"delete link #", Text
"show link #"]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"set voice", Text
"set delete", Text
"set direct #", Text
"set disappear", Text
"mute", Text
"unmute"]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"create user", Text
"profile", Text
"users", Text
"user", Text
"mute user", Text
"unmute user", Text
"hide user", Text
"unhide user", Text
"delete user"]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"chats", Text
"contacts", Text
"help", Text
"markdown", Text
"quit", Text
"db export", Text
"db encrypt", Text
"db decrypt", Text
"db key"]
            hasPfx :: Text -> [Text] -> [String]
hasPfx Text
pfx = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> ([Text] -> [Text]) -> [Text] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text
pfx Text -> Text -> Bool
`T.isPrefixOf`)
            common :: Text -> [String] -> (String, [String])
common Text
pfx [String]
xs = ([String] -> String
commonPrefix ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int -> String -> String) -> Int -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
pfx) [String]
xs, [String]
xs)
    commonPrefix :: [String] -> String
commonPrefix = \case
      String
x : [String]
xs -> (String -> String -> String) -> String -> [String] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> String -> String
go String
x [String]
xs
      [String]
_ -> String
""
      where
        go :: String -> String -> String
go (Char
c : String
cs) (Char
c' : String
cs')
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
go String
cs String
cs'
          | Bool
otherwise = String
""
        go String
_ String
_ = String
""
    charsWithContact :: String -> String
charsWithContact String
cs
      | Bool
live = String
cs
      | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"@" Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"#" Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"/" Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
">" Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"\\" Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"!" Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"+" Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"-" =
          String
chatPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cs
      | (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
">" Bool -> Bool -> Bool
|| String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"\\" Bool -> Bool -> Bool
|| String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"!") Bool -> Bool -> Bool
&& String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
" " =
          String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
chatPrefix
      | Bool
otherwise = String
cs
    insertChars :: String -> TerminalState
insertChars = (String, Int) -> TerminalState
ts' ((String, Int) -> TerminalState)
-> (String -> (String, Int)) -> String -> TerminalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s then String -> (String, Int)
append else String -> (String, Int)
insert
    append :: String -> (String, Int)
append String
cs = let s' :: String
s' = String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cs in (String
s', String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s')
    insert :: String -> (String, Int)
insert String
cs = let (String
b, String
a) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
p String
s in (String
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
a, Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs)
    backDeleteChar :: TerminalState
backDeleteChar
      | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = TerminalState
ts
      | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s = (String, Int) -> TerminalState
ts' (String -> String
forall a. HasCallStack => [a] -> [a]
init String
s, String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      | Bool
otherwise = let (String
b, String
a) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
p String
s in (String, Int) -> TerminalState
ts' (String -> String
forall a. HasCallStack => [a] -> [a]
init String
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
a, Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    deleteChar :: TerminalState
deleteChar
      | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Bool -> Bool -> Bool
|| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = TerminalState
ts
      | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (String, Int) -> TerminalState
ts' (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
s, Int
0)
      | Bool
otherwise = let (String
b, String
a) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
p String
s in (String, Int) -> TerminalState
ts' (String
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. HasCallStack => [a] -> [a]
tail String
a, Int
p)
    leftPos :: Int
leftPos
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
forall a. Monoid a => a
mempty = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
shiftKey = Int
0
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
ctrlKey = Int
prevWordPos
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
altKey = Int
prevWordPos
      | Bool
otherwise = Int
p
    rightPos :: Int
rightPos
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
forall a. Monoid a => a
mempty = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
shiftKey = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
ctrlKey = Int
nextWordPos
      | Modifiers
ms Modifiers -> Modifiers -> Bool
forall a. Eq a => a -> a -> Bool
== Modifiers
altKey = Int
nextWordPos
      | Bool
otherwise = Int
p
    upArrowCmd :: String -> String
upArrowCmd String
inp = case ByteString -> Either String ChatCommand
parseChatCommand (ByteString -> Either String ChatCommand)
-> (Text -> ByteString) -> Text -> Either String ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Either String ChatCommand)
-> Text -> Either String ChatCommand
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
inp of
      Left String
_ -> String
inp
      Right ChatCommand
cmd -> case ChatCommand
cmd of
        SendMessage {} -> String
"! " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
inp
        SendMessageQuote {Text
contactName :: Text
contactName :: ChatCommand -> Text
contactName, Text
message :: Text
message :: ChatCommand -> Text
message} -> Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"! @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contactName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message
        SendGroupMessageQuote {Text
groupName :: Text
groupName :: ChatCommand -> Text
groupName, Text
message :: ChatCommand -> Text
message :: Text
message} -> Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"! #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
groupName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message
        ChatCommand
_ -> String
inp
    setPosition :: Int -> TerminalState
setPosition Int
p' = (String, Int) -> TerminalState
ts' (String
s, Int
p')
    prevWordPos :: Int
prevWordPos
      | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = Int
p
      | Bool
otherwise =
          let before :: String
before = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
p String
s
              beforeWord :: String
beforeWord = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
before
           in Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
beforeWord
    nextWordPos :: Int
nextWordPos
      | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Bool -> Bool -> Bool
|| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = Int
p
      | Bool
otherwise =
          let after :: String
after = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
p String
s
              afterWord :: String
afterWord = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
after
           in Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
after Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
afterWord
    ts' :: (String, Int) -> TerminalState
ts' (String
s', Int
p') = TerminalState
ts {inputString = s', inputPosition = p', autoComplete = acp {acTabPressed = False}}