{-# 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 :: Text -> Int -> ClientState -> [Image']
whoLines Text
network Int
width ClientState
st =
  -- TODO: This pattern exists in a few other views. Maybe deduplicate?
  case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
    Just NetworkState
cs -> NetworkState -> Int -> ClientState -> [Image']
whoLines' NetworkState
cs Int
width ClientState
st
    Maybe NetworkState
Nothing -> [Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) Text
"No connection"]
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st

whoLines' :: NetworkState -> Int -> ClientState -> [Image']
whoLines' :: NetworkState -> Int -> ClientState -> [Image']
whoLines' NetworkState
cs Int
width ClientState
st
  | Text -> Bool
Text.null forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' NetworkState WhoReply
csWhoReply forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WhoReply (Text, Maybe Text)
whoQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1) NetworkState
cs = [Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) Text
"No previous WHO query"]
  | WhoReply
whorplforall s a. s -> Getting a s a -> a
^.Lens' WhoReply Bool
whoDone = Image'
countImage forall a. Semigroup a => a -> a -> a
<> Image'
queryPart forall a. a -> [a] -> [a]
: [Image']
images
  | Bool
otherwise = Image'
countImagePending forall a. Semigroup a => a -> a -> a
<> Image'
queryPart forall a. a -> [a] -> [a]
: [Image']
images
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    whorpl :: WhoReply
whorpl = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState WhoReply
csWhoReply NetworkState
cs
    (Text
query, Maybe Text
arg) = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReply (Text, Maybe Text)
whoQuery WhoReply
whorpl
    entries :: [WhoReplyItem]
entries = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReply [WhoReplyItem]
whoItems WhoReply
whorpl
    entries' :: [WhoReplyItem]
entries' = forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st WhoReplyItem -> Text
whoFilterText [WhoReplyItem]
entries

    images :: [Image']
images = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap WhoReplyItem -> [Image']
renderEntry [WhoReplyItem]
entries'
    renderEntry :: WhoReplyItem -> [Image']
    renderEntry :: WhoReplyItem -> [Image']
renderEntry WhoReplyItem
entry = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Int -> Image' -> Image' -> [Image']
lineWrapPrefix Int
width (WhoReplyItem -> Image'
renderPrefix WhoReplyItem
entry) (WhoReplyItem -> Image'
renderSuffix WhoReplyItem
entry)
    -- Skipping rendering the channel because it doesn't add anything most of the time.
    renderPrefix :: WhoReplyItem -> Image'
renderPrefix WhoReplyItem
entry = Palette
-> RenderMode -> HashMap Identifier Highlight -> UserInfo -> Image'
coloredUserInfo Palette
pal RenderMode
DetailedRender HashMap Identifier Highlight
hilites (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem UserInfo
whoUserInfo WhoReplyItem
entry)
      where hilites :: HashMap Identifier Highlight
hilites = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Focus
NetworkFocus (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs)) ClientState
st
    renderSuffix :: WhoReplyItem -> Image'
    renderSuffix :: WhoReplyItem -> Image'
renderSuffix WhoReplyItem
entry = forall a. Monoid a => [a] -> a
mconcat 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
      (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
      (Text -> Image' -> Image'
label Text
"$a:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Image'
identifier)
      (Text -> Image' -> Image'
label Text
"ip: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' Attr
defAttr)
      (Text -> Image' -> Image'
label Text
"server: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Image'
identifier)
      (Text -> Image' -> Image'
label Text
"away" forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image'
text' Attr
defAttr Text
"")
      (Text -> Image' -> Image'
label Text
"flags: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSigil Palette
pal))
      (Text -> Image' -> Image'
label Text
"hops: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> String -> Image'
string Attr
defAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
      (Text -> Image' -> Image'
label Text
"idle: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> String -> Image'
string Attr
defAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
prettyTime Int
1)
      (Text -> Image' -> Image'
label Text
"oplvl: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' Attr
defAttr)
      (Text -> Image' -> Image'
label Text
"gecos: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Palette -> Text -> Image'
parseIrcText' Bool
False Palette
pal)

    countImagePending :: Image'
countImagePending = Image'
countImage forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Text
"..."
    countImage :: Image'
countImage = Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Text
"Users in " forall a. Semigroup a => a -> a -> a
<>
                 Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier forall k v. HashMap k v
HashMap.empty (Text -> Identifier
mkId Text
query) forall a. Semigroup a => a -> a -> a
<>
                 Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Text
" (visible/total): " forall a. Semigroup a => a -> a -> a
<>
                 Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [WhoReplyItem]
entries')) forall a. Semigroup a => a -> a -> a
<>
                 Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Char
'/' forall a. Semigroup a => a -> a -> a
<>
                 Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [WhoReplyItem]
entries))
    queryPart :: Image'
queryPart = case Maybe Text
arg of
      Just Text
txt | Bool -> Bool
not (Text -> Bool
Text.null Text
txt) -> Text -> Image' -> Image'
label Text
" Options: " forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image'
text' Attr
defAttr Text
txt
      Maybe Text
_ -> Attr -> Text -> Image'
text' Attr
defAttr Text
""

    label :: Text -> Image' -> Image'
label Text
txt Image'
image = Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Text
txt forall a. Semigroup a => a -> a -> a
<> Image'
image forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
defAttr Text
" "
    -- Don't use hilites here; the identifiers are never the user's nick.
    identifier :: Identifier -> Image'
identifier = Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier forall k v. HashMap k v
HashMap.empty