{-# 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 Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
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 Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: [Image'] -> [Image']
forall a. [a] -> [a]
reverse [[Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat (Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
intersperse Image'
gap [Image']
row) | [Image']
row <- Int -> [Image'] -> [[Image']]
forall e. Int -> [e] -> [[e]]
chunksOf Int
columns [Image']
paddedNames]
  where
    paddedNames :: [Image']
paddedNames = (Image' -> Image') -> [Image'] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Image' -> Image'
resizeImage Int
maxWidth) [Image']
nameImages
    nameImages :: [Image']
nameImages = ((Identifier, String) -> Image')
-> [(Identifier, String)] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, String) -> Image'
renderUser [(Identifier, String)]
usersList
    maxWidth :: Int
maxWidth   = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Image' -> Int) -> [Image'] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Image' -> Int
imageWidth [Image']
nameImages)
    columns :: Int
columns    = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 ((Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` (Int
maxWidthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))

    countImage :: Image'
countImage = Palette -> [String] -> Image'
drawSigilCount Palette
pal (((Identifier, String) -> String)
-> [(Identifier, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, String) -> String
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 (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) Identifier
channel) ClientState
st

    renderUser :: (Identifier, String) -> Image'
renderUser (Identifier
ident, String
sigils) =
      Attr -> String -> Image'
string (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palSigil Palette
pal) String
sigils Image' -> Image' -> Image'
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 = ((Identifier, String) -> (Identifier, String) -> Ordering)
-> [(Identifier, String)] -> [(Identifier, String)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Identifier, String) -> Identifier)
-> (Identifier, String) -> (Identifier, String) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Identifier, String) -> Identifier
forall a b. (a, b) -> a
fst)
              ([(Identifier, String)] -> [(Identifier, String)])
-> [(Identifier, String)] -> [(Identifier, String)]
forall a b. (a -> b) -> a -> b
$ ClientState
-> ((Identifier, String) -> Text)
-> [(Identifier, String)]
-> [(Identifier, String)]
forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st (Identifier, String) -> Text
filterOn
              ([(Identifier, String)] -> [(Identifier, String)])
-> [(Identifier, String)] -> [(Identifier, String)]
forall a b. (a -> b) -> a -> b
$ HashMap Identifier String -> [(Identifier, String)]
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 =
      Getting
  (HashMap Identifier String)
  NetworkState
  (HashMap Identifier String)
-> NetworkState -> HashMap Identifier String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HashMap Identifier ChannelState
 -> Const
      (HashMap Identifier String) (HashMap Identifier ChannelState))
-> NetworkState -> Const (HashMap Identifier String) NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const
       (HashMap Identifier String) (HashMap Identifier ChannelState))
 -> NetworkState -> Const (HashMap Identifier String) NetworkState)
-> ((HashMap Identifier String
     -> Const (HashMap Identifier String) (HashMap Identifier String))
    -> HashMap Identifier ChannelState
    -> Const
         (HashMap Identifier String) (HashMap Identifier ChannelState))
-> Getting
     (HashMap Identifier String)
     NetworkState
     (HashMap Identifier String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
channel ((ChannelState -> Const (HashMap Identifier String) ChannelState)
 -> HashMap Identifier ChannelState
 -> Const
      (HashMap Identifier String) (HashMap Identifier ChannelState))
-> ((HashMap Identifier String
     -> Const (HashMap Identifier String) (HashMap Identifier String))
    -> ChannelState -> Const (HashMap Identifier String) ChannelState)
-> (HashMap Identifier String
    -> Const (HashMap Identifier String) (HashMap Identifier String))
-> HashMap Identifier ChannelState
-> Const
     (HashMap Identifier String) (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier String
 -> Const (HashMap Identifier String) (HashMap Identifier String))
-> ChannelState -> Const (HashMap Identifier String) ChannelState
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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Text
"Users:" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> [Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat [Image']
entries
  where
    sigilCounts :: Map String Int
sigilCounts = (Int -> Int -> Int) -> [(String, Int)] -> Map String Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [ (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
sigil, Int
1::Int) | String
sigil <- [String]
sigils ]

    entries :: [Image']
entries
      | Map String Int -> Bool
forall k a. Map k a -> Bool
Map.null Map String Int
sigilCounts = [Image'
" 0"]
      | Bool
otherwise = [ Attr -> String -> Image'
string (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palSigil Palette
pal) (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
sigil) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                      Attr -> String -> Image'
string Attr
defAttr (Int -> String
forall a. Show a => a -> String
show Int
n)
                    | (String
sigil,Int
n) <- Map String Int -> [(String, Int)]
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 Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
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 Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: (((UserInfo, Text), String) -> Image')
-> [((UserInfo, Text), String)] -> [Image']
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 ((((UserInfo, Text), String) -> String)
-> [((UserInfo, Text), String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((UserInfo, Text), String) -> String
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 (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
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 (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palSigil Palette
pal) String
sigils Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
" " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
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 = Getting
  (HashMap Identifier UserAndHost)
  NetworkState
  (HashMap Identifier UserAndHost)
-> NetworkState -> HashMap Identifier UserAndHost
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashMap Identifier UserAndHost)
  NetworkState
  (HashMap Identifier UserAndHost)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers NetworkState
cs

    toInfo :: Identifier -> (UserInfo, Text)
toInfo Identifier
nick =
      case Getting
  (Maybe UserAndHost)
  (HashMap Identifier UserAndHost)
  (Maybe UserAndHost)
-> HashMap Identifier UserAndHost -> Maybe UserAndHost
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Index (HashMap Identifier UserAndHost)
-> Lens'
     (HashMap Identifier UserAndHost)
     (Maybe (IxValue (HashMap Identifier UserAndHost)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier UserAndHost)
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 = (((UserInfo, Text), String)
 -> ((UserInfo, Text), String) -> Ordering)
-> [((UserInfo, Text), String)] -> [((UserInfo, Text), String)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((((UserInfo, Text), String)
 -> ((UserInfo, Text), String) -> Ordering)
-> ((UserInfo, Text), String)
-> ((UserInfo, Text), String)
-> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((((UserInfo, Text), String) -> Identifier)
-> ((UserInfo, Text), String)
-> ((UserInfo, Text), String)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (UserInfo -> Identifier
userNick (UserInfo -> Identifier)
-> (((UserInfo, Text), String) -> UserInfo)
-> ((UserInfo, Text), String)
-> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserInfo, Text) -> UserInfo
forall a b. (a, b) -> a
fst ((UserInfo, Text) -> UserInfo)
-> (((UserInfo, Text), String) -> (UserInfo, Text))
-> ((UserInfo, Text), String)
-> UserInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UserInfo, Text), String) -> (UserInfo, Text)
forall a b. (a, b) -> a
fst)))
              ([((UserInfo, Text), String)] -> [((UserInfo, Text), String)])
-> [((UserInfo, Text), String)] -> [((UserInfo, Text), String)]
forall a b. (a -> b) -> a -> b
$ ClientState
-> (((UserInfo, Text), String) -> Text)
-> [((UserInfo, Text), String)]
-> [((UserInfo, Text), String)]
forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st ((UserInfo, Text), String) -> Text
filterOn
              ([((UserInfo, Text), String)] -> [((UserInfo, Text), String)])
-> [((UserInfo, Text), String)] -> [((UserInfo, Text), String)]
forall a b. (a -> b) -> a -> b
$ ((Identifier, String) -> ((UserInfo, Text), String))
-> [(Identifier, String)] -> [((UserInfo, Text), String)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter
  (Identifier, String)
  ((UserInfo, Text), String)
  Identifier
  (UserInfo, Text)
-> (Identifier -> (UserInfo, Text))
-> (Identifier, String)
-> ((UserInfo, Text), String)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Identifier, String)
  ((UserInfo, Text), String)
  Identifier
  (UserInfo, Text)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Identifier -> (UserInfo, Text)
toInfo)
              ([(Identifier, String)] -> [((UserInfo, Text), String)])
-> [(Identifier, String)] -> [((UserInfo, Text), String)]
forall a b. (a -> b) -> a -> b
$ HashMap Identifier String -> [(Identifier, String)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Identifier String
usersHashMap

    usersHashMap :: HashMap Identifier String
usersHashMap = Getting
  (HashMap Identifier String)
  NetworkState
  (HashMap Identifier String)
-> NetworkState -> HashMap Identifier String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HashMap Identifier ChannelState
 -> Const
      (HashMap Identifier String) (HashMap Identifier ChannelState))
-> NetworkState -> Const (HashMap Identifier String) NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const
       (HashMap Identifier String) (HashMap Identifier ChannelState))
 -> NetworkState -> Const (HashMap Identifier String) NetworkState)
-> ((HashMap Identifier String
     -> Const (HashMap Identifier String) (HashMap Identifier String))
    -> HashMap Identifier ChannelState
    -> Const
         (HashMap Identifier String) (HashMap Identifier ChannelState))
-> Getting
     (HashMap Identifier String)
     NetworkState
     (HashMap Identifier String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
channel ((ChannelState -> Const (HashMap Identifier String) ChannelState)
 -> HashMap Identifier ChannelState
 -> Const
      (HashMap Identifier String) (HashMap Identifier ChannelState))
-> ((HashMap Identifier String
     -> Const (HashMap Identifier String) (HashMap Identifier String))
    -> ChannelState -> Const (HashMap Identifier String) ChannelState)
-> (HashMap Identifier String
    -> Const (HashMap Identifier String) (HashMap Identifier String))
-> HashMap Identifier ChannelState
-> Const
     (HashMap Identifier String) (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier String
 -> Const (HashMap Identifier String) (HashMap Identifier String))
-> ChannelState -> Const (HashMap Identifier String) ChannelState
Lens' ChannelState (HashMap Identifier String)
chanUsers) NetworkState
cs