{-# Language OverloadedStrings, BangPatterns #-}
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
'─'
statusLineImage ::
Int ->
ClientState ->
Vty.Image
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)
transientErrorImage ::
Text ->
Vty.Image
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
"]"
minorStatusLineImage ::
Focus ->
Subfocus ->
Int ->
Bool ->
ClientState ->
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)
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
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
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
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 <-
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 <-
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
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
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
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'
")"
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
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
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
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
| 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
makeLines ::
Int ->
[Vty.Image] ->
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"