{-# 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
(WhoReplyItem -> WhoReplyItem -> Bool)
-> (WhoReplyItem -> WhoReplyItem -> Bool) -> Eq WhoReplyItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhoReplyItem -> WhoReplyItem -> Bool
== :: WhoReplyItem -> WhoReplyItem -> Bool
$c/= :: WhoReplyItem -> WhoReplyItem -> Bool
/= :: WhoReplyItem -> WhoReplyItem -> Bool
Eq, Eq WhoReplyItem
Eq WhoReplyItem =>
(WhoReplyItem -> WhoReplyItem -> Ordering)
-> (WhoReplyItem -> WhoReplyItem -> Bool)
-> (WhoReplyItem -> WhoReplyItem -> Bool)
-> (WhoReplyItem -> WhoReplyItem -> Bool)
-> (WhoReplyItem -> WhoReplyItem -> Bool)
-> (WhoReplyItem -> WhoReplyItem -> WhoReplyItem)
-> (WhoReplyItem -> WhoReplyItem -> WhoReplyItem)
-> Ord 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
$ccompare :: WhoReplyItem -> WhoReplyItem -> Ordering
compare :: WhoReplyItem -> WhoReplyItem -> Ordering
$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
>= :: WhoReplyItem -> WhoReplyItem -> Bool
$cmax :: WhoReplyItem -> WhoReplyItem -> WhoReplyItem
max :: WhoReplyItem -> WhoReplyItem -> WhoReplyItem
$cmin :: WhoReplyItem -> WhoReplyItem -> WhoReplyItem
min :: WhoReplyItem -> WhoReplyItem -> WhoReplyItem
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, Maybe Text
forall a. Maybe a
Nothing)
  , _whoToken :: String
_whoToken = String
""
  , _whoFields :: Set Char
_whoFields = Set Char
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, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (Char
'%'Char -> String -> String
forall a. a -> [a] -> [a]
:String
arg))
  , _whoToken :: String
_whoToken = if Char -> Set Char -> Bool
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 = String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList String
fields
    (String
fields, String
token) = ASetter (String, String) (String, String) String String
-> (String -> String) -> (String, String) -> (String, String)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (String, String) (String, String) String String
forall s t a b. Field2 s t a b => Lens s t a b
Lens (String, String) (String, String) String String
_2 (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1) ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') String
arg
    token' :: String
token' = if String -> Bool
forall a. [a] -> Bool
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, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
arg)
  , _whoToken :: String
_whoToken = String
""
  , _whoFields :: Set Char
_whoFields = Set Char
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) = (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,  String -> Text
Text.pack String
rest)
splitFlags (Char
'H':String
rest) = (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False, String -> Text
Text.pack String
rest)
splitFlags String
rest       = (Maybe Bool
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      = Maybe Bool
forall a. Maybe a
Nothing
  , _whoMiscFlags :: Text
_whoMiscFlags = Text
""
  , _whoHops :: Maybe Int
_whoHops      = Maybe Int
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 = True, _whoItems = reverse $ sort (_whoItems 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 = wri:_whoItems reply}
  where
    wri :: WhoReplyItem
wri = WhoReplyItem
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
      }
    (Text
hops, Text
realname) = (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
hcrn
    (Maybe Bool
away, Text
miscFlags) = String -> (Maybe Bool, Text)
splitFlags (String -> (Maybe Bool, Text)) -> String -> (Maybe Bool, Text)
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = [Text] -> WhoReply
withWri [Text]
args
  | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
args = WhoReply
reply
  | WhoReply -> String
_whoToken WhoReply
reply String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> String
Text.unpack ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
args) = [Text] -> WhoReply
withWri ([Text] -> WhoReply) -> [Text] -> WhoReply
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail [Text]
args
  | Bool
otherwise = WhoReply
reply
  where
    fields :: String
fields = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (((Char -> Set Char -> Bool) -> Set Char -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Set Char -> Bool
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 = recordWhoXReply' (zip args' fields) newWhoReplyItem:_whoItems reply}

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

whoFilterText :: WhoReplyItem -> LText.Text
whoFilterText :: WhoReplyItem -> Text
whoFilterText WhoReplyItem
entry = [Text] -> Text
LText.fromChunks ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ WhoReplyItem
-> (UserInfo -> [Text])
-> (Identifier -> [Text])
-> (Text -> [Text])
-> (Identifier -> [Text])
-> [Text]
-> (Text -> [Text])
-> (Int -> [Text])
-> (String -> [Text])
-> (Text -> [Text])
-> (Text -> [Text])
-> [[Text]]
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
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])