{-# 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
  { WhoReply -> (Text, Maybe Text)
_whoQuery  :: !(Text, Maybe Text)
  , WhoReply -> Set Char
_whoFields :: !(Set Char)
  , WhoReply -> String
_whoToken  :: !String
  , WhoReply -> Bool
_whoDone   :: !Bool
  , WhoReply -> [WhoReplyItem]
_whoItems  :: ![WhoReplyItem]
  }

data WhoReplyItem = WhoReplyItem
  { WhoReplyItem -> UserInfo
_whoUserInfo  :: !UserInfo
  , WhoReplyItem -> Identifier
_whoAcct      :: !Identifier
  , WhoReplyItem -> Text
_whoIp        :: !Text -- We don't have iproute; (Maybe IP) would be nice here.
  , WhoReplyItem -> Identifier
_whoServer    :: !Identifier
  , WhoReplyItem -> Maybe Bool
_whoAway      :: !(Maybe Bool)
  , WhoReplyItem -> Text
_whoMiscFlags :: !Text
  , WhoReplyItem -> Maybe Int
_whoHops      :: !(Maybe Int)
  , WhoReplyItem -> String
_whoIdleSecs  :: !String -- This can be a Maybe Int, but prettyTime takes a String.
  , WhoReplyItem -> Text
_whoOpLvl     :: !Text
  , WhoReplyItem -> Text
_whoRealname  :: !Text
  } deriving (WhoReplyItem -> WhoReplyItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WhoReplyItem -> WhoReplyItem -> Bool
$c/= :: WhoReplyItem -> WhoReplyItem -> Bool
== :: WhoReplyItem -> WhoReplyItem -> Bool
$c== :: WhoReplyItem -> WhoReplyItem -> Bool
Eq, Eq WhoReplyItem
WhoReplyItem -> WhoReplyItem -> Bool
WhoReplyItem -> WhoReplyItem -> Ordering
WhoReplyItem -> WhoReplyItem -> WhoReplyItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WhoReplyItem -> WhoReplyItem -> WhoReplyItem
$cmin :: WhoReplyItem -> WhoReplyItem -> WhoReplyItem
max :: WhoReplyItem -> WhoReplyItem -> WhoReplyItem
$cmax :: WhoReplyItem -> WhoReplyItem -> WhoReplyItem
>= :: WhoReplyItem -> WhoReplyItem -> Bool
$c>= :: WhoReplyItem -> WhoReplyItem -> Bool
> :: WhoReplyItem -> WhoReplyItem -> Bool
$c> :: WhoReplyItem -> WhoReplyItem -> Bool
<= :: WhoReplyItem -> WhoReplyItem -> Bool
$c<= :: WhoReplyItem -> WhoReplyItem -> Bool
< :: WhoReplyItem -> WhoReplyItem -> Bool
$c< :: WhoReplyItem -> WhoReplyItem -> Bool
compare :: WhoReplyItem -> WhoReplyItem -> Ordering
$ccompare :: WhoReplyItem -> WhoReplyItem -> Ordering
Ord)

makeLenses ''WhoReply
makeLenses ''WhoReplyItem

newWhoReply :: Text -> String -> WhoReply
newWhoReply :: Text -> String -> WhoReply
newWhoReply Text
query String
"" = WhoReply
  { _whoQuery :: (Text, Maybe Text)
_whoQuery = (Text
query, forall a. Maybe a
Nothing)
  , _whoToken :: String
_whoToken = String
""
  , _whoFields :: Set Char
_whoFields = forall a. Set a
Set.empty
  , _whoDone :: Bool
_whoDone = Bool
False
  , _whoItems :: [WhoReplyItem]
_whoItems = []
  }
newWhoReply Text
query (Char
'%':String
arg) = WhoReply
  { _whoQuery :: (Text, Maybe Text)
_whoQuery = (Text
query, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (Char
'%'forall a. a -> [a] -> [a]
:String
arg))
  , _whoToken :: String
_whoToken = if forall a. Ord a => a -> Set a -> Bool
Set.member Char
't' Set Char
fieldSet then String
token' else String
""
  , _whoFields :: Set Char
_whoFields = Set Char
fieldSet
  , _whoDone :: Bool
_whoDone = Bool
False
  , _whoItems :: [WhoReplyItem]
_whoItems = []
  }
  where
    fieldSet :: Set Char
fieldSet = forall a. Ord a => [a] -> Set a
Set.fromList String
fields
    (String
fields, String
token) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Field2 s t a b => Lens s t a b
_2 (forall a. Int -> [a] -> [a]
drop Int
1) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
',') String
arg
    token' :: String
token' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
token then String
"0" else String
token
newWhoReply Text
query String
arg = WhoReply
  { _whoQuery :: (Text, Maybe Text)
_whoQuery = (Text
query, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
arg)
  , _whoToken :: String
_whoToken = String
""
  , _whoFields :: Set Char
_whoFields = forall a. Set a
Set.empty
  , _whoDone :: Bool
_whoDone = Bool
False
  , _whoItems :: [WhoReplyItem]
_whoItems = []
  }

splitFlags :: String -> (Maybe Bool, Text)
splitFlags :: String -> (Maybe Bool, Text)
splitFlags (Char
'G':String
rest) = (forall a. a -> Maybe a
Just Bool
True,  String -> Text
Text.pack String
rest)
splitFlags (Char
'H':String
rest) = (forall a. a -> Maybe a
Just Bool
False, String -> Text
Text.pack String
rest)
splitFlags String
rest       = (forall a. Maybe a
Nothing,    String -> Text
Text.pack String
rest)

newWhoReplyItem :: WhoReplyItem
newWhoReplyItem :: WhoReplyItem
newWhoReplyItem = WhoReplyItem
  { _whoUserInfo :: UserInfo
_whoUserInfo  = UserInfo
    { userNick :: Identifier
userNick = Text -> Identifier
mkId Text
""
    , userName :: Text
userName = Text
""
    , userHost :: Text
userHost = Text
""
    }
  , _whoAcct :: Identifier
_whoAcct      = Identifier
"0"
  , _whoIp :: Text
_whoIp        = Text
"255.255.255.255"
  , _whoServer :: Identifier
_whoServer    = Identifier
""
  , _whoAway :: Maybe Bool
_whoAway      = forall a. Maybe a
Nothing
  , _whoMiscFlags :: Text
_whoMiscFlags = Text
""
  , _whoHops :: Maybe Int
_whoHops      = forall a. Maybe a
Nothing
  , _whoIdleSecs :: String
_whoIdleSecs  = String
""
  , _whoOpLvl :: Text
_whoOpLvl     = Text
"n/a"
  , _whoRealname :: Text
_whoRealname  = Text
""
  }

finishWhoReply :: WhoReply -> WhoReply
finishWhoReply :: WhoReply -> WhoReply
finishWhoReply WhoReply
wr = WhoReply
wr { _whoDone :: Bool
_whoDone = Bool
True, _whoItems :: [WhoReplyItem]
_whoItems = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort (WhoReply -> [WhoReplyItem]
_whoItems WhoReply
wr) }

recordWhoReply :: [Text] -> WhoReply -> WhoReply
recordWhoReply :: [Text] -> WhoReply -> WhoReply
recordWhoReply [Text
_, Text
_, Text
uname, Text
host, Text
server, Text
nick, Text
flags, Text
hcrn] WhoReply
reply
  | WhoReply -> Bool
_whoDone WhoReply
reply = WhoReply
reply
  | Bool
otherwise = WhoReply
reply { _whoItems :: [WhoReplyItem]
_whoItems = WhoReplyItem
wriforall a. a -> [a] -> [a]
:WhoReply -> [WhoReplyItem]
_whoItems WhoReply
reply}
  where
    wri :: WhoReplyItem
wri = WhoReplyItem
newWhoReplyItem
      { _whoUserInfo :: UserInfo
_whoUserInfo = UserInfo { userNick :: Identifier
userNick = Text -> Identifier
mkId Text
nick, userName :: Text
userName = Text
uname, userHost :: Text
userHost = Text
host }
      , _whoServer :: Identifier
_whoServer = Text -> Identifier
mkId Text
server
      , _whoAway :: Maybe Bool
_whoAway = Maybe Bool
away
      , _whoMiscFlags :: Text
_whoMiscFlags = Text
miscFlags
      , _whoHops :: Maybe Int
_whoHops = forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
hops
      , _whoRealname :: Text
_whoRealname = Text -> Text
Text.stripStart Text
realname
      }
    (Text
hops, Text
realname) = (Char -> Bool) -> Text -> (Text, Text)
Text.break (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
hcrn
    (Maybe Bool
away, Text
miscFlags) = String -> (Maybe Bool, Text)
splitFlags forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
flags
recordWhoReply [Text]
_ WhoReply
reply = WhoReply
reply

-- | Field names for WHOX replies in order, excluding 't'.
whoXReplyFields :: [Char]
whoXReplyFields :: String
whoXReplyFields = String
"cuihsnfdlaor"

recordWhoXReply :: [Text] -> WhoReply -> WhoReply
recordWhoXReply :: [Text] -> WhoReply -> WhoReply
recordWhoXReply []       WhoReply
reply = WhoReply
reply
recordWhoXReply (Text
_:[Text]
args) WhoReply
reply
  | WhoReply -> Bool
_whoDone WhoReply
reply = WhoReply
reply
  | WhoReply -> String
_whoToken WhoReply
reply forall a. Eq a => a -> a -> Bool
== String
"" = [Text] -> WhoReply
withWri [Text]
args
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
args = WhoReply
reply
  | WhoReply -> String
_whoToken WhoReply
reply forall a. Eq a => a -> a -> Bool
== Text -> String
Text.unpack (forall a. [a] -> a
head [Text]
args) = [Text] -> WhoReply
withWri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [Text]
args
  | Bool
otherwise = WhoReply
reply
  where
    fields :: String
fields = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Bool
Set.member) (WhoReply -> Set Char
_whoFields WhoReply
reply)) String
whoXReplyFields
    withWri :: [Text] -> WhoReply
withWri [Text]
args' = WhoReply
reply { _whoItems :: [WhoReplyItem]
_whoItems = [(Text, Char)] -> WhoReplyItem -> WhoReplyItem
recordWhoXReply' (forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
args' String
fields) WhoReplyItem
newWhoReplyItemforall a. a -> [a] -> [a]
:WhoReply -> [WhoReplyItem]
_whoItems WhoReply
reply}

recordWhoXReply' :: [(Text, Char)] -> WhoReplyItem -> WhoReplyItem
recordWhoXReply' :: [(Text, Char)] -> WhoReplyItem -> WhoReplyItem
recordWhoXReply' [] = forall a. a -> a
id
recordWhoXReply' ((Text
arg, Char
kind):[(Text, Char)]
rest) = [(Text, Char)] -> WhoReplyItem -> WhoReplyItem
recordWhoXReply' [(Text, Char)]
rest forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhoReplyItem -> WhoReplyItem
updateFn
  where
    updateFn :: WhoReplyItem -> WhoReplyItem
updateFn = case Char
kind of
      Char
'a' -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' WhoReplyItem Identifier
whoAcct (Text -> Identifier
mkId Text
arg)
      -- Skip c
      Char
'd' -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' WhoReplyItem (Maybe Int)
whoHops (forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
arg)
      -- SOUNDNESS: whoAway and whoMiscFlags project disjoint parts of WhoReplyItem
      Char
'f' -> forall s t a b. ASetter s t a b -> b -> s -> t
set (forall s a b. ALens' s a -> ALens' s b -> Lens' s (a, b)
lensProduct Lens' WhoReplyItem (Maybe Bool)
whoAway Lens' WhoReplyItem Text
whoMiscFlags) (Maybe Bool, Text)
flagsSplit
      Char
'h' -> forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' WhoReplyItem UserInfo
whoUserInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> UserInfo -> f UserInfo
uiHost) Text
arg
      Char
'i' -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' WhoReplyItem Text
whoIp Text
arg
      Char
'l' -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' WhoReplyItem String
whoIdleSecs (Text -> String
Text.unpack Text
arg)
      Char
'n' -> forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' WhoReplyItem UserInfo
whoUserInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick) (Text -> Identifier
mkId Text
arg)
      Char
'o' -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' WhoReplyItem Text
whoOpLvl Text
arg
      Char
'r' -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' WhoReplyItem Text
whoRealname Text
arg
      Char
's' -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' WhoReplyItem Identifier
whoServer (Text -> Identifier
mkId Text
arg)
      Char
'u' -> forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' WhoReplyItem UserInfo
whoUserInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> UserInfo -> f UserInfo
uiName) Text
arg
      Char
_   -> forall a. a -> a
id
    flagsSplit :: (Maybe Bool, Text)
flagsSplit = String -> (Maybe Bool, Text)
splitFlags forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
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 :: forall a.
WhoReplyItem
-> (UserInfo -> a)
-> (Identifier -> a)
-> (Text -> a)
-> (Identifier -> a)
-> a
-> (Text -> a)
-> (Int -> a)
-> (String -> a)
-> (Text -> a)
-> (Text -> a)
-> [a]
mapJoinWhoFields WhoReplyItem
wri UserInfo -> a
userinfo Identifier -> a
acct Text -> a
ip Identifier -> a
server a
away Text -> a
flags Int -> a
hops String -> a
idle Text -> a
oplvl Text -> a
gecos = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (forall {a}. (a -> Bool) -> a -> Maybe a
require Text -> Bool
notNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem Text
whoRealname) Text -> a
gecos forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (forall {a}. (a -> Bool) -> a -> Maybe a
require (forall a. Eq a => a -> a -> Bool
/= Text
"n/a") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem Text
whoOpLvl) Text -> a
oplvl forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (forall {a}. (a -> Bool) -> a -> Maybe a
require forall {a}. (Eq a, IsString a) => a -> Bool
notNullOrZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem String
whoIdleSecs) String -> a
idle forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (\WhoReplyItem
n -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem (Maybe Int)
whoHops WhoReplyItem
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. (a -> Bool) -> a -> Maybe a
require (forall a. Ord a => a -> a -> Bool
> Int
0)) Int -> a
hops forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (forall {a}. (a -> Bool) -> a -> Maybe a
require Text -> Bool
notNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem Text
whoMiscFlags) Text -> a
flags forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (\WhoReplyItem
n -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem (Maybe Bool)
whoAway WhoReplyItem
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. (a -> Bool) -> a -> Maybe a
require forall a. a -> a
id) (forall a b. a -> b -> a
const a
away) forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (forall {a}. (a -> Bool) -> a -> Maybe a
require (Text -> Bool
notNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
idText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem Identifier
whoServer) Identifier -> a
server forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (forall {a}. (a -> Bool) -> a -> Maybe a
require (forall a. Eq a => a -> a -> Bool
/= Text
"255.255.255.255") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem Text
whoIp) Text -> a
ip forall a b. (a -> b) -> a -> b
$
  forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf (forall {a}. (a -> Bool) -> a -> Maybe a
require (forall a. Eq a => a -> a -> Bool
/= Identifier
"0") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem Identifier
whoAcct) Identifier -> a
acct
  [UserInfo -> a
userinfo forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem UserInfo
whoUserInfo WhoReplyItem
wri]
  where
    addFieldIf :: (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
    addFieldIf :: forall a b. (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
addFieldIf WhoReplyItem -> Maybe a
getF a -> b
mapF [b]
list = case WhoReplyItem -> Maybe a
getF WhoReplyItem
wri of
      Just a
v -> a -> b
mapF a
vforall a. a -> [a] -> [a]
:[b]
list
      Maybe a
Nothing -> [b]
list
    notNull :: Text -> Bool
notNull = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null
    notNullOrZero :: a -> Bool
notNullOrZero a
""  = Bool
False
    notNullOrZero a
"0" = Bool
False
    notNullOrZero a
_   = Bool
True
    require :: (a -> Bool) -> a -> Maybe a
require a -> Bool
f a
v
      | a -> Bool
f a
v = forall a. a -> Maybe a
Just a
v
      | Bool
otherwise = forall a. Maybe a
Nothing

whoFilterText :: WhoReplyItem -> LText.Text
whoFilterText :: WhoReplyItem -> Text
whoFilterText WhoReplyItem
entry = [Text] -> Text
LText.fromChunks forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a.
WhoReplyItem
-> (UserInfo -> a)
-> (Identifier -> a)
-> (Text -> a)
-> (Identifier -> a)
-> a
-> (Text -> a)
-> (Int -> a)
-> (String -> a)
-> (Text -> a)
-> (Text -> a)
-> [a]
mapJoinWhoFields WhoReplyItem
entry
  (\UserInfo
x -> [UserInfo -> Text
renderUserInfo UserInfo
x])
  (\Identifier
x -> [Text
" $a:", Identifier -> Text
idText Identifier
x])
  (\Text
x -> [Text
" ip: ", Text
x])
  (\Identifier
x -> [Text
" server: ", Identifier -> Text
idText Identifier
x])
  [Text
" away"]
  (\Text
x -> [Text
" flags: ", Text
x])
  (\Int
x -> [Text
" hops: ", String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
x])
  (\String
x -> [Text
" idle: ", String -> Text
Text.pack String
x])
  (\Text
x -> [Text
" oplvl: ", Text
x])
  (\Text
x -> [Text
" gecos: ", Text -> Text
cleanText Text
x])