diff --git a/glirc.cabal b/glirc.cabal index 9e43895f..2ffabc4b 100644 --- a/glirc.cabal +++ b/glirc.cabal @@ -125,6 +125,7 @@ library Client.State.Network Client.State.Window Client.UserHost + Client.WhoReply Client.View Client.View.Cert Client.View.ChannelList @@ -140,6 +141,7 @@ library Client.View.RtsStats Client.View.UrlSelection Client.View.UserList + Client.View.Who Client.View.Windows other-modules: diff --git a/lib/src/Irc/UserInfo.hs b/lib/src/Irc/UserInfo.hs index 4128d353..f8c2a350 100644 --- a/lib/src/Irc/UserInfo.hs +++ b/lib/src/Irc/UserInfo.hs @@ -32,14 +32,14 @@ import qualified Data.Text as Text import Irc.Identifier --- | 'UserInfo' packages a nickname along with the username and hsotname +-- | 'UserInfo' packages a nickname along with the username and hostname -- if they are known in the current context. data UserInfo = UserInfo { userNick :: {-# UNPACK #-} !Identifier -- ^ nickname , userName :: {-# UNPACK #-} !Text -- ^ username, empty when missing , userHost :: {-# UNPACK #-} !Text -- ^ hostname, empty when missing } - deriving (Eq, Read, Show) + deriving (Eq, Ord, Read, Show) -- | Lens into 'userNick' field. uiNick :: Functor f => (Identifier -> f Identifier) -> UserInfo -> f UserInfo diff --git a/src/Client/Commands/Queries.hs b/src/Client/Commands/Queries.hs index 5d43bc50..f809caa7 100644 --- a/src/Client/Commands/Queries.hs +++ b/src/Client/Commands/Queries.hs @@ -15,8 +15,10 @@ import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, e 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.Focus (Subfocus(FocusChanList)) -import Client.State.Network (sendMsg, csChannelList, clsElist, csPingStatus, _PingConnecting) +import Client.State.Focus (Subfocus(FocusChanList, FocusWho)) +import Client.State.Network (sendMsg, csChannelList, clsElist, csPingStatus, _PingConnecting, csWhoReply) +import Client.WhoReply (newWhoReply) +import Control.Applicative (liftA2) import Control.Lens (has, set, view) import Control.Monad (unless) import Data.Maybe (fromMaybe, maybeToList) @@ -28,8 +30,8 @@ queryCommands = CommandSection "Queries" [ Command (pure "who") - (remainingArg "arguments") - "Send WHO query to server with given arguments.\n" + (optionalArg (liftA2 (,) (simpleToken "[channel|nick|mask]") (optionalArg (simpleToken "[options]")))) + "Send WHO query to server with given arguments, or just show the who view.\n" $ NetworkCommand cmdWho simpleNetworkTab , Command @@ -254,10 +256,15 @@ cmdWhois cs st rest = do sendMsg cs (ircWhois (Text.pack <$> words rest)) commandSuccess st -cmdWho :: NetworkCommand String -cmdWho cs st rest = - do sendMsg cs (ircWho (Text.pack <$> words rest)) - commandSuccess st +cmdWho :: NetworkCommand (Maybe (String, Maybe String)) +cmdWho _ st Nothing = commandSuccess (changeSubfocus FocusWho st) +cmdWho cs st (Just (query, arg)) = + do + let query' = Text.pack query + let arg' = fromMaybe "" arg + let cs' = set csWhoReply (newWhoReply query' arg') cs + sendMsg cs (ircWho (query' : (maybeToList $ Text.pack <$> arg))) + commandSuccessUpdateCS cs' (changeSubfocus FocusWho st) cmdWhowas :: NetworkCommand String cmdWhowas cs st rest = diff --git a/src/Client/Image/Message.hs b/src/Client/Image/Message.hs index ab55a07c..ae8dc151 100644 --- a/src/Client/Image/Message.hs +++ b/src/Client/Image/Message.hs @@ -26,7 +26,7 @@ module Client.Image.Message , timeImage , drawWindowLine , modesImage - + , prettyTime , parseIrcTextWithNicks , Highlight(..) ) where diff --git a/src/Client/Image/StatusLine.hs b/src/Client/Image/StatusLine.hs index c7091ad6..04c58cef 100644 --- a/src/Client/Image/StatusLine.hs +++ b/src/Client/Image/StatusLine.hs @@ -387,6 +387,7 @@ viewSubfocusLabel pal subfocus = FocusRtsStats -> Just $ string (view palLabel pal) "rtsstats" FocusCert{} -> Just $ string (view palLabel pal) "cert" FocusChanList _ _ -> Just $ string (view palLabel pal) "channels" + FocusWho -> Just $ string (view palLabel pal) "who" FocusMasks m -> Just $ mconcat [ string (view palLabel pal) "masks" , char defAttr ':' diff --git a/src/Client/State.hs b/src/Client/State.hs index 2328246a..872fa0a1 100644 --- a/src/Client/State.hs +++ b/src/Client/State.hs @@ -134,6 +134,7 @@ import qualified Client.State.EditBox as Edit import Client.State.Focus import Client.State.Network import Client.State.Window +import Client.WhoReply (WhoReplyItem, whoFilterText, whoUserInfo, whoItems, whoRealname) import ContextFilter import Control.Applicative import Control.Concurrent.MVar @@ -881,6 +882,8 @@ urlList st = urlFn st urlFn = case (network, subfocus) of (Just net, FocusChanList min' max') -> matchesTopic min' max' . view (clientConnections . at net) + (Just net, FocusWho) -> + matchesWhoReply . view (clientConnections . at net) (_, _) -> toListOf (clientWindows . ix focus . winMessages . each . folding matchesMsg) focus = view clientFocus st @@ -891,11 +894,17 @@ urlList st = urlFn st | url <- concatMap urlMatches $ clientFilter st id [views wlText id wl] ] matchesTopic _ _ Nothing = [] - matchesTopic min' max' (Just ct) = - [ (Just $! chan, url) - | (chan, _, topic) <- clientFilterChannels st min' max' $ view (csChannelList . clsItems) ct - , url <- urlMatches $ LText.fromStrict topic - ] + matchesTopic min' max' (Just cs) = + [ (Just $! chan, url) + | (chan, _, topic) <- clientFilterChannels st min' max' $ view (csChannelList . clsItems) cs + , url <- urlMatches $ LText.fromStrict topic + ] + matchesWhoReply Nothing = [] + matchesWhoReply (Just cs) = + [ (Just $! userNick $ view whoUserInfo wri, url) + | wri <- clientFilter st whoFilterText $ view (csWhoReply . whoItems) cs + , url <- urlMatches $ LText.fromStrict $ view whoRealname wri + ] -- | Remove a network connection and unlink it from the network map. -- This operation assumes that the network connection exists and should diff --git a/src/Client/State/Focus.hs b/src/Client/State/Focus.hs index 7cc40dff..b0e06cdf 100644 --- a/src/Client/State/Focus.hs +++ b/src/Client/State/Focus.hs @@ -56,6 +56,7 @@ data Subfocus | FocusIgnoreList -- ^ Show ignored masks | FocusCert -- ^ Show rendered certificate | FocusChanList (Maybe Int) (Maybe Int) -- ^ Show channel list + | FocusWho -- ^ Show last reply to a WHO query deriving (Eq,Show) -- | Unfocused first, followed by focuses sorted by network. diff --git a/src/Client/State/Network.hs b/src/Client/State/Network.hs index 3c9c20a8..780ada64 100644 --- a/src/Client/State/Network.hs +++ b/src/Client/State/Network.hs @@ -28,6 +28,7 @@ module Client.State.Network , csNick , csChannels , csChannelList + , csWhoReply , csSocket , csModeTypes , csChannelTypes @@ -93,6 +94,7 @@ import Client.Hooks (messageHooks) import Client.Network.Async (abortConnection, send, NetworkConnection, TerminationReason(PingTimeout)) import Client.State.Channel import Client.UserHost (UserAndHost(UserAndHost, _uhAccount)) +import Client.WhoReply import Control.Lens import Data.Bits (Bits((.&.))) import Data.ByteString qualified as B @@ -126,6 +128,7 @@ import System.Random qualified as Random data NetworkState = NetworkState { _csChannels :: !(HashMap Identifier ChannelState) -- ^ joined channels , _csChannelList :: !ChannelList -- ^ cached ELIST parameter and /list output + , _csWhoReply :: !WhoReply -- ^ cached reply from the last WHO query , _csSocket :: !NetworkConnection -- ^ network socket , _csModeTypes :: !ModeTypes -- ^ channel mode meanings , _csUmodeTypes :: !ModeTypes -- ^ user mode meanings @@ -202,6 +205,7 @@ data Transaction | CapLsTransaction [(Text, Maybe Text)] deriving Show + makeLenses ''NetworkState makeLenses ''ChannelList makePrisms ''Transaction @@ -298,6 +302,7 @@ newNetworkState network settings sock ping seed = NetworkState { _csUserInfo = UserInfo "*" "" "" , _csChannels = HashMap.empty , _csChannelList = newChannelList Nothing Nothing + , _csWhoReply = finishWhoReply $ newWhoReply "" "" , _csSocket = sock , _csChannelTypes = defaultChannelTypes , _csModeTypes = defaultModeTypes @@ -414,6 +419,7 @@ applyMessage' msgWhen msg cs = noReply (set (csUserInfo . uiHost) host cs) -- /who <#channel> %tuhna,616 + -- TODO: Use a different magic token here? Reply _ RPL_WHOSPCRPL [_me,"616",user,host,nick,acct] -> let acct' = if acct == "0" then "*" else acct in noReply (recordUser (UserInfo (mkId nick) user host) acct' cs) @@ -630,14 +636,15 @@ doRpl cmd msgWhen args cs = case args of _me:_tgt:uname:host:_server:nick:_ -> noReply $ + over csWhoReply (recordWhoReply args) $ over csTransaction (\t -> let !x = UserInfo (mkId nick) uname host !xs = view _WhoTransaction t in WhoTransaction (x : xs)) cs _ -> noReply cs - - RPL_ENDOFWHO -> noReply (massRegistration cs) + RPL_WHOSPCRPL -> noReply (over csWhoReply (recordWhoXReply args) cs) + RPL_ENDOFWHO -> noReply (over csWhoReply finishWhoReply $ massRegistration cs) RPL_CHANNELMODEIS -> case args of diff --git a/src/Client/View.hs b/src/Client/View.hs index 5606961c..033cc8d5 100644 --- a/src/Client/View.hs +++ b/src/Client/View.hs @@ -30,34 +30,39 @@ import Client.View.Palette (paletteViewLines) import Client.View.RtsStats (rtsStatsLines) import Client.View.UrlSelection (urlSelectionView) import Client.View.UserList (userInfoImages, userListImages) +import Client.View.Who (whoLines) import Client.View.Windows (windowsImages) import Control.Lens (view) viewLines :: Focus -> Subfocus -> Int -> ClientState -> [Image'] viewLines focus subfocus w !st = - case (focus, subfocus) of + case (network', channel', subfocus) of _ | Just ("url",arg) <- clientActiveCommand st -> urlSelectionView w focus arg st - (ChannelFocus network channel, FocusInfo) -> + (Just network, Just channel, FocusInfo) -> channelInfoImages network channel st - (ChannelFocus network channel, FocusUsers) + (Just network, Just channel, FocusUsers) | view clientDetailView st -> userInfoImages network channel st | otherwise -> userListImages network channel w st - (ChannelFocus network channel, FocusMasks mode) -> + (Just network, Just channel, FocusMasks mode) -> maskListImages mode network channel w st - (_, FocusWindows filt) -> windowsImages filt st - (_, FocusMentions) -> mentionsViewLines w st - (_, FocusPalette) -> paletteViewLines pal - (_, FocusDigraphs) -> digraphLines w st - (_, FocusKeyMap) -> keyMapLines st - (_, FocusHelp mb) -> helpImageLines st mb pal - (_, FocusRtsStats) -> rtsStatsLines (view clientRtsStats st) pal - (_, FocusIgnoreList) -> ignoreListLines (view clientIgnores st) pal - (_, FocusCert) -> certViewLines st - (ChannelFocus network _, FocusChanList min' max') -> - channelListLines network w st (min', max') - (NetworkFocus network , FocusChanList min' max') -> + (_, _, FocusWindows filt) -> windowsImages filt st + (_, _, FocusMentions) -> mentionsViewLines w st + (_, _, FocusPalette) -> paletteViewLines pal + (_, _, FocusDigraphs) -> digraphLines w st + (_, _, FocusKeyMap) -> keyMapLines st + (_, _, FocusHelp mb) -> helpImageLines st mb pal + (_, _, FocusRtsStats) -> rtsStatsLines (view clientRtsStats st) pal + (_, _, FocusIgnoreList) -> ignoreListLines (view clientIgnores st) pal + (_, _, FocusCert) -> certViewLines st + (Just network, _, FocusChanList min' max') -> channelListLines network w st (min', max') + (Just network, _, FocusWho) -> + whoLines network w st _ -> chatMessageImages focus w st where + (network', channel') = case focus of + Unfocused -> (Nothing, Nothing) + NetworkFocus network -> (Just network, Nothing) + ChannelFocus network channel -> (Just network, Just channel) pal = clientPalette st diff --git a/src/Client/View/ChannelList.hs b/src/Client/View/ChannelList.hs index c8fcae3a..5d9132af 100644 --- a/src/Client/View/ChannelList.hs +++ b/src/Client/View/ChannelList.hs @@ -43,8 +43,8 @@ channelListLines' :: NetworkState -> Int -> ClientState -> (Maybe Int, Maybe Int) -> [Image'] channelListLines' cs width st (min', max') - | chanList^.clsDone = countImage : images - | otherwise = countImagePending : images + | chanList^.clsDone = countImage <> queryPart : images + | otherwise = countImagePending <> queryPart : images where chanList = cs^.csChannelList els = chanList^.clsElist @@ -54,8 +54,7 @@ channelListLines' cs width st (min', max') countImage = text' (view palLabel pal) "Channels (visible/total): " <> string defAttr (show (length entries')) <> char (view palLabel pal) '/' <> - string defAttr (show (length entries)) <> - queryPart + string defAttr (show (length entries)) queryPart = mconcat $ [text' (view palLabel pal) " More-than: " <> string defAttr (show lo) | FocusChanList (Just lo) _ <- [st^.clientSubfocus]] ++ diff --git a/src/Client/View/Who.hs b/src/Client/View/Who.hs new file mode 100644 index 00000000..800cca53 --- /dev/null +++ b/src/Client/View/Who.hs @@ -0,0 +1,88 @@ +{-# Language OverloadedStrings #-} +{-| +Module : Client.View.Who +Description : Line renderer for /who replies +Copyright : (c) TheDaemoness, 2023 +License : ISC +Maintainer : emertens@gmail.com + +This module renders the lines used in /who replies. +-} +module Client.View.Who ( whoLines ) where + +import Client.Image.LineWrap (lineWrapPrefix) +import Client.Image.Message (IdentifierColorMode(NormalIdentifier), coloredIdentifier, coloredUserInfo, RenderMode (DetailedRender), prettyTime) +import Client.Image.PackedImage +import Client.Image.Palette +import Client.State +import Client.State.Network +import Client.WhoReply +import Control.Lens +import Data.Text (Text) +import qualified Data.Text as Text +import Graphics.Vty.Attributes (defAttr) +import Irc.Identifier +import qualified Data.HashMap.Strict as HashMap +import Client.Image.MircFormatting (parseIrcText') +import Client.State.Focus (Focus(NetworkFocus)) + +-- | +-- | Render the lines used by the @/who@ command in normal mode. +whoLines :: + Text {- ^ network -} -> + Int {- ^ window width -} -> + ClientState {- ^ client state -} -> + [Image'] +whoLines network width st = + -- TODO: This pattern exists in a few other views. Maybe deduplicate? + case preview (clientConnection network) st of + Just cs -> whoLines' cs width st + Nothing -> [text' (view palError pal) "No connection"] + where + pal = clientPalette st + +whoLines' :: NetworkState -> Int -> ClientState -> [Image'] +whoLines' cs width st + | Text.null $ view (csWhoReply . whoQuery . _1) cs = [text' (view palError pal) "No previous WHO query"] + | whorpl^.whoDone = countImage <> queryPart : images + | otherwise = countImagePending <> queryPart : images + where + pal = clientPalette st + whorpl = view csWhoReply cs + (query, arg) = view whoQuery whorpl + entries = view whoItems whorpl + entries' = clientFilter st whoFilterText entries + + images = concatMap renderEntry entries' + renderEntry :: WhoReplyItem -> [Image'] + renderEntry entry = reverse $ lineWrapPrefix width (renderPrefix entry) (renderSuffix entry) + -- Skipping rendering the channel because it doesn't add anything most of the time. + renderPrefix entry = coloredUserInfo pal DetailedRender hilites (view whoUserInfo entry) + where hilites = clientHighlightsFocus (NetworkFocus (view csNetwork cs)) st + renderSuffix :: WhoReplyItem -> Image' + renderSuffix entry = mconcat $ mapJoinWhoFields entry + (const mempty) + (label "$a:" . identifier) + (label "ip: " . text' defAttr) + (label "server: " . identifier) + (label "away" $ text' defAttr "") + (label "flags: " . text' (view palSigil pal)) + (label "hops: " . string defAttr . show) + (label "idle: " . string defAttr . prettyTime 1) + (label "oplvl: " . text' defAttr) + (label "gecos: " . parseIrcText' False pal) + + countImagePending = countImage <> text' (view palLabel pal) "..." + countImage = text' (view palLabel pal) "Users in " <> + coloredIdentifier pal NormalIdentifier HashMap.empty (mkId query) <> + text' (view palLabel pal) " (visible/total): " <> + string defAttr (show (length entries')) <> + char (view palLabel pal) '/' <> + string defAttr (show (length entries)) + queryPart = case arg of + Just txt | not (Text.null txt) -> label " Options: " $ text' defAttr txt + _ -> text' defAttr "" + + label txt image = text' (view palLabel pal) txt <> image <> text' defAttr " " + -- Don't use hilites here; the identifiers are never the user's nick. + identifier = coloredIdentifier pal NormalIdentifier HashMap.empty diff --git a/src/Client/WhoReply.hs b/src/Client/WhoReply.hs new file mode 100644 index 00000000..7f2f39a6 --- /dev/null +++ b/src/Client/WhoReply.hs @@ -0,0 +1,233 @@ +{-# Language TemplateHaskell, OverloadedStrings, BangPatterns #-} + +{-| +Module : Client.WhoReply +Description : Parsed replies from WHO +Copyright : (c) TheDaemoness, 2023 +License : ISC +Maintainer : emertens@gmail.com + +Because WHOX allows for a LOT of fiddliness regarding parameters, +this is extracted from Client.State.Network and given its own module. +-} + +module Client.WhoReply + ( WhoReply + , WhoReplyItem + , newWhoReply + , finishWhoReply + , recordWhoReply + , recordWhoXReply + , mapJoinWhoFields + , whoFilterText + + -- Lenses + , whoQuery + , whoFields + , whoToken + , whoDone + , whoItems + , whoUserInfo + , whoIp + , whoServer + , whoAway + , whoMiscFlags + , whoHops + , whoIdleSecs + , whoAcct + , whoOpLvl + , whoRealname + ) where + +import Client.Image.Message (cleanText) +import Control.Lens +import Control.Lens.Unsound (lensProduct) -- Don't worry about it. Ctrl+F SOUNDNESS. +import Data.List (sort) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Lazy as LText +import Irc.Identifier +import Irc.UserInfo +import Text.Read (readMaybe) + +data WhoReply = WhoReply + { _whoQuery :: !(Text, Maybe Text) + , _whoFields :: !(Set Char) + , _whoToken :: !String + , _whoDone :: !Bool + , _whoItems :: ![WhoReplyItem] + } + +data WhoReplyItem = WhoReplyItem + { _whoUserInfo :: !UserInfo + , _whoAcct :: !Identifier + , _whoIp :: !Text -- We don't have iproute; (Maybe IP) would be nice here. + , _whoServer :: !Identifier + , _whoAway :: !(Maybe Bool) + , _whoMiscFlags :: !Text + , _whoHops :: !(Maybe Int) + , _whoIdleSecs :: !String -- This can be a Maybe Int, but prettyTime takes a String. + , _whoOpLvl :: !Text + , _whoRealname :: !Text + } deriving (Eq, Ord) + +makeLenses ''WhoReply +makeLenses ''WhoReplyItem + +newWhoReply :: Text -> String -> WhoReply +newWhoReply query "" = WhoReply + { _whoQuery = (query, Nothing) + , _whoToken = "" + , _whoFields = Set.empty + , _whoDone = False + , _whoItems = [] + } +newWhoReply query ('%':arg) = WhoReply + { _whoQuery = (query, Just $ Text.pack ('%':arg)) + , _whoToken = token + , _whoFields = fieldSet + , _whoDone = False + , _whoItems = [] + } + where + fieldSet = Set.fromList fields + (fields, token) = break (== ',') arg +newWhoReply query arg = WhoReply + { _whoQuery = (query, Just $ Text.pack arg) + , _whoToken = "" + , _whoFields = Set.empty + , _whoDone = False + , _whoItems = [] + } + +splitFlags :: String -> (Maybe Bool, Text) +splitFlags ('G':rest) = (Just True, Text.pack rest) +splitFlags ('H':rest) = (Just False, Text.pack rest) +splitFlags rest = (Nothing, Text.pack rest) + +newWhoReplyItem :: WhoReplyItem +newWhoReplyItem = WhoReplyItem + { _whoUserInfo = UserInfo + { userNick = mkId "" + , userName = "" + , userHost = "" + } + , _whoAcct = "0" + , _whoIp = "255.255.255.255" + , _whoServer = "" + , _whoAway = Nothing + , _whoMiscFlags = "" + , _whoHops = Nothing + , _whoIdleSecs = "" + , _whoOpLvl = "n/a" + , _whoRealname = "" + } + +finishWhoReply :: WhoReply -> WhoReply +finishWhoReply wr = wr { _whoDone = True, _whoItems = reverse $ sort (_whoItems wr) } + +recordWhoReply :: [Text] -> WhoReply -> WhoReply +recordWhoReply [_, _, uname, host, server, nick, flags, hcrn] reply + | _whoDone reply = reply + | otherwise = reply { _whoItems = wri:_whoItems reply} + where + wri = newWhoReplyItem + { _whoUserInfo = UserInfo { userNick = mkId nick, userName = uname, userHost = host } + , _whoServer = mkId server + , _whoAway = away + , _whoMiscFlags = miscFlags + , _whoHops = readMaybe $ Text.unpack hops + , _whoRealname = Text.stripStart realname + } + (hops, realname) = Text.break (== ' ') hcrn + (away, miscFlags) = splitFlags $ Text.unpack flags +recordWhoReply _ reply = reply + +-- | Field names for WHOX replies in order, excluding 't'. +whoXReplyFields :: [Char] +whoXReplyFields = "cuihsnfdlaor" + +recordWhoXReply :: [Text] -> WhoReply -> WhoReply +recordWhoXReply [] reply = reply +recordWhoXReply (_:args) reply + | _whoDone reply = reply + | _whoToken reply == "" = withWri args + | null args = reply + | _whoToken reply == Text.unpack (head args) = withWri $ tail args + | otherwise = reply + where + fields = filter ((flip Set.member) (_whoFields reply)) whoXReplyFields + withWri args' = reply { _whoItems = recordWhoXReply' (zip args' fields) newWhoReplyItem:_whoItems reply} + +recordWhoXReply' :: [(Text, Char)] -> WhoReplyItem -> WhoReplyItem +recordWhoXReply' [] = id +recordWhoXReply' ((arg, kind):rest) = recordWhoXReply' rest . updateFn + where + updateFn = case kind of + 'a' -> set whoAcct (mkId arg) + -- Skip c + 'd' -> set whoHops (readMaybe $ Text.unpack arg) + -- SOUNDNESS: whoAway and whoMiscFlags project disjoint parts of WhoReplyItem + 'f' -> set (lensProduct whoAway whoMiscFlags) flagsSplit + 'h' -> set (whoUserInfo . uiHost) arg + 'i' -> set whoIp arg + 'l' -> set whoIdleSecs (Text.unpack arg) + 'n' -> set (whoUserInfo . uiNick) (mkId arg) + 'o' -> set whoOpLvl arg + 'r' -> set whoRealname arg + 's' -> set whoServer (mkId arg) + 'u' -> set (whoUserInfo . uiName) arg + _ -> id + flagsSplit = splitFlags $ Text.unpack arg + +-- Map non-default field values and join them into a list. +mapJoinWhoFields :: WhoReplyItem -> + (UserInfo -> a) -> + (Identifier -> a) -> + (Text -> a) -> + (Identifier -> a) -> + a -> + (Text -> a) -> + (Int -> a) -> + (String -> a) -> + (Text -> a) -> + (Text -> a) -> + [a] +mapJoinWhoFields wri userinfo acct ip server away flags hops idle oplvl gecos = reverse $ + addFieldIf (require notNull . view whoRealname) gecos $ + addFieldIf (require (/= "n/a") . view whoOpLvl) oplvl $ + addFieldIf (require notNullOrZero . view whoIdleSecs) idle $ + addFieldIf (\n -> view whoHops n >>= require (> 0)) hops $ + addFieldIf (require notNull . view whoMiscFlags) flags $ + addFieldIf (\n -> view whoAway n >>= require id) (const away) $ + addFieldIf (require (notNull . idText) . view whoServer) server $ + addFieldIf (require (/= "255.255.255.255") . view whoIp) ip $ + addFieldIf (require (/= "0") . view whoAcct) acct + [userinfo $ view whoUserInfo wri] + where + addFieldIf :: (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b] + addFieldIf getF mapF list = case getF wri of + Just v -> mapF v:list + Nothing -> list + notNull = not . Text.null + notNullOrZero "" = False + notNullOrZero "0" = False + notNullOrZero _ = True + require f v + | f v = Just v + | otherwise = Nothing + +whoFilterText :: WhoReplyItem -> LText.Text +whoFilterText entry = LText.fromChunks $ concat $ mapJoinWhoFields entry + (\x -> [renderUserInfo x]) + (\x -> [" $a:", idText x]) + (\x -> [" ip: ", x]) + (\x -> [" server: ", idText x]) + [" away"] + (\x -> [" flags: ", x]) + (\x -> [" hops: ", Text.pack $ show x]) + (\x -> [" idle: ", Text.pack x]) + (\x -> [" oplvl: ", x]) + (\x -> [" gecos: ", cleanText x])