{-# 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

  , parseIrcTextWithNicks
  , Highlight(..)
  ) where

import           Client.Configuration (PaddingMode(..))
import           Client.Image.LineWrap
import           Client.Image.MircFormatting
import           Client.Image.PackedImage
import           Client.Image.Palette
import           Client.Message
import           Client.State.Window
import           Client.UserHost
import           Control.Applicative ((<|>))
import           Control.Lens
import           Data.Char
import           Data.Hashable (hash)
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import           Data.List
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Time
import qualified Data.Vector as Vector
import           Graphics.Vty.Attributes
import           Irc.Codes
import           Irc.Identifier
import           Irc.Message
import           Irc.RawIrcMsg
import           Irc.UserInfo
import           Text.Read

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

-- | Default 'MessageRendererParams' with no sigils or nicknames specified
defaultRenderParams :: MessageRendererParams
defaultRenderParams :: MessageRendererParams
defaultRenderParams = MessageRendererParams :: [Char]
-> [Char]
-> HashMap Identifier Highlight
-> Palette
-> Maybe (HashMap Identifier UserAndHost)
-> MessageRendererParams
MessageRendererParams
  { rendStatusMsg :: [Char]
rendStatusMsg   = [Char]
""
  , rendUserSigils :: [Char]
rendUserSigils  = [Char]
""
  , rendHighlights :: HashMap Identifier Highlight
rendHighlights  = HashMap Identifier Highlight
forall k v. HashMap k v
HashMap.empty
  , rendPalette :: Palette
rendPalette     = Palette
defaultPalette
  , rendAccounts :: Maybe (HashMap Identifier UserAndHost)
rendAccounts    = Maybe (HashMap Identifier UserAndHost)
forall a. Maybe a
Nothing
  }


-- | 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 Image' -> Image' -> Image'
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 =
      [Image'] -> Image'
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x20'  = Int -> Char
chr (Int
0x2400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
x) -- ␀ .. ␙
  | Char
x Char -> Char -> Bool
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 (Text -> Image') -> (Text -> Text) -> Text -> Image'
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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palError (MessageRendererParams -> Palette
rendPalette MessageRendererParams
params)) Text
"error" Image' -> Image' -> Image'
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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel (MessageRendererParams -> Palette
rendPalette MessageRendererParams
params)) Text
"client" Image' -> Image' -> Image'
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
  | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
modes = Image'
forall a. Monoid a => a
mempty
  | Bool
otherwise  = Image'
"(" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
statusMsgColor [Char]
modes Image' -> Image' -> Image'
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 (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palTime Palette
palette)
  ([Char] -> Image') -> (TimeOfDay -> [Char]) -> TimeOfDay -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> [Char] -> TimeOfDay -> [Char]
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 (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palTime Palette
palette)
  ([Char] -> Image') -> (ZonedTime -> [Char]) -> ZonedTime -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> [Char] -> ZonedTime -> [Char]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
iw -> Int -> Image'
mkpad (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iw) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
img
    RightPadding Int
w | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
iw -> Image'
img Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Int -> Image'
mkpad (Int
wInt -> Int -> Int
forall 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 (Int -> Char -> [Char]
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 (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palSigil Palette
pal) [Char]
sigils Image' -> Image' -> Image'
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 Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*")
                       lkupAcct :: Maybe Text
lkupAcct = HashMap Identifier UserAndHost
accts
                             HashMap Identifier UserAndHost
-> Getting (First Text) (HashMap Identifier UserAndHost) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (HashMap Identifier UserAndHost)
-> Traversal'
     (HashMap Identifier UserAndHost)
     (IxValue (HashMap Identifier UserAndHost))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
n))
                              ((UserAndHost -> Const (First Text) UserAndHost)
 -> HashMap Identifier UserAndHost
 -> Const (First Text) (HashMap Identifier UserAndHost))
-> ((Text -> Const (First Text) Text)
    -> UserAndHost -> Const (First Text) UserAndHost)
-> Getting (First Text) (HashMap Identifier UserAndHost) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> UserAndHost -> Const (First Text) UserAndHost
Lens' UserAndHost Text
uhAccount
                              ((Text -> Const (First Text) Text)
 -> UserAndHost -> Const (First Text) UserAndHost)
-> ((Text -> Const (First Text) Text)
    -> Text -> Const (First Text) Text)
-> (Text -> Const (First Text) Text)
-> UserAndHost
-> Const (First Text) UserAndHost
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool)
-> (Text -> Const (First Text) Text)
-> Text
-> Const (First Text) Text
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered Text -> Bool
isKnown in
                   case Maybe Text
tagAcct Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
lkupAcct of
                     Just Text
acct
                       | Text -> Identifier
mkId Text
acct Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
n) -> Image'
baseUI
                       | Bool
otherwise -> Image'
baseUI Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
"(" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
acct Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
")"
                     Maybe Text
Nothing -> Image'
"~" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
baseUI
  in
  case IrcMsg
body of
    Join       {} -> Image'
forall a. Monoid a => a
mempty
    Part       {} -> Image'
forall a. Monoid a => a
mempty
    Quit       {} -> Image'
forall a. Monoid a => a
mempty
    Ping       {} -> Image'
forall a. Monoid a => a
mempty
    Pong       {} -> Image'
forall a. Monoid a => a
mempty
    Nick       {} -> Image'
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 Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
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 " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Source -> Image'
who Source
src Image' -> Image' -> Image'
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]
"* " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Source -> Image'
who Source
src
    Ctcp {} -> Image'
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]
"! " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Source -> Image'
who Source
src

    Error {} -> Attr -> [Char] -> Image'
string (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palError Palette
pal) [Char]
"ERROR" Image' -> Image' -> Image'
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 (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palError Palette
pal) [Char]
"?"

    Cap CapCmd
cmd ->
      Attr -> Text -> Image'
text' (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
magenta) (CapCmd -> Text
renderCapCmd CapCmd
cmd) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
":"

    Authenticate{} -> Image'
"AUTHENTICATE"
    BatchStart{}   -> Image'
forall a. Monoid a => a
mempty
    BatchEnd{}     -> Image'
forall a. Monoid a => a
mempty

    Account Source
user Text
_ -> Source -> Image'
who Source
user Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" account:"
    Chghost Source
ui Text
_ Text
_ -> Source -> Image'
who Source
ui Image' -> Image' -> Image'
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        {} -> Image'
forall a. Monoid a => a
mempty
    Part        {} -> Image'
forall a. Monoid a => a
mempty
    Quit        {} -> Image'
forall a. Monoid a => a
mempty
    Ping        {} -> Image'
forall a. Monoid a => a
mempty
    Pong        {} -> Image'
forall a. Monoid a => a
mempty
    BatchStart  {} -> Image'
forall a. Monoid a => a
mempty
    BatchEnd    {} -> Image'
forall a. Monoid a => a
mempty
    Nick        {} -> Image'
forall a. Monoid a => a
mempty
    Authenticate{} -> Image'
"***"

    Error                   Text
txt -> Palette -> Text -> Image'
parseIrcText Palette
pal Text
txt
    Topic Source
_ Identifier
_ Text
txt ->
      Image'
"changed the topic: " Image' -> Image' -> 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

    Kick Source
_who Identifier
_channel Identifier
kickee Text
reason ->
      Image'
"kicked " Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
": " Image' -> Image' -> 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 " Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
": " Image' -> Image' -> 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 {}                     -> Image'
forall a. Monoid a => a
mempty
    CtcpNotice Source
_ Identifier
_ Text
cmd      Text
txt -> Palette -> Text -> Image'
parseIrcText Palette
pal Text
cmd Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" " Image' -> Image' -> 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 (Getting Text RawIrcMsg Text -> RawIrcMsg -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text RawIrcMsg Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
irc) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Palette -> [Text] -> Image'
separatedParams Palette
pal (Getting [Text] RawIrcMsg [Text] -> RawIrcMsg -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Text] RawIrcMsg [Text]
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
_ [Text]
params ->
      Image'
"set mode: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Palette -> [Text] -> Image'
ircWords Palette
pal [Text]
params

    Invite Source
_ Identifier
tgt Identifier
chan ->
      Image'
"invited " Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
" to " Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" " Image' -> Image' -> 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 = Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
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 (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palSigil Palette
pal) [Char]
sigils Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>

        -- nick!user@host
        UserInfo -> Image'
plainWho (Source -> UserInfo
srcUser Source
n) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>

        case MessageRendererParams -> Maybe (HashMap Identifier UserAndHost)
rendAccounts MessageRendererParams
rp Maybe (HashMap Identifier UserAndHost)
-> Getting
     (First Text) (Maybe (HashMap Identifier UserAndHost)) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (HashMap Identifier UserAndHost
 -> Const (First Text) (HashMap Identifier UserAndHost))
-> Maybe (HashMap Identifier UserAndHost)
-> Const (First Text) (Maybe (HashMap Identifier UserAndHost))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((HashMap Identifier UserAndHost
  -> Const (First Text) (HashMap Identifier UserAndHost))
 -> Maybe (HashMap Identifier UserAndHost)
 -> Const (First Text) (Maybe (HashMap Identifier UserAndHost)))
-> Getting (First Text) (HashMap Identifier UserAndHost) Text
-> Getting
     (First Text) (Maybe (HashMap Identifier UserAndHost)) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier UserAndHost)
-> Traversal'
     (HashMap Identifier UserAndHost)
     (IxValue (HashMap Identifier UserAndHost))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
n)) ((UserAndHost -> Const (First Text) UserAndHost)
 -> HashMap Identifier UserAndHost
 -> Const (First Text) (HashMap Identifier UserAndHost))
-> ((Text -> Const (First Text) Text)
    -> UserAndHost -> Const (First Text) UserAndHost)
-> Getting (First Text) (HashMap Identifier UserAndHost) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> UserAndHost -> Const (First Text) UserAndHost
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
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText (Source -> Text
srcAcct Source
n) Text -> Text -> Text
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
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText Text
acct Text -> Text -> Text
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 Attr
quietAttr [Char]
"nick " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
old Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
" is now known as " Image' -> Image' -> Image'
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 Attr
quietAttr [Char]
"join " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      UserInfo -> Image'
plainWho (Source -> UserInfo
srcUser Source
nick) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
accountPart Image' -> Image' -> Image'
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
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText (Source -> Text
srcAcct Source
nick) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
          | Bool -> Bool
not (Text -> Bool
Text.null Text
acct) = Attr -> Text -> Image'
text' Attr
quietAttr (Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText Text
acct Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
          | Bool
otherwise = Image'
forall a. Monoid a => a
mempty
        gecosPart :: Image'
gecosPart
          | Text -> Bool
Text.null Text
gecos = Image'
forall a. Monoid a => a
mempty
          | Bool
otherwise       = Attr -> Text -> Image'
text' Attr
quietAttr (Text
" [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanText Text
gecos Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")

    Part Source
nick Identifier
_chan Maybe Text
mbreason ->
      Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"part " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
nick Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      (Text -> Image') -> Maybe Text -> Image'
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
reason -> Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
" (" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                          Palette -> Text -> Image'
parseIrcText Palette
pal Text
reason Image' -> Image' -> Image'
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 Attr
quietAttr [Char]
"quit "   Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
nick Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      (Text -> Image') -> Maybe Text -> Image'
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
reason -> Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
" (" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                          Palette -> Text -> Image'
parseIrcText Palette
pal Text
reason Image' -> Image' -> Image'
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 Attr
quietAttr [Char]
"kick " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
kicker Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
" kicked " Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
": " Image' -> Image' -> 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 Attr
quietAttr [Char]
"kill " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
killer Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
" killed " Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
": " Image' -> Image' -> 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 " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
" changed the topic: " Image' -> Image' -> Image'
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 " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
" invited " Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
" to " Image' -> Image' -> Image'
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 " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) [Char]
": " Image' -> Image' -> 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

    Privmsg Source
src Identifier
_dst Text
txt ->
      Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"chat " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
": " Image' -> Image' -> 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 " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
": " Image' -> Image' -> 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 " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue) [Char]
"* " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" " Image' -> Image' -> 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 " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue) [Char]
"! " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Palette -> Text -> Image'
parseIrcText Palette
pal Text
cmd Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      if Text -> Bool
Text.null Text
txt then Image'
forall a. Monoid a => a
mempty else Image'
separatorImage Image' -> Image' -> Image'
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 " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Attr -> [Char] -> Image'
string (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) [Char]
"! " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Palette -> Text -> Image'
parseIrcText Palette
pal Text
cmd Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      if Text -> Bool
Text.null Text
txt then Image'
forall a. Monoid a => a
mempty else Image'
separatorImage Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
txt

    Ping [Text]
params ->
      Image'
"PING " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Palette -> [Text] -> Image'
separatedParams Palette
pal [Text]
params

    Pong [Text]
params ->
      Image'
"PONG " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Palette -> [Text] -> Image'
separatedParams Palette
pal [Text]
params

    Error Text
reason ->
      Attr -> [Char] -> Image'
string (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palError Palette
pal) [Char]
"ERROR " Image' -> Image' -> Image'
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 ->
      (UserInfo -> Image') -> Maybe UserInfo -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
' ')
        (Getting (Maybe UserInfo) RawIrcMsg (Maybe UserInfo)
-> RawIrcMsg -> Maybe UserInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UserInfo) RawIrcMsg (Maybe UserInfo)
forall (f :: * -> *).
Functor f =>
(Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix RawIrcMsg
irc) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Text -> Image'
ctxt (Getting Text RawIrcMsg Text -> RawIrcMsg -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text RawIrcMsg Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
irc) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Palette -> [Text] -> Image'
separatedParams Palette
pal (Getting [Text] RawIrcMsg [Text] -> RawIrcMsg -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Text] RawIrcMsg [Text]
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) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Image'
": " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Text -> Image'
ctxt (CapCmd -> Text
capCmdText CapCmd
cmd)

    Mode Source
nick Identifier
_chan [Text]
params ->
      Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"mode " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
nick Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" set mode: " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Palette -> [Text] -> Image'
ircWords Palette
pal [Text]
params

    Authenticate{} -> Image'
"AUTHENTICATE ***"
    BatchStart{}   -> Image'
"BATCH +"
    BatchEnd{}     -> Image'
"BATCH -"

    Account Source
src Text
acct ->
      Attr -> [Char] -> Image'
string Attr
quietAttr [Char]
"acct " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
src Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
": " Image' -> Image' -> 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 Attr
quietAttr [Char]
"chng " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Source -> Image'
who Source
user Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
": " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Text -> Image'
ctxt Text
newuser Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
newhost


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 = [Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat ([Image'] -> Image') -> ([Text] -> [Image']) -> [Text] -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
intersperse Image'
separatorImage ([Image'] -> [Image'])
-> ([Text] -> [Image']) -> [Text] -> [Image']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Image') -> [Text] -> [Image']
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 = [Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat ([Image'] -> Image') -> ([Text] -> [Image']) -> [Text] -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
intersperse (Attr -> Char -> Image'
char Attr
defAttr Char
' ') ([Image'] -> [Image'])
-> ([Text] -> [Image']) -> [Text] -> [Image']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Image') -> [Text] -> [Image']
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) Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
attr (Word -> ShowS
forall a. Show a => a -> ShowS
shows Word
w [Char]
" ") Image' -> Image' -> Image'
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_LIST         -> Image'
listParamsImage
        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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Text
t Image' -> Image' -> Image'
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   -> Int -> [Text] -> [Text]
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" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
ctxt Text
who Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" at" Image' -> Image' -> Image'
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) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Text
"!" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
ctxt Text
user Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) Text
"@" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" gecos" Image' -> Image' -> Image'
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)) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" sign-on" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" note" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" duration" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
60 (Text -> [Char]
Text.unpack Text
mins)) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" mask"     Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mask Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" reason"   Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" sendQ" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
sendQ Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" sendM" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
sendM Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" sendK" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
sendK Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" recvM" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
recvM Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" recvK" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
recvK Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" since" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
conn)) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" idle"  Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
idle)) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" caps"  Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
pass Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"<NULL>" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" pass" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
pass) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" mask" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mask' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
port Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" port" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
port) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
special then Image'
forall a. Monoid a => a
mempty else
            Text -> Image'
label Text
" special" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt ([Text] -> Text
Text.unwords [Text]
special)) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text -> Bool
Text.null Text
note then Image'
forall a. Monoid a => a
mempty else
            Text -> Image'
label Text
" note" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
pass Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"<NULL>" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" pass" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
pass) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" mask" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mask' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
port Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" port" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
port) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
special then Image'
forall a. Monoid a => a
mempty else
            Text -> Image'
label Text
" special" Image' -> Image' -> Image'
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expect ->
          Text -> Image'
ctxt Text
mask Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" reason" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
reason Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" hits" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
gecos Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" gecos" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
gecos) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" local"  Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
local Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" remote" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" host"  Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" count" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
count Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" flags" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" host" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" reason" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" host"  Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
user Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" user" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
user) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" reason" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" txt"  Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" max"  Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" host" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" port" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
port Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
certfp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" certfp" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
certfp) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
flags then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" flags" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" host" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" port" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
port Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
flags then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" flags" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" server" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" server" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" count" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
count Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" bytes" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
bytes Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" remote-count" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" host" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" name" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
name Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
privset Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" privset" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" mask" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mask Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" flags" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" ping-freq" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
pingFreq Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" con-freq" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
conFreq Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" max-users" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
maxUsers Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" max-sendq" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
maxSendq Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" max-local" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
maxLocal Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" max-global" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
maxGlobal Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" current" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" msg" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Palette -> Text -> Image'
parseIrcText Palette
pal Text
txt
        [Text]
_ -> Image'
rawParamsImage

    listParamsImage :: Image'
listParamsImage =
      case [Text]
params of
        [Text
_, Text
chan, Text
users, Text
topic] ->
          Text -> Image'
ctxt Text
chan Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" users" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
users Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" topic" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
topic
        [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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" link" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
link Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" hops" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
hops Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" location" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
"!" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
user Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
"@" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" gecos" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
gecos Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
ip Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0" Bool -> Bool -> Bool
|| Text
ip Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" ip" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
ip) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" server" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
server Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" kind" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" nick" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
nick Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" version" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" class" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" class" Image' -> Image' -> Image'
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
          , Text -> Char
Text.head Text
ip Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
          , Text -> Char
Text.last Text
ip Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' ->
          Text -> Image'
ctxt Text
mask Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
ip Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then Image'
forall a. Monoid a => a
mempty else
           Text -> Image'
label Text
" ip" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.tail (Text -> Text
Text.init Text
ip))) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" idle" Image' -> Image' -> Image'
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'S', Text -> Char
Text.last Text
clients Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'C' ->
          Text -> Image'
ctxt Text
link Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" who" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
who Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" servers" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.init Text
servers) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" clients" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.init Text
clients) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" idle" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
label Text
" count" Image' -> Image' -> Image'
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
          , Text -> Char
Text.head Text
ip Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
          , Text -> Char
Text.last Text
ip Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' ->
          Text -> Image'
ctxt Text
mask Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
ip Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then Image'
forall a. Monoid a => a
mempty else
           Text -> Image'
label Text
" ip" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.tail (Text -> Text
Text.init Text
ip))) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" pkt-idle" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
lastpkt)) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" msg-idle" Image' -> Image' -> Image'
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
          , Text -> Char
Text.head Text
ip Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
          , Text -> Char
Text.last Text
ip Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' ->
          Text -> Image'
ctxt Text
mask Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
ip Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then Image'
forall a. Monoid a => a
mempty else
           Text -> Image'
label Text
" ip" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt (Text -> Text
Text.tail (Text -> Text
Text.init Text
ip))) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" pkt-idle" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> [Char] -> Image'
string Attr
defAttr (Int -> ShowS
prettyTime Int
1 (Text -> [Char]
Text.unpack Text
lastpkt)) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" msg-idle" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
"!" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
user Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
"@" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
host Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" gecos" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
gecos Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          (if Text
ip Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0" Bool -> Bool -> Bool
|| Text
ip Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"255.255.255.255" then Image'
forall a. Monoid a => a
mempty else Text -> Image'
label Text
" ip" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
ip) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" kind" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
kind Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" class" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
klass Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" p1" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
p1 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" p2" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" account" Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
              Text -> Image'
label Text
" end" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
list
            Just Text
list' ->
              Text -> Image'
ctxt Text
target Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
              Text -> Image'
label Text
" ..." Image' -> Image' -> Image'
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 Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" mode" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Text -> Image'
ctxt Text
mode Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Text -> Image'
label Text
" mlock" Image' -> Image' -> Image'
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 Char -> Maybe Text
forall a. IsString a => Char -> Maybe a
getFlag Char
x of
            Maybe Text
Nothing   -> [Text] -> Text -> [Text]
go (Char -> Text
Text.singleton Char
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
acc) Text
xs'
            Just Text
flag -> [Text] -> Text -> [Text]
go (Text
flagText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
acc) Text
xs'
        Maybe (Char, Text)
Nothing -> [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
acc

    getFlag :: Char -> Maybe a
getFlag Char
x =
      case Char
x of
        Char
'A' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"auto-connect"
        Char
'M' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"sctp"
        Char
'S' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"tls"
        Char
'T' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"topic-burst"
        Char
'Z' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"compressed"
        Char
_   -> Maybe a
forall a. Maybe a
Nothing

parseILinePrefix :: Text -> (Text, [Text])
parseILinePrefix :: Text -> (Text, [Text])
parseILinePrefix = [Text] -> Text -> (Text, [Text])
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 (Char -> Maybe a
forall a. IsString a => Char -> Maybe a
getSpecial -> Just a
s, Text
mask') -> [a] -> Text -> (Text, [a])
go (a
sa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
special) Text
mask'
        Maybe (Char, Text)
_ -> (Text
mask, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
special)

    getSpecial :: Char -> Maybe a
getSpecial Char
x =
      case Char
x of
        Char
'-' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"no-tilde"
        Char
'+' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"need-ident"
        Char
'=' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"spoof-IP"
        Char
'%' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"need-sasl"
        Char
'|' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"flood-exempt"
        Char
'$' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"dnsbl-exempt"
        Char
'^' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"kline-exempt"
        Char
'>' -> a -> Maybe a
forall a. a -> Maybe a
Just a
"limits-exempt"
        Char
_   -> Maybe a
forall a. Maybe a
Nothing


-- | Transform string representing seconds in POSIX time to pretty format.
prettyUnixTime :: String -> String
prettyUnixTime :: ShowS
prettyUnixTime [Char]
str =
  case Bool -> TimeLocale -> [Char] -> [Char] -> Maybe UTCTime
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  -> TimeLocale -> [Char] -> UTCTime -> [Char]
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 [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str of
    Maybe Int
Nothing -> [Char]
str
    Just Int
0  -> [Char]
"0s"
    Just Int
n  -> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" "
             ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Char, Int) -> [Char]) -> [(Char, Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
u,Int
i) -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
u])
             ([(Char, Int)] -> [[Char]]) -> [(Char, Int)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ((Char, Int) -> Bool) -> [(Char, Int)] -> [(Char, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Char, Int)
x -> (Char, Int) -> Int
forall a b. (a, b) -> b
snd (Char, Int)
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
             ([(Char, Int)] -> [(Char, Int)]) -> [(Char, Int)] -> [(Char, Int)]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Int] -> [(Char, Int)]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
scale
        (Int
n1,Int
s) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n0 Int
60
        (Int
n2,Int
m) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n1 Int
60
        (Int
d ,Int
h) = Int -> Int -> (Int, Int)
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
      | Highlight -> Maybe Highlight
forall a. a -> Maybe a
Just Highlight
HighlightMe Maybe Highlight -> Maybe Highlight -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier -> HashMap Identifier Highlight -> Maybe Highlight
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 -> Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palSelfHighlight Palette
palette
            IdentifierColorMode
NormalIdentifier  -> Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palSelf Palette
palette

      | Bool
otherwise = Vector Attr
v Vector Attr -> Int -> Attr
forall a. Vector a -> Int -> a
Vector.! Int
i

    v :: Vector Attr
v = Getting (Vector Attr) Palette (Vector Attr)
-> Palette -> Vector Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Vector Attr) Palette (Vector Attr)
Lens' Palette (Vector Attr)
palNicks Palette
palette
    i :: Int
i = Identifier -> Int
forall a. Hashable a => a -> Int
hash Identifier
ident Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Vector Attr -> Int
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 =
  [Image'] -> Image'
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 = Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palMeta Palette
palette
    aux :: Char -> Text -> Image'
aux Char
x Text
xs
      | Text -> Bool
Text.null Text
xs = Image'
forall a. Monoid a => a
mempty
      | Bool
otherwise    = Attr -> Char -> Image'
char Attr
quietAttr Char
x Image' -> Image' -> Image'
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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palMeta Palette
palette) (Text -> Text
cleanText (Identifier -> Text
idText Identifier
ident))

data Highlight
  = HighlightMe
  | HighlightNick
  | HighlightError
  | HighlightNone
  deriving Highlight -> Highlight -> Bool
(Highlight -> Highlight -> Bool)
-> (Highlight -> Highlight -> Bool) -> Eq Highlight
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 = (Text -> Image') -> [Text] -> Image'
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 Identifier -> HashMap Identifier Highlight -> Maybe Highlight
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' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palError Palette
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 :: IrcSummary -> Maybe (Image', Identifier, Maybe Identifier)
metadataImg :: IrcSummary -> Maybe (Image', Identifier, Maybe Identifier)
metadataImg IrcSummary
msg =
  case IrcSummary
msg of
    QuitSummary Identifier
who QuitKind
_   -> (Image', Identifier, Maybe Identifier)
-> Maybe (Image', Identifier, Maybe Identifier)
forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red   ) Char
'x', Identifier
who, Maybe Identifier
forall a. Maybe a
Nothing)
    PartSummary Identifier
who     -> (Image', Identifier, Maybe Identifier)
-> Maybe (Image', Identifier, Maybe Identifier)
forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red   ) Char
'-', Identifier
who, Maybe Identifier
forall a. Maybe a
Nothing)
    JoinSummary Identifier
who     -> (Image', Identifier, Maybe Identifier)
-> Maybe (Image', Identifier, Maybe Identifier)
forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
green ) Char
'+', Identifier
who, Maybe Identifier
forall a. Maybe a
Nothing)
    CtcpSummary Identifier
who     -> (Image', Identifier, Maybe Identifier)
-> Maybe (Image', Identifier, Maybe Identifier)
forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
white ) Char
'C', Identifier
who, Maybe Identifier
forall a. Maybe a
Nothing)
    NickSummary Identifier
old Identifier
new -> (Image', Identifier, Maybe Identifier)
-> Maybe (Image', Identifier, Maybe Identifier)
forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
yellow) Char
'>', Identifier
old, Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
new)
    ChngSummary Identifier
who     -> (Image', Identifier, Maybe Identifier)
-> Maybe (Image', Identifier, Maybe Identifier)
forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue  ) Char
'*', Identifier
who, Maybe Identifier
forall a. Maybe a
Nothing)
    AcctSummary Identifier
who     -> (Image', Identifier, Maybe Identifier)
-> Maybe (Image', Identifier, Maybe Identifier)
forall a. a -> Maybe a
Just (Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue  ) Char
'*', Identifier
who, Maybe Identifier
forall a. Maybe a
Nothing)
    IrcSummary
_                   -> Maybe (Image', Identifier, Maybe Identifier)
forall a. Maybe a
Nothing



-- | Image used when treating ignored chat messages as metadata
ignoreImage :: Image'
ignoreImage :: Image'
ignoreImage = Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
yellow) Char
'I'


-- | 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) (Getting Image' WindowLine Image' -> WindowLine -> Image'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Image' WindowLine Image'
Lens' WindowLine Image'
wlImage WindowLine
wl)
  where
    drawTime :: PackedTime -> Image'
drawTime = Palette -> TimeOfDay -> Image'
timeImage Palette
palette (TimeOfDay -> Image')
-> (PackedTime -> TimeOfDay) -> PackedTime -> Image'
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 = [Image'] -> [Image']
forall a. [a] -> [a]
reverse (Int -> Image' -> Image' -> [Image']
lineWrapPrefix Int
w Image'
pfx Image'
body)
    drawPrefix :: WindowLine -> Image'
drawPrefix = LensLike' (Const Image') WindowLine PackedTime
-> (PackedTime -> Image') -> WindowLine -> Image'
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Image') WindowLine PackedTime
Lens' WindowLine PackedTime
wlTimestamp PackedTime -> Image'
drawTime (WindowLine -> Image')
-> (WindowLine -> Image') -> WindowLine -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 Getting Image' WindowLine Image'
-> (Image' -> Image') -> WindowLine -> Image'
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Getting Image' WindowLine Image'
Lens' WindowLine Image'
wlPrefix    Image' -> Image'
padNick