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

    images :: [Image']
images = (WhoReplyItem -> [Image']) -> [WhoReplyItem] -> [Image']
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 = [Image'] -> [Image']
forall a. [a] -> [a]
reverse ([Image'] -> [Image']) -> [Image'] -> [Image']
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 (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
entry)
      where hilites :: HashMap Identifier Highlight
hilites = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Focus
NetworkFocus (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs)) ClientState
st
    renderSuffix :: WhoReplyItem -> Image'
    renderSuffix :: WhoReplyItem -> Image'
renderSuffix WhoReplyItem
entry = [Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat ([Image'] -> Image') -> [Image'] -> Image'
forall a b. (a -> b) -> a -> b
$ WhoReplyItem
-> (UserInfo -> Image')
-> (Identifier -> Image')
-> (Text -> Image')
-> (Identifier -> Image')
-> Image'
-> (Text -> Image')
-> (Int -> Image')
-> (String -> Image')
-> (Text -> Image')
-> (Text -> Image')
-> [Image']
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
      (Image' -> UserInfo -> Image'
forall a b. a -> b -> a
const Image'
forall a. Monoid a => a
mempty)
      (Text -> Image' -> Image'
label Text
"$a:" (Image' -> Image')
-> (Identifier -> Image') -> Identifier -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Image'
identifier)
      (Text -> Image' -> Image'
label Text
"ip: " (Image' -> Image') -> (Text -> Image') -> Text -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' Attr
defAttr)
      (Text -> Image' -> Image'
label Text
"server: " (Image' -> Image')
-> (Identifier -> Image') -> Identifier -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Image'
identifier)
      (Text -> Image' -> Image'
label Text
"away" (Image' -> Image') -> Image' -> Image'
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image'
text' Attr
defAttr Text
"")
      (Text -> Image' -> Image'
label Text
"flags: " (Image' -> Image') -> (Text -> Image') -> Text -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palSigil Palette
pal))
      (Text -> Image' -> Image'
label Text
"hops: " (Image' -> Image') -> (Int -> Image') -> Int -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> String -> Image'
string Attr
defAttr (String -> Image') -> (Int -> String) -> Int -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show)
      (Text -> Image' -> Image'
label Text
"idle: " (Image' -> Image') -> (String -> Image') -> String -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> String -> Image'
string Attr
defAttr (String -> Image') -> (String -> String) -> String -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
prettyTime Int
1)
      (Text -> Image' -> Image'
label Text
"oplvl: " (Image' -> Image') -> (Text -> Image') -> Text -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' Attr
defAttr)
      (Text -> Image' -> Image'
label Text
"gecos: " (Image' -> Image') -> (Text -> Image') -> Text -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Palette -> Text -> Image'
parseIrcText' Bool
False Palette
pal)

    countImagePending :: Image'
countImagePending = Image'
countImage Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Text
"..."
    countImage :: Image'
countImage = Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Text
"Users in " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
forall k v. HashMap k v
HashMap.empty (Text -> Identifier
mkId Text
query) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Text
" (visible/total): " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 Attr -> String -> Image'
string Attr
defAttr (Int -> String
forall a. Show a => a -> String
show ([WhoReplyItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WhoReplyItem]
entries')) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 Attr -> Char -> Image'
char (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Char
'/' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 Attr -> String -> Image'
string Attr
defAttr (Int -> String
forall a. Show a => a -> String
show ([WhoReplyItem] -> Int
forall a. [a] -> Int
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: " (Image' -> Image') -> Image' -> Image'
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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Text
txt Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
image Image' -> 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 HashMap Identifier Highlight
forall k v. HashMap k v
HashMap.empty