trim trailing whitespace, additional commands to list contacts and groups (#149)

src/Simplex/Chat.hs

@@ -23,6 +23,7 @@ import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
+import Data.Char (isSpace)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -72,6 +73,7 @@ data ChatCommand
   | AddContact
   | Connect AConnectionRequest
   | DeleteContact ContactName
+  | ListContacts
   | CreateMyAddress
   | DeleteMyAddress
   | ShowMyAddress
@@ -86,6 +88,7 @@ data ChatCommand
   | LeaveGroup GroupName
   | DeleteGroup GroupName
   | ListMembers GroupName
+  | ListGroups
   | SendGroupMessage GroupName ByteString
   | SendFile ContactName FilePath
   | SendGroupFile GroupName FilePath
@@ -164,7 +167,7 @@ inputSubscriber = do
     atomically (readTBQueue q) >>= \case
       InputControl _ -> pure ()
       InputCommand s ->
-        case parseAll chatCommandP . encodeUtf8 $ T.pack s of
+        case parseAll chatCommandP . B.dropWhileEnd isSpace . encodeUtf8 $ T.pack s of
           Left e -> printToView [plain s, "invalid input: " <> plain e]
           Right cmd -> do
             case cmd of
@@ -204,6 +207,7 @@ processChatCommand user@User {userId, profile} = \case
         unsetActive $ ActiveC cName
         showContactDeleted cName
       gs -> showContactGroups cName gs
+  ListContacts -> withStore (`getUserContacts` user) >>= showContactsList
   CreateMyAddress -> do
     (connId, cReq) <- withAgent (`createConnection` SCMContact)
     withStore $ \st -> createUserContactLink st userId connId cReq
@@ -293,6 +297,7 @@ processChatCommand user@User {userId, profile} = \case
   ListMembers gName -> do
     group <- withStore $ \st -> getGroup st user gName
     showGroupMembers group
+  ListGroups -> withStore (`getUserGroupNames` userId) >>= showGroupsList
   SendGroupMessage gName msg -> do
     -- TODO save sent messages
     -- TODO save pending message delivery for members without connections
@@ -1163,7 +1168,9 @@ chatCommandP =
     <|> ("/leave #" <|> "/leave " <|> "/l #" <|> "/l ") *> (LeaveGroup <$> displayName)
     <|> ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName)
     <|> ("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName)
+    <|> ("/groups" <|> "/gs") $> ListGroups
     <|> A.char '#' *> (SendGroupMessage <$> displayName <* A.space <*> A.takeByteString)
+    <|> ("/contacts" <|> "/cs") $> ListContacts
     <|> ("/connect " <|> "/c ") *> (Connect <$> connReqP)
     <|> ("/connect" <|> "/c") $> AddContact
     <|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName)

src/Simplex/Chat/Help.hs

@@ -55,8 +55,9 @@ chatHelpInfo =
       green "Other commands:",
       indent <> highlight "/profile         " <> " - show / update user profile",
       indent <> highlight "/delete <contact>" <> " - delete contact and all messages with them",
-      indent <> highlight "/markdown        " <> " - show supported markdown syntax",
-      indent <> highlight "/version         " <> " - show SimpleX Chat version",
+      indent <> highlight "/contacts        " <> " - list contacts",
+      indent <> highlight "/markdown        " <> " - supported markdown syntax",
+      indent <> highlight "/version         " <> " - SimpleX Chat version",
       indent <> highlight "/quit            " <> " - quit chat",
       "",
       "The commands may be abbreviated: " <> listHighlight ["/c", "/f", "/g", "/p", "/ad"] <> ", etc."
@@ -88,9 +89,10 @@ groupsHelpInfo =
       indent <> highlight "/leave <group>                 " <> " - leave group",
       indent <> highlight "/delete <group>                " <> " - delete group",
       indent <> highlight "/members <group>               " <> " - list group members",
+      indent <> highlight "/groups                        " <> " - list groups",
       indent <> highlight "#<group> <message>             " <> " - send message to group",
       "",
-      "The commands may be abbreviated: " <> listHighlight ["/g", "/a", "/j", "/rm", "/l", "/d", "/ms"]
+      "The commands may be abbreviated: " <> listHighlight ["/g", "/a", "/j", "/rm", "/l", "/d", "/ms", "/gs"]
     ]
 
 myAddressHelpInfo :: [StyledString]

src/Simplex/Chat/Store.hs

@@ -48,6 +48,7 @@ module Simplex.Chat.Store
     getGroup,
     deleteGroup,
     getUserGroups,
+    getUserGroupNames,
     getGroupInvitation,
     createContactGroupMember,
     createMemberConnection,
@@ -969,9 +970,15 @@ deleteGroup st User {userId} Group {groupId, members, localDisplayName} =
 getUserGroups :: MonadUnliftIO m => SQLiteStore -> User -> m [Group]
 getUserGroups st user =
   liftIO . withTransaction st $ \db -> do
-    groupNames <- liftIO $ map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only $ userId user)
+    groupNames <- getUserGroupNames_ db $ userId user
     map fst . rights <$> mapM (runExceptT . getGroup_ db user) groupNames
 
+getUserGroupNames :: MonadUnliftIO m => SQLiteStore -> UserId -> m [GroupName]
+getUserGroupNames st userId = liftIO $ withTransaction st (`getUserGroupNames_` userId)
+
+getUserGroupNames_ :: DB.Connection -> UserId -> IO [GroupName]
+getUserGroupNames_ db userId = map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only userId)
+
 getGroupInvitation :: StoreMonad m => SQLiteStore -> User -> GroupName -> m ReceivedGroupInvitation
 getGroupInvitation st user localDisplayName =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do

src/Simplex/Chat/View.hs

@@ -11,6 +11,7 @@ module Simplex.Chat.View
     showChatError,
     showContactDeleted,
     showContactGroups,
+    showContactsList,
     showContactConnected,
     showContactDisconnected,
     showContactAnotherClient,
@@ -63,6 +64,7 @@ module Simplex.Chat.View
     showLeftMemberUser,
     showLeftMember,
     showGroupMembers,
+    showGroupsList,
     showContactsMerged,
     showUserProfile,
     showUserProfileUpdated,
@@ -80,7 +82,7 @@ import Data.ByteString.Char8 (ByteString)
 import Data.Composition ((.:), (.:.))
 import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (groupBy, intersperse, sortOn)
+import Data.List (groupBy, intersperse, sortOn, sort)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (DiffTime, UTCTime)
@@ -112,6 +114,9 @@ showContactDeleted = printToView . contactDeleted
 showContactGroups :: ChatReader m => ContactName -> [GroupName] -> m ()
 showContactGroups = printToView .: contactGroups
 
+showContactsList :: ChatReader m => [Contact] -> m ()
+showContactsList = printToView . contactsList
+
 showContactConnected :: ChatReader m => Contact -> m ()
 showContactConnected = printToView . contactConnected
 
@@ -274,6 +279,9 @@ showLeftMember = printToView .: leftMember
 showGroupMembers :: ChatReader m => Group -> m ()
 showGroupMembers = printToView . groupMembers
 
+showGroupsList :: ChatReader m => [GroupName] -> m ()
+showGroupsList = printToView . groupsList
+
 showContactsMerged :: ChatReader m => Contact -> Contact -> m ()
 showContactsMerged = printToView .: contactsMerged
 
@@ -309,6 +317,11 @@ contactGroups c gNames = [ttyContact c <> ": contact cannot be deleted, it is a
     ttyGroups [g] = ttyGroup g
     ttyGroups (g : gs) = ttyGroup g <> ", " <> ttyGroups gs
 
+contactsList :: [Contact] -> [StyledString]
+contactsList =
+  let ldn = T.toLower . (localDisplayName :: Contact -> ContactName)
+   in map ttyFullContact . sortOn ldn
+
 contactConnected :: Contact -> [StyledString]
 contactConnected ct = [ttyFullContact ct <> ": contact is connected"]
 
@@ -461,6 +474,10 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov
       GSMemCreator -> "created group"
       _ -> ""
 
+groupsList :: [GroupName] -> [StyledString]
+groupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
+groupsList gs = map ttyGroup $ sort gs
+
 contactsMerged :: Contact -> Contact -> [StyledString]
 contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayName = c2} =
   [ "contact " <> ttyContact c2 <> " is merged into " <> ttyContact c1,