{-# 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 :: 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
                    ]


-- | 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 :: 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