{-# Language OverloadedStrings #-}
{-# Language BangPatterns #-}
module Client.View.ChannelInfo
( channelInfoImages
) where
import Client.Image.Message
import Client.Image.MircFormatting
import Client.Image.PackedImage
import Client.Image.Palette
import Client.State
import Client.State.Channel
import Client.State.Focus
import Client.State.Network
import Control.Lens
import Data.Text (Text)
import Data.Time
import Graphics.Vty.Attributes
import Irc.Identifier
import Data.HashMap.Strict (HashMap)
import qualified Data.Map as Map
import qualified Data.Text as Text
channelInfoImages ::
Text ->
Identifier ->
ClientState -> [Image']
channelInfoImages :: Text -> Identifier -> ClientState -> [Image']
channelInfoImages Text
network Identifier
channelId ClientState
st
| Just NetworkState
cs <- 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
, Just ChannelState
channel <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (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
channelId) NetworkState
cs
= Palette -> HashMap Identifier Highlight -> ChannelState -> [Image']
channelInfoImages' Palette
pal (Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (Text -> Focus
NetworkFocus Text
network) ClientState
st) ChannelState
channel
| Bool
otherwise = [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 channel information"]
where
pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
channelInfoImages' :: Palette -> HashMap Identifier Highlight -> ChannelState -> [Image']
channelInfoImages' :: Palette -> HashMap Identifier Highlight -> ChannelState -> [Image']
channelInfoImages' Palette
pal HashMap Identifier Highlight
myNicks !ChannelState
channel
= forall a. [a] -> [a]
reverse
forall a b. (a -> b) -> a -> b
$ Image'
topicLine
forall a. a -> [a] -> [a]
: [Image']
provenanceLines
forall a. [a] -> [a] -> [a]
++ [Image']
creationLines
forall a. [a] -> [a] -> [a]
++ [Image']
urlLines
forall a. [a] -> [a] -> [a]
++ [Image']
modeLines
forall a. [a] -> [a] -> [a]
++ [Image']
modeArgLines
where
label :: Text -> Image'
label = Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal)
topicLine :: Image'
topicLine = Text -> Image'
label Text
"Topic: " forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ChannelState Text
chanTopic ChannelState
channel)
utcTimeImage :: UTCTime -> Image'
utcTimeImage = Attr -> String -> Image'
string Attr
defAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T"
provenanceLines :: [Image']
provenanceLines =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ChannelState (Maybe TopicProvenance)
chanTopicProvenance ChannelState
channel of
Maybe TopicProvenance
Nothing -> []
Just !TopicProvenance
prov ->
[ Text -> Image'
label Text
"Topic set by: " forall a. Semigroup a => a -> a -> a
<>
Palette
-> RenderMode -> HashMap Identifier Highlight -> UserInfo -> Image'
coloredUserInfo Palette
pal RenderMode
DetailedRender HashMap Identifier Highlight
myNicks (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' TopicProvenance UserInfo
topicAuthor TopicProvenance
prov)
, Text -> Image'
label Text
"Topic set on: " forall a. Semigroup a => a -> a -> a
<> UTCTime -> Image'
utcTimeImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' TopicProvenance UTCTime
topicTime TopicProvenance
prov)
]
creationLines :: [Image']
creationLines =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ChannelState (Maybe UTCTime)
chanCreation ChannelState
channel of
Maybe UTCTime
Nothing -> []
Just UTCTime
time -> [Text -> Image'
label Text
"Created on: " forall a. Semigroup a => a -> a -> a
<> UTCTime -> Image'
utcTimeImage UTCTime
time]
urlLines :: [Image']
urlLines =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ChannelState (Maybe Text)
chanUrl ChannelState
channel of
Maybe Text
Nothing -> []
Just Text
url -> [ Text -> Image'
label Text
"Channel URL: " forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
url ]
modeLines :: [Image']
modeLines = [Text -> Image'
label Text
"Modes: " forall a. Semigroup a => a -> a -> a
<> Attr -> String -> Image'
string Attr
defAttr String
modes | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
modes) ]
where
modes :: String
modes = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ChannelState (Map Char Text)
chanModes forall k a. Map k a -> [k]
Map.keys ChannelState
channel
modeArgLines :: [Image']
modeArgLines =
[ Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) (String
"Mode " forall a. [a] -> [a] -> [a]
++ [Char
mode, Char
':', Char
' ']) forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
arg
| (Char
mode, Text
arg) <- forall k a. Map k a -> [(k, a)]
Map.toList (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ChannelState (Map Char Text)
chanModes ChannelState
channel)
, Bool -> Bool
not (Text -> Bool
Text.null Text
arg)
]