{-# Language OverloadedStrings #-} {-| Module : Client.View.UserList Description : Line renderers for channel user list view Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module renders the lines used in the channel user list. -} module Client.View.UserList ( userListImages , userInfoImages ) where import Client.Image.Message import Client.Image.PackedImage import Client.Image.Palette import Client.State import Client.State.Channel import Client.State.Focus import Client.State.Network import Client.UserHost import Control.Lens import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as Map import Data.List import Data.List.Split import Data.Ord import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import Graphics.Vty.Attributes import Irc.Identifier import Irc.UserInfo -- | Render the lines used by the @/users@ command in normal mode. -- These lines show the count of users having each channel mode -- in addition to the nicknames of the users. userListImages :: Text {- ^ network -} -> Identifier {- ^ channel -} -> Int {- ^ window width -} -> ClientState {- ^ client state -} -> [Image'] userListImages network channel w st = case preview (clientConnection network) st of Just cs -> userListImages' cs channel w st Nothing -> [text' (view palError pal) "No connection"] where pal = clientPalette st userListImages' :: NetworkState -> Identifier -> Int -> ClientState -> [Image'] userListImages' cs channel w st = countImage : reverse [mconcat (intersperse gap row) | row <- chunksOf columns paddedNames] where paddedNames = map (resizeImage maxWidth) nameImages nameImages = map renderUser usersList maxWidth = maximum (map imageWidth nameImages) columns = max 1 ((w+1) `quot` (maxWidth+1)) countImage = drawSigilCount pal (map snd usersList) hilites = clientHighlightsFocus (ChannelFocus (view csNetwork cs) channel) st renderUser (ident, sigils) = string (view palSigil pal) sigils <> coloredIdentifier pal NormalIdentifier hilites ident gap = char defAttr ' ' filterOn (ident,sigils) = LText.fromChunks [Text.pack sigils, idText ident] usersList = sortBy (comparing fst) $ clientFilter st filterOn $ HashMap.toList usersHashMap pal = clientPalette st usersHashMap = view (csChannels . ix channel . chanUsers) cs drawSigilCount :: Palette -> [String] -> Image' drawSigilCount pal sigils = text' (view palLabel pal) "Users:" <> mconcat entries where sigilCounts = Map.fromListWith (+) [ (take 1 sigil, 1::Int) | sigil <- sigils ] entries | Map.null sigilCounts = [" 0"] | otherwise = [ string (view palSigil pal) (' ':sigil) <> string defAttr (show n) | (sigil,n) <- Map.toList sigilCounts ] -- | Render lines for the @/users@ command in detailed view. -- Each user will be rendered on a separate line with username -- and host visible when known. userInfoImages :: Text {- ^ network -} -> Identifier {- ^ channel -} -> ClientState -> [Image'] userInfoImages network channel st = case preview (clientConnection network) st of Just cs -> userInfoImages' cs channel st Nothing -> [text' (view palError pal) "No connection"] where pal = clientPalette st userInfoImages' :: NetworkState -> Identifier -> ClientState -> [Image'] userInfoImages' cs channel st = countImage : map renderEntry usersList where countImage = drawSigilCount pal (map snd usersList) hilites = clientHighlightsFocus (ChannelFocus (view csNetwork cs) channel) st pal = clientPalette st renderEntry ((info, acct), sigils) = string (view palSigil pal) sigils <> coloredUserInfo pal DetailedRender hilites info <> " " <> text' (view palMeta pal) (cleanText acct) filterOn ((info, acct),sigils) = LText.fromChunks [Text.pack sigils, renderUserInfo info, " ", acct] userInfos = view csUsers cs toInfo nick = case view (at nick) userInfos of Just (UserAndHost n h a) -> (UserInfo nick n h, a) Nothing -> (UserInfo nick "" "", "") usersList = sortBy (flip (comparing (userNick . fst . fst))) $ clientFilter st filterOn $ map (over _1 toInfo) $ HashMap.toList usersHashMap usersHashMap = view (csChannels . ix channel . chanUsers) cs