Add basic support for message-tags (#121)

bot/irc-core-bot.cabal

@@ -31,7 +31,7 @@ executable irc-core-bot
     base       >=4.9  && <4.21,
     bytestring >=0.10 && <0.13,
     hookup     ^>=0.8,
-    irc-core   ^>=2.12,
+    irc-core   ^>=2.13,
     random     >=1.1 && <1.3,
     text       >=1.2 && <2.2,
     containers ^>={0.6, 0.7},

glirc.cabal

@@ -181,7 +181,7 @@ library
     githash              ^>=0.1.6,
     hashable             >=1.2.4  && <1.6,
     hookup               ^>=0.8,
-    irc-core             ^>=2.12,
+    irc-core             ^>=2.13,
     kan-extensions       >=5.0    && <5.3,
     lens                 >=4.14   && <5.4,
     random               >=1.1    && <1.3,

lib/ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for irc-core
 
+## 2.13
+
+* Added constructors for TAGMSG from messages-tags
+
 ## 2.12
 
 * Added constructors for AWAY

lib/irc-core.cabal

@@ -1,6 +1,6 @@
 cabal-version:       3.0
 name:                irc-core
-version:             2.12
+version:             2.13
 synopsis:            IRC core library for glirc
 description:         IRC core library for glirc
                      .

lib/src/Irc/Message.hs

@@ -75,6 +75,7 @@ data IrcMsg
   | Wallops  !Source !Text -- ^ Braodcast message: Source, message
   | Invite !Source !Identifier !Identifier -- ^ sender target channel
   | Away !Source (Maybe Text)
+  | Tagmsg !Source !Identifier -- ^ source target
   deriving Show
 
 data Source = Source { srcUser :: {-# UNPACK #-}!UserInfo, srcAcct :: !Text }
@@ -213,6 +214,12 @@ cookIrcMsg msg =
            , message <- view msgParams msg ->
            Away source (listToMaybe message)
 
+    "TAGMSG"
+      | Just source <- msgSource msg
+      , [target] <- view msgParams msg ->
+      Tagmsg source (mkId target)
+
+
     _      -> UnknownMsg msg
 
 -- | Parse a CTCP encoded message:
@@ -247,7 +254,7 @@ msgTarget me msg =
     Part _ chan _            -> TargetWindow chan
     Quit user _              -> TargetUser (userNick (srcUser user))
     Kick _ chan _ _          -> TargetWindow chan
-    Kill _ _ _               -> TargetNetwork
+    Kill{}                   -> TargetNetwork
     Topic _ chan _           -> TargetWindow chan
     Invite{}                 -> TargetNetwork
     Privmsg src tgt _        -> directed (srcUser src) tgt
@@ -266,6 +273,7 @@ msgTarget me msg =
     Chghost user _ _         -> TargetUser (userNick (srcUser user))
     Wallops _ _              -> TargetNetwork
     Away user _              -> TargetExisting (userNick (srcUser user))
+    Tagmsg src tgt           -> directed (srcUser src) tgt
   where
     directed src tgt
       | Text.null (userHost src) = TargetNetwork -- server message
@@ -308,6 +316,7 @@ msgActor msg =
     Chghost x _ _ -> Just x
     Wallops x _   -> Just x
     Away x _      -> Just x
+    Tagmsg x _    -> Just x
 
 renderSource :: Source -> Text
 renderSource (Source u "") = renderUserInfo u
@@ -340,11 +349,12 @@ ircMsgText msg =
     Authenticate{} -> ""
     BatchStart{}   -> ""
     BatchEnd{}     -> ""
-    Invite _ _ _   -> ""
+    Invite{}       -> ""
     Chghost x a b  -> Text.unwords [renderSource x, a, b]
     Wallops x t    -> Text.unwords [renderSource x, t]
     Away x (Just t) -> Text.unwords [renderSource x, "away", t]
     Away x Nothing  -> Text.unwords [renderSource x, "back"]
+    Tagmsg x _     -> renderSource x
 
 capCmdText :: CapCmd -> Text
 capCmdText cmd =

src/Client/Commands/Queries.hs

@@ -11,11 +11,11 @@ Maintainer  : [email protected]
 
 module Client.Commands.Queries (queryCommands) where
 
-import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, extensionArg, Args, tokenArg)
+import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, tokenArg)
 import Client.Commands.Docs (queriesDocs, cmdDoc)
 import Client.Commands.TabCompletion (noNetworkTab, simpleNetworkTab)
 import Client.Commands.Types (commandSuccess, commandSuccessUpdateCS, Command(Command), CommandImpl(NetworkCommand), CommandSection(CommandSection), NetworkCommand)
-import Client.State (changeSubfocus, ClientState)
+import Client.State (changeSubfocus)
 import Client.State.Focus (Subfocus(FocusChanList, FocusWho))
 import Client.State.Network (sendMsg, csChannelList, clsElist, csPingStatus, _PingConnecting, csWhoReply, csNetwork)
 import Client.WhoReply (newWhoReply)

src/Client/Image/Message.hs

@@ -286,6 +286,7 @@ ircLinePrefix !rp body =
 
     Account user _ -> who user <> " account:"
     Chghost ui _ _ -> who ui <> " chghost:"
+    Tagmsg{} -> mempty
 
 
 -- | Render a chat message given a rendering mode, the sigils of the user
@@ -308,6 +309,7 @@ ircLineImage !rp body =
     Nick        {} -> mempty
     Authenticate{} -> "***"
     Away        {} -> mempty
+    Tagmsg      {} -> mempty
 
     Error                   txt -> parseIrcText pal txt
     Topic _ _ txt ->
@@ -544,6 +546,10 @@ fullIrcLineImage !rp body =
       string (view palUsrChg pal) "back " <>
       who user
 
+    Tagmsg user _ ->
+      string quietAttr "tagm " <>
+      who user
+
 
 renderCapCmd :: CapCmd -> Text
 renderCapCmd cmd =
@@ -1214,6 +1220,7 @@ metadataImg pal msg =
     AcctSummary who       -> Just (char (view palUsrChg pal) '*', who, Nothing)
     AwaySummary who True  -> Just (char (view palAway pal)   'a', who, Nothing)
     AwaySummary who False -> Just (char (view palUsrChg pal) 'b', who, Nothing)
+    TagmSummary who       -> Just (char (view palTagmsg pal) 't', who, Nothing)
     _                     -> Nothing
 
 -- | Image used when treating ignored chat messages as metadata

src/Client/Image/Palette.hs

@@ -42,6 +42,7 @@ module Client.Image.Palette
   , palModes
   , palUsrChg
   , palIgnore
+  , palTagmsg
 
   -- * Lenses (Network)
   , palCModes
@@ -95,6 +96,7 @@ data Palette = Palette
   , _palPart          :: Attr
   , _palUsrChg        :: Attr
   , _palIgnore        :: Attr
+  , _palTagmsg        :: Attr -- ^ color of TAGMSG sigil
   }
   deriving Show
 
@@ -139,6 +141,7 @@ defaultPalette = Palette
   , _palModes              = metaLo
   , _palUsrChg             = metaLo
   , _palIgnore             = withForeColor defAttr white
+  , _palTagmsg             = metaLo
   }
   where
     metaNo = withForeColor defAttr brightBlack
@@ -200,4 +203,5 @@ paletteMap =
   , ("part"             , Lens palPart)
   , ("user-change"      , Lens palUsrChg)
   , ("ignore"           , Lens palIgnore)
+  , ("tagmsg"           , Lens palTagmsg)
   ]

src/Client/Message.hs

@@ -71,11 +71,12 @@ data IrcSummary
   | PartSummary {-# UNPACK #-} !Identifier
   | NickSummary {-# UNPACK #-} !Identifier {-# UNPACK #-} !Identifier
   | ReplySummary {-# UNPACK #-} !ReplyCode
-  | ChatSummary {-# UNPACK #-} !UserInfo
+  | ChatSummary {-# UNPACK #-} !UserInfo -- userinfo to help with ignore rules
   | CtcpSummary {-# UNPACK #-} !Identifier
   | ChngSummary {-# UNPACK #-} !Identifier -- ^ Chghost command
   | AcctSummary {-# UNPACK #-} !Identifier -- ^ Account command
   | AwaySummary {-# UNPACK #-} !Identifier !Bool
+  | TagmSummary {-# UNPACK #-} !Identifier -- ^ TAGMSG command
   | NoSummary
   deriving (Eq, Show)
 
@@ -111,6 +112,7 @@ ircSummary msg =
     Account who _   -> AcctSummary (userNick (srcUser who))
     Chghost who _ _ -> ChngSummary (userNick (srcUser who))
     Away who mb     -> AwaySummary (userNick (srcUser who)) (isJust mb)
+    Tagmsg who _    -> TagmSummary (userNick (srcUser who))
     _               -> NoSummary
 
 quitKind :: Maybe Text -> QuitKind
@@ -131,5 +133,6 @@ summaryActor s =
     AcctSummary who   -> Just who
     ChngSummary who   -> Just who
     AwaySummary who _ -> Just who
+    TagmSummary who   -> Just who
     ReplySummary {}   -> Nothing
     NoSummary         -> Nothing

src/Client/State/Network.hs

@@ -834,7 +834,7 @@ selectCaps cs offered = (supported `intersect` Map.keys capMap)
       ["multi-prefix", "batch", "znc.in/playback", "znc.in/self-message"
       , "cap-notify", "extended-join", "account-notify", "chghost"
       , "userhost-in-names", "account-tag", "solanum.chat/identify-msg"
-      , "solanum.chat/realhost", "away-notify"]
+      , "solanum.chat/realhost", "away-notify", "message-tags"]
 
     -- logic for using IRCv3.2 server-time if available and falling back
     -- to ZNC's specific extension otherwise.

src/Client/View/Help.hs

@@ -14,7 +14,7 @@ module Client.View.Help
   ( helpImageLines
   ) where
 
-import           Client.State (ClientState, clientConfig, clientFocus)
+import           Client.State (ClientState, clientConfig)
 import           Client.Configuration (configMacros)
 import           Client.Commands
 import           Client.Commands.Interpolation