{-# Language OverloadedStrings, BangPatterns #-}
{-|
Module      : Client.Image.Focus
Description : Renderer for focus labels
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides image renderers used to construct
the labels for window names and activity boxes.
-}
module Client.Image.Focus
  ( FocusLabelType (..)
  , focusLabel
  , windowLabel
  ) where

import Client.Image.Message (cleanChar, cleanText, IdentifierColorMode (NormalIdentifier), coloredIdentifier, modesImage)
import Client.Image.PackedImage
import Client.Image.Palette
import Client.State
import Client.State.Channel (chanModes, chanUsers)
import Client.State.Focus (focusNetwork, Focus(..))
import Client.State.Network
import Client.State.Window
import Control.Lens (view, preview, Ixed(ix))
import Data.Map.Strict qualified as Map
import qualified Data.HashMap.Strict as HashMap
import Graphics.Vty.Attributes (defAttr)

windowLabel :: ClientState -> (Focus, Window) -> Image'
windowLabel :: ClientState -> (Focus, Window) -> Image'
windowLabel ClientState
st (Focus
focus, Window
w) =
  Image'
jumpLabel Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
  FocusLabelType -> ClientState -> Focus -> Image'
focusLabel FocusLabelType
FocusLabelJump ClientState
st Focus
focus Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
  Image'
activity
  where
    jumpLabel :: Image'
jumpLabel =
      case Getting (Maybe Char) Window (Maybe Char) -> Window -> Maybe Char
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Char) Window (Maybe Char)
Lens' Window (Maybe Char)
winName Window
w of
        Maybe Char
Nothing   -> Image'
forall a. Monoid a => a
mempty
        Just Char
name -> Attr -> Char -> Image'
char (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
palWindowName Palette
pal) Char
name Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                     Attr -> Char -> Image'
char Attr
defAttr Char
':'
    n :: Int
n   = Getting Int Window Int -> Window -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Window Int
Lens' Window Int
winUnread Window
w
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    activity :: Image'
activity
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Image'
forall a. Monoid a => a
mempty
      | Getting WindowLineImportance Window WindowLineImportance
-> Window -> WindowLineImportance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLineImportance Window WindowLineImportance
Lens' Window WindowLineImportance
winMention Window
w WindowLineImportance -> WindowLineImportance -> Bool
forall a. Eq a => a -> a -> Bool
== WindowLineImportance
WLImportant = Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> 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
palMention Palette
pal) (Int -> String
forall a. Show a => a -> String
show Int
n)
      | Bool
otherwise = Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> 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
palActivity Palette
pal) (Int -> String
forall a. Show a => a -> String
show Int
n)

data FocusLabelType = FocusLabelJump | FocusLabelShort | FocusLabelLong

focusLabel :: FocusLabelType -> ClientState -> Focus -> Image'
focusLabel :: FocusLabelType -> ClientState -> Focus -> Image'
focusLabel FocusLabelType
labelType ClientState
st Focus
focus =
  let
    !pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    netpal :: NetworkPalette
netpal = ClientState -> NetworkPalette
clientNetworkPalette ClientState
st
    colon :: Image'
colon = Attr -> Char -> Image'
char Attr
defAttr Char
':'
    networkLabel :: Text -> Image'
networkLabel Text
network = 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 -> Text
cleanText Text
network)
    channelLabel :: Identifier -> Image'
channelLabel         = Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
forall k v. HashMap k v
HashMap.empty
  in case (Focus
focus, FocusLabelType
labelType) of
    (Focus
Unfocused, FocusLabelType
_) ->
      Attr -> Char -> Image'
char (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) Char
'*'
    (NetworkFocus Text
network, FocusLabelType
FocusLabelJump) -> Text -> Image'
networkLabel Text
network Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
colon
    (NetworkFocus Text
network, FocusLabelType
_) -> Text -> Image'
networkLabel Text
network
    (ChannelFocus Text
network Identifier
channel, FocusLabelType
FocusLabelJump)
      | Text -> Maybe Text
forall a. a -> Maybe a
Just Text
network Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Focus -> Maybe Text
focusNetwork (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st) -> Identifier -> Image'
channelLabel Identifier
channel
    (ChannelFocus Text
network Identifier
channel, FocusLabelType
FocusLabelLong) ->
      Text -> Image'
networkLabel Text
network Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
colon Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      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
cleanChar (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
sigils) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Identifier -> Image'
channelLabel Identifier
channel Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
channelModes
      where
        (String
sigils, Image'
channelModes) =
          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 ->
               ( let nick :: Identifier
nick = Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs in
                 Getting String NetworkState String -> NetworkState -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HashMap Identifier ChannelState
 -> Const String (HashMap Identifier ChannelState))
-> NetworkState -> Const String NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const String (HashMap Identifier ChannelState))
 -> NetworkState -> Const String NetworkState)
-> ((String -> Const String String)
    -> HashMap Identifier ChannelState
    -> Const String (HashMap Identifier ChannelState))
-> Getting String NetworkState 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 String ChannelState)
 -> HashMap Identifier ChannelState
 -> Const String (HashMap Identifier ChannelState))
-> ((String -> Const String String)
    -> ChannelState -> Const String ChannelState)
-> (String -> Const String String)
-> HashMap Identifier ChannelState
-> Const String (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier String
 -> Const String (HashMap Identifier String))
-> ChannelState -> Const String ChannelState
Lens' ChannelState (HashMap Identifier String)
chanUsers ((HashMap Identifier String
  -> Const String (HashMap Identifier String))
 -> ChannelState -> Const String ChannelState)
-> ((String -> Const String String)
    -> HashMap Identifier String
    -> Const String (HashMap Identifier String))
-> (String -> Const String String)
-> ChannelState
-> Const String ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier String)
-> Traversal'
     (HashMap Identifier String) (IxValue (HashMap Identifier String))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier String)
nick) NetworkState
cs
               , case Getting (First (Map Char Text)) NetworkState (Map Char Text)
-> NetworkState -> Maybe (Map Char Text)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((HashMap Identifier ChannelState
 -> Const (First (Map Char Text)) (HashMap Identifier ChannelState))
-> NetworkState -> Const (First (Map Char Text)) NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const (First (Map Char Text)) (HashMap Identifier ChannelState))
 -> NetworkState -> Const (First (Map Char Text)) NetworkState)
-> ((Map Char Text
     -> Const (First (Map Char Text)) (Map Char Text))
    -> HashMap Identifier ChannelState
    -> Const (First (Map Char Text)) (HashMap Identifier ChannelState))
-> Getting (First (Map Char Text)) NetworkState (Map Char Text)
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 (First (Map Char Text)) ChannelState)
 -> HashMap Identifier ChannelState
 -> Const (First (Map Char Text)) (HashMap Identifier ChannelState))
-> ((Map Char Text
     -> Const (First (Map Char Text)) (Map Char Text))
    -> ChannelState -> Const (First (Map Char Text)) ChannelState)
-> (Map Char Text -> Const (First (Map Char Text)) (Map Char Text))
-> HashMap Identifier ChannelState
-> Const (First (Map Char Text)) (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Char Text -> Const (First (Map Char Text)) (Map Char Text))
-> ChannelState -> Const (First (Map Char Text)) ChannelState
Lens' ChannelState (Map Char Text)
chanModes) NetworkState
cs of
                    Just Map Char Text
modeMap | Bool -> Bool
not (Map Char Text -> Bool
forall a. Map Char a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Char Text
modeMap) ->
                        Image'
" " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> HashMap Char Attr -> String -> Image'
modesImage (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
palModes Palette
pal) (Getting (HashMap Char Attr) NetworkPalette (HashMap Char Attr)
-> NetworkPalette -> HashMap Char Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (HashMap Char Attr) NetworkPalette (HashMap Char Attr)
Lens' NetworkPalette (HashMap Char Attr)
palCModes NetworkPalette
netpal) (Char
'+'Char -> String -> String
forall a. a -> [a] -> [a]
:Map Char Text -> String
forall k a. Map k a -> [k]
Map.keys Map Char Text
modeMap)
                    Maybe (Map Char Text)
_ -> Image'
forall a. Monoid a => a
mempty
               )
            Maybe NetworkState
_ -> (String
"", Image'
forall a. Monoid a => a
mempty)
    (ChannelFocus Text
network Identifier
channel, FocusLabelType
_) ->
      Text -> Image'
networkLabel Text
network Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
colon Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Identifier -> Image'
channelLabel Identifier
channel