{-# Language OverloadedStrings #-}
module Client.View.Who ( whoLines ) where
import Client.Image.LineWrap (lineWrapPrefix)
import Client.Image.Message (IdentifierColorMode(NormalIdentifier), coloredIdentifier, coloredUserInfo, RenderMode (DetailedRender), prettyTime)
import Client.Image.PackedImage
import Client.Image.Palette
import Client.State
import Client.State.Network
import Client.WhoReply
import Control.Lens
import Data.Text (Text)
import qualified Data.Text as Text
import Graphics.Vty.Attributes (defAttr)
import Irc.Identifier
import qualified Data.HashMap.Strict as HashMap
import Client.Image.MircFormatting (parseIrcText')
import Client.State.Focus (Focus(NetworkFocus))
whoLines ::
Text ->
Int ->
ClientState ->
[Image']
whoLines :: Text -> Int -> ClientState -> [Image']
whoLines Text
network Int
width 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 -> Int -> ClientState -> [Image']
whoLines' NetworkState
cs Int
width 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
whoLines' :: NetworkState -> Int -> ClientState -> [Image']
whoLines' :: NetworkState -> Int -> ClientState -> [Image']
whoLines' NetworkState
cs Int
width ClientState
st
| Text -> Bool
Text.null forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' NetworkState WhoReply
csWhoReply forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WhoReply (Text, Maybe Text)
whoQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1) NetworkState
cs = [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 previous WHO query"]
| WhoReply
whorplforall s a. s -> Getting a s a -> a
^.Lens' WhoReply Bool
whoDone = Image'
countImage forall a. Semigroup a => a -> a -> a
<> Image'
queryPart forall a. a -> [a] -> [a]
: [Image']
images
| Bool
otherwise = Image'
countImagePending forall a. Semigroup a => a -> a -> a
<> Image'
queryPart forall a. a -> [a] -> [a]
: [Image']
images
where
pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
whorpl :: WhoReply
whorpl = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState WhoReply
csWhoReply NetworkState
cs
(Text
query, Maybe Text
arg) = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReply (Text, Maybe Text)
whoQuery WhoReply
whorpl
entries :: [WhoReplyItem]
entries = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReply [WhoReplyItem]
whoItems WhoReply
whorpl
entries' :: [WhoReplyItem]
entries' = forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st WhoReplyItem -> Text
whoFilterText [WhoReplyItem]
entries
images :: [Image']
images = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap WhoReplyItem -> [Image']
renderEntry [WhoReplyItem]
entries'
renderEntry :: WhoReplyItem -> [Image']
renderEntry :: WhoReplyItem -> [Image']
renderEntry WhoReplyItem
entry = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Int -> Image' -> Image' -> [Image']
lineWrapPrefix Int
width (WhoReplyItem -> Image'
renderPrefix WhoReplyItem
entry) (WhoReplyItem -> Image'
renderSuffix WhoReplyItem
entry)
renderPrefix :: WhoReplyItem -> Image'
renderPrefix WhoReplyItem
entry = Palette
-> RenderMode -> HashMap Identifier Highlight -> UserInfo -> Image'
coloredUserInfo Palette
pal RenderMode
DetailedRender HashMap Identifier Highlight
hilites (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WhoReplyItem UserInfo
whoUserInfo WhoReplyItem
entry)
where hilites :: HashMap Identifier Highlight
hilites = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Focus
NetworkFocus (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs)) ClientState
st
renderSuffix :: WhoReplyItem -> Image'
renderSuffix :: WhoReplyItem -> Image'
renderSuffix WhoReplyItem
entry = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a.
WhoReplyItem
-> (UserInfo -> a)
-> (Identifier -> a)
-> (Text -> a)
-> (Identifier -> a)
-> a
-> (Text -> a)
-> (Int -> a)
-> (String -> a)
-> (Text -> a)
-> (Text -> a)
-> [a]
mapJoinWhoFields WhoReplyItem
entry
(forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
(Text -> Image' -> Image'
label Text
"$a:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Image'
identifier)
(Text -> Image' -> Image'
label Text
"ip: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' Attr
defAttr)
(Text -> Image' -> Image'
label Text
"server: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Image'
identifier)
(Text -> Image' -> Image'
label Text
"away" forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image'
text' Attr
defAttr Text
"")
(Text -> Image' -> Image'
label Text
"flags: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSigil Palette
pal))
(Text -> Image' -> Image'
label Text
"hops: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> String -> Image'
string Attr
defAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
(Text -> Image' -> Image'
label Text
"idle: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> String -> Image'
string Attr
defAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
prettyTime Int
1)
(Text -> Image' -> Image'
label Text
"oplvl: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Image'
text' Attr
defAttr)
(Text -> Image' -> Image'
label Text
"gecos: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Palette -> Text -> Image'
parseIrcText' Bool
False Palette
pal)
countImagePending :: Image'
countImagePending = Image'
countImage 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
palLabel Palette
pal) Text
"..."
countImage :: Image'
countImage = 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 in " forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier forall k v. HashMap k v
HashMap.empty (Text -> Identifier
mkId Text
query) 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
palLabel Palette
pal) Text
" (visible/total): " forall a. Semigroup a => a -> a -> a
<>
Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [WhoReplyItem]
entries')) forall a. Semigroup a => a -> a -> a
<>
Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Char
'/' forall a. Semigroup a => a -> a -> a
<>
Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [WhoReplyItem]
entries))
queryPart :: Image'
queryPart = case Maybe Text
arg of
Just Text
txt | Bool -> Bool
not (Text -> Bool
Text.null Text
txt) -> Text -> Image' -> Image'
label Text
" Options: " forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Image'
text' Attr
defAttr Text
txt
Maybe Text
_ -> Attr -> Text -> Image'
text' Attr
defAttr Text
""
label :: Text -> Image' -> Image'
label Text
txt Image'
image = 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
txt forall a. Semigroup a => a -> a -> a
<> Image'
image forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
defAttr Text
" "
identifier :: Identifier -> Image'
identifier = Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier forall k v. HashMap k v
HashMap.empty