mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
switch to JSON single field encodings for sum types to align with Swift enums (#229)
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
28ee40074a
commit
37cfb93217
+3
-3
@@ -777,7 +777,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
notifyMemberConnected :: GroupInfo -> GroupMember -> m ()
|
||||
notifyMemberConnected gInfo m@GroupMember {localDisplayName = c} = do
|
||||
toView $ CRConnectedToGroupMember gInfo m
|
||||
let g = groupName gInfo
|
||||
let g = groupName' gInfo
|
||||
setActive $ ActiveG g
|
||||
showToast ("#" <> g) $ "member " <> c <> " is connected"
|
||||
|
||||
@@ -812,7 +812,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
newGroupContentMessage gInfo m@GroupMember {localDisplayName = c} mc msgId msgMeta = do
|
||||
ci <- saveRcvGroupChatItem userId gInfo m msgId msgMeta (CIMsgContent mc)
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
|
||||
let g = groupName gInfo
|
||||
let g = groupName' gInfo
|
||||
showToast ("#" <> g <> " " <> c <> "> ") $ msgContentText mc
|
||||
setActive $ ActiveG g
|
||||
|
||||
@@ -834,7 +834,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
ci <- saveRcvGroupChatItem userId gInfo m msgId msgMeta (CIRcvFileInvitation ft)
|
||||
withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId ci
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
|
||||
let g = groupName gInfo
|
||||
let g = groupName' gInfo
|
||||
showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file"
|
||||
setActive $ ActiveG g
|
||||
|
||||
|
||||
@@ -23,11 +23,12 @@ import Numeric.Natural
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Store (StoreError)
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (enumJSON, singleFieldJSON)
|
||||
import Simplex.Messaging.Agent (AgentClient)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig)
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
|
||||
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
|
||||
import Simplex.Messaging.Parsers (dropPrefix)
|
||||
import Simplex.Messaging.Protocol (CorrId)
|
||||
import System.IO (Handle)
|
||||
import UnliftIO.STM
|
||||
@@ -72,8 +73,8 @@ data HelpSection = HSMain | HSFiles | HSGroups | HSMyAddress | HSMarkdown
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON HelpSection where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "HS"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "HS"
|
||||
toJSON = J.genericToJSON . enumJSON $ dropPrefix "HS"
|
||||
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "HS"
|
||||
|
||||
data ChatCommand
|
||||
= ChatHelp HelpSection
|
||||
@@ -113,8 +114,8 @@ data ChatCommand
|
||||
data ChatResponse
|
||||
= CRNewChatItem {chatItem :: AChatItem}
|
||||
| CRCmdAccepted {corr :: CorrId}
|
||||
| CRChatHelp HelpSection
|
||||
| CRWelcome User
|
||||
| CRChatHelp {helpSection :: HelpSection}
|
||||
| CRWelcome {user :: User}
|
||||
| CRGroupCreated {groupInfo :: GroupInfo}
|
||||
| CRGroupMembers {group :: Group}
|
||||
| CRContactsList {contacts :: [Contact]}
|
||||
@@ -181,19 +182,19 @@ data ChatResponse
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON ChatResponse where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "CR"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "CR"
|
||||
|
||||
data ChatError
|
||||
= ChatError ChatErrorType
|
||||
| ChatErrorMessage String
|
||||
| ChatErrorAgent AgentErrorType
|
||||
| ChatErrorStore StoreError
|
||||
= ChatError {errorType :: ChatErrorType}
|
||||
| ChatErrorMessage {errorMessage :: String}
|
||||
| ChatErrorAgent {agentError :: AgentErrorType}
|
||||
| ChatErrorStore {storeError :: StoreError}
|
||||
deriving (Show, Exception, Generic)
|
||||
|
||||
instance ToJSON ChatError where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "Chat"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "Chat"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "Chat"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "Chat"
|
||||
|
||||
data ChatErrorType
|
||||
= CEGroupUserRole
|
||||
@@ -222,8 +223,8 @@ data ChatErrorType
|
||||
deriving (Show, Exception, Generic)
|
||||
|
||||
instance ToJSON ChatErrorType where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CE"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CE"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "CE"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "CE"
|
||||
|
||||
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
|
||||
|
||||
|
||||
@@ -30,10 +30,11 @@ import Database.SQLite.Simple.ToField (ToField (..))
|
||||
import GHC.Generics (Generic)
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (enumJSON, singleFieldJSON)
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgIntegrity, MsgMeta (..))
|
||||
import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
|
||||
import Simplex.Messaging.Parsers (dropPrefix)
|
||||
import Simplex.Messaging.Protocol (MsgBody)
|
||||
|
||||
data ChatType = CTDirect | CTGroup
|
||||
@@ -51,8 +52,8 @@ data JSONChatInfo
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON JSONChatInfo where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCInfo"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCInfo"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCInfo"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCInfo"
|
||||
|
||||
instance ToJSON (ChatInfo c) where
|
||||
toJSON = J.toJSON . jsonChatInfo
|
||||
@@ -73,24 +74,26 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) where
|
||||
deriving instance Show (ChatItem c d)
|
||||
|
||||
data JSONChatItem d
|
||||
= JCItemDirect {meta :: CIMeta d, content :: CIContent d}
|
||||
| JCItemSndGroup {meta :: CIMeta d, content :: CIContent d}
|
||||
| JCItemRcvGroup {member :: GroupMember, meta :: CIMeta d, content :: CIContent d}
|
||||
= JCItemDirect {dir :: MsgDirection, meta :: CIMeta d, content :: CIContent d}
|
||||
| JCItemSndGroup {dir :: MsgDirection, meta :: CIMeta d, content :: CIContent d}
|
||||
| JCItemRcvGroup {dir :: MsgDirection, member :: GroupMember, meta :: CIMeta d, content :: CIContent d}
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON (JSONChatItem d) where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCItem"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCItem"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCItem"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCItem"
|
||||
|
||||
instance ToJSON (ChatItem c d) where
|
||||
instance MsgDirectionI d => ToJSON (ChatItem c d) where
|
||||
toJSON = J.toJSON . jsonChatItem
|
||||
toEncoding = J.toEncoding . jsonChatItem
|
||||
|
||||
jsonChatItem :: ChatItem c d -> JSONChatItem d
|
||||
jsonChatItem :: forall c d. MsgDirectionI d => ChatItem c d -> JSONChatItem d
|
||||
jsonChatItem = \case
|
||||
DirectChatItem meta cic -> JCItemDirect meta cic
|
||||
SndGroupChatItem meta cic -> JCItemSndGroup meta cic
|
||||
RcvGroupChatItem m meta cic -> JCItemRcvGroup m meta cic
|
||||
DirectChatItem meta cic -> JCItemDirect md meta cic
|
||||
SndGroupChatItem meta cic -> JCItemSndGroup md meta cic
|
||||
RcvGroupChatItem m meta cic -> JCItemRcvGroup md m meta cic
|
||||
where
|
||||
md = toMsgDirection $ msgDirection @d
|
||||
|
||||
data CChatItem c = forall d. CChatItem (SMsgDirection d) (ChatItem c d)
|
||||
|
||||
@@ -128,7 +131,7 @@ data AChatPreview = forall c. AChatPreview (SChatType c) (ChatInfo c) (Maybe (CC
|
||||
deriving instance Show AChatPreview
|
||||
|
||||
-- | type to show a mix of messages from multiple chats
|
||||
data AChatItem = forall c d. AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d)
|
||||
data AChatItem = forall c d. MsgDirectionI d => AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d)
|
||||
|
||||
deriving instance Show AChatItem
|
||||
|
||||
@@ -139,7 +142,7 @@ instance ToJSON AChatItem where
|
||||
data JSONAnyChatItem c d = JSONAnyChatItem {chatInfo :: ChatInfo c, chatItem :: ChatItem c d}
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON (JSONAnyChatItem c d) where
|
||||
instance MsgDirectionI d => ToJSON (JSONAnyChatItem c d) where
|
||||
toJSON = J.genericToJSON J.defaultOptions
|
||||
toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
@@ -159,8 +162,8 @@ data JSONCIMeta
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON JSONCIMeta where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIMeta"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIMeta"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCIMeta"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCIMeta"
|
||||
|
||||
jsonCIMeta :: CIMeta d -> JSONCIMeta
|
||||
jsonCIMeta = \case
|
||||
@@ -201,8 +204,8 @@ data JSONCIContent
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON JSONCIContent where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "JCI"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "JCI"
|
||||
|
||||
jsonCIContent :: CIContent d -> JSONCIContent
|
||||
jsonCIContent = \case
|
||||
@@ -251,7 +254,14 @@ data PendingGroupMessage = PendingGroupMessage
|
||||
type MessageId = Int64
|
||||
|
||||
data MsgDirection = MDRcv | MDSnd
|
||||
deriving (Show)
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance FromJSON MsgDirection where
|
||||
parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MD"
|
||||
|
||||
instance ToJSON MsgDirection where
|
||||
toJSON = J.genericToJSON . enumJSON $ dropPrefix "MD"
|
||||
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MD"
|
||||
|
||||
data SMsgDirection (d :: MsgDirection) where
|
||||
SMDRcv :: SMsgDirection 'MDRcv
|
||||
@@ -271,6 +281,11 @@ instance MsgDirectionI 'MDRcv where msgDirection = SMDRcv
|
||||
|
||||
instance MsgDirectionI 'MDSnd where msgDirection = SMDSnd
|
||||
|
||||
toMsgDirection :: SMsgDirection d -> MsgDirection
|
||||
toMsgDirection = \case
|
||||
SMDRcv -> MDRcv
|
||||
SMDSnd -> MDSnd
|
||||
|
||||
instance ToField MsgDirection where toField = toField . msgDirectionInt
|
||||
|
||||
msgDirectionInt :: MsgDirection -> Int
|
||||
|
||||
+16
-15
@@ -138,11 +138,12 @@ import Simplex.Chat.Migrations.M20220122_pending_group_messages
|
||||
import Simplex.Chat.Migrations.M20220125_chat_items
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (singleFieldJSON)
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..))
|
||||
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, firstRow, withTransaction)
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
|
||||
import Simplex.Messaging.Parsers (dropPrefix)
|
||||
import Simplex.Messaging.Util (liftIOEither, (<$$>))
|
||||
import System.FilePath (takeFileName)
|
||||
import UnliftIO.STM
|
||||
@@ -1984,28 +1985,28 @@ randomBytes gVar n = B64.encode <$> (atomically . stateTVar gVar $ randomBytesGe
|
||||
|
||||
data StoreError
|
||||
= SEDuplicateName
|
||||
| SEContactNotFound ContactName
|
||||
| SEContactNotReady ContactName
|
||||
| SEContactNotFound {contactName :: ContactName}
|
||||
| SEContactNotReady {contactName :: ContactName}
|
||||
| SEDuplicateContactLink
|
||||
| SEUserContactLinkNotFound
|
||||
| SEContactRequestNotFound ContactName
|
||||
| SEGroupNotFound GroupName
|
||||
| SEContactRequestNotFound {contactName :: ContactName}
|
||||
| SEGroupNotFound {groupName :: GroupName}
|
||||
| SEGroupWithoutUser
|
||||
| SEDuplicateGroupMember
|
||||
| SEGroupAlreadyJoined
|
||||
| SEGroupInvitationNotFound
|
||||
| SESndFileNotFound Int64
|
||||
| SESndFileInvalid Int64
|
||||
| SERcvFileNotFound Int64
|
||||
| SEFileNotFound Int64
|
||||
| SERcvFileInvalid Int64
|
||||
| SEConnectionNotFound AgentConnId
|
||||
| SESndFileNotFound {fileId :: FileTransferId}
|
||||
| SESndFileInvalid {fileId :: FileTransferId}
|
||||
| SERcvFileNotFound {fileId :: FileTransferId}
|
||||
| SEFileNotFound {fileId :: FileTransferId}
|
||||
| SERcvFileInvalid {fileId :: FileTransferId}
|
||||
| SEConnectionNotFound {agentConnId :: AgentConnId}
|
||||
| SEIntroNotFound
|
||||
| SEUniqueID
|
||||
| SEInternal String
|
||||
| SENoMsgDelivery Int64 AgentMsgId
|
||||
| SEInternal {message :: String}
|
||||
| SENoMsgDelivery {connId :: Int64, agentMsgId :: AgentMsgId}
|
||||
deriving (Show, Exception, Generic)
|
||||
|
||||
instance ToJSON StoreError where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SE"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SE"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "SE"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "SE"
|
||||
|
||||
@@ -25,12 +25,12 @@ simplexChat cfg opts t
|
||||
sendNotification' <- initializeNotifications
|
||||
let f = chatStoreFile $ dbFilePrefix opts
|
||||
st <- createStore f $ dbPoolSize cfg
|
||||
user <- getCreateActiveUser st
|
||||
u <- getCreateActiveUser st
|
||||
ct <- newChatTerminal t
|
||||
cc <- newChatController st user cfg opts sendNotification'
|
||||
runSimplexChat user ct cc
|
||||
cc <- newChatController st u cfg opts sendNotification'
|
||||
runSimplexChat u ct cc
|
||||
|
||||
runSimplexChat :: User -> ChatTerminal -> ChatController -> IO ()
|
||||
runSimplexChat user ct = runReaderT $ do
|
||||
whenM (asks firstTime) . liftIO . printToTerminal ct $ chatWelcome user
|
||||
runSimplexChat u ct = runReaderT $ do
|
||||
whenM (asks firstTime) . liftIO . printToTerminal ct $ chatWelcome u
|
||||
raceAny_ [runTerminalInput ct, runTerminalOutput ct, runInputLoop ct, runChatController]
|
||||
|
||||
+12
-11
@@ -32,10 +32,11 @@ import Database.SQLite.Simple.Internal (Field (..))
|
||||
import Database.SQLite.Simple.Ok (Ok (Ok))
|
||||
import Database.SQLite.Simple.ToField (ToField (..))
|
||||
import GHC.Generics (Generic)
|
||||
import Simplex.Chat.Util (singleFieldJSON)
|
||||
import Simplex.Messaging.Agent.Protocol (ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
|
||||
import Simplex.Messaging.Parsers (dropPrefix)
|
||||
import Simplex.Messaging.Util ((<$?>))
|
||||
|
||||
class IsContact a where
|
||||
@@ -120,8 +121,8 @@ data GroupInfo = GroupInfo
|
||||
|
||||
instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
groupName :: GroupInfo -> GroupName
|
||||
groupName GroupInfo {localDisplayName = g} = g
|
||||
groupName' :: GroupInfo -> GroupName
|
||||
groupName' GroupInfo {localDisplayName = g} = g
|
||||
|
||||
data Profile = Profile
|
||||
{ displayName :: ContactName,
|
||||
@@ -243,11 +244,11 @@ data InvitedBy = IBContact {byContactId :: Int64} | IBUser | IBUnknown
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromJSON InvitedBy where
|
||||
parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "IB"
|
||||
parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "IB"
|
||||
|
||||
instance ToJSON InvitedBy where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "IB"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "IB"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "IB"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "IB"
|
||||
|
||||
toInvitedBy :: Int64 -> Maybe Int64 -> InvitedBy
|
||||
toInvitedBy userCtId (Just ctId)
|
||||
@@ -483,11 +484,11 @@ data RcvFileStatus
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromJSON RcvFileStatus where
|
||||
parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RFS"
|
||||
parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "RFS"
|
||||
|
||||
instance ToJSON RcvFileStatus where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RFS"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RFS"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "RFS"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "RFS"
|
||||
|
||||
data RcvFileInfo = RcvFileInfo
|
||||
{ filePath :: FilePath,
|
||||
@@ -521,8 +522,8 @@ data FileTransfer = FTSnd {sndFileTransfers :: [SndFileTransfer]} | FTRcv RcvFil
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON FileTransfer where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "FT"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "FT"
|
||||
toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "FT"
|
||||
toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "FT"
|
||||
|
||||
data FileStatus = FSNew | FSAccepted | FSConnected | FSComplete | FSCancelled deriving (Eq, Ord, Show)
|
||||
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
module Simplex.Chat.Util where
|
||||
|
||||
import Control.Monad (when)
|
||||
import qualified Data.Aeson as J
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeUtf8With)
|
||||
@@ -18,3 +19,18 @@ whenM ba a = ba >>= (`when` a)
|
||||
|
||||
unlessM :: Monad m => m Bool -> m () -> m ()
|
||||
unlessM b = ifM b $ pure ()
|
||||
|
||||
enumJSON :: (String -> String) -> J.Options
|
||||
enumJSON tagModifier =
|
||||
J.defaultOptions
|
||||
{ J.constructorTagModifier = tagModifier,
|
||||
J.allNullaryToStringTag = True
|
||||
}
|
||||
|
||||
singleFieldJSON :: (String -> String) -> J.Options
|
||||
singleFieldJSON tagModifier =
|
||||
J.defaultOptions
|
||||
{ J.constructorTagModifier = tagModifier,
|
||||
J.sumEncoding = J.ObjectWithSingleField,
|
||||
J.omitNothingFields = True
|
||||
}
|
||||
|
||||
@@ -99,7 +99,7 @@ responseToView cmd = \case
|
||||
CRLeftMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"]
|
||||
CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"]
|
||||
CRGroupDeleted g m -> [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName g) <> " to delete the local copy of the group"]
|
||||
CRGroupDeleted g m -> [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
|
||||
CRMemberSubError g c e -> [ttyGroup' g <> " member " <> ttyContact c <> " error: " <> sShow e]
|
||||
CRGroupSubscribed g -> [ttyFullGroup g <> ": connected to server(s)"]
|
||||
CRSndFileSubError SndFileTransfer {fileId, fileName} e ->
|
||||
@@ -203,11 +203,11 @@ viewCannotResendInvitation GroupInfo {localDisplayName = gn} c =
|
||||
viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString]
|
||||
viewReceivedGroupInvitation g c role =
|
||||
[ ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role),
|
||||
"use " <> highlight ("/j " <> groupName g) <> " to accept"
|
||||
"use " <> highlight ("/j " <> groupName' g) <> " to accept"
|
||||
]
|
||||
|
||||
groupPreserved :: GroupInfo -> [StyledString]
|
||||
groupPreserved g = ["use " <> highlight ("/d #" <> groupName g) <> " to delete the group"]
|
||||
groupPreserved g = ["use " <> highlight ("/d #" <> groupName' g) <> " to delete the group"]
|
||||
|
||||
connectedMember :: GroupMember -> StyledString
|
||||
connectedMember m = case memberCategory m of
|
||||
@@ -446,7 +446,7 @@ viewChatError = \case
|
||||
CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
|
||||
CEGroupUserRole -> ["you have insufficient permissions for this group command"]
|
||||
CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]
|
||||
CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> groupName g)]
|
||||
CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> groupName' g)]
|
||||
CEGroupMemberNotActive -> ["you cannot invite other members yet, try later"]
|
||||
CEGroupMemberUserRemoved -> ["you are no longer a member of the group"]
|
||||
CEGroupMemberNotFound c -> ["contact " <> ttyContact c <> " is not a group member"]
|
||||
@@ -514,7 +514,7 @@ ttyGroup :: GroupName -> StyledString
|
||||
ttyGroup g = styled (Colored Blue) $ "#" <> g
|
||||
|
||||
ttyGroup' :: GroupInfo -> StyledString
|
||||
ttyGroup' = ttyGroup . groupName
|
||||
ttyGroup' = ttyGroup . groupName'
|
||||
|
||||
ttyGroups :: [GroupName] -> StyledString
|
||||
ttyGroups [] = ""
|
||||
|
||||
Reference in New Issue
Block a user