{-# 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.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
userListImages ::
Text ->
Identifier ->
Int ->
ClientState ->
[Image']
userListImages :: Text -> Identifier -> Int -> ClientState -> [Image']
userListImages Text
network Identifier
channel Int
w ClientState
st =
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 -> Identifier -> Int -> ClientState -> [Image']
userListImages' NetworkState
cs Identifier
channel Int
w 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
userListImages' :: NetworkState -> Identifier -> Int -> ClientState -> [Image']
userListImages' :: NetworkState -> Identifier -> Int -> ClientState -> [Image']
userListImages' NetworkState
cs Identifier
channel Int
w ClientState
st
= Image'
countImage forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Image'
gap [Image']
row) | [Image']
row <- forall e. Int -> [e] -> [[e]]
chunksOf Int
columns [Image']
paddedNames]
where
paddedNames :: [Image']
paddedNames = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Image' -> Image'
resizeImage Int
maxWidth) [Image']
nameImages
nameImages :: [Image']
nameImages = forall a b. (a -> b) -> [a] -> [b]
map (Identifier, String) -> Image'
renderUser [(Identifier, String)]
usersList
maxWidth :: Int
maxWidth = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map Image' -> Int
imageWidth [Image']
nameImages)
columns :: Int
columns = forall a. Ord a => a -> a -> a
max Int
1 ((Int
wforall a. Num a => a -> a -> a
+Int
1) forall a. Integral a => a -> a -> a
`quot` (Int
maxWidthforall a. Num a => a -> a -> a
+Int
1))
countImage :: Image'
countImage = Palette -> [String] -> Image'
drawSigilCount Palette
pal (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Identifier, String)]
usersList)
hilites :: HashMap Identifier Highlight
hilites = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Identifier -> Focus
ChannelFocus (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs) Identifier
channel) ClientState
st
renderUser :: (Identifier, String) -> Image'
renderUser (Identifier
ident, String
sigils) =
Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSigil Palette
pal) String
sigils forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
ident
gap :: Image'
gap = Attr -> Char -> Image'
char Attr
defAttr Char
' '
filterOn :: (Identifier, String) -> Text
filterOn (Identifier
ident,String
sigils) = [Text] -> Text
LText.fromChunks [String -> Text
Text.pack String
sigils, Identifier -> Text
idText Identifier
ident]
usersList :: [(Identifier, String)]
usersList = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst)
forall a b. (a -> b) -> a -> b
$ forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st (Identifier, String) -> Text
filterOn
forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Identifier String
usersHashMap
pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
usersHashMap :: HashMap Identifier String
usersHashMap =
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
channel forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers) NetworkState
cs
drawSigilCount :: Palette -> [String] -> Image'
drawSigilCount :: Palette -> [String] -> Image'
drawSigilCount Palette
pal [String]
sigils =
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:" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [Image']
entries
where
sigilCounts :: Map String Int
sigilCounts = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Num a => a -> a -> a
(+) [ (forall a. Int -> [a] -> [a]
take Int
1 String
sigil, Int
1::Int) | String
sigil <- [String]
sigils ]
entries :: [Image']
entries
| forall k a. Map k a -> Bool
Map.null Map String Int
sigilCounts = [Image'
" 0"]
| Bool
otherwise = [ Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSigil Palette
pal) (Char
' 'forall a. a -> [a] -> [a]
:String
sigil) forall a. Semigroup a => a -> a -> a
<>
Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show Int
n)
| (String
sigil,Int
n) <- forall k a. Map k a -> [(k, a)]
Map.toList Map String Int
sigilCounts
]
userInfoImages ::
Text ->
Identifier ->
ClientState ->
[Image']
userInfoImages :: Text -> Identifier -> ClientState -> [Image']
userInfoImages Text
network Identifier
channel ClientState
st =
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 -> Identifier -> ClientState -> [Image']
userInfoImages' NetworkState
cs Identifier
channel 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
userInfoImages' :: NetworkState -> Identifier -> ClientState -> [Image']
userInfoImages' :: NetworkState -> Identifier -> ClientState -> [Image']
userInfoImages' NetworkState
cs Identifier
channel ClientState
st = Image'
countImage forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((UserInfo, Text), String) -> Image'
renderEntry [((UserInfo, Text), String)]
usersList
where
countImage :: Image'
countImage = Palette -> [String] -> Image'
drawSigilCount Palette
pal (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [((UserInfo, Text), String)]
usersList)
hilites :: HashMap Identifier Highlight
hilites = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Identifier -> Focus
ChannelFocus (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs) Identifier
channel) ClientState
st
pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
renderEntry :: ((UserInfo, Text), String) -> Image'
renderEntry ((UserInfo
info, Text
acct), String
sigils) =
Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSigil Palette
pal) String
sigils forall a. Semigroup a => a -> a -> a
<>
Palette
-> RenderMode -> HashMap Identifier Highlight -> UserInfo -> Image'
coloredUserInfo Palette
pal RenderMode
DetailedRender HashMap Identifier Highlight
hilites UserInfo
info forall a. Semigroup a => a -> a -> a
<>
Image'
" " 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
palMeta Palette
pal) (Text -> Text
cleanText Text
acct)
filterOn :: ((UserInfo, Text), String) -> Text
filterOn ((UserInfo
info, Text
acct),String
sigils) =
[Text] -> Text
LText.fromChunks [String -> Text
Text.pack String
sigils, UserInfo -> Text
renderUserInfo UserInfo
info, Text
" ", Text
acct]
userInfos :: HashMap Identifier UserAndHost
userInfos = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers NetworkState
cs
toInfo :: Identifier -> (UserInfo, Text)
toInfo Identifier
nick =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
nick) HashMap Identifier UserAndHost
userInfos of
Just (UserAndHost Text
n Text
h Text
a) -> (Identifier -> Text -> Text -> UserInfo
UserInfo Identifier
nick Text
n Text
h, Text
a)
Maybe UserAndHost
Nothing -> (Identifier -> Text -> Text -> UserInfo
UserInfo Identifier
nick Text
"" Text
"", Text
"")
usersList :: [((UserInfo, Text), String)]
usersList = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (UserInfo -> Identifier
userNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)))
forall a b. (a -> b) -> a -> b
$ forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st ((UserInfo, Text), String) -> Text
filterOn
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Field1 s t a b => Lens s t a b
_1 Identifier -> (UserInfo, Text)
toInfo)
forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Identifier String
usersHashMap
usersHashMap :: HashMap Identifier String
usersHashMap = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
channel forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers) NetworkState
cs