{-# Language OverloadedStrings #-}
{-# Language BangPatterns #-}
module Client.View.ChannelInfo
( channelInfoImages
) where
import Client.Image.Message
import Client.Image.MircFormatting
import Client.Image.Palette
import Client.State
import Client.State.Channel
import Client.State.Network
import Control.Lens
import Data.HashSet (HashSet)
import Data.Text (Text)
import Data.Time
import Graphics.Vty.Attributes
import Graphics.Vty.Image
import Irc.Identifier
channelInfoImages ::
Text ->
Identifier ->
ClientState -> [Image]
channelInfoImages network channelId st
| Just cs <- preview (clientConnection network) st
, Just channel <- preview (csChannels . ix channelId) cs
= channelInfoImages' pal (clientHighlights cs st) channel
| otherwise = [text' (view palError pal) "No channel information"]
where
pal = clientPalette st
channelInfoImages' :: Palette -> HashSet Identifier -> ChannelState -> [Image]
channelInfoImages' pal myNicks !channel
= topicLine
: provenanceLines
++ creationLines
++ urlLines
where
label = text' (view palLabel pal)
topicLine = label "Topic: " <|> parseIrcText (view chanTopic channel)
utcTimeImage = string defAttr . formatTime defaultTimeLocale "%F %T"
provenanceLines =
case view chanTopicProvenance channel of
Nothing -> []
Just !prov ->
[ label "Topic set by: " <|>
coloredUserInfo pal DetailedRender myNicks (view topicAuthor prov)
, label "Topic set on: " <|> utcTimeImage (view topicTime prov)
]
creationLines =
case view chanCreation channel of
Nothing -> []
Just time -> [label "Created on: " <|> utcTimeImage time]
urlLines =
case view chanUrl channel of
Nothing -> []
Just url -> [ label "Channel URL: " <|> parseIrcText url ]