{-# Language OverloadedStrings #-}
{-|
Module      : Client.View.ChannelList
Description : Line renderer for searchable channel lists
Copyright   : (c) TheDaemoness, 2023
License     : ISC
Maintainer  : emertens@gmail.com

This module renders the lines used in the channel user list.
-}
module Client.View.ChannelList ( channelListLines ) where

import           Client.Image.LineWrap (lineWrapPrefix)
import           Client.Image.Message (IdentifierColorMode(NormalIdentifier), coloredIdentifier)
import           Client.Image.PackedImage
import           Client.Image.Palette
import           Client.State
import           Client.State.Network
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.State.Focus (Subfocus(FocusChanList))

-- |
-- | Render the lines used by the @/list@ command in normal mode.
channelListLines ::
  Text        {- ^ network           -} ->
  Int         {- ^ window width      -} ->
  ClientState {- ^ client state      -} ->
  (Maybe Int, Maybe Int) {- ^ bounds -} ->
  [Image']
channelListLines :: Text -> Int -> ClientState -> (Maybe Int, Maybe Int) -> [Image']
channelListLines Text
network Int
width ClientState
st (Maybe Int, Maybe Int)
bounds =
  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 -> (Maybe Int, Maybe Int) -> [Image']
channelListLines' NetworkState
cs Int
width ClientState
st (Maybe Int, Maybe Int)
bounds
    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

channelListLines' ::
  NetworkState ->
  Int -> ClientState -> (Maybe Int, Maybe Int) -> [Image']
channelListLines' :: NetworkState
-> Int -> ClientState -> (Maybe Int, Maybe Int) -> [Image']
channelListLines' NetworkState
cs Int
width ClientState
st (Maybe Int
min', Maybe Int
max')
  | ChannelList
chanListforall s a. s -> Getting a s a -> a
^.Lens' ChannelList Bool
clsDone = 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
    chanList :: ChannelList
chanList = NetworkState
csforall s a. s -> Getting a s a -> a
^.Lens' NetworkState ChannelList
csChannelList
    els :: Maybe Text
els = ChannelList
chanListforall s a. s -> Getting a s a -> a
^.Lens' ChannelList (Maybe Text)
clsElist
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st

    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
"Channels (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 [(Identifier, Int, Text)]
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 [(Identifier, Int, Text)]
entries))

    queryPart :: Image'
queryPart = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
      [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
" More-than: " forall a. Semigroup a => a -> a -> a
<> Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show Int
lo) | FocusChanList (Just Int
lo) Maybe Int
_ <- [ClientState
stforall s a. s -> Getting a s a -> a
^.Lens' ClientState Subfocus
clientSubfocus]] forall 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
" Less-than: " forall a. Semigroup a => a -> a -> a
<> Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show Int
hi) | FocusChanList Maybe Int
_ (Just Int
hi) <- [ClientState
stforall s a. s -> Getting a s a -> a
^.Lens' ClientState Subfocus
clientSubfocus]] forall 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
" Elist: " forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
defAttr Text
txt | Just Text
txt <- [Maybe Text
els], Bool -> Bool
not (Text -> Bool
Text.null Text
txt)]

    entries :: [(Identifier, Int, Text)]
entries = ChannelList
chanListforall s a. s -> Getting a s a -> a
^.Lens' ChannelList [(Identifier, Int, Text)]
clsItems
    entries' :: [(Identifier, Int, Text)]
entries' = ClientState
-> Maybe Int
-> Maybe Int
-> [(Identifier, Int, Text)]
-> [(Identifier, Int, Text)]
clientFilterChannels ClientState
st Maybe Int
min' Maybe Int
max' [(Identifier, Int, Text)]
entries

    images :: [Image']
images = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Identifier, Int, Text) -> [Image']
listItemImage [(Identifier, Int, Text)]
entries'

    listItemImage :: (Identifier, Int, Text) -> [Image']
    listItemImage :: (Identifier, Int, Text) -> [Image']
listItemImage (Identifier
chan, Int
users, Text
topic)
      | Text -> Bool
Text.null Text
topic = [Image'
baseImage]
      | Bool
otherwise = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Int -> Image' -> Image' -> [Image']
lineWrapPrefix Int
width (Image'
baseImage forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" topic:") (Attr -> Text -> Image'
text' Attr
defAttr Text
topic)
      where
        chanImage :: Image'
chanImage = Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier forall k v. HashMap k v
HashMap.empty Identifier
chan
        baseImage :: Image'
baseImage = Image'
chanImage forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" users: " forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
defAttr (String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
users)
        label :: Text -> Image'
label = Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal)