From a177dc5a13ac6587726da3117c9a1b9c36b37174 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 9 Dec 2022 21:50:01 +0000 Subject: [PATCH] core: refactor parser (#1537) * core: refactor parser * fix --- src/Simplex/Chat.hs | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index bbad35301b..28149a8042 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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 =