IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: refactor parser (#1537)

Browse Source 
* core: refactor parser

* fix
This commit is contained in:
Evgeny Poberezkin
2022-12-09 21:50:01 +00:00
committed by GitHub
parent a4f207875f
commit a177dc5a13
1 changed files with 23 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
src/Simplex/Chat.hs
View File

@@ -3378,7 +3378,7 @@ chatCommandP =
"/_accept " *> (APIAcceptContact <$> A.decimal),
"/_reject " *> (APIRejectContact <$> A.decimal),
"/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP),
("/call @" <|> "/call ") *> (SendCallInvitation <$> displayName <*> pure defaultCallType),
"/call " *> char_ '@' *> (SendCallInvitation <$> displayName <*> pure defaultCallType),
"/_call reject @" *> (APIRejectCall <$> A.decimal),
"/_call offer @" *> (APISendCallOffer <$> A.decimal <* A.space <*> jsonP),
"/_call answer @" *> (APISendCallAnswer <$> A.decimal <* A.space <*> jsonP),
@@ -3420,42 +3420,42 @@ chatCommandP =
"/_settings " *> (APISetChatSettings <$> chatRefP <* A.space <*> jsonP),
"/_info #" *> (APIGroupMemberInfo <$> A.decimal <* A.space <*> A.decimal),
"/_info @" *> (APIContactInfo <$> A.decimal),
("/info #" <|> "/i #") *> (GroupMemberInfo <$> displayName <* A.space <* optional (A.char '@') <*> displayName),
("/info @" <|> "/info " <|> "/i @" <|> "/i ") *> (ContactInfo <$> displayName),
("/info #" <|> "/i #") *> (GroupMemberInfo <$> displayName <* A.space <* char_ '@' <*> displayName),
("/info " <|> "/i ") *> char_ '@' *> (ContactInfo <$> displayName),
"/_switch #" *> (APISwitchGroupMember <$> A.decimal <* A.space <*> A.decimal),
"/_switch @" *> (APISwitchContact <$> A.decimal),
"/switch #" *> (SwitchGroupMember <$> displayName <* A.space <* optional (A.char '@') <*> displayName),
("/switch @" <|> "/switch ") *> (SwitchContact <$> displayName),
"/switch #" *> (SwitchGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName),
"/switch " *> char_ '@' *> (SwitchContact <$> displayName),
"/_get code @" *> (APIGetContactCode <$> A.decimal),
"/_get code #" *> (APIGetGroupMemberCode <$> A.decimal <* A.space <*> A.decimal),
"/_verify code @" *> (APIVerifyContact <$> A.decimal <* A.space <*> textP),
"/_verify code @" *> (APIVerifyGroupMember <$> A.decimal <* A.space <*> A.decimal <* A.space <*> textP),
("/code @" <|> "/code ") *> (GetContactCode <$> displayName),
"/code #" *> (GetGroupMemberCode <$> displayName <* A.space <* optional (A.char '@') <*> displayName),
("/verify @" <|> "/verify ") *> (VerifyContact <$> displayName <* A.space <*> textP),
"/verify #" *> (VerifyGroupMember <$> displayName <* A.space <* optional (A.char '@') <*> displayName <* A.space <*> textP),
"/code " *> char_ '@' *> (GetContactCode <$> displayName),
"/code #" *> (GetGroupMemberCode <$> displayName <* A.space <* char_ '@' <*> displayName),
"/verify " *> char_ '@' *> (VerifyContact <$> displayName <* A.space <*> textP),
"/verify #" *> (VerifyGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> textP),
("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles,
("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups,
("/help address" <|> "/ha") $> ChatHelp HSMyAddress,
("/help messages" <|> "/hm") $> ChatHelp HSMessages,
("/help settings" <|> "/hs") $> ChatHelp HSSettings,
("/help" <|> "/h") $> ChatHelp HSMain,
("/group #" <|> "/group " <|> "/g #" <|> "/g ") *> (NewGroup <$> groupProfile),
("/group " <|> "/g ") *> char_ '#' *> (NewGroup <$> groupProfile),
"/_group " *> (NewGroup <$> jsonP),
("/add #" <|> "/add " <|> "/a #" <|> "/a ") *> (AddMember <$> displayName <* A.space <* optional (A.char '@') <*> displayName <*> memberRole),
("/join #" <|> "/join " <|> "/j #" <|> "/j ") *> (JoinGroup <$> displayName),
("/member role #" <|> "/member role " <|> "/mr #" <|> "/mr ") *> (MemberRole <$> displayName <* A.space <* optional (A.char '@') <*> displayName <*> memberRole),
("/remove #" <|> "/remove " <|> "/rm #" <|> "/rm ") *> (RemoveMember <$> displayName <* A.space <* optional (A.char '@') <*> displayName),
("/leave #" <|> "/leave " <|> "/l #" <|> "/l ") *> (LeaveGroup <$> displayName),
("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole),
("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayName),
("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole),
("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMember <$> displayName <* A.space <* char_ '@' <*> displayName),
("/leave " <|> "/l ") *> char_ '#' *> (LeaveGroup <$> displayName),
("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName),
("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName),
("/delete " <|> "/d ") *> char_ '@' *> (DeleteContact <$> displayName),
"/clear #" *> (ClearGroup <$> displayName),
("/clear @" <|> "/clear ") *> (ClearContact <$> displayName),
("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName),
"/clear " *> char_ '@' *> (ClearContact <$> displayName),
("/members " <|> "/ms ") *> char_ '#' *> (ListMembers <$> displayName),
("/groups" <|> "/gs") $> ListGroups,
"/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP),
-- TODO group profile update via terminal should not reset image and preferences to Nothing (now it does)
("/group_profile #" <|> "/gp #" <|> "/group_profile " <|> "/gp ") *> (UpdateGroupProfile <$> displayName <* A.space <*> groupProfile),
("/group_profile " <|> "/gp ") *> char_ '#' *> (UpdateGroupProfile <$> displayName <* A.space <*> groupProfile),
"/_create link #" *> (APICreateGroupLink <$> A.decimal),
"/_delete link #" *> (APIDeleteGroupLink <$> A.decimal),
"/_get link #" *> (APIGetGroupLink <$> A.decimal),
@@ -3463,7 +3463,7 @@ chatCommandP =
"/delete link #" *> (DeleteGroupLink <$> displayName),
"/show link #" *> (ShowGroupLink <$> displayName),
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> A.takeByteString),
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* optional (A.char '@') <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> A.takeByteString),
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> A.takeByteString),
("/contacts" <|> "/cs") $> ListContacts,
("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
("/connect" <|> "/c") $> AddContact,
@@ -3487,8 +3487,8 @@ chatCommandP =
("/delete_address" <|> "/da") $> DeleteMyAddress,
("/show_address" <|> "/sa") $> ShowMyAddress,
"/auto_accept " *> (AddressAutoAccept <$> autoAcceptP),
("/accept @" <|> "/accept " <|> "/ac @" <|> "/ac ") *> (AcceptContact <$> displayName),
("/reject @" <|> "/reject " <|> "/rc @" <|> "/rc ") *> (RejectContact <$> displayName),
("/accept " <|> "/ac ") *> char_ '@' *> (AcceptContact <$> displayName),
("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayName),
("/markdown" <|> "/m") $> ChatHelp HSMarkdown,
("/welcome" <|> "/w") $> Welcome,
"/profile_image " *> (UpdateProfileImage . Just . ImageData <$> imageP),
@@ -3575,6 +3575,7 @@ chatCommandP =
(Just <$> (AutoAccept <$> (" incognito=" *> onOffP <|> pure False) <*> optional (A.space *> msgContentP)))
(pure Nothing)
toServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
char_ = optional . A.char
adminContactReq :: ConnReqContact
adminContactReq =