{-# Language OverloadedStrings #-}
{-# Language BangPatterns #-}

{-|
Module      : Client.View.ChannelInfo
Description : Channel information renderer
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module implements a renderer for the window that shows
channel metadata.

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

-- | Render the lines used in a channel mask list
channelInfoImages ::
  Text        {- ^ network -} ->
  Identifier  {- ^ channel -} ->
  ClientState -> [Image']
channelInfoImages :: Text -> Identifier -> ClientState -> [Image']
channelInfoImages Text
network Identifier
channelId ClientState
st

  | Just NetworkState
cs      <- 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
  , Just ChannelState
channel <- Getting (First ChannelState) NetworkState ChannelState
-> NetworkState -> Maybe ChannelState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((HashMap Identifier ChannelState
 -> Const (First ChannelState) (HashMap Identifier ChannelState))
-> NetworkState -> Const (First ChannelState) NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const (First ChannelState) (HashMap Identifier ChannelState))
 -> NetworkState -> Const (First ChannelState) NetworkState)
-> ((ChannelState -> Const (First ChannelState) ChannelState)
    -> HashMap Identifier ChannelState
    -> Const (First ChannelState) (HashMap Identifier ChannelState))
-> Getting (First ChannelState) NetworkState ChannelState
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)
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' (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 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
    = [Image'] -> [Image']
forall a. [a] -> [a]
reverse
    ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ Image'
topicLine
    Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: [Image']
provenanceLines
   [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ [Image']
creationLines
   [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ [Image']
urlLines
   [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ [Image']
modeLines
   [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ [Image']
modeArgLines

  where
    label :: Text -> Image'
label = 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)

    topicLine :: Image'
topicLine = Text -> Image'
label Text
"Topic: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                Palette -> Text -> Image'
parseIrcText Palette
pal (Getting Text ChannelState Text -> ChannelState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ChannelState Text
Lens' ChannelState Text
chanTopic ChannelState
channel)


    utcTimeImage :: UTCTime -> Image'
utcTimeImage = Attr -> String -> Image'
string Attr
defAttr (String -> Image') -> (UTCTime -> String) -> UTCTime -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T"

    provenanceLines :: [Image']
provenanceLines =
        case Getting
  (Maybe TopicProvenance) ChannelState (Maybe TopicProvenance)
-> ChannelState -> Maybe TopicProvenance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe TopicProvenance) ChannelState (Maybe TopicProvenance)
Lens' ChannelState (Maybe TopicProvenance)
chanTopicProvenance ChannelState
channel of
          Maybe TopicProvenance
Nothing -> []
          Just !TopicProvenance
prov ->
            [ Text -> Image'
label Text
"Topic set by: " 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
myNicks (Getting UserInfo TopicProvenance UserInfo
-> TopicProvenance -> UserInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserInfo TopicProvenance UserInfo
Lens' TopicProvenance UserInfo
topicAuthor TopicProvenance
prov)
            , Text -> Image'
label Text
"Topic set on: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> UTCTime -> Image'
utcTimeImage (Getting UTCTime TopicProvenance UTCTime
-> TopicProvenance -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime TopicProvenance UTCTime
Lens' TopicProvenance UTCTime
topicTime TopicProvenance
prov)
            ]

    creationLines :: [Image']
creationLines =
        case Getting (Maybe UTCTime) ChannelState (Maybe UTCTime)
-> ChannelState -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) ChannelState (Maybe UTCTime)
Lens' ChannelState (Maybe UTCTime)
chanCreation ChannelState
channel of
          Maybe UTCTime
Nothing   -> []
          Just UTCTime
time -> [Text -> Image'
label Text
"Created on: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> UTCTime -> Image'
utcTimeImage UTCTime
time]

    urlLines :: [Image']
urlLines =
        case Getting (Maybe Text) ChannelState (Maybe Text)
-> ChannelState -> Maybe Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Text) ChannelState (Maybe Text)
Lens' ChannelState (Maybe Text)
chanUrl ChannelState
channel of
          Maybe Text
Nothing -> []
          Just Text
url -> [ Text -> Image'
label Text
"Channel URL: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
url ]

    modeLines :: [Image']
modeLines = [Text -> Image'
label Text
"Modes: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> String -> Image'
string Attr
defAttr String
modes | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
modes) ]
      where
        modes :: String
modes = LensLike' (Const String) ChannelState (Map Char Text)
-> (Map Char Text -> String) -> ChannelState -> String
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const String) ChannelState (Map Char Text)
Lens' ChannelState (Map Char Text)
chanModes Map Char Text -> String
forall k a. Map k a -> [k]
Map.keys ChannelState
channel

    modeArgLines :: [Image']
modeArgLines =
      [ 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
palLabel Palette
pal) (String
"Mode " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
mode, Char
':', Char
' ']) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
arg
        | (Char
mode, Text
arg) <- Map Char Text -> [(Char, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (Getting (Map Char Text) ChannelState (Map Char Text)
-> ChannelState -> Map Char Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Char Text) ChannelState (Map Char Text)
Lens' ChannelState (Map Char Text)
chanModes ChannelState
channel)
        , Bool -> Bool
not (Text -> Bool
Text.null Text
arg)
        ]