{-# Language OverloadedStrings #-}
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.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.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
userListImages ::
Text ->
Identifier ->
ClientState ->
[Image']
userListImages network channel st =
case preview (clientConnection network) st of
Just cs -> userListImages' cs channel st
Nothing -> [text' (view palError pal) "No connection"]
where
pal = clientPalette st
userListImages' :: NetworkState -> Identifier -> ClientState -> [Image']
userListImages' cs channel st =
[countImage, mconcat (intersperse gap (map renderUser usersList))]
where
countImage = drawSigilCount pal (map snd usersList)
matcher = maybe (const True) matcherPred (clientMatcher st)
myNicks = clientHighlights cs st
renderUser (ident, sigils) =
string (view palSigil pal) sigils <>
coloredIdentifier pal NormalIdentifier myNicks ident
gap = char defAttr ' '
matcher' (ident,sigils) = matcher (LText.fromChunks [Text.pack sigils, idText ident])
usersList = sortBy (comparing fst)
$ filter matcher'
$ 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
]
userInfoImages ::
Text ->
Identifier ->
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
matcher = maybe (const True) matcherPred (clientMatcher st)
countImage = drawSigilCount pal (map snd usersList)
myNicks = clientHighlights cs st
pal = clientPalette st
renderEntry ((info, acct), sigils) =
string (view palSigil pal) sigils <>
coloredUserInfo pal DetailedRender myNicks info <>
" " <> text' (view palMeta pal) (cleanText acct)
matcher' ((info, acct),sigils) =
matcher (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)))
$ filter matcher'
$ map (over _1 toInfo)
$ HashMap.toList usersHashMap
usersHashMap = view (csChannels . ix channel . chanUsers) cs