{-# Language OverloadedStrings, BangPatterns, ViewPatterns #-}
module Client.Image.Message
( MessageRendererParams(..)
, RenderMode(..)
, IdentifierColorMode(..)
, defaultRenderParams
, msgImage
, metadataImg
, ignoreImage
, quietIdentifier
, coloredUserInfo
, coloredIdentifier
, cleanText
, cleanChar
, nickPad
, timeImage
, drawWindowLine
, modesImage
, prettyTime
, parseIrcTextWithNicks
, Highlight(..)
) where
import Client.Configuration (PaddingMode(..))
import Client.Image.LineWrap (lineWrapPrefix)
import Client.Image.MircFormatting (parseIrcText, parseIrcText')
import Client.Image.PackedImage (char, imageWidth, string, text', Image')
import Client.Image.Palette
import Client.Message
import Client.State.Window (unpackTimeOfDay, wlImage, wlPrefix, wlTimestamp, WindowLine)
import Client.UserHost ( uhAccount, UserAndHost )
import Control.Applicative ((<|>))
import Control.Lens (view, (^?), filtered, folded, views, Ixed(ix), At (at))
import Data.Char (ord, chr, isControl)
import Data.Hashable (hash)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.List (intercalate, intersperse)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (UTCTime, ZonedTime, TimeOfDay, formatTime, defaultTimeLocale, parseTimeM)
import Data.Vector qualified as Vector
import Graphics.Vty.Attributes
import Irc.Codes
import Irc.Identifier (Identifier, idText, mkId)
import Irc.Message
import Irc.RawIrcMsg (msgCommand, msgParams, msgPrefix)
import Irc.UserInfo (UserInfo(userHost, userNick, userName))
import Text.Read (readMaybe)
data MessageRendererParams = MessageRendererParams
{ MessageRendererParams -> [Char]
rendStatusMsg :: [Char]
, MessageRendererParams -> [Char]
rendUserSigils :: [Char]
, MessageRendererParams -> HashMap Identifier Highlight
rendHighlights :: HashMap Identifier Highlight
, MessageRendererParams -> Palette
rendPalette :: Palette
, MessageRendererParams -> Maybe (HashMap Identifier UserAndHost)
rendAccounts :: Maybe (HashMap Identifier UserAndHost)
, MessageRendererParams -> NetworkPalette
rendNetPalette :: NetworkPalette
, MessageRendererParams -> [Char]
rendChanTypes :: [Char]
}
defaultRenderParams :: MessageRendererParams
defaultRenderParams :: MessageRendererParams
defaultRenderParams = MessageRendererParams
{ rendStatusMsg :: [Char]
rendStatusMsg = [Char]
""
, rendUserSigils :: [Char]
rendUserSigils = [Char]
""
, rendHighlights :: HashMap Identifier Highlight
rendHighlights = forall k v. HashMap k v
HashMap.empty
, rendPalette :: Palette
rendPalette = Palette
defaultPalette
, rendAccounts :: Maybe (HashMap Identifier UserAndHost)
rendAccounts = forall a. Maybe a
Nothing
, rendNetPalette :: NetworkPalette
rendNetPalette = NetworkPalette
defaultNetworkPalette
, rendChanTypes :: [Char]
rendChanTypes = [Char]
"#&!+"
}
msgImage ::
ZonedTime ->
MessageRendererParams ->
MessageBody ->
(Image', Image', Image')
msgImage :: ZonedTime
-> MessageRendererParams -> MessageBody -> (Image', Image', Image')
msgImage ZonedTime
when MessageRendererParams
params MessageBody
body = (Image'
prefix, Image'
image, Image'
full)
where
si :: Image'
si = [Char] -> Image'
statusMsgImage (MessageRendererParams -> [Char]
rendStatusMsg MessageRendererParams
params)
prefix :: Image'
prefix = Image'
si forall a. Semigroup a => a -> a -> a
<> MessageRendererParams -> MessageBody -> Image'
prefixImage MessageRendererParams
params MessageBody
body
image :: Image'
image = RenderMode -> MessageRendererParams -> MessageBody -> Image'
bodyImage RenderMode
NormalRender MessageRendererParams
params MessageBody
body
full :: Image'
full =
forall a. Monoid a => [a] -> a
mconcat
[ Palette -> ZonedTime -> Image'
datetimeImage (MessageRendererParams -> Palette
rendPalette MessageRendererParams
params) ZonedTime
when
, [Char] -> Image'
statusMsgImage (MessageRendererParams -> [Char]
rendStatusMsg MessageRendererParams
params)
, RenderMode -> MessageRendererParams -> MessageBody -> Image'
bodyImage RenderMode
DetailedRender MessageRendererParams
params MessageBody
body
]
cleanChar :: Char -> Char
cleanChar :: Char -> Char
cleanChar Char
x
| Char
x forall a. Ord a => a -> a -> Bool
< Char
'\x20' = Int -> Char
chr (Int
0x2400 forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
x)
| Char
x forall a. Eq a => a -> a -> Bool
== Char
'\DEL' = Char
'\x2421'
| Char -> Bool
isControl Char
x = Char
'\xfffd'
| Bool
otherwise = Char
x
cleanText :: Text -> Text
cleanText :: Text -> Text
cleanText = (Char -> Char) -> Text -> Text
Text.map Char -> Char
cleanChar
ctxt :: Text -> Image'
ctxt :: Text -> Image'
ctxt = Attr -> Text -> Image'
text' Attr
defAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
cleanText
errorPrefix ::
MessageRendererParams ->
Image'
errorPrefix :: MessageRendererParams -> Image'
errorPrefix MessageRendererParams
params =
Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError (MessageRendererParams -> Palette
rendPalette MessageRendererParams
params)) Text
"error" forall a. Semigroup a => a -> a -> a
<>
Attr -> Char -> Image'
char Attr
defAttr Char
':'
normalPrefix :: MessageRendererParams -> Image'
normalPrefix :: MessageRendererParams -> Image'
normalPrefix MessageRendererParams
params =
Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel (MessageRendererParams -> Palette
rendPalette MessageRendererParams
params)) Text
"client" forall a. Semigroup a => a -> a -> a
<>
Attr -> Char -> Image'
char Attr
defAttr Char
':'
statusMsgImage :: [Char] -> Image'
statusMsgImage :: [Char] -> Image'
statusMsgImage [Char]
modes
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
modes = forall a. Monoid a => a
mempty
| Bool
otherwise = Image'
"(" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
statusMsgColor [Char]
modes forall a. Semigroup a => a -> a -> a
<> Image'
") "
where
statusMsgColor :: Attr
statusMsgColor = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red
prefixImage ::
MessageRendererParams ->
MessageBody -> Image'
prefixImage :: MessageRendererParams -> MessageBody -> Image'
prefixImage MessageRendererParams
params MessageBody
body =
case MessageBody
body of
IrcBody IrcMsg
irc -> MessageRendererParams -> IrcMsg -> Image'
ircLinePrefix MessageRendererParams
params IrcMsg
irc
ErrorBody{} -> MessageRendererParams -> Image'
errorPrefix MessageRendererParams
params
NormalBody{} -> MessageRendererParams -> Image'
normalPrefix MessageRendererParams
params
bodyImage ::
RenderMode ->
MessageRendererParams ->
MessageBody -> Image'
bodyImage :: RenderMode -> MessageRendererParams -> MessageBody -> Image'
bodyImage RenderMode
rm MessageRendererParams
params MessageBody
body =
case MessageBody
body of
IrcBody IrcMsg
irc | RenderMode
NormalRender <- RenderMode
rm -> MessageRendererParams -> IrcMsg -> Image'
ircLineImage MessageRendererParams
params IrcMsg
irc
| RenderMode
DetailedRender <- RenderMode
rm -> MessageRendererParams -> IrcMsg -> Image'
fullIrcLineImage MessageRendererParams
params IrcMsg
irc
ErrorBody Text
txt -> Palette -> Text -> Image'
parseIrcText (MessageRendererParams -> Palette
rendPalette MessageRendererParams
params) Text
txt
NormalBody Text
txt -> Palette -> Text -> Image'
parseIrcText (MessageRendererParams -> Palette
rendPalette MessageRendererParams
params) Text
txt
timeImage :: Palette -> TimeOfDay -> Image'
timeImage :: Palette -> TimeOfDay -> Image'
timeImage Palette
palette
= Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palTime Palette
palette)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%R "
datetimeImage :: Palette -> ZonedTime -> Image'
datetimeImage :: Palette -> ZonedTime -> Image'
datetimeImage Palette
palette
= Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palTime Palette
palette)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%m-%d %T "
data RenderMode
= NormalRender
| DetailedRender
nickPad ::
PaddingMode ->
Image' ->
Image'
nickPad :: PaddingMode -> Image' -> Image'
nickPad PaddingMode
mode Image'
img =
case PaddingMode
mode of
LeftPadding Int
w | Int
w forall a. Ord a => a -> a -> Bool
> Int
iw -> Int -> Image'
mkpad (Int
wforall a. Num a => a -> a -> a
-Int
iw) forall a. Semigroup a => a -> a -> a
<> Image'
img
RightPadding Int
w | Int
w forall a. Ord a => a -> a -> Bool
> Int
iw -> Image'
img forall a. Semigroup a => a -> a -> a
<> Int -> Image'
mkpad (Int
wforall a. Num a => a -> a -> a
-Int
iw)
PaddingMode
_ -> Image'
img
where
iw :: Int
iw = Image' -> Int
imageWidth Image'
img
mkpad :: Int -> Image'
mkpad Int
n = Attr -> [Char] -> Image'
string Attr
defAttr (forall a. Int -> a -> [a]
replicate Int
n Char
' ')
ircLinePrefix ::
MessageRendererParams ->
IrcMsg -> Image'
ircLinePrefix :: MessageRendererParams -> IrcMsg -> Image'
ircLinePrefix !MessageRendererParams
rp IrcMsg
body =
let pal :: Palette
pal = MessageRendererParams -> Palette
rendPalette MessageRendererParams
rp
sigils :: [Char]
sigils = MessageRendererParams -> [Char]
rendUserSigils MessageRendererParams
rp
hilites :: HashMap Identifier Highlight
hilites = MessageRendererParams -> HashMap Identifier Highlight
rendHighlights MessageRendererParams
rp
rm :: RenderMode
rm = RenderMode
NormalRender
who :: Source -> Image'
who Source
n = Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSigil Palette
pal) [Char]
sigils forall a. Semigroup a => a -> a -> a
<> Image'
ui
where
baseUI :: Image'
baseUI = Palette
-> RenderMode -> HashMap Identifier Highlight -> UserInfo -> Image'
coloredUserInfo Palette
pal RenderMode
rm HashMap Identifier Highlight
hilites (Source -> UserInfo
srcUser Source
n)
ui :: Image'
ui = case MessageRendererParams -> Maybe (HashMap Identifier UserAndHost)
rendAccounts MessageRendererParams
rp of
Maybe (HashMap Identifier UserAndHost)
Nothing -> Image'
baseUI
Just HashMap Identifier UserAndHost
accts ->
let tagAcct :: Maybe Text
tagAcct = if Text -> Bool
Text.null (Source -> Text
srcAcct Source
n) then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Source -> Text
srcAcct Source
n)
isKnown :: Text -> Bool
isKnown Text
acct = Bool -> Bool
not (Text -> Bool
Text.null Text
acct Bool -> Bool -> Bool
|| Text
acct forall a. Eq a => a -> a -> Bool
== Text
"*")
lkupAcct :: Maybe Text
lkupAcct = HashMap Identifier UserAndHost
accts
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UserAndHost Text
uhAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered Text -> Bool
isKnown in
case Maybe Text
tagAcct forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
lkupAcct of
Just Text
acct
| Text -> Identifier
mkId Text
acct forall a. Eq a => a -> a -> Bool
== UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
n) -> Image'
baseUI
| Bool
otherwise -> Image'
baseUI forall a. Semigroup a => a -> a -> a
<> Image'
"(" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
acct forall a. Semigroup a => a -> a -> a
<> Image'
")"
Maybe Text
Nothing -> Image'
"~" forall a. Semigroup a => a -> a -> a
<> Image'
baseUI
in
case IrcMsg
body of
Join {} -> forall a. Monoid a => a
mempty
Part {} -> forall a. Monoid a => a
mempty
Quit {} -> forall a. Monoid a => a
mempty
Ping {} -> forall a. Monoid a => a
mempty
Pong {} -> forall a. Monoid a => a
mempty
Nick {} -> forall a. Monoid a => a
mempty
Away {} -> forall a. Monoid a => a
mempty
Topic Source
src Identifier
_ Text
_ -> Source -> Image'
who Source
src
Kick Source
src Identifier
_ Identifier
_ Text
_ -> Source -> Image'
who Source
src
Kill Source
src Identifier
_ Text
_ -> Source -> Image'
who Source
src
Mode Source
src Identifier
_ [Text]
_ -> Source -> Image'
who Source
src
Invite Source
src Identifier
_ Identifier
_ -> Source -> Image'
who Source
src
Notice Source
src Identifier
_ Text
_ ->
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) [Char]
":"
Privmsg Source
src Identifier
_ Text
_ -> Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<> Image'
":"
Wallops Source
src Text
_ ->
Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) [Char]
"WALL " forall a. Semigroup a => a -> a -> a
<> Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<> Image'
":"
Ctcp Source
src Identifier
_dst Text
"ACTION" Text
_txt ->
Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue) [Char]
"* " forall a. Semigroup a => a -> a -> a
<> Source -> Image'
who Source
src
Ctcp {} -> forall a. Monoid a => a
mempty
CtcpNotice Source
src Identifier
_dst Text
_cmd Text
_txt ->
Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) [Char]
"! " forall a. Semigroup a => a -> a -> a
<> Source -> Image'
who Source
src
Error {} -> Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) [Char]
"ERROR" forall a. Semigroup a => a -> a -> a
<> Image'
":"
Reply Text
_ ReplyCode
code [Text]
_ -> ReplyCode -> Image'
replyCodePrefix ReplyCode
code
UnknownMsg RawIrcMsg
irc ->
case RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
irc of
Just Source
src -> Source -> Image'
who Source
src
Maybe Source
Nothing -> Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) [Char]
"?"
Cap CapCmd
cmd ->
Attr -> Text -> Image'
text' (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
magenta) (CapCmd -> Text
renderCapCmd CapCmd
cmd) forall a. Semigroup a => a -> a -> a
<> Image'
":"
Authenticate{} -> Image'
"AUTHENTICATE"
BatchStart{} -> forall a. Monoid a => a
mempty
BatchEnd{} -> forall a. Monoid a => a
mempty
Account Source
user Text
_ -> Source -> Image'
who Source
user forall a. Semigroup a => a -> a -> a
<> Image'
" account:"
Chghost Source
ui Text
_ Text
_ -> Source -> Image'
who Source
ui forall a. Semigroup a => a -> a -> a
<> Image'
" chghost:"
ircLineImage ::
MessageRendererParams ->
IrcMsg -> Image'
ircLineImage :: MessageRendererParams -> IrcMsg -> Image'
ircLineImage !MessageRendererParams
rp IrcMsg
body =
let pal :: Palette
pal = MessageRendererParams -> Palette
rendPalette MessageRendererParams
rp
hilites :: HashMap Identifier Highlight
hilites = MessageRendererParams -> HashMap Identifier Highlight
rendHighlights MessageRendererParams
rp
in
case IrcMsg
body of
Join {} -> forall a. Monoid a => a
mempty
Part {} -> forall a. Monoid a => a
mempty
Quit {} -> forall a. Monoid a => a
mempty
Ping {} -> forall a. Monoid a => a
mempty
Pong {} -> forall a. Monoid a => a
mempty
BatchStart {} -> forall a. Monoid a => a
mempty
BatchEnd {} -> forall a. Monoid a => a
mempty
Nick {} -> forall a. Monoid a => a
mempty
Authenticate{} -> Image'
"***"
Away {} -> forall a. Monoid a => a
mempty
Error Text
txt -> Palette -> Text -> Image'
parseIrcText Palette
pal Text
txt
Topic Source
_ Identifier
_ Text
txt ->
Image'
"changed the topic: " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Kick Source
_who Identifier
_channel Identifier
kickee Text
reason ->
Image'
"kicked " forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
kickee forall a. Semigroup a => a -> a -> a
<>
Image'
": " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
reason
Kill Source
_who Identifier
killee Text
reason ->
Image'
"killed " forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
killee forall a. Semigroup a => a -> a -> a
<>
Image'
": " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
reason
Notice Source
_ Identifier
_ Text
txt -> Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Privmsg Source
_ Identifier
_ Text
txt -> Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Wallops Source
_ Text
txt -> Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Ctcp Source
_ Identifier
_ Text
"ACTION" Text
txt -> Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Ctcp {} -> forall a. Monoid a => a
mempty
CtcpNotice Source
_ Identifier
_ Text
cmd Text
txt -> Palette -> Text -> Image'
parseIrcText Palette
pal Text
cmd forall a. Semigroup a => a -> a -> a
<> Image'
" " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Reply Text
srv ReplyCode
code [Text]
params -> Palette -> RenderMode -> Text -> ReplyCode -> [Text] -> Image'
renderReplyCode Palette
pal RenderMode
NormalRender Text
srv ReplyCode
code [Text]
params
UnknownMsg RawIrcMsg
irc ->
Text -> Image'
ctxt (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
irc) forall a. Semigroup a => a -> a -> a
<>
Attr -> Char -> Image'
char Attr
defAttr Char
' ' forall a. Semigroup a => a -> a -> a
<>
Palette -> [Text] -> Image'
separatedParams Palette
pal (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
irc)
Cap CapCmd
cmd -> Text -> Image'
ctxt (CapCmd -> Text
capCmdText CapCmd
cmd)
Mode Source
_ Identifier
chan (Text
modes:[Text]
params) ->
Image'
"set mode: " forall a. Semigroup a => a -> a -> a
<>
Attr -> HashMap Char Attr -> [Char] -> Image'
modesImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palModes Palette
pal) (Identifier -> MessageRendererParams -> HashMap Char Attr
modesPaletteFor Identifier
chan MessageRendererParams
rp) (Text -> [Char]
Text.unpack Text
modes) forall a. Semigroup a => a -> a -> a
<>
Image'
" " forall a. Semigroup a => a -> a -> a
<>
Palette -> [Text] -> Image'
ircWords Palette
pal [Text]
params
Mode Source
_ Identifier
_ [] ->
Image'
"changed no modes"
Invite Source
_ Identifier
tgt Identifier
chan ->
Image'
"invited " forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
tgt forall a. Semigroup a => a -> a -> a
<>
Image'
" to " forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Identifier -> Text
idText Identifier
chan)
Account Source
_ Text
acct -> if Text -> Bool
Text.null Text
acct then Image'
"*" else Text -> Image'
ctxt Text
acct
Chghost Source
_ Text
user Text
host -> Text -> Image'
ctxt Text
user forall a. Semigroup a => a -> a -> a
<> Image'
" " forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host
fullIrcLineImage ::
MessageRendererParams ->
IrcMsg -> Image'
fullIrcLineImage :: MessageRendererParams -> IrcMsg -> Image'
fullIrcLineImage !MessageRendererParams
rp IrcMsg
body =
let quietAttr :: Attr
quietAttr = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palMeta Palette
pal
pal :: Palette
pal = MessageRendererParams -> Palette
rendPalette MessageRendererParams
rp
sigils :: [Char]
sigils = MessageRendererParams -> [Char]
rendUserSigils MessageRendererParams
rp
hilites :: HashMap Identifier Highlight
hilites = MessageRendererParams -> HashMap Identifier Highlight
rendHighlights MessageRendererParams
rp
rm :: RenderMode
rm = RenderMode
DetailedRender
plainWho :: UserInfo -> Image'
plainWho = Palette
-> RenderMode -> HashMap Identifier Highlight -> UserInfo -> Image'
coloredUserInfo Palette
pal RenderMode
rm HashMap Identifier Highlight
hilites
who :: Source -> Image'
who Source
n =
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSigil Palette
pal) [Char]
sigils forall a. Semigroup a => a -> a -> a
<>
UserInfo -> Image'
plainWho (Source -> UserInfo
srcUser Source
n) forall a. Semigroup a => a -> a -> a
<>
case MessageRendererParams -> Maybe (HashMap Identifier UserAndHost)
rendAccounts MessageRendererParams
rp forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
n)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UserAndHost Text
uhAccount of
Maybe Text
_ | Bool -> Bool
not (Text -> Bool
Text.null (Source -> Text
srcAcct Source
n)) -> Attr -> Text -> Image'
text' Attr
quietAttr (Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText (Source -> Text
srcAcct Source
n) forall a. Semigroup a => a -> a -> a
<> Text
")")
Just Text
acct
| Bool -> Bool
not (Text -> Bool
Text.null Text
acct) -> Attr -> Text -> Image'
text' Attr
quietAttr (Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText Text
acct forall a. Semigroup a => a -> a -> a
<> Text
")")
Maybe Text
_ -> Image'
""
in
case IrcMsg
body of
Nick Source
old Identifier
new ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palUsrChg Palette
pal) [Char]
"nick " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
old forall a. Semigroup a => a -> a -> a
<>
Image'
" is now known as " forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
new
Join Source
nick Identifier
_chan Text
acct Text
gecos ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palJoin Palette
pal) [Char]
"join " forall a. Semigroup a => a -> a -> a
<>
UserInfo -> Image'
plainWho (Source -> UserInfo
srcUser Source
nick) forall a. Semigroup a => a -> a -> a
<>
Image'
accountPart forall a. Semigroup a => a -> a -> a
<> Image'
gecosPart
where
accountPart :: Image'
accountPart
| Bool -> Bool
not (Text -> Bool
Text.null (Source -> Text
srcAcct Source
nick)) = Attr -> Text -> Image'
text' Attr
quietAttr (Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText (Source -> Text
srcAcct Source
nick) forall a. Semigroup a => a -> a -> a
<> Text
")")
| Bool -> Bool
not (Text -> Bool
Text.null Text
acct) = Attr -> Text -> Image'
text' Attr
quietAttr (Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText Text
acct forall a. Semigroup a => a -> a -> a
<> Text
")")
| Bool
otherwise = forall a. Monoid a => a
mempty
gecosPart :: Image'
gecosPart
| Text -> Bool
Text.null Text
gecos = forall a. Monoid a => a
mempty
| Bool
otherwise = Attr -> Text -> Image'
text' Attr
quietAttr (Text
" [" forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText Text
gecos forall a. Semigroup a => a -> a -> a
<> Text
"]")
Part Source
nick Identifier
_chan Maybe Text
mbreason ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palPart Palette
pal) [Char]
"part " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
nick forall a. Semigroup a => a -> a -> a
<>
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
reason -> Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
" (" forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal Text
reason forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
")") Maybe Text
mbreason
Quit Source
nick Maybe Text
mbreason ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palPart Palette
pal) [Char]
"quit " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
nick forall a. Semigroup a => a -> a -> a
<>
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
reason -> Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
" (" forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal Text
reason forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
")") Maybe Text
mbreason
Kick Source
kicker Identifier
_channel Identifier
kickee Text
reason ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palPart Palette
pal) [Char]
"kick " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
kicker forall a. Semigroup a => a -> a -> a
<>
Image'
" kicked " forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
kickee forall a. Semigroup a => a -> a -> a
<>
Image'
": " forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal Text
reason
Kill Source
killer Identifier
killee Text
reason ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palPart Palette
pal) [Char]
"kill " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
killer forall a. Semigroup a => a -> a -> a
<>
Image'
" killed " forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
killee forall a. Semigroup a => a -> a -> a
<>
Image'
": " forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal Text
reason
Topic Source
src Identifier
_dst Text
txt ->
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"tpic " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<>
Image'
" changed the topic: " forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal Text
txt
Invite Source
src Identifier
tgt Identifier
chan ->
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"invt " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<>
Image'
" invited " forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
tgt forall a. Semigroup a => a -> a -> a
<>
Image'
" to " forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
ctxt (Identifier -> Text
idText Identifier
chan)
Notice Source
src Identifier
_dst Text
txt ->
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"note " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) [Char]
": " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Privmsg Source
src Identifier
_dst Text
txt ->
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"chat " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<> Image'
": " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Wallops Source
src Text
txt ->
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"wall " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<> Image'
": " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Ctcp Source
src Identifier
_dst Text
"ACTION" Text
txt ->
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"actp " forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue) [Char]
"* " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<> Image'
" " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Ctcp Source
src Identifier
_dst Text
cmd Text
txt ->
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"ctcp " forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue) [Char]
"! " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<> Image'
" " forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal Text
cmd forall a. Semigroup a => a -> a -> a
<>
if Text -> Bool
Text.null Text
txt then forall a. Monoid a => a
mempty else Image'
separatorImage forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
txt
CtcpNotice Source
src Identifier
_dst Text
cmd Text
txt ->
Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"ctcp " forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) [Char]
"! " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<> Image'
" " forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal Text
cmd forall a. Semigroup a => a -> a -> a
<>
if Text -> Bool
Text.null Text
txt then forall a. Monoid a => a
mempty else Image'
separatorImage forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
txt
Ping [Text]
params ->
Image'
"PING " forall a. Semigroup a => a -> a -> a
<> Palette -> [Text] -> Image'
separatedParams Palette
pal [Text]
params
Pong [Text]
params ->
Image'
"PONG " forall a. Semigroup a => a -> a -> a
<> Palette -> [Text] -> Image'
separatedParams Palette
pal [Text]
params
Error Text
reason ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) [Char]
"ERROR " forall a. Semigroup a => a -> a -> a
<>
Palette -> Text -> Image'
parseIrcText Palette
pal Text
reason
Reply Text
srv ReplyCode
code [Text]
params ->
Palette -> RenderMode -> Text -> ReplyCode -> [Text] -> Image'
renderReplyCode Palette
pal RenderMode
DetailedRender Text
srv ReplyCode
code [Text]
params
UnknownMsg RawIrcMsg
irc ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\UserInfo
ui -> Palette
-> RenderMode -> HashMap Identifier Highlight -> UserInfo -> Image'
coloredUserInfo Palette
pal RenderMode
rm HashMap Identifier Highlight
hilites UserInfo
ui forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
' ')
(forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix RawIrcMsg
irc) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
ctxt (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
irc) forall a. Semigroup a => a -> a -> a
<>
Attr -> Char -> Image'
char Attr
defAttr Char
' ' forall a. Semigroup a => a -> a -> a
<>
Palette -> [Text] -> Image'
separatedParams Palette
pal (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
irc)
Cap CapCmd
cmd ->
Attr -> Text -> Image'
text' (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
magenta) (CapCmd -> Text
renderCapCmd CapCmd
cmd) forall a. Semigroup a => a -> a -> a
<>
Image'
": " forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
ctxt (CapCmd -> Text
capCmdText CapCmd
cmd)
Mode Source
nick Identifier
chan (Text
modes:[Text]
params) ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palModes Palette
pal) [Char]
"mode " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
nick forall a. Semigroup a => a -> a -> a
<> Image'
" set mode: " forall a. Semigroup a => a -> a -> a
<>
Attr -> HashMap Char Attr -> [Char] -> Image'
modesImage (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palModes Palette
pal) (Identifier -> MessageRendererParams -> HashMap Char Attr
modesPaletteFor Identifier
chan MessageRendererParams
rp) (Text -> [Char]
Text.unpack Text
modes) forall a. Semigroup a => a -> a -> a
<>
Image'
" " forall a. Semigroup a => a -> a -> a
<>
Palette -> [Text] -> Image'
ircWords Palette
pal [Text]
params
Mode Source
nick Identifier
_ [] ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palModes Palette
pal) [Char]
"mode " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
nick forall a. Semigroup a => a -> a -> a
<> Image'
" changed no modes"
Authenticate{} -> Image'
"AUTHENTICATE ***"
BatchStart{} -> Image'
"BATCH +"
BatchEnd{} -> Image'
"BATCH -"
Account Source
src Text
acct ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palUsrChg Palette
pal) [Char]
"acct " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
src forall a. Semigroup a => a -> a -> a
<> Image'
": " forall a. Semigroup a => a -> a -> a
<>
if Text -> Bool
Text.null Text
acct then Image'
"*" else Text -> Image'
ctxt Text
acct
Chghost Source
user Text
newuser Text
newhost ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palUsrChg Palette
pal) [Char]
"chng " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
user forall a. Semigroup a => a -> a -> a
<> Image'
": " forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
ctxt Text
newuser forall a. Semigroup a => a -> a -> a
<> Image'
" " forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
newhost
Away Source
user (Just Text
txt) ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palAway Palette
pal) [Char]
"away " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
user forall a. Semigroup a => a -> a -> a
<> Image'
": " forall a. Semigroup a => a -> a -> a
<>
Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
False Text
txt
Away Source
user Maybe Text
Nothing ->
Attr -> [Char] -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palUsrChg Palette
pal) [Char]
"back " forall a. Semigroup a => a -> a -> a
<>
Source -> Image'
who Source
user
renderCapCmd :: CapCmd -> Text
renderCapCmd :: CapCmd -> Text
renderCapCmd CapCmd
cmd =
case CapCmd
cmd of
CapLs {} -> Text
"caps-available"
CapList {} -> Text
"caps-active"
CapAck {} -> Text
"caps-acknowledged"
CapNak {} -> Text
"caps-rejected"
CapNew {} -> Text
"caps-offered"
CapDel {} -> Text
"caps-withdrawn"
separatorImage :: Image'
separatorImage :: Image'
separatorImage = Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue) Char
'·'
separatedParams :: Palette -> [Text] -> Image'
separatedParams :: Palette -> [Text] -> Image'
separatedParams Palette
pal = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Image'
separatorImage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Palette -> Text -> Image'
parseIrcText Palette
pal)
ircWords :: Palette -> [Text] -> Image'
ircWords :: Palette -> [Text] -> Image'
ircWords Palette
pal = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (Attr -> Char -> Image'
char Attr
defAttr Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Palette -> Text -> Image'
parseIrcText Palette
pal)
replyCodePrefix :: ReplyCode -> Image'
replyCodePrefix :: ReplyCode -> Image'
replyCodePrefix ReplyCode
code = Attr -> Text -> Image'
text' Attr
attr (ReplyCodeInfo -> Text
replyCodeText ReplyCodeInfo
info) forall a. Semigroup a => a -> a -> a
<> Image'
":"
where
info :: ReplyCodeInfo
info = ReplyCode -> ReplyCodeInfo
replyCodeInfo ReplyCode
code
color :: Color
color = case ReplyCodeInfo -> ReplyType
replyCodeType ReplyCodeInfo
info of
ReplyType
ClientServerReply -> Color
magenta
ReplyType
CommandReply -> Color
green
ReplyType
ErrorReply -> Color
red
ReplyType
UnknownReply -> Color
yellow
attr :: Attr
attr = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
color
renderReplyCode :: Palette -> RenderMode -> Text -> ReplyCode -> [Text] -> Image'
renderReplyCode :: Palette -> RenderMode -> Text -> ReplyCode -> [Text] -> Image'
renderReplyCode Palette
pal RenderMode
rm Text
srv code :: ReplyCode
code@(ReplyCode Word
w) [Text]
params =
case RenderMode
rm of
RenderMode
DetailedRender -> Text -> Image'
ctxt Text
srv forall a. Semigroup a => a -> a -> a
<> Image'
" " forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
attr (forall a. Show a => a -> ShowS
shows Word
w [Char]
" ") forall a. Semigroup a => a -> a -> a
<> Image'
rawParamsImage
RenderMode
NormalRender ->
case ReplyCode
code of
ReplyCode
RPL_WHOISUSER -> Image'
whoisUserParamsImage
ReplyCode
RPL_WHOWASUSER -> Image'
whoisUserParamsImage
ReplyCode
RPL_WHOISACTUALLY-> Image'
param_3_4_Image
ReplyCode
RPL_WHOISIDLE -> Image'
whoisIdleParamsImage
ReplyCode
RPL_WHOISCHANNELS-> Image'
param_3_3_Image
ReplyCode
RPL_WHOISACCOUNT -> Image'
param_3_4_Image
ReplyCode
RPL_WHOISSERVER -> Image'
whoisServerParamsImage
ReplyCode
RPL_WHOISSECURE -> Image'
param_3_3_Image
ReplyCode
RPL_WHOISOPERATOR-> Image'
param_3_3_Image
ReplyCode
RPL_WHOISCERTFP -> Image'
param_3_3_Image
ReplyCode
RPL_WHOISSPECIAL -> Image'
param_3_3_Image
ReplyCode
RPL_WHOISHOST -> Image'
param_3_3_Image
ReplyCode
RPL_ENDOFWHOIS -> Image'
""
ReplyCode
RPL_ENDOFWHOWAS -> Image'
""
ReplyCode
RPL_TOPIC -> Image'
param_3_3_Image
ReplyCode
RPL_TOPICWHOTIME -> Image'
topicWhoTimeParamsImage
ReplyCode
RPL_CHANNEL_URL -> Image'
param_3_3_Image
ReplyCode
RPL_CREATIONTIME -> Image'
creationTimeParamsImage
ReplyCode
RPL_INVITING -> Image'
params_2_3_Image
ReplyCode
RPL_TESTLINE -> Image'
testlineParamsImage
ReplyCode
RPL_STATSLINKINFO-> Image'
linkInfoParamsImage
ReplyCode
RPL_STATSPLINE -> Image'
portParamsImage
ReplyCode
RPL_STATSILINE -> Image'
authLineParamsImage
ReplyCode
RPL_STATSDLINE -> Image'
dlineParamsImage
ReplyCode
RPL_STATSQLINE -> Text -> Image'
banlineParamsImage Text
"Q"
ReplyCode
RPL_STATSXLINE -> Text -> Image'
banlineParamsImage Text
"X"
ReplyCode
RPL_STATSKLINE -> Image'
klineParamsImage
ReplyCode
RPL_STATSCLINE -> Image'
connectLineParamsImage
ReplyCode
RPL_STATSHLINE -> Image'
hubLineParamsImage
ReplyCode
RPL_STATSCOMMANDS-> Image'
commandsParamsImage
ReplyCode
RPL_STATSOLINE -> Image'
operLineParamsImage
ReplyCode
RPL_STATSULINE -> Image'
sharedLineParamsImage
ReplyCode
RPL_STATSYLINE -> Image'
classLineParamsImage
ReplyCode
RPL_STATSDEBUG -> Image'
statsDebugParamsImage
ReplyCode
RPL_HELPSTART -> Image'
statsDebugParamsImage
ReplyCode
RPL_HELPTXT -> Image'
statsDebugParamsImage
ReplyCode
RPL_TESTMASKGECOS-> Image'
testmaskGecosParamsImage
ReplyCode
RPL_LOCALUSERS -> Image'
lusersParamsImage
ReplyCode
RPL_GLOBALUSERS -> Image'
lusersParamsImage
ReplyCode
RPL_LUSEROP -> Image'
params_2_3_Image
ReplyCode
RPL_LUSERCHANNELS-> Image'
params_2_3_Image
ReplyCode
RPL_LUSERUNKNOWN -> Image'
params_2_3_Image
ReplyCode
RPL_ENDOFSTATS -> Image'
params_2_3_Image
ReplyCode
RPL_AWAY -> Image'
awayParamsImage
ReplyCode
RPL_TRACEUSER -> Image'
traceUserParamsImage
ReplyCode
RPL_TRACEOPERATOR-> Image'
traceOperatorParamsImage
ReplyCode
RPL_TRACESERVER -> Image'
traceServerParamsImage
ReplyCode
RPL_TRACECLASS -> Image'
traceClassParamsImage
ReplyCode
RPL_TRACELINK -> Image'
traceLinkParamsImage
ReplyCode
RPL_TRACEUNKNOWN -> Image'
traceUnknownParamsImage
ReplyCode
RPL_TRACECONNECTING -> Image'
traceConnectingParamsImage
ReplyCode
RPL_TRACEHANDSHAKE -> Image'
traceHandShakeParamsImage
ReplyCode
RPL_ETRACE -> Image'
etraceParamsImage
ReplyCode
RPL_ETRACEFULL -> Image'
etraceFullParamsImage
ReplyCode
RPL_ENDOFTRACE -> Image'
params_2_3_Image
ReplyCode
RPL_ENDOFHELP -> Image'
params_2_3_Image
ReplyCode
RPL_LINKS -> Image'
linksParamsImage
ReplyCode
RPL_ENDOFLINKS -> Image'
params_2_3_Image
ReplyCode
RPL_PRIVS -> Image'
privsImage
ReplyCode
RPL_LOGGEDIN -> Image'
loggedInImage
ReplyCode
ERR_NOPRIVS -> Image'
params_2_3_Image
ReplyCode
ERR_HELPNOTFOUND -> Image'
params_2_3_Image
ReplyCode
ERR_NEEDMOREPARAMS -> Image'
params_2_3_Image
ReplyCode
ERR_NOSUCHNICK -> Image'
params_2_3_Image
ReplyCode
ERR_NOSUCHSERVER -> Image'
params_2_3_Image
ReplyCode
ERR_NICKNAMEINUSE -> Image'
params_2_3_Image
ReplyCode
ERR_MLOCKRESTRICTED -> Image'
mlockRestrictedImage
ReplyCode
_ -> Image'
rawParamsImage
where
label :: Text -> Image'
label Text
t = 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
t forall a. Semigroup a => a -> a -> a
<> Image'
": "
rawParamsImage :: Image'
rawParamsImage = Palette -> [Text] -> Image'
separatedParams Palette
pal [Text]
params'
params' :: [Text]
params' = case RenderMode
rm of
RenderMode
DetailedRender -> [Text]
params
RenderMode
NormalRender -> forall a. Int -> [a] -> [a]
drop Int
1 [Text]
params
info :: ReplyCodeInfo
info = ReplyCode -> ReplyCodeInfo
replyCodeInfo ReplyCode
code
color :: Color
color = case ReplyCodeInfo -> ReplyType
replyCodeType ReplyCodeInfo
info of
ReplyType
ClientServerReply -> Color
magenta
ReplyType
CommandReply -> Color
green
ReplyType
ErrorReply -> Color
red
ReplyType
UnknownReply -> Color
yellow
attr :: Attr
attr = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
color
params_2_3_Image :: Image'
params_2_3_Image =
case [Text]
params of
[Text
_, Text
p, Text
_] -> Text -> Image'
ctxt Text
p
[Text]
_ -> Image'
rawParamsImage
param_3_3_Image :: Image'
param_3_3_Image =
case [Text]
params of
[Text
_, Text
_, Text
txt] -> Text -> Image'
ctxt Text
txt
[Text]
_ -> Image'
rawParamsImage
param_3_4_Image :: Image'
param_3_4_Image =
case [Text]
params of
[Text
_, Text
_, Text
p, Text
_] -> Text -> Image'
ctxt Text
p
[Text]
_ -> Image'
rawParamsImage
topicWhoTimeParamsImage :: Image'
topicWhoTimeParamsImage =
case [Text]
params of
[Text
_, Text
_, Text
who, Text
time] ->
Text -> Image'
label Text
"set by" forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
ctxt Text
who forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" at" forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string Attr
defAttr (ShowS
prettyUnixTime (Text -> [Char]
Text.unpack Text
time))
[Text]
_ -> Image'
rawParamsImage
creationTimeParamsImage :: Image'
creationTimeParamsImage =
case [Text]
params of
[Text
_, Text
_, Text
time, Text
_] -> Attr -> [Char] -> Image'
string Attr
defAttr (ShowS
prettyUnixTime (Text -> [Char]
Text.unpack Text
time))
[Text]
_ -> Image'
rawParamsImage
whoisUserParamsImage :: Image'
whoisUserParamsImage =
case [Text]
params of
[Text
_, Text
nick, Text
user, Text
host, Text
_, Text
real] ->
Attr -> Text -> Image'
text' (Attr -> Style -> Attr
withStyle Attr
defAttr Style
bold) (Text -> Text
cleanText Text
nick) 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
"!" forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
ctxt Text
user 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
"@" forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" gecos" forall a. Semigroup a => a -> a -> a
<>
Bool -> Palette -> Text -> Image'
parseIrcText' Bool
False Palette
pal Text
real
[Text]
_ -> Image'
rawParamsImage
whoisIdleParamsImage :: Image'
whoisIdleParamsImage =
case [Text]
params of
[Text
_, Text
_, Text
idle, Text
signon, Text
_txt] ->
Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
idle)) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" sign-on" forall a. Semigroup a => a -> a -> a
<>
Attr -> [Char] -> Image'
string Attr
defAttr (ShowS
prettyUnixTime (Text -> [Char]
Text.unpack Text
signon))
[Text]
_ -> Image'
rawParamsImage
whoisServerParamsImage :: Image'
whoisServerParamsImage =
case [Text]
params of
[Text
_, Text
_, Text
host, Text
txt] ->
Bool -> Palette -> Text -> Image'
parseIrcText' Bool
False Palette
pal Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" note" forall a. Semigroup a => a -> a -> a
<>
Bool -> Palette -> Text -> Image'
parseIrcText' Bool
False Palette
pal Text
txt
[Text]
_ -> Image'
rawParamsImage
testlineParamsImage :: Image'
testlineParamsImage =
case [Text]
params of
[Text
_, Text
name, Text
mins, Text
mask, Text
msg] ->
Text -> Image'
ctxt Text
name forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" duration" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
60 (Text -> [Char]
Text.unpack Text
mins)) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" mask" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" reason" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
msg
[Text]
_ -> Image'
rawParamsImage
linkInfoParamsImage :: Image'
linkInfoParamsImage =
case [Text]
params of
[Text
_, Text
name, Text
sendQ, Text
sendM, Text
sendK, Text
recvM, Text
recvK, Text -> [Text]
Text.words -> Text
conn : Text
idle : [Text]
caps] ->
Text -> Image'
ctxt Text
name forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" sendQ" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
sendQ forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" sendM" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
sendM forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" sendK" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
sendK forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" recvM" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
recvM forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" recvK" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
recvK forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" since" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
conn)) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" idle" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
idle)) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" caps" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt ([Text] -> Text
Text.unwords [Text]
caps)
[Text]
_ -> Image'
rawParamsImage
authLineParamsImage :: Image'
authLineParamsImage =
case [Text]
params of
[Text
_, Text
"I", Text
name, Text
pass, Text
mask, Text
port, Text
klass, Text
note] ->
Text -> Image'
ctxt Text
name forall a. Semigroup a => a -> a -> a
<>
(if Text
pass forall a. Eq a => a -> a -> Bool
== Text
"<NULL>" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" pass" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
pass) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" mask" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mask' forall a. Semigroup a => a -> a -> a
<>
(if Text
port forall a. Eq a => a -> a -> Bool
== Text
"0" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" port" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
port) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
special then forall a. Monoid a => a
mempty else
Text -> Image'
label Text
" special" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt ([Text] -> Text
Text.unwords [Text]
special)) forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
Text.null Text
note then forall a. Monoid a => a
mempty else
Text -> Image'
label Text
" note" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
note)
where
(Text
mask', [Text]
special) = Text -> (Text, [Text])
parseILinePrefix Text
mask
[Text
_, Text
"I", Text
name, Text
pass, Text
mask, Text
port, Text
klass] ->
Text -> Image'
ctxt Text
name forall a. Semigroup a => a -> a -> a
<>
(if Text
pass forall a. Eq a => a -> a -> Bool
== Text
"<NULL>" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" pass" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
pass) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" mask" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mask' forall a. Semigroup a => a -> a -> a
<>
(if Text
port forall a. Eq a => a -> a -> Bool
== Text
"0" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" port" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
port) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
special then forall a. Monoid a => a
mempty else
Text -> Image'
label Text
" special" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt ([Text] -> Text
Text.unwords [Text]
special))
where
(Text
mask', [Text]
special) = Text -> (Text, [Text])
parseILinePrefix Text
mask
[Text]
_ -> Image'
rawParamsImage
banlineParamsImage :: Text -> Image'
banlineParamsImage Text
expect =
case [Text]
params of
[Text
_, Text
letter, Text
hits, Text
mask, Text
reason] | Text
letter forall a. Eq a => a -> a -> Bool
== Text
expect ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" reason" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
reason forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" hits" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
hits
[Text]
_ -> Image'
rawParamsImage
testmaskGecosParamsImage :: Image'
testmaskGecosParamsImage =
case [Text]
params of
[Text
_, Text
local, Text
remote, Text
mask, Text
gecos, Text
_txt] ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
(if Text
gecos forall a. Eq a => a -> a -> Bool
== Text
"*" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" gecos" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
gecos) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" local" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
local forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" remote" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
remote
[Text]
_ -> Image'
rawParamsImage
portParamsImage :: Image'
portParamsImage =
case [Text]
params of
[Text
_, Text
"P", Text
port, Text
host, Text
count, Text
flags] ->
Text -> Image'
ctxt Text
port forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" host" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" count" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
count forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" flags" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
flags
[Text]
_ -> Image'
rawParamsImage
dlineParamsImage :: Image'
dlineParamsImage =
case [Text]
params of
[Text
_, Text
flag, Text
host, Text
reason] ->
Text -> Image'
ctxt Text
flag forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" host" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" reason" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
reason
[Text]
_ -> Image'
rawParamsImage
klineParamsImage :: Image'
klineParamsImage =
case [Text]
params of
[Text
_, Text
flag, Text
host, Text
"*", Text
user, Text
reason] ->
Text -> Image'
ctxt Text
flag forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" host" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
(if Text
user forall a. Eq a => a -> a -> Bool
== Text
"*" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" user" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
user) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" reason" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
reason
[Text]
_ -> Image'
rawParamsImage
statsDebugParamsImage :: Image'
statsDebugParamsImage =
case [Text]
params of
[Text
_, Text
flag, Text
txt] -> Text -> Image'
ctxt Text
flag forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" txt" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
txt
[Text]
_ -> Image'
rawParamsImage
lusersParamsImage :: Image'
lusersParamsImage =
case [Text]
params of
[Text
_, Text
n, Text
m, Text
_txt] -> Text -> Image'
ctxt Text
n forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" max" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
m
[Text]
_ -> Image'
rawParamsImage
connectLineParamsImage :: Image'
connectLineParamsImage =
case [Text]
params of
[Text
_, Text
"C", Text
mask, Text
flagTxt, Text
host, Text
port, Text
klass, Text
certfp] ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" host" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" port" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
port forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
(if Text
certfp forall a. Eq a => a -> a -> Bool
== Text
"*" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" certfp" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
certfp) forall a. Semigroup a => a -> a -> a
<>
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
flags then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" flags" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt ([Text] -> Text
Text.unwords [Text]
flags))
where
flags :: [Text]
flags = Text -> [Text]
parseCLineFlags Text
flagTxt
[Text
_, Text
"C", Text
mask, Text
flagTxt, Text
host, Text
port, Text
klass] ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" host" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" port" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
port forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
flags then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" flags" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt ([Text] -> Text
Text.unwords [Text]
flags))
where
flags :: [Text]
flags = Text -> [Text]
parseCLineFlags Text
flagTxt
[Text]
_ -> Image'
rawParamsImage
hubLineParamsImage :: Image'
hubLineParamsImage =
case [Text]
params of
[Text
_, Text
"H", Text
host, Text
"*", Text
server, Text
"0", Text
"-1"] ->
Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" server" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
server
[Text
_, Text
"H", Text
host, Text
"*", Text
server] ->
Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" server" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
server
[Text]
_ -> Image'
rawParamsImage
commandsParamsImage :: Image'
commandsParamsImage =
case [Text]
params of
[Text
_, Text
cmd, Text
count, Text
bytes, Text
rcount] ->
Text -> Image'
ctxt Text
cmd forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" count" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
count forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" bytes" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
bytes forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" remote-count" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
rcount
[Text]
_ -> Image'
rawParamsImage
operLineParamsImage :: Image'
operLineParamsImage =
case [Text]
params of
[Text
_, Text
"O", Text
mask, Text
host, Text
name, Text
privset, Text
"-1"] ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" host" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" name" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
name forall a. Semigroup a => a -> a -> a
<>
(if Text
privset forall a. Eq a => a -> a -> Bool
== Text
"0" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" privset" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
privset)
[Text]
_ -> Image'
rawParamsImage
sharedLineParamsImage :: Image'
sharedLineParamsImage =
case [Text]
params of
[Text
_, Text
"U", Text
server, Text
mask, Text
flags] ->
Text -> Image'
ctxt Text
server forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" mask" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" flags" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
flags
[Text]
_ -> Image'
rawParamsImage
classLineParamsImage :: Image'
classLineParamsImage =
case [Text]
params of
[Text
_, Text
"Y", Text
name, Text
pingFreq, Text
conFreq, Text
maxUsers, Text
maxSendq, Text
maxLocal, Text
maxGlobal, Text
curUsers] ->
Text -> Image'
ctxt Text
name forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" ping-freq" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
pingFreq forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" con-freq" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
conFreq forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" max-users" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
maxUsers forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" max-sendq" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
maxSendq forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" max-local" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
maxLocal forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" max-global" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
maxGlobal forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" current" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
curUsers
[Text]
_ -> Image'
rawParamsImage
awayParamsImage :: Image'
awayParamsImage =
case [Text]
params of
[Text
_, Text
nick, Text
txt] -> Text -> Image'
ctxt Text
nick forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" msg" forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
txt
[Text]
_ -> Image'
rawParamsImage
linksParamsImage :: Image'
linksParamsImage =
case [Text]
params of
[Text
_, Text
name, Text
link, Text -> Text -> (Text, Text)
Text.breakOn Text
" " -> (Text
hops,Text
location)] ->
Text -> Image'
ctxt Text
name forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" link" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
link forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" hops" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
hops forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" location" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Int -> Text -> Text
Text.drop Int
1 Text
location)
[Text]
_ -> Image'
rawParamsImage
etraceParamsImage :: Image'
etraceParamsImage =
case [Text]
params of
[Text
_, Text
kind, Text
server, Text
nick, Text
user, Text
host, Text
ip, Text
gecos] ->
Text -> Image'
ctxt Text
nick forall a. Semigroup a => a -> a -> a
<> Image'
"!" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
user forall a. Semigroup a => a -> a -> a
<> Image'
"@" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" gecos" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
gecos forall a. Semigroup a => a -> a -> a
<>
(if Text
ip forall a. Eq a => a -> a -> Bool
== Text
"0" Bool -> Bool -> Bool
|| Text
ip forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" ip" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
ip) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" server" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
server forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" kind" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
kind
[Text]
_ -> Image'
rawParamsImage
traceLinkParamsImage :: Image'
traceLinkParamsImage =
case [Text]
params of
[Text
_, Text
"Link", Text
version, Text
nick, Text
server] ->
Text -> Image'
ctxt Text
server forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" nick" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
nick forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" version" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
version
[Text]
_ -> Image'
rawParamsImage
traceConnectingParamsImage :: Image'
traceConnectingParamsImage =
case [Text]
params of
[Text
_, Text
"Try.", Text
klass, Text
mask] -> Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass
[Text]
_ -> Image'
rawParamsImage
traceHandShakeParamsImage :: Image'
traceHandShakeParamsImage =
case [Text]
params of
[Text
_, Text
"H.S.", Text
klass, Text
mask] -> Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass
[Text]
_ -> Image'
rawParamsImage
traceUnknownParamsImage :: Image'
traceUnknownParamsImage =
case [Text]
params of
[Text
_, Text
"????", Text
klass, Text
mask, Text
ip, Text
lastmsg]
| Text -> Int
Text.length Text
ip forall a. Ord a => a -> a -> Bool
> Int
2
, Text -> Char
Text.head Text
ip forall a. Eq a => a -> a -> Bool
== Char
'('
, Text -> Char
Text.last Text
ip forall a. Eq a => a -> a -> Bool
== Char
')' ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
(if Text
ip forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then forall a. Monoid a => a
mempty else
Text -> Image'
label Text
" ip" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.tail (Text -> Text
Text.init Text
ip))) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" idle" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
lastmsg))
[Text]
_ -> Image'
rawParamsImage
traceServerParamsImage :: Image'
traceServerParamsImage =
case [Text]
params of
[Text
_, Text
"Serv", Text
klass, Text
servers, Text
clients, Text
link, Text
who, Text
lastmsg]
| Bool -> Bool
not (Text -> Bool
Text.null Text
servers), Bool -> Bool
not (Text -> Bool
Text.null Text
clients)
, Text -> Char
Text.last Text
servers forall a. Eq a => a -> a -> Bool
== Char
'S', Text -> Char
Text.last Text
clients forall a. Eq a => a -> a -> Bool
== Char
'C' ->
Text -> Image'
ctxt Text
link forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" who" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
who forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" servers" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.init Text
servers) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" clients" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.init Text
clients) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" idle" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
lastmsg))
[Text]
_ -> Image'
rawParamsImage
traceClassParamsImage :: Image'
traceClassParamsImage =
case [Text]
params of
[Text
_, Text
"Class", Text
klass, Text
count] ->
Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" count" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
count
[Text]
_ -> Image'
rawParamsImage
traceUserParamsImage :: Image'
traceUserParamsImage =
case [Text]
params of
[Text
_, Text
"User", Text
klass, Text
mask, Text
ip, Text
lastpkt, Text
lastmsg]
| Text -> Int
Text.length Text
ip forall a. Ord a => a -> a -> Bool
> Int
2
, Text -> Char
Text.head Text
ip forall a. Eq a => a -> a -> Bool
== Char
'('
, Text -> Char
Text.last Text
ip forall a. Eq a => a -> a -> Bool
== Char
')' ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
(if Text
ip forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then forall a. Monoid a => a
mempty else
Text -> Image'
label Text
" ip" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.tail (Text -> Text
Text.init Text
ip))) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" pkt-idle" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
lastpkt)) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" msg-idle" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
lastmsg))
[Text]
_ -> Image'
rawParamsImage
traceOperatorParamsImage :: Image'
traceOperatorParamsImage =
case [Text]
params of
[Text
_, Text
"Oper", Text
klass, Text
mask, Text
ip, Text
lastpkt, Text
lastmsg]
| Text -> Int
Text.length Text
ip forall a. Ord a => a -> a -> Bool
> Int
2
, Text -> Char
Text.head Text
ip forall a. Eq a => a -> a -> Bool
== Char
'('
, Text -> Char
Text.last Text
ip forall a. Eq a => a -> a -> Bool
== Char
')' ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
(if Text
ip forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then forall a. Monoid a => a
mempty else
Text -> Image'
label Text
" ip" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.tail (Text -> Text
Text.init Text
ip))) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" pkt-idle" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
lastpkt)) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" msg-idle" forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
lastmsg))
[Text]
_ -> Image'
rawParamsImage
etraceFullParamsImage :: Image'
etraceFullParamsImage =
case [Text]
params of
[Text
_, Text
kind, Text
klass, Text
nick, Text
user, Text
host, Text
ip, Text
p1, Text
p2, Text
gecos] ->
Text -> Image'
ctxt Text
nick forall a. Semigroup a => a -> a -> a
<> Image'
"!" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
user forall a. Semigroup a => a -> a -> a
<> Image'
"@" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" gecos" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
gecos forall a. Semigroup a => a -> a -> a
<>
(if Text
ip forall a. Eq a => a -> a -> Bool
== Text
"0" Bool -> Bool -> Bool
|| Text
ip forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then forall a. Monoid a => a
mempty else Text -> Image'
label Text
" ip" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
ip) forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" kind" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
kind forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" class" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" p1" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
p1 forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" p2" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
p2
[Text]
_ -> Image'
rawParamsImage
loggedInImage :: Image'
loggedInImage =
case [Text]
params of
[Text
_, Text
mask, Text
account, Text
_txt] ->
Text -> Image'
ctxt Text
mask forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" account" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
account
[Text]
_ -> Image'
rawParamsImage
privsImage :: Image'
privsImage =
case [Text]
params of
[Text
_, Text
target, Text
list] ->
case Text -> Text -> Maybe Text
Text.stripPrefix Text
"* " Text
list of
Maybe Text
Nothing ->
Text -> Image'
ctxt Text
target forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" end" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
list
Just Text
list' ->
Text -> Image'
ctxt Text
target forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" ..." forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
list'
[Text]
_ -> Image'
rawParamsImage
mlockRestrictedImage :: Image'
mlockRestrictedImage =
case [Text]
params of
[Text
_, Text
chan, Text
mode, Text
mlock, Text
_] ->
Text -> Image'
ctxt Text
chan forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" mode" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mode forall a. Semigroup a => a -> a -> a
<>
Text -> Image'
label Text
" mlock" forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mlock
[Text]
_ -> Image'
rawParamsImage
parseCLineFlags :: Text -> [Text]
parseCLineFlags :: Text -> [Text]
parseCLineFlags = [Text] -> Text -> [Text]
go []
where
go :: [Text] -> Text -> [Text]
go [Text]
acc Text
xs =
case Text -> Maybe (Char, Text)
Text.uncons Text
xs of
Just (Char
x, Text
xs') ->
case forall {a}. IsString a => Char -> Maybe a
getFlag Char
x of
Maybe Text
Nothing -> [Text] -> Text -> [Text]
go (Char -> Text
Text.singleton Char
xforall a. a -> [a] -> [a]
:[Text]
acc) Text
xs'
Just Text
flag -> [Text] -> Text -> [Text]
go (Text
flagforall a. a -> [a] -> [a]
:[Text]
acc) Text
xs'
Maybe (Char, Text)
Nothing -> forall a. [a] -> [a]
reverse [Text]
acc
getFlag :: Char -> Maybe a
getFlag Char
x =
case Char
x of
Char
'A' -> forall a. a -> Maybe a
Just a
"auto-connect"
Char
'M' -> forall a. a -> Maybe a
Just a
"sctp"
Char
'S' -> forall a. a -> Maybe a
Just a
"tls"
Char
'T' -> forall a. a -> Maybe a
Just a
"topic-burst"
Char
'Z' -> forall a. a -> Maybe a
Just a
"compressed"
Char
_ -> forall a. Maybe a
Nothing
parseILinePrefix :: Text -> (Text, [Text])
parseILinePrefix :: Text -> (Text, [Text])
parseILinePrefix = forall {a}. IsString a => [a] -> Text -> (Text, [a])
go []
where
go :: [a] -> Text -> (Text, [a])
go [a]
special Text
mask =
case Text -> Maybe (Char, Text)
Text.uncons Text
mask of
Just (forall {a}. IsString a => Char -> Maybe a
getSpecial -> Just a
s, Text
mask') -> [a] -> Text -> (Text, [a])
go (a
sforall a. a -> [a] -> [a]
:[a]
special) Text
mask'
Maybe (Char, Text)
_ -> (Text
mask, forall a. [a] -> [a]
reverse [a]
special)
getSpecial :: Char -> Maybe a
getSpecial Char
x =
case Char
x of
Char
'-' -> forall a. a -> Maybe a
Just a
"no-tilde"
Char
'+' -> forall a. a -> Maybe a
Just a
"need-ident"
Char
'=' -> forall a. a -> Maybe a
Just a
"spoof-IP"
Char
'%' -> forall a. a -> Maybe a
Just a
"need-sasl"
Char
'|' -> forall a. a -> Maybe a
Just a
"flood-exempt"
Char
'$' -> forall a. a -> Maybe a
Just a
"dnsbl-exempt"
Char
'^' -> forall a. a -> Maybe a
Just a
"kline-exempt"
Char
'>' -> forall a. a -> Maybe a
Just a
"limits-exempt"
Char
_ -> forall a. Maybe a
Nothing
prettyUnixTime :: String -> String
prettyUnixTime :: ShowS
prettyUnixTime [Char]
str =
case forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [Char] -> [Char] -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale [Char]
"%s" [Char]
str of
Maybe UTCTime
Nothing -> [Char]
str
Just UTCTime
t -> forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%c" (UTCTime
t :: UTCTime)
prettyTime :: Int -> String -> String
prettyTime :: Int -> ShowS
prettyTime Int
scale [Char]
str =
case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str of
Maybe Int
Nothing -> [Char]
str
Just Int
0 -> [Char]
"0s"
Just Int
n -> forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" "
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Char
u,Int
i) -> forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char
u])
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(Char, Int)
x -> forall a b. (a, b) -> b
snd (Char, Int)
x forall a. Eq a => a -> a -> Bool
/= Int
0)
forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Char]
"dhms" [Int
d,Int
h,Int
m,Int
s :: Int]
where
n0 :: Int
n0 = Int
n forall a. Num a => a -> a -> a
* Int
scale
(Int
n1,Int
s) = forall a. Integral a => a -> a -> (a, a)
quotRem Int
n0 Int
60
(Int
n2,Int
m) = forall a. Integral a => a -> a -> (a, a)
quotRem Int
n1 Int
60
(Int
d ,Int
h) = forall a. Integral a => a -> a -> (a, a)
quotRem Int
n2 Int
24
data IdentifierColorMode
= PrivmsgIdentifier
| NormalIdentifier
coloredIdentifier ::
Palette ->
IdentifierColorMode ->
HashMap Identifier Highlight ->
Identifier ->
Image'
coloredIdentifier :: Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
palette IdentifierColorMode
icm HashMap Identifier Highlight
hilites Identifier
ident =
Attr -> Text -> Image'
text' Attr
color (Text -> Text
cleanText (Identifier -> Text
idText Identifier
ident))
where
color :: Attr
color
| forall a. a -> Maybe a
Just Highlight
HighlightMe forall a. Eq a => a -> a -> Bool
== forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
ident HashMap Identifier Highlight
hilites =
case IdentifierColorMode
icm of
IdentifierColorMode
PrivmsgIdentifier -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSelfHighlight Palette
palette
IdentifierColorMode
NormalIdentifier -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palSelf Palette
palette
| Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe (Vector Attr
v forall a. Vector a -> Int -> a
Vector.! Int
i) (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
ident (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette (HashMap Identifier Attr)
palIdOverride Palette
palette))
v :: Vector Attr
v = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette (Vector Attr)
palNicks Palette
palette
i :: Int
i = forall a. Hashable a => a -> Int
hash Identifier
ident forall a. Integral a => a -> a -> a
`mod` forall a. Vector a -> Int
Vector.length Vector Attr
v
coloredUserInfo ::
Palette ->
RenderMode ->
HashMap Identifier Highlight ->
UserInfo ->
Image'
coloredUserInfo :: Palette
-> RenderMode -> HashMap Identifier Highlight -> UserInfo -> Image'
coloredUserInfo Palette
palette RenderMode
NormalRender HashMap Identifier Highlight
hilites UserInfo
ui =
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
palette IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites (UserInfo -> Identifier
userNick UserInfo
ui)
coloredUserInfo Palette
palette RenderMode
DetailedRender HashMap Identifier Highlight
hilites !UserInfo
ui =
forall a. Monoid a => [a] -> a
mconcat
[ Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
palette IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites (UserInfo -> Identifier
userNick UserInfo
ui)
, Char -> Text -> Image'
aux Char
'!' (UserInfo -> Text
userName UserInfo
ui)
, Char -> Text -> Image'
aux Char
'@' (UserInfo -> Text
userHost UserInfo
ui)
]
where
quietAttr :: Attr
quietAttr = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palMeta Palette
palette
aux :: Char -> Text -> Image'
aux Char
x Text
xs
| Text -> Bool
Text.null Text
xs = forall a. Monoid a => a
mempty
| Bool
otherwise = Attr -> Char -> Image'
char Attr
quietAttr Char
x forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Image'
text' Attr
quietAttr (Text -> Text
cleanText Text
xs)
quietIdentifier :: Palette -> Identifier -> Image'
quietIdentifier :: Palette -> Identifier -> Image'
quietIdentifier Palette
palette Identifier
ident =
Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palMeta Palette
palette) (Text -> Text
cleanText (Identifier -> Text
idText Identifier
ident))
data Highlight
= HighlightMe
| HighlightNick
| HighlightError
| HighlightNone
deriving Highlight -> Highlight -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Highlight -> Highlight -> Bool
$c/= :: Highlight -> Highlight -> Bool
== :: Highlight -> Highlight -> Bool
$c== :: Highlight -> Highlight -> Bool
Eq
parseIrcTextWithNicks ::
Palette ->
HashMap Identifier Highlight ->
Bool ->
Text ->
Image'
parseIrcTextWithNicks :: Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
palette HashMap Identifier Highlight
hilite Bool
explicit Text
txt
| (Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
isControl Text
txt = Bool -> Palette -> Text -> Image'
parseIrcText' Bool
explicit Palette
palette Text
txt
| Bool
otherwise = Palette -> HashMap Identifier Highlight -> Text -> Image'
highlightNicks Palette
palette HashMap Identifier Highlight
hilite Text
txt
highlightNicks ::
Palette ->
HashMap Identifier Highlight ->
Text -> Image'
highlightNicks :: Palette -> HashMap Identifier Highlight -> Text -> Image'
highlightNicks Palette
palette HashMap Identifier Highlight
hilites Text
txt = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Image'
highlight1 [Text]
txtParts
where
txtParts :: [Text]
txtParts = Text -> [Text]
nickSplit Text
txt
highlight1 :: Text -> Image'
highlight1 Text
part =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
partId HashMap Identifier Highlight
hilites of
Maybe Highlight
Nothing -> Text -> Image'
ctxt Text
part
Just Highlight
HighlightNone -> Text -> Image'
ctxt Text
part
Just Highlight
HighlightError -> Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
palette) Text
part
Maybe Highlight
_ -> Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
palette IdentifierColorMode
PrivmsgIdentifier HashMap Identifier Highlight
hilites Identifier
partId
where
partId :: Identifier
partId = Text -> Identifier
mkId Text
part
metadataImg :: Palette -> IrcSummary -> Maybe (Image', Identifier, Maybe Identifier)
metadataImg :: Palette
-> IrcSummary -> Maybe (Image', Identifier, Maybe Identifier)
metadataImg Palette
pal IrcSummary
msg =
case IrcSummary
msg of
QuitSummary Identifier
who QuitKind
_ -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palPart Palette
pal) Char
'x', Identifier
who, forall a. Maybe a
Nothing)
PartSummary Identifier
who -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palPart Palette
pal) Char
'-', Identifier
who, forall a. Maybe a
Nothing)
JoinSummary Identifier
who -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palJoin Palette
pal) Char
'+', Identifier
who, forall a. Maybe a
Nothing)
CtcpSummary Identifier
who -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palIgnore Palette
pal) Char
'C', Identifier
who, forall a. Maybe a
Nothing)
NickSummary Identifier
old Identifier
new -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palUsrChg Palette
pal) Char
'>', Identifier
old, forall a. a -> Maybe a
Just Identifier
new)
ChngSummary Identifier
who -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palUsrChg Palette
pal) Char
'@', Identifier
who, forall a. Maybe a
Nothing)
AcctSummary Identifier
who -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palUsrChg Palette
pal) Char
'*', Identifier
who, forall a. Maybe a
Nothing)
AwaySummary Identifier
who Bool
True -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palAway Palette
pal) Char
'a', Identifier
who, forall a. Maybe a
Nothing)
AwaySummary Identifier
who Bool
False -> forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palUsrChg Palette
pal) Char
'b', Identifier
who, forall a. Maybe a
Nothing)
IrcSummary
_ -> forall a. Maybe a
Nothing
ignoreImage :: Palette -> Image'
ignoreImage :: Palette -> Image'
ignoreImage Palette
pal = Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palIgnore Palette
pal) Char
'I'
modesImage :: Attr -> HashMap Char Attr -> String -> Image'
modesImage :: Attr -> HashMap Char Attr -> [Char] -> Image'
modesImage Attr
def HashMap Char Attr
pal [Char]
modes = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Image'
modeImage [Char]
modes
where
modeImage :: Char -> Image'
modeImage Char
m =
Attr -> Char -> Image'
char (forall a. a -> Maybe a -> a
fromMaybe Attr
def (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Char
m) HashMap Char Attr
pal)) Char
m
drawWindowLine ::
Palette ->
Int ->
PaddingMode ->
WindowLine ->
[Image']
drawWindowLine :: Palette -> Int -> PaddingMode -> WindowLine -> [Image']
drawWindowLine Palette
palette Int
w PaddingMode
padAmt WindowLine
wl = Image' -> Image' -> [Image']
wrap (WindowLine -> Image'
drawPrefix WindowLine
wl) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WindowLine Image'
wlImage WindowLine
wl)
where
drawTime :: PackedTime -> Image'
drawTime = Palette -> TimeOfDay -> Image'
timeImage Palette
palette forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedTime -> TimeOfDay
unpackTimeOfDay
padNick :: Image' -> Image'
padNick = PaddingMode -> Image' -> Image'
nickPad PaddingMode
padAmt
wrap :: Image' -> Image' -> [Image']
wrap Image'
pfx Image'
body = forall a. [a] -> [a]
reverse (Int -> Image' -> Image' -> [Image']
lineWrapPrefix Int
w Image'
pfx Image'
body)
drawPrefix :: WindowLine -> Image'
drawPrefix = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' WindowLine PackedTime
wlTimestamp PackedTime -> Image'
drawTime forall a. Semigroup a => a -> a -> a
<>
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' WindowLine Image'
wlPrefix Image' -> Image'
padNick
modesPaletteFor :: Identifier -> MessageRendererParams -> HashMap Char Attr
modesPaletteFor :: Identifier -> MessageRendererParams -> HashMap Char Attr
modesPaletteFor Identifier
name MessageRendererParams
rp
| Char -> Bool
isChanPrefix forall a b. (a -> b) -> a -> b
$ Text -> Char
Text.head forall a b. (a -> b) -> a -> b
$ Identifier -> Text
idText Identifier
name = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkPalette (HashMap Char Attr)
palCModes (MessageRendererParams -> NetworkPalette
rendNetPalette MessageRendererParams
rp)
| Bool
otherwise = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkPalette (HashMap Char Attr)
palUModes (MessageRendererParams -> NetworkPalette
rendNetPalette MessageRendererParams
rp)
where
isChanPrefix :: Char -> Bool
isChanPrefix Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (MessageRendererParams -> [Char]
rendChanTypes MessageRendererParams
rp)