{-# 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.Focus
import Client.Image.Message (cleanChar, cleanText, modesImage)
import Client.Image.PackedImage
import Client.Image.Palette
import Client.State
import Client.State.Focus (focusNetwork, Focus(..), Subfocus(..), WindowsFilter(..))
import Client.State.Help (hsQuery, HelpQuery (..))
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 Data.Maybe (mapMaybe, maybeToList)
import Data.Text (Text)
import qualified Data.Text 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, mkId)
import Numeric (showFFloat)
import Client.WhoReply (whoQuery)

clientTitle :: ClientState -> String
clientTitle :: ClientState -> String
clientTitle ClientState
st
  = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
cleanChar
  (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
LText.unpack
  (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"glirc - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Image' -> Text
imageText (Bool -> ClientState -> Subfocus -> Focus -> Image'
currentViewImage Bool
False ClientState
st (Getting Subfocus ClientState Subfocus -> ClientState -> Subfocus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Subfocus ClientState Subfocus
Lens' ClientState Subfocus
clientSubfocus ClientState
st) (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))

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 Image -> [Image] -> [Image]
forall a. a -> [a] -> [a]
: [Image]
activity [Image] -> [Image] -> [Image]
forall a. [a] -> [a] -> [a]
++ [Image]
errorImgs)
  where
    focus :: Focus
focus = 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
    common :: Image
common = [Image] -> Image
Vty.horizCat ([Image] -> Image) -> [Image] -> Image
forall a b. (a -> b) -> a -> b
$
      ClientState -> Image
myNickImage ClientState
st Image -> [Image] -> [Image]
forall a. a -> [a] -> [a]
:
      (Image' -> Image) -> [Image'] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map Image' -> Image
unpackImage
      [ Image' -> Image'
infoBubble (Image' -> Image') -> Image' -> Image'
forall a b. (a -> b) -> a -> b
$ Bool -> ClientState -> Subfocus -> Focus -> Image'
currentViewImage Bool
True ClientState
st (Getting Subfocus ClientState Subfocus -> ClientState -> Subfocus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Subfocus ClientState Subfocus
Lens' ClientState Subfocus
clientSubfocus ClientState
st) Focus
focus
      , ClientState -> Image'
detailImage ClientState
st
      , Focus -> ClientState -> Image'
nometaImage Focus
focus ClientState
st
      , ClientState -> Image'
scrollImage ClientState
st
      , ClientState -> Image'
filterImage ClientState
st
      , ClientState -> Image'
lockImage ClientState
st
      , Image'
latency
      ]

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

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

    errorImgs :: [Image]
errorImgs =
      Text -> Image
transientErrorImage (Text -> Image) -> [Text] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Getting (Maybe Text) ClientState (Maybe Text)
-> ClientState -> Maybe Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Text) ClientState (Maybe Text)
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> [Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat (Int -> Image' -> [Image']
forall a. Int -> a -> [a]
replicate Int
fillSize Image'
bar)
  where
    nometaImage' :: Image'
nometaImage' = if Bool
showHideMeta then Focus -> ClientState -> Image'
nometaImage Focus
focus ClientState
st else Image'
forall a. Monoid a => a
mempty
    content :: Image'
content = Image' -> Image'
infoBubble (Image' -> Image') -> Image' -> Image'
forall a b. (a -> b) -> a -> b
$ (Bool -> ClientState -> Subfocus -> Focus -> Image'
currentViewImage Bool
True ClientState
st Subfocus
subfocus Focus
focus Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
nometaImage')
    fillSize :: Int
fillSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
w Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
Lens' ClientState Int
clientScroll ClientState
st = Image'
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 = 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


-- | 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           = Image'
forall a. Monoid a => a
mempty
  where
    pal :: Palette
pal  = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr = 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

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


-- | 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 = (Image' -> Image')
-> (Image' -> Image') -> Either Image' Image' -> Image'
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Image' -> Image'
forall a. a -> a
id Image' -> Image'
forall a. a -> a
id (Either Image' Image' -> Image') -> Either Image' Image' -> Image'
forall a b. (a -> b) -> a -> b
$

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

     NetworkState
cs <- -- detect when offline
       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
         Maybe NetworkState
Nothing -> Image' -> Either Image' NetworkState
forall a b. a -> Either a b
Left (Image' -> Image'
infoBubble (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
palError Palette
pal) String
"offline"))
         Just NetworkState
cs -> NetworkState -> Either Image' NetworkState
forall a b. b -> Either a b
Right NetworkState
cs

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

     Image' -> Either Image' Image'
forall a b. b -> Either a b
Right (Image' -> Either Image' Image') -> Image' -> Either Image' Image'
forall a b. (a -> b) -> a -> b
$ case Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
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 (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
palLatency Palette
pal) String
"connecting" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Int -> Image'
forall {a}. (Ord a, Num a, Show a) => a -> Image'
retryImage Int
n)

       PingStatus
PingNone -> Image'
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 (Image' -> Image') -> (String -> Image') -> String -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
palLatency Palette
pal)

    retryImage :: a -> Image'
retryImage a
n
      | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0     = Image'
": " 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
palLabel Palette
pal) (String
"retry " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n)
      | Bool
otherwise = Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
"(" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
img Image' -> Image' -> Image'
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
  | Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientDetailView ClientState
st = Image' -> Image'
infoBubble (Attr -> String -> Image'
string Attr
attr String
"detail")
  | Bool
otherwise = Image'
forall a. Monoid a => a
mempty
  where
    pal :: Palette
pal  = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr = 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


-- | 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  = Image'
forall a. Monoid a => a
mempty
  where
    pal :: Palette
pal        = ClientState -> Palette
clientPalette ClientState
st
    attr :: Attr
attr       = 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
    metaHidden :: Bool
metaHidden = Getting Any ClientState Bool -> ClientState -> Bool
forall s. Getting Any s Bool -> s -> Bool
orOf ((Map Focus Window -> Const Any (Map Focus Window))
-> ClientState -> Const Any ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const Any (Map Focus Window))
 -> ClientState -> Const Any ClientState)
-> ((Bool -> Const Any Bool)
    -> Map Focus Window -> Const Any (Map Focus Window))
-> Getting Any ClientState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
Focus
focus ((Window -> Const Any Window)
 -> Map Focus Window -> Const Any (Map Focus Window))
-> ((Bool -> Const Any Bool) -> Window -> Const Any Window)
-> (Bool -> Const Any Bool)
-> Map Focus Window
-> Const Any (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Any Bool) -> Window -> Const Any Window
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
  | [Image] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Image]
indicators Bool -> Bool -> Bool
&& Int
anon Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 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.<|>
                Image
anonImage Image -> Image -> Image
Vty.<|>
                Attr -> String -> Image
Vty.string Attr
defAttr String
"]"
    where
      pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
      ([Image]
indicators, Int
impanon, Int
anon) = (Window -> ([Image], Int, Int) -> ([Image], Int, Int))
-> ([Image], Int, Int) -> [Window] -> ([Image], Int, Int)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Window -> ([Image], Int, Int) -> ([Image], Int, Int)
aux ([], Int
0, Int
0) [Window]
windows
      spacer :: Image
spacer
        | [Image] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Image]
indicators = Attr -> String -> Image
Vty.string Attr
defAttr String
"+"
        | Bool
otherwise       = Attr -> String -> Image
Vty.string Attr
defAttr String
" +"
      anonImage :: Image
anonImage
        | Int
anon Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Image
Vty.emptyImage
        | Int
impanon Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Image
spacer Image -> Image -> Image
Vty.<|>
                         Attr -> String -> Image
Vty.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
anon)
        | Bool
otherwise = Image
spacer Image -> Image -> Image
Vty.<|>
                      Attr -> String -> Image
Vty.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
impanon) Image -> Image -> Image
Vty.<|>
                      Attr -> String -> Image
Vty.string Attr
defAttr String
"/" Image -> Image -> Image
Vty.<|>
                      Attr -> String -> Image
Vty.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
anon)
      windows :: [Window]
windows    = LensLike' (Const [Window]) ClientState (Map Focus Window)
-> (Map Focus Window -> [Window]) -> ClientState -> [Window]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [Window]) ClientState (Map Focus Window)
Lens' ClientState (Map Focus Window)
clientWindows Map Focus Window -> [Window]
forall k a. Map k a -> [a]
Map.elems ClientState
st

      aux :: Window -> ([Vty.Image], Int, Int) -> ([Vty.Image], Int, Int)
      aux :: Window -> ([Image], Int, Int) -> ([Image], Int, Int)
aux Window
w ([Image]
indicators', Int
impanon', Int
anon') = 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, 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) of
          (Maybe Char
Nothing, WindowLineImportance
WLImportant)   -> ([Image]
indicators', Int
impanon'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
anon'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
          (Maybe Char
Nothing, WindowLineImportance
WLNormal)      -> ([Image]
indicators', Int
impanon', Int
anon'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
          (Just Char
name, WindowLineImportance
WLImportant) -> (Attr -> Char -> Image
Vty.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
palMention Palette
pal) Char
name Image -> [Image] -> [Image]
forall a. a -> [a] -> [a]
: [Image]
indicators', Int
impanon', Int
anon')
          (Just Char
name, WindowLineImportance
WLNormal)    -> (Attr -> Char -> Image
Vty.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
palActivity Palette
pal) Char
name Image -> [Image] -> [Image]
forall a. a -> [a] -> [a]
: [Image]
indicators', Int
impanon', Int
anon')
          (Maybe Char, WindowLineImportance)
_                        -> ([Image]
indicators', Int
impanon', Int
anon')

-- | Multi-line activity information enabled by F3
activityBarImages :: ClientState -> [Vty.Image]
activityBarImages :: ClientState -> [Image]
activityBarImages ClientState
st
  = ((Focus, Window) -> Maybe Image) -> [(Focus, Window)] -> [Image]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Focus, Window) -> Maybe Image
baraux
  ([(Focus, Window)] -> [Image]) -> [(Focus, Window)] -> [Image]
forall a b. (a -> b) -> a -> b
$ Map Focus Window -> [(Focus, Window)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
  (Map Focus Window -> [(Focus, Window)])
-> Map Focus Window -> [(Focus, Window)]
forall a b. (a -> b) -> a -> b
$ Getting (Map Focus Window) ClientState (Map Focus Window)
-> ClientState -> Map Focus Window
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Focus Window) ClientState (Map Focus Window)
Lens' ClientState (Map Focus Window)
clientWindows ClientState
st
  where
    baraux :: (Focus, Window) -> Maybe Image
baraux pair :: (Focus, Window)
pair@(Focus
_,Window
w)
      | Getting ActivityFilter Window ActivityFilter
-> Window -> ActivityFilter
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActivityFilter Window ActivityFilter
Lens' Window ActivityFilter
winActivityFilter Window
w ActivityFilter -> ActivityFilter -> Bool
forall a. Eq a => a -> a -> Bool
== ActivityFilter
AFSilent = Maybe Image
forall a. Maybe a
Nothing
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe Image
forall a. Maybe a
Nothing -- todo: make configurable
      | Bool
otherwise = Image -> Maybe Image
forall a. a -> Maybe a
Just (Image -> Maybe Image) -> Image -> Maybe Image
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' -> Image
unpackImage ((Focus, Window) -> Image'
windowLabel' (Focus, Window)
pair) Image -> Image -> Image
Vty.<|>
        Attr -> Char -> Image
Vty.char Attr
defAttr Char
']'
      where
        windowLabel' :: (Focus, Window) -> Image'
windowLabel' = ClientState -> (Focus, Window) -> Image'
windowLabel ClientState
st
        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

-- | 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' Int -> Int -> Bool
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 ([Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat (Int -> Image' -> [Image']
forall a. Int -> a -> [a]
replicate Int
fillsize Image'
bar))
      where
        fillsize :: Int
fillsize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Image -> Int
Vty.imageWidth Image
acc)

myNickImage :: ClientState -> Vty.Image
myNickImage :: ClientState -> Image
myNickImage ClientState
st =
  case 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 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 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
        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 (Image' -> Image) -> Image' -> Image
forall a b. (a -> b) -> a -> b
$
                      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)
palUModes NetworkPalette
netpal) (Char
'+'Char -> String -> String
forall a. a -> [a] -> [a]
:Getting String NetworkState String -> NetworkState -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String NetworkState String
Lens' NetworkState String
csModes NetworkState
cs) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                      Image'
snomaskImage)
          where
            attr :: Attr
attr
              | Getting Bool NetworkState Bool -> NetworkState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool NetworkState Bool
Lens' NetworkState Bool
csAway NetworkState
cs = 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
palAway Palette
pal
              | Bool
otherwise      = Attr
defAttr

            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

            snomaskImage :: Image'
snomaskImage
              | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Getting String NetworkState String -> NetworkState -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String NetworkState String
Lens' NetworkState String
csSnomask NetworkState
cs) = Image'
""
              | Bool
otherwise                = 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)
palSnomask NetworkPalette
netpal) (Char
'+'Char -> String -> String
forall a. a -> [a] -> [a]
:Getting String NetworkState String -> NetworkState -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String NetworkState String
Lens' NetworkState String
csSnomask NetworkState
cs)

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
')'

currentViewImage :: Bool -> ClientState -> Subfocus -> Focus -> Image'
currentViewImage :: Bool -> ClientState -> Subfocus -> Focus -> Image'
currentViewImage Bool
showFull ClientState
st Subfocus
subfocus Focus
focus =
  case Subfocus
subfocus of
    Subfocus
FocusMessages         -> Image'
windowName Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> FocusLabelType -> ClientState -> Focus -> Image'
focusLabel FocusLabelType
labelType ClientState
st Focus
focus
    FocusWindows WindowsFilter
filt     -> Attr -> String -> Image'
string Attr
defAttr String
"windows" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Image'
opt (WindowsFilter -> Maybe Text
windowFilterName WindowsFilter
filt)
    FocusInfo Text
net Identifier
chan    -> Attr -> String -> Image'
string Attr
defAttr String
"info" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Focus -> Image'
ctxLabel (Text -> Identifier -> Focus
ChannelFocus Text
net Identifier
chan)
    FocusUsers Text
net Identifier
chan   -> Attr -> String -> Image'
string Attr
defAttr String
"names" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Focus -> Image'
ctxLabel (Text -> Identifier -> Focus
ChannelFocus Text
net Identifier
chan)
    Subfocus
FocusMentions         -> Attr -> String -> Image'
string Attr
defAttr String
"mentions"
    Subfocus
FocusPalette          -> Attr -> String -> Image'
string Attr
defAttr String
"palette"
    Subfocus
FocusDigraphs         -> Attr -> String -> Image'
string Attr
defAttr String
"digraphs"
    Subfocus
FocusKeyMap           -> Attr -> String -> Image'
string Attr
defAttr String
"keymap"
    Subfocus
FocusHelp             -> Attr -> String -> Image'
string Attr
defAttr String
"help" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
helpQuery
    Subfocus
FocusIgnoreList       -> Attr -> String -> Image'
string Attr
defAttr String
"ignores"
    Subfocus
FocusRtsStats         -> Attr -> String -> Image'
string Attr
defAttr String
"rtsstats"
    FocusCert{}           -> Attr -> String -> Image'
string Attr
defAttr String
"cert"
    FocusChanList Text
net Maybe Int
_ Maybe Int
_ -> Attr -> String -> Image'
string Attr
defAttr String
"channels" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Focus -> Image'
ctxLabel (Text -> Focus
NetworkFocus Text
net)
    FocusWho Text
net          -> Attr -> String -> Image'
string Attr
defAttr String
"who" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
whoTarget Text
net
    FocusMasks Text
net Identifier
chan Char
m -> Attr -> String -> Image'
string Attr
defAttr String
"masks" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Char -> Image'
maskLabel Char
m Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Focus -> Image'
ctxLabel (Text -> Identifier -> Focus
ChannelFocus Text
net Identifier
chan)
  where
    labelType :: FocusLabelType
labelType = if Bool
showFull then FocusLabelType
FocusLabelLong else FocusLabelType
FocusLabelShort
    !pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    ctxLabel :: Focus -> Image'
ctxLabel Focus
focus' = Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> FocusLabelType -> ClientState -> Focus -> Image'
focusLabel FocusLabelType
FocusLabelShort ClientState
st Focus
focus'
    maskLabel :: Char -> Image'
maskLabel Char
m = Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> 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
palLabel Palette
pal) Char
m
    opt :: Maybe Text -> Image'
opt = (Text -> Image') -> Maybe Text -> Image'
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
cmd -> Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                           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
cmd)
    windowName :: Image'
windowName
      | Bool
showFull = case Getting (First Char) ClientState Char -> ClientState -> Maybe Char
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map Focus Window -> Const (First Char) (Map Focus Window))
-> ClientState -> Const (First Char) ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const (First Char) (Map Focus Window))
 -> ClientState -> Const (First Char) ClientState)
-> ((Char -> Const (First Char) Char)
    -> Map Focus Window -> Const (First Char) (Map Focus Window))
-> Getting (First Char) ClientState Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
Focus
focus ((Window -> Const (First Char) Window)
 -> Map Focus Window -> Const (First Char) (Map Focus Window))
-> ((Char -> Const (First Char) Char)
    -> Window -> Const (First Char) Window)
-> (Char -> Const (First Char) Char)
-> Map Focus Window
-> Const (First Char) (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Char -> Const (First Char) (Maybe Char))
-> Window -> Const (First Char) Window
Lens' Window (Maybe Char)
winName ((Maybe Char -> Const (First Char) (Maybe Char))
 -> Window -> Const (First Char) Window)
-> ((Char -> Const (First Char) Char)
    -> Maybe Char -> Const (First Char) (Maybe Char))
-> (Char -> Const (First Char) Char)
-> Window
-> Const (First Char) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Const (First Char) Char)
-> Maybe Char -> Const (First Char) (Maybe Char)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) ClientState
st of
          Just Char
n -> 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
n Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
":"
          Maybe Char
_      -> Image'
forall a. Monoid a => a
mempty
      | Bool
otherwise = Image'
forall a. Monoid a => a
mempty
    whoTarget :: Text -> Image'
whoTarget Text
net = case Getting (First (Text, Maybe Text)) ClientState (Text, Maybe Text)
-> ClientState -> Maybe (Text, Maybe Text)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text
-> LensLike'
     (Const (First (Text, Maybe Text))) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net LensLike'
  (Const (First (Text, Maybe Text))) ClientState NetworkState
-> (((Text, Maybe Text)
     -> Const (First (Text, Maybe Text)) (Text, Maybe Text))
    -> NetworkState -> Const (First (Text, Maybe Text)) NetworkState)
-> Getting
     (First (Text, Maybe Text)) ClientState (Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WhoReply -> Const (First (Text, Maybe Text)) WhoReply)
-> NetworkState -> Const (First (Text, Maybe Text)) NetworkState
Lens' NetworkState WhoReply
csWhoReply ((WhoReply -> Const (First (Text, Maybe Text)) WhoReply)
 -> NetworkState -> Const (First (Text, Maybe Text)) NetworkState)
-> (((Text, Maybe Text)
     -> Const (First (Text, Maybe Text)) (Text, Maybe Text))
    -> WhoReply -> Const (First (Text, Maybe Text)) WhoReply)
-> ((Text, Maybe Text)
    -> Const (First (Text, Maybe Text)) (Text, Maybe Text))
-> NetworkState
-> Const (First (Text, Maybe Text)) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Maybe Text)
 -> Const (First (Text, Maybe Text)) (Text, Maybe Text))
-> WhoReply -> Const (First (Text, Maybe Text)) WhoReply
Lens' WhoReply (Text, Maybe Text)
whoQuery) ClientState
st of
      Just (Text
query, Maybe Text
_) | Text -> Bool
Text.null Text
query -> Focus -> Image'
ctxLabel (Text -> Focus
NetworkFocus Text
net)
      Just (Text
query, Maybe Text
_) -> Focus -> Image'
ctxLabel (Text -> Identifier -> Focus
ChannelFocus Text
net (Identifier -> Focus) -> Identifier -> Focus
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
mkId Text
query)
      Maybe (Text, Maybe Text)
_ -> Image'
forall a. Monoid a => a
mempty
    helpQuery :: Image'
helpQuery = case Getting HelpQuery ClientState HelpQuery -> ClientState -> HelpQuery
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HelpState -> Const HelpQuery HelpState)
-> ClientState -> Const HelpQuery ClientState
Lens' ClientState HelpState
clientHelp ((HelpState -> Const HelpQuery HelpState)
 -> ClientState -> Const HelpQuery ClientState)
-> ((HelpQuery -> Const HelpQuery HelpQuery)
    -> HelpState -> Const HelpQuery HelpState)
-> Getting HelpQuery ClientState HelpQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HelpQuery -> Const HelpQuery HelpQuery)
-> HelpState -> Const HelpQuery HelpState
Lens' HelpState HelpQuery
hsQuery) ClientState
st of
      HelpQuery
HelpList ->
        Image'
forall a. Monoid a => a
mempty
      HelpCmd Text
txt ->
        Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
defAttr Text
txt
      HelpNet Text
net Text
txt ->
        Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> 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
net) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
':' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
defAttr Text
txt
      HelpNetPartial Text
net Text
txt Maybe Text
_ ->
        Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> 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
net) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
':' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
defAttr Text
txt

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