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

This module provides image renderers used to construct
the status image that sits between text input and the message
window.

-}
module Client.Image.StatusLine
  ( statusLineImage
  , minorStatusLineImage
  , clientTitle
  ) 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(..), Subfocus(..), WindowsFilter(..))
import Client.State.Network
import Client.State.Window
import Control.Lens (view, orOf, preview, views, _Just, Ixed(ix))
import Data.Foldable (for_)
import Data.Map.Strict qualified as Map
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (mapMaybe, maybeToList)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified as LText
import Graphics.Vty.Attributes (Attr, defAttr, bold, withForeColor, withStyle, red)
import Graphics.Vty.Image qualified as Vty
import Irc.Identifier (idText)
import Numeric (showFFloat)

clientTitle :: ClientState -> String
clientTitle :: ClientState -> String
clientTitle ClientState
st
  = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
cleanChar
  forall a b. (a -> b) -> a -> b
$ Text -> String
LText.unpack
  forall a b. (a -> b) -> a -> b
$ Text
"glirc - " forall a. Semigroup a => a -> a -> a
<> Image' -> Text
imageText (ClientState -> Focus -> Image'
viewFocusLabel ClientState
st (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st))

bar :: Image'
bar :: Image'
bar = Attr -> Char -> Image'
char (Attr -> Style -> Attr
withStyle Attr
defAttr Style
bold) Char
'─'


-- | Renders the status line between messages and the textbox.
statusLineImage ::
  Int         {- ^ draw width   -} ->
  ClientState {- ^ client state -} ->
  Vty.Image   {- ^ status bar   -}
statusLineImage :: Int -> ClientState -> Image
statusLineImage Int
w ClientState
st =
  Int -> [Image] -> Image
makeLines Int
w (Image
common forall a. a -> [a] -> [a]
: [Image]
activity forall a. [a] -> [a] -> [a]
++ [Image]
errorImgs)
  where
    common :: Image
common = [Image] -> Image
Vty.horizCat forall a b. (a -> b) -> a -> b
$
      ClientState -> Image
myNickImage ClientState
st forall a. a -> [a] -> [a]
:
      forall a b. (a -> b) -> [a] -> [b]
map Image' -> Image
unpackImage
      [ Focus -> ClientState -> Image'
focusImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st) ClientState
st
      , Subfocus -> ClientState -> Image'
subfocusImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Subfocus
clientSubfocus ClientState
st) ClientState
st
      , ClientState -> Image'
detailImage ClientState
st
      , Focus -> ClientState -> Image'
nometaImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st) ClientState
st
      , ClientState -> Image'
scrollImage ClientState
st
      , ClientState -> Image'
filterImage ClientState
st
      , ClientState -> Image'
lockImage ClientState
st
      , Image'
latency
      ]

    latency :: Image'
latency
      | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientShowPing ClientState
st = ClientState -> Image'
latencyImage ClientState
st
      | Bool
otherwise              = forall a. Monoid a => a
mempty

    activity :: [Image]
activity
      | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientActivityBar ClientState
st = ClientState -> [Image]
activityBarImages ClientState
st
      | Bool
otherwise                 = [ClientState -> Image
activitySummary ClientState
st]

    errorImgs :: [Image]
errorImgs =
      Text -> Image
transientErrorImage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> [a]
maybeToList (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Maybe Text)
clientErrorMsg ClientState
st)


-- Generates an error message notification image.
transientErrorImage ::
  Text  {- ^ @error-message@           -} ->
  Vty.Image {- ^ @─[error: error-message]@ -}
transientErrorImage :: Text -> Image
transientErrorImage Text
txt =
  Attr -> Text -> Image
Vty.text' Attr
defAttr Text
"─[" Image -> Image -> Image
Vty.<|>
  Attr -> Text -> Image
Vty.text' (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) Text
"error: " Image -> Image -> Image
Vty.<|>
  Attr -> Text -> Image
Vty.text' Attr
defAttr (Text -> Text
cleanText Text
txt) Image -> Image -> Image
Vty.<|>
  Attr -> Text -> Image
Vty.text' Attr
defAttr Text
"]"


-- | The minor status line is used when rendering the @/splits@ and
-- @/mentions@ views to show the associated window name.
minorStatusLineImage ::
  Focus       {- ^ window name          -} ->
  Subfocus    {- ^ subfocus             -} ->
  Int         {- ^ draw width           -} ->
  Bool        {- ^ show hidemeta status -} ->
  ClientState {- ^ client state -} ->
  Image'
minorStatusLineImage :: Focus -> Subfocus -> Int -> Bool -> ClientState -> Image'
minorStatusLineImage Focus
focus Subfocus
subfocus Int
w Bool
showHideMeta ClientState
st =
  Image'
content forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
fillSize Image'
bar)
  where
    content :: Image'
content = Focus -> ClientState -> Image'
focusImage Focus
focus ClientState
st forall a. Semigroup a => a -> a -> a
<>
              Subfocus -> ClientState -> Image'
subfocusImage Subfocus
subfocus ClientState
st forall a. Semigroup a => a -> a -> a
<>
              if Bool
showHideMeta then Focus -> ClientState -> Image'
nometaImage Focus
focus ClientState
st else forall a. Monoid a => a
mempty

    fillSize :: Int
fillSize = forall a. Ord a => a -> a -> a
max Int
0 (Int
w forall a. Num a => a -> a -> a
- Image' -> Int
imageWidth Image'
content)


-- | Indicate when the client is scrolling and old messages are being shown.
scrollImage :: ClientState -> Image'
scrollImage :: ClientState -> Image'
scrollImage ClientState
st
  | Int
0 forall a. Eq a => a -> a -> Bool
== forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientScroll ClientState
st = forall a. Monoid a => a
mempty
  | Bool
otherwise = Image' -> Image'
infoBubble (Attr -> String -> Image'
string Attr
attr String
"scroll")
  where
    pal :: Palette
pal  = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal


-- | Indicate when the client is potentially showing a subset of the
-- available chat messages.
filterImage :: ClientState -> Image'
filterImage :: ClientState -> Image'
filterImage ClientState
st
  | ClientState -> Bool
clientIsFiltered ClientState
st = Image' -> Image'
infoBubble (Attr -> String -> Image'
string Attr
attr String
"filtered")
  | Bool
otherwise           = forall a. Monoid a => a
mempty
  where
    pal :: Palette
pal  = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal

-- | Indicate when the client editor is locked
lockImage :: ClientState -> Image'
lockImage :: ClientState -> Image'
lockImage ClientState
st
  | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientEditLock ClientState
st = Image' -> Image'
infoBubble (Attr -> String -> Image'
string Attr
attr String
"locked")
  | Bool
otherwise              = forall a. Monoid a => a
mempty
  where
    pal :: Palette
pal  = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal


-- | Indicate the current connection health. This will either indicate
-- that the connection is being established or that a ping has been
-- sent or long the previous ping round-trip was.
latencyImage :: ClientState -> Image'
latencyImage :: ClientState -> Image'
latencyImage ClientState
st = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall a b. (a -> b) -> a -> b
$

  do Text
network <- -- no network -> no image
       case forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st of
         Maybe Text
Nothing  -> forall a b. a -> Either a b
Left forall a. Monoid a => a
mempty
         Just Text
net -> forall a b. b -> Either a b
Right Text
net

     NetworkState
cs <- -- detect when offline
       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
         Maybe NetworkState
Nothing -> forall a b. a -> Either a b
Left (Image' -> Image'
infoBubble (Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) String
"offline"))
         Just NetworkState
cs -> forall a b. b -> Either a b
Right NetworkState
cs

     -- render latency if one is stored
     forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState (Maybe NominalDiffTime)
csLatency NetworkState
cs) forall a b. (a -> b) -> a -> b
$ \NominalDiffTime
latency ->
       forall a b. a -> Either a b
Left (String -> Image'
latencyBubble (forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (forall a. a -> Maybe a
Just Int
2) (forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
latency :: Double) String
"s"))

     forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState PingStatus
csPingStatus NetworkState
cs of

       PingSent {} -> String -> Image'
latencyBubble String
"wait"

       PingConnecting Int
n Maybe UTCTime
_ ConnectRestriction
_ ->
         Image' -> Image'
infoBubble (Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLatency Palette
pal) String
"connecting" forall a. Semigroup a => a -> a -> a
<> forall {a}. (Ord a, Num a, Show a) => a -> Image'
retryImage Int
n)

       PingStatus
PingNone -> forall a. Monoid a => a
mempty -- just connected no ping sent yet

  where
    pal :: Palette
pal           = ClientState -> Palette
clientPalette ClientState
st
    latencyBubble :: String -> Image'
latencyBubble = Image' -> Image'
infoBubble forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLatency Palette
pal)

    retryImage :: a -> Image'
retryImage a
n
      | a
n forall a. Ord a => a -> a -> Bool
> a
0     = Image'
": " forall a. Semigroup a => a -> a -> a
<> 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
"retry " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n)
      | Bool
otherwise = forall a. Monoid a => a
mempty


-- | Wrap some text in parentheses to make it suitable for inclusion in the
-- status line.
infoBubble :: Image' -> Image'
infoBubble :: Image' -> Image'
infoBubble Image'
img = Image'
bar forall a. Semigroup a => a -> a -> a
<> Image'
"(" forall a. Semigroup a => a -> a -> a
<> Image'
img forall a. Semigroup a => a -> a -> a
<> Image'
")"


-- | Indicate that the client is in the /detailed/ view.
detailImage :: ClientState -> Image'
detailImage :: ClientState -> Image'
detailImage ClientState
st
  | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientDetailView ClientState
st = Image' -> Image'
infoBubble (Attr -> String -> Image'
string Attr
attr String
"detail")
  | Bool
otherwise = forall a. Monoid a => a
mempty
  where
    pal :: Palette
pal  = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal


-- | Indicate that the client isn't showing the metadata lines in /normal/
-- view.
nometaImage :: Focus -> ClientState -> Image'
nometaImage :: Focus -> ClientState -> Image'
nometaImage Focus
focus ClientState
st
  | Bool
metaHidden = Image' -> Image'
infoBubble (Attr -> String -> Image'
string Attr
attr String
"nometa")
  | Bool
otherwise  = forall a. Monoid a => a
mempty
  where
    pal :: Palette
pal        = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr       = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal
    metaHidden :: Bool
metaHidden = forall s. Getting Any s Bool -> s -> Bool
orOf (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window Bool
winHideMeta) ClientState
st

-- | Image for little box with active window names:
--
-- @-[15p]@
activitySummary :: ClientState -> Vty.Image
activitySummary :: ClientState -> Image
activitySummary ClientState
st
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Image]
indicators = Image
Vty.emptyImage
  | Bool
otherwise       = Image' -> Image
unpackImage Image'
bar Image -> Image -> Image
Vty.<|>
                      Attr -> String -> Image
Vty.string Attr
defAttr String
"[" Image -> Image -> Image
Vty.<|>
                      [Image] -> Image
Vty.horizCat [Image]
indicators Image -> Image -> Image
Vty.<|>
                      Attr -> String -> Image
Vty.string Attr
defAttr String
"]"
  where
    indicators :: [Image]
indicators = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Window -> [Image] -> [Image]
aux [] [Window]
windows
    windows :: [Window]
windows    = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState (Map Focus Window)
clientWindows forall k a. Map k a -> [a]
Map.elems ClientState
st

    aux :: Window -> [Image] -> [Image]
aux Window
w [Image]
rest =
      let name :: Char
name = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window (Maybe Char)
winName Window
w of
                   Maybe Char
Nothing -> Char
'?'
                   Just Char
i -> Char
i in
      case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window WindowLineImportance
winMention Window
w of
        WindowLineImportance
WLImportant -> Attr -> Char -> Image
Vty.char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palMention  Palette
pal) Char
name forall a. a -> [a] -> [a]
: [Image]
rest
        WindowLineImportance
WLNormal    -> Attr -> Char -> Image
Vty.char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palActivity Palette
pal) Char
name forall a. a -> [a] -> [a]
: [Image]
rest
        WindowLineImportance
WLBoring    -> [Image]
rest
      where
        pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st

-- | Multi-line activity information enabled by F3
activityBarImages :: ClientState -> [Vty.Image]
activityBarImages :: ClientState -> [Image]
activityBarImages ClientState
st
  = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Focus, Window) -> Maybe Image
baraux
  forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toAscList
  forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Map Focus Window)
clientWindows ClientState
st

  where
    baraux :: (Focus, Window) -> Maybe Image
baraux (Focus
focus,Window
w)
      | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window ActivityFilter
winActivityFilter Window
w forall a. Eq a => a -> a -> Bool
== ActivityFilter
AFSilent = forall a. Maybe a
Nothing
      | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. Maybe a
Nothing -- todo: make configurable
      | Bool
otherwise = forall a. a -> Maybe a
Just
                  forall a b. (a -> b) -> a -> b
$ Image' -> Image
unpackImage Image'
bar Image -> Image -> Image
Vty.<|>
                    Attr -> Char -> Image
Vty.char Attr
defAttr Char
'[' Image -> Image -> Image
Vty.<|>
                    Image
jumpLabel Image -> Image -> Image
Vty.<|>
                    Image
focusLabel Image -> Image -> Image
Vty.<|>
                    Attr -> Char -> Image
Vty.char Attr
defAttr Char
':' Image -> Image -> Image
Vty.<|>
                    Attr -> String -> Image
Vty.string Attr
attr (forall a. Show a => a -> String
show Int
n) Image -> Image -> Image
Vty.<|>
                    Attr -> Char -> Image
Vty.char Attr
defAttr Char
']'
      where
        jumpLabel :: Image
jumpLabel =
          case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window (Maybe Char)
winName Window
w of
            Maybe Char
Nothing   -> forall a. Monoid a => a
mempty
            Just Char
name -> Attr -> Char -> Image
Vty.char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palWindowName Palette
pal) Char
name Image -> Image -> Image
Vty.<|>
                         Attr -> Char -> Image
Vty.char Attr
defAttr Char
':'
        n :: Int
n   = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window Int
winUnread Window
w
        pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
        attr :: Attr
attr = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window WindowLineImportance
winMention Window
w of
                 WindowLineImportance
WLImportant -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palMention Palette
pal
                 WindowLineImportance
_           -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palActivity Palette
pal
        focusLabel :: Image
focusLabel =
          Image' -> Image
unpackImage forall a b. (a -> b) -> a -> b
$ case Focus
focus of
            Focus
Unfocused           -> Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) (String -> Text
Text.pack String
"*")
            NetworkFocus Text
net    -> 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 -> Text
cleanText Text
net)
            ChannelFocus Text
_ Identifier
chan -> Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier forall k v. HashMap k v
HashMap.empty Identifier
chan


-- | Pack a list of images into a single image spanning possibly many lines.
-- The images will stack upward with the first element of the list being in
-- the bottom left corner of the image. Each line will have at least one
-- of the component images in it, which might truncate that image in extreme
-- cases.
makeLines ::
  Int     {- ^ window width       -} ->
  [Vty.Image] {- ^ components to pack -} ->
  Vty.Image
makeLines :: Int -> [Image] -> Image
makeLines Int
_ [] = Image
Vty.emptyImage
makeLines Int
w (Image
x:[Image]
xs) = Image -> [Image] -> Image
go Image
x [Image]
xs
  where
    go :: Image -> [Image] -> Image
go Image
acc (Image
y:[Image]
ys)
      | let acc' :: Image
acc' = Image
acc Image -> Image -> Image
Vty.<|> Image
y
      , Image -> Int
Vty.imageWidth Image
acc' forall a. Ord a => a -> a -> Bool
<= Int
w
      = Image -> [Image] -> Image
go Image
acc' [Image]
ys

    go Image
acc [Image]
ys = Int -> [Image] -> Image
makeLines Int
w [Image]
ys
        Image -> Image -> Image
Vty.<-> Int -> Image -> Image
Vty.cropRight Int
w Image
acc
        Image -> Image -> Image
Vty.<|> Image' -> Image
unpackImage (forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
fillsize Image'
bar))
      where
        fillsize :: Int
fillsize = forall a. Ord a => a -> a -> a
max Int
0 (Int
w forall a. Num a => a -> a -> a
- Image -> Int
Vty.imageWidth Image
acc)


myNickImage :: ClientState -> Vty.Image
myNickImage :: ClientState -> Image
myNickImage ClientState
st =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of
    NetworkFocus Text
network      -> Text -> Image
nickPart Text
network
    ChannelFocus Text
network Identifier
_    -> Text -> Image
nickPart Text
network
    Focus
Unfocused                 -> Image
Vty.emptyImage
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    netpal :: NetworkPalette
netpal = ClientState -> NetworkPalette
clientNetworkPalette ClientState
st
    nickPart :: Text -> Image
nickPart Text
network =
      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
        Maybe NetworkState
Nothing -> Image
Vty.emptyImage
        Just NetworkState
cs -> Attr -> Text -> Image
Vty.text' Attr
attr (Text -> Text
cleanText (Identifier -> Text
idText Identifier
nick))
           Image -> Image -> Image
Vty.<|> Attr -> Image -> Image
parens Attr
defAttr
                     (Image' -> Image
unpackImage forall a b. (a -> b) -> a -> b
$
                      Attr -> HashMap Char Attr -> String -> Image'
modesImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palModes Palette
pal) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkPalette (HashMap Char Attr)
palUModes NetworkPalette
netpal) (Char
'+'forall a. a -> [a] -> [a]
:forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState String
csModes NetworkState
cs) forall a. Semigroup a => a -> a -> a
<>
                      Image'
snomaskImage)
          where
            attr :: Attr
attr
              | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Bool
csAway NetworkState
cs = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palAway Palette
pal
              | Bool
otherwise      = Attr
defAttr

            nick :: Identifier
nick = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Identifier
csNick NetworkState
cs

            snomaskImage :: Image'
snomaskImage
              | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState String
csSnomask NetworkState
cs) = Image'
""
              | Bool
otherwise                = Image'
" " forall a. Semigroup a => a -> a -> a
<>
                Attr -> HashMap Char Attr -> String -> Image'
modesImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palModes Palette
pal) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkPalette (HashMap Char Attr)
palSnomask NetworkPalette
netpal) (Char
'+'forall a. a -> [a] -> [a]
:forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState String
csSnomask NetworkState
cs)

subfocusImage :: Subfocus -> ClientState -> Image'
subfocusImage :: Subfocus -> ClientState -> Image'
subfocusImage Subfocus
subfocus ClientState
st = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Image' -> Image'
infoBubble (Palette -> Subfocus -> Maybe Image'
viewSubfocusLabel Palette
pal Subfocus
subfocus)
  where
    pal :: Palette
pal         = ClientState -> Palette
clientPalette ClientState
st

focusImage :: Focus -> ClientState -> Image'
focusImage :: Focus -> ClientState -> Image'
focusImage Focus
focus ClientState
st =
  Image' -> Image'
infoBubble forall a b. (a -> b) -> a -> b
$
  case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' ClientState (Map Focus Window)
clientWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Focus
focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window (Maybe Char)
winName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ClientState
st of
    Maybe Char
Nothing -> Image'
label
    Just Char
n  -> Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palWindowName Palette
pal) Char
n forall a. Semigroup a => a -> a -> a
<> Image'
":" forall a. Semigroup a => a -> a -> a
<> Image'
label
  where
    !pal :: Palette
pal        = ClientState -> Palette
clientPalette ClientState
st
    label :: Image'
label       = ClientState -> Focus -> Image'
viewFocusLabel ClientState
st Focus
focus

parens :: Attr -> Vty.Image -> Vty.Image
parens :: Attr -> Image -> Image
parens Attr
attr Image
i = Attr -> Char -> Image
Vty.char Attr
attr Char
'(' Image -> Image -> Image
Vty.<|> Image
i Image -> Image -> Image
Vty.<|> Attr -> Char -> Image
Vty.char Attr
attr Char
')'

viewFocusLabel :: ClientState -> Focus -> Image'
viewFocusLabel :: ClientState -> Focus -> Image'
viewFocusLabel ClientState
st Focus
focus =
  let
    !pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    netpal :: NetworkPalette
netpal = ClientState -> NetworkPalette
clientNetworkPalette ClientState
st
  in case Focus
focus of
    Focus
Unfocused ->
      Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) Char
'*'
    NetworkFocus Text
network ->
      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 -> Text
cleanText Text
network)
    ChannelFocus Text
network Identifier
channel ->
      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 -> Text
cleanText Text
network) forall a. Semigroup a => a -> a -> a
<>
      Attr -> Char -> Image'
char Attr
defAttr Char
':' forall a. Semigroup a => a -> a -> a
<>
      Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSigil Palette
pal) (Char -> Char
cleanChar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
sigils) 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 Identifier
channel forall a. Semigroup a => a -> a -> a
<>
      Image'
channelModes

      where
        (String
sigils, Image'
channelModes) =
          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
            Maybe NetworkState
Nothing -> (String
"", forall a. Monoid a => a
mempty)
            Just NetworkState
cs ->
               ( let nick :: Identifier
nick = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Identifier
csNick NetworkState
cs in
                 forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (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
channel forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (HashMap Identifier String)
chanUsers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
nick) NetworkState
cs

               , case 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
channel forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (Map Char Text)
chanModes) NetworkState
cs of
                    Just Map Char Text
modeMap | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Char Text
modeMap) ->
                        Image'
" " forall a. Semigroup a => a -> a -> a
<> Attr -> HashMap Char Attr -> String -> Image'
modesImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palModes Palette
pal) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkPalette (HashMap Char Attr)
palCModes NetworkPalette
netpal) (Char
'+'forall a. a -> [a] -> [a]
:forall k a. Map k a -> [k]
Map.keys Map Char Text
modeMap)
                    Maybe (Map Char Text)
_ -> forall a. Monoid a => a
mempty
               )

viewSubfocusLabel :: Palette -> Subfocus -> Maybe Image'
viewSubfocusLabel :: Palette -> Subfocus -> Maybe Image'
viewSubfocusLabel Palette
pal Subfocus
subfocus =
  case Subfocus
subfocus of
    Subfocus
FocusMessages     -> forall a. Maybe a
Nothing
    FocusWindows WindowsFilter
filt -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"windows" forall a. Semigroup a => a -> a -> a
<>
                                Maybe Text -> Image'
opt (WindowsFilter -> Maybe Text
windowFilterName WindowsFilter
filt)
    Subfocus
FocusInfo         -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"info"
    Subfocus
FocusUsers        -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"users"
    Subfocus
FocusMentions     -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"mentions"
    Subfocus
FocusPalette      -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"palette"
    Subfocus
FocusDigraphs     -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"digraphs"
    Subfocus
FocusKeyMap       -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"keymap"
    FocusHelp Maybe Text
mb      -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"help" forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Image'
opt Maybe Text
mb
    Subfocus
FocusIgnoreList   -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"ignores"
    Subfocus
FocusRtsStats     -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"rtsstats"
    FocusCert{}       -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"cert"
    FocusChanList Maybe Int
_ Maybe Int
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"channels"
    Subfocus
FocusWho          -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
"who"
    FocusMasks Char
m      -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ 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
"masks"
      , Attr -> Char -> Image'
char Attr
defAttr Char
':'
      , 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
m
      ]
  where
    opt :: Maybe Text -> Image'
opt = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
cmd -> Attr -> Char -> Image'
char Attr
defAttr Char
':' 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
cmd)

windowFilterName :: WindowsFilter -> Maybe Text
windowFilterName :: WindowsFilter -> Maybe Text
windowFilterName WindowsFilter
x =
  case WindowsFilter
x of
    WindowsFilter
AllWindows     -> forall a. Maybe a
Nothing
    WindowsFilter
NetworkWindows -> forall a. a -> Maybe a
Just Text
"networks"
    WindowsFilter
ChannelWindows -> forall a. a -> Maybe a
Just Text
"channels"
    WindowsFilter
UserWindows    -> forall a. a -> Maybe a
Just Text
"users"