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

This module provides image renderers for messages.

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

-- | Parameters used when rendering messages
data MessageRendererParams = MessageRendererParams
  { MessageRendererParams -> [Char]
rendStatusMsg  :: [Char] -- ^ restricted message sigils
  , MessageRendererParams -> [Char]
rendUserSigils :: [Char] -- ^ sender sigils
  , MessageRendererParams -> HashMap Identifier Highlight
rendHighlights :: HashMap Identifier Highlight -- ^ words to highlight
  , MessageRendererParams -> Palette
rendPalette    :: Palette -- ^ nick color palette
  , MessageRendererParams -> Maybe (HashMap Identifier UserAndHost)
rendAccounts   :: Maybe (HashMap Identifier UserAndHost)
  , MessageRendererParams -> NetworkPalette
rendNetPalette :: NetworkPalette
  , MessageRendererParams -> [Char]
rendChanTypes  :: [Char] -- ^ A list of valid channel name prefixes.
  }

-- | Default 'MessageRendererParams' with no sigils or nicknames specified
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]
"#&!+" -- Default for if we aren't told otherwise by ISUPPORT.
  }

-- | Construct a message given the time the message was received and its
-- render parameters.
msgImage ::
  ZonedTime                {- ^ time of message     -} ->
  MessageRendererParams    {- ^ render parameters   -} ->
  MessageBody              {- ^ message body        -} ->
  (Image', Image', Image') {- ^ prefix, image, full -}
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
':'


-- | Render the sigils for a restricted message.
statusMsgImage :: [Char] {- ^ sigils -} -> 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


-- | Render a 'MessageBody' given the sender's sigils and the nicknames to
-- highlight.
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

-- | Render a 'MessageBody' given the sender's sigils and the nicknames to
-- highlight.
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

-- | Render a 'ZonedTime' as time using quiet attributes
--
-- @
-- 23:15
-- @
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 "

-- | Render a 'ZonedTime' as full date and time user quiet attributes.
-- Excludes the year.
--
-- @
-- 07-24 23:15:10
-- @
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 "

-- | Level of detail to use when rendering
data RenderMode
  = NormalRender -- ^ only render nicknames
  | DetailedRender -- ^ render full user info

-- | Optionally add padding to an input image according to the
-- specified mode. If the input image is already wider than
-- the specified padding mode, the image is returned unmodified.
nickPad ::
  PaddingMode {- ^ padding mode -} ->
  Image'      {- ^ input image  -} ->
  Image'      {- ^ padded 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
' ')


-- | Render the sender of a message in normal mode.
-- This is typically something like @\@nickname:@
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 -- not tracking any accounts
                 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

    -- details in message part
    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:"


-- | Render a chat message given a rendering mode, the sigils of the user
-- who sent the message, and a list of nicknames to highlight.
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

-- | Render a chat message given a rendering mode, the sigils of the user
-- who sent the message, and a list of nicknames to highlight.
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 =
        -- sigils
        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
<>

        -- nick!user@host
        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
'·'

-- | Process list of 'Text' as individual IRC formatted words
-- separated by a special separator to distinguish parameters
-- from words within parameters.
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)

-- | Process list of 'Text' as individual IRC formatted words
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


-- | Transform string representing seconds in POSIX time to pretty format.
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)

-- | Render string representing seconds into days, hours, minutes, and seconds.
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 -- ^ An identifier in a PRIVMSG
  | NormalIdentifier  -- ^ An identifier somewhere else

-- | Render a nickname in its hash-based color.
coloredIdentifier ::
  Palette             {- ^ color palette      -} ->
  IdentifierColorMode {- ^ draw mode          -} ->
  HashMap Identifier Highlight {- ^ highlights -} ->
  Identifier          {- ^ identifier to draw -} ->
  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

-- | Render an a full user. In normal mode only the nickname will be rendered.
-- If detailed mode the full user info including the username and hostname parts
-- will be rendered. The nickname will be colored.
coloredUserInfo ::
  Palette            {- ^ color palette   -} ->
  RenderMode         {- ^ mode            -} ->
  HashMap Identifier Highlight {- ^ highlights -} ->
  UserInfo           {- ^ userinfo to draw-} ->
  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)

-- | Render an identifier without using colors. This is useful for metadata.
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

-- | Parse message text to construct an image. If the text has formatting
-- control characters in it then the text will be rendered according to
-- the formatting codes. Otherwise the nicknames in the message are
-- highlighted.
parseIrcTextWithNicks ::
  Palette            {- ^ palette      -} ->
  HashMap Identifier Highlight {- ^ Highlights -} ->
  Bool               {- ^ explicit controls rendering -} ->
  Text               {- ^ input text   -} ->
  Image'             {- ^ colored text -}
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

-- | Given a list of nicknames and a chat message, this will generate
-- an image where all of the occurrences of those nicknames are colored.
highlightNicks ::
  Palette ->
  HashMap Identifier Highlight {- ^ highlights -} ->
  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

-- | Returns image and identifier to be used when collapsing metadata
-- messages.
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

-- | Image used when treating ignored chat messages as metadata
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

-- | Render the normal view of a chat message line padded and wrapped.
drawWindowLine ::
  Palette     {- ^ palette       -} ->
  Int         {- ^ draw columns  -} ->
  PaddingMode {- ^ nick padding  -} ->
  WindowLine  {- ^ window line   -} ->
  [Image']    {- ^ wrapped lines -}
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)