    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE OverloadedStrings #-}

    {-|
    Module      : Irc.RawIrcMsg
    Description : Low-level representation of IRC messages
    Copyright   : (c) Eric Mertens, 2016
    License     : ISC
    Maintainer  : emertens@gmail.com

    This module provides a parser and printer for the low-level IRC
    message format. It handles splitting up IRC commands into the
    prefix, command, and arguments.

    -}
    module Irc.RawIrcMsg
      (
      -- * Low-level IRC messages
        RawIrcMsg(..)
      , TagEntry(..)
      , rawIrcMsg
      , msgTags
      , msgPrefix
      , msgCommand
      , msgParams

      -- * Text format for IRC messages
      , parseRawIrcMsg
      , renderRawIrcMsg
      , prefixParser
      , simpleTokenParser

      -- * Permissive text decoder
      , asUtf8
      ) where

    import           Control.Applicative
    import           Data.Attoparsec.Text as P
    import           Data.ByteString (ByteString)
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as L
    import           Data.ByteString.Builder (Builder)
    import qualified Data.ByteString.Builder as Builder
    import           Data.List
    import           Data.Maybe
    import           Data.Text (Text)
    import qualified Data.Text as Text
    import qualified Data.Text.Encoding as Text
    import           Data.Vector (Vector)
    import qualified Data.Vector as Vector

    import           Irc.UserInfo
    import           View

    -- | 'RawIrcMsg' breaks down the IRC protocol into its most basic parts.
    -- The "trailing" parameter indicated in the IRC protocol with a leading
    -- colon will appear as the last parameter in the parameter list.
    --
    -- Note that RFC 2812 specifies a maximum of 15 parameters.
    --
    -- This parser is permissive regarding spaces. It aims to parse carefully
    -- constructed messages exactly and to make a best effort to recover from
    -- extraneous spaces. It makes no effort to validate nicknames, usernames,
    -- hostnames, commands, etc. Servers don't all agree on these things.
    --
    -- @:prefix COMMAND param0 param1 param2 .. paramN@
    data RawIrcMsg = RawIrcMsg
      { RawIrcMsg -> [TagEntry]
    _msgTags       :: [TagEntry]     -- ^ IRCv3.2 message tags
      , RawIrcMsg -> Maybe UserInfo
    _msgPrefix     :: Maybe UserInfo -- ^ Optional sender of message
      , RawIrcMsg -> Text
    _msgCommand    :: !Text          -- ^ Command
      , RawIrcMsg -> [Text]
    _msgParams     :: [Text]         -- ^ Command parameters
      }
      deriving (RawIrcMsg -> RawIrcMsg -> Bool
    (RawIrcMsg -> RawIrcMsg -> Bool)
    -> (RawIrcMsg -> RawIrcMsg -> Bool) -> Eq RawIrcMsg
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: RawIrcMsg -> RawIrcMsg -> Bool
    == :: RawIrcMsg -> RawIrcMsg -> Bool
    $c/= :: RawIrcMsg -> RawIrcMsg -> Bool
    /= :: RawIrcMsg -> RawIrcMsg -> Bool
    Eq, ReadPrec [RawIrcMsg]
    ReadPrec RawIrcMsg
    Int -> ReadS RawIrcMsg
    ReadS [RawIrcMsg]
    (Int -> ReadS RawIrcMsg)
    -> ReadS [RawIrcMsg]
    -> ReadPrec RawIrcMsg
    -> ReadPrec [RawIrcMsg]
    -> Read RawIrcMsg
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS RawIrcMsg
    readsPrec :: Int -> ReadS RawIrcMsg
    $creadList :: ReadS [RawIrcMsg]
    readList :: ReadS [RawIrcMsg]
    $creadPrec :: ReadPrec RawIrcMsg
    readPrec :: ReadPrec RawIrcMsg
    $creadListPrec :: ReadPrec [RawIrcMsg]
    readListPrec :: ReadPrec [RawIrcMsg]
    Read, Int -> RawIrcMsg -> ShowS
    [RawIrcMsg] -> ShowS
    RawIrcMsg -> [Char]
    (Int -> RawIrcMsg -> ShowS)
    -> (RawIrcMsg -> [Char])
    -> ([RawIrcMsg] -> ShowS)
    -> Show RawIrcMsg
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RawIrcMsg -> ShowS
    showsPrec :: Int -> RawIrcMsg -> ShowS
    $cshow :: RawIrcMsg -> [Char]
    show :: RawIrcMsg -> [Char]
    $cshowList :: [RawIrcMsg] -> ShowS
    showList :: [RawIrcMsg] -> ShowS
    Show)

    -- | Key value pair representing an IRCv3.2 message tag.
    -- The value in this pair has had the message tag unescape
    -- algorithm applied.
    data TagEntry = TagEntry {-# UNPACK #-} !Text {-# UNPACK #-} !Text
      deriving (TagEntry -> TagEntry -> Bool
    (TagEntry -> TagEntry -> Bool)
    -> (TagEntry -> TagEntry -> Bool) -> Eq TagEntry
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TagEntry -> TagEntry -> Bool
    == :: TagEntry -> TagEntry -> Bool
    $c/= :: TagEntry -> TagEntry -> Bool
    /= :: TagEntry -> TagEntry -> Bool
    Eq, ReadPrec [TagEntry]
    ReadPrec TagEntry
    Int -> ReadS TagEntry
    ReadS [TagEntry]
    (Int -> ReadS TagEntry)
    -> ReadS [TagEntry]
    -> ReadPrec TagEntry
    -> ReadPrec [TagEntry]
    -> Read TagEntry
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS TagEntry
    readsPrec :: Int -> ReadS TagEntry
    $creadList :: ReadS [TagEntry]
    readList :: ReadS [TagEntry]
    $creadPrec :: ReadPrec TagEntry
    readPrec :: ReadPrec TagEntry
    $creadListPrec :: ReadPrec [TagEntry]
    readListPrec :: ReadPrec [TagEntry]
    Read, Int -> TagEntry -> ShowS
    [TagEntry] -> ShowS
    TagEntry -> [Char]
    (Int -> TagEntry -> ShowS)
    -> (TagEntry -> [Char]) -> ([TagEntry] -> ShowS) -> Show TagEntry
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TagEntry -> ShowS
    showsPrec :: Int -> TagEntry -> ShowS
    $cshow :: TagEntry -> [Char]
    show :: TagEntry -> [Char]
    $cshowList :: [TagEntry] -> ShowS
    showList :: [TagEntry] -> ShowS
    Show)

    -- | Lens for '_msgTags'
    msgTags :: Functor f => ([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
    msgTags :: forall (f :: * -> *).
    Functor f =>
    ([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
    msgTags [TagEntry] -> f [TagEntry]
    f RawIrcMsg
    m = (\[TagEntry]
    x -> RawIrcMsg
    m { _msgTags = x }) ([TagEntry] -> RawIrcMsg) -> f [TagEntry] -> f RawIrcMsg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TagEntry] -> f [TagEntry]
    f (RawIrcMsg -> [TagEntry]
    _msgTags RawIrcMsg
    m)

    -- | Lens for '_msgPrefix'
    msgPrefix :: Functor f => (Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
    msgPrefix :: forall (f :: * -> *).
    Functor f =>
    (Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
    msgPrefix Maybe UserInfo -> f (Maybe UserInfo)
    f RawIrcMsg
    m = (\Maybe UserInfo
    x -> RawIrcMsg
    m { _msgPrefix = x }) (Maybe UserInfo -> RawIrcMsg) -> f (Maybe UserInfo) -> f RawIrcMsg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe UserInfo -> f (Maybe UserInfo)
    f (RawIrcMsg -> Maybe UserInfo
    _msgPrefix RawIrcMsg
    m)

    -- | Lens for '_msgCommand'
    msgCommand :: Functor f => (Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
    msgCommand :: forall (f :: * -> *).
    Functor f =>
    (Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
    msgCommand Text -> f Text
    f RawIrcMsg
    m = (\Text
    x -> RawIrcMsg
    m { _msgCommand = x }) (Text -> RawIrcMsg) -> f Text -> f RawIrcMsg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> f Text
    f (RawIrcMsg -> Text
    _msgCommand RawIrcMsg
    m)

    -- | Lens for '_msgParams'
    msgParams :: Functor f => ([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
    msgParams :: forall (f :: * -> *).
    Functor f =>
    ([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
    msgParams [Text] -> f [Text]
    f RawIrcMsg
    m = (\[Text]
    x -> RawIrcMsg
    m { _msgParams = x }) ([Text] -> RawIrcMsg) -> f [Text] -> f RawIrcMsg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Text] -> f [Text]
    f (RawIrcMsg -> [Text]
    _msgParams RawIrcMsg
    m)

    -- | Attempt to split an IRC protocol message without its trailing newline
    -- information into a structured message.
    parseRawIrcMsg :: Text -> Maybe RawIrcMsg
    parseRawIrcMsg :: Text -> Maybe RawIrcMsg
    parseRawIrcMsg Text
    x =
      case Parser RawIrcMsg -> Text -> Either [Char] RawIrcMsg
    forall a. Parser a -> Text -> Either [Char] a
    parseOnly Parser RawIrcMsg
    rawIrcMsgParser Text
    x of
        Left{}  -> Maybe RawIrcMsg
    forall a. Maybe a
    Nothing
        Right RawIrcMsg
    r -> RawIrcMsg -> Maybe RawIrcMsg
    forall a. a -> Maybe a
    Just RawIrcMsg
    r

    -- | RFC 2812 specifies that there can only be up to
    -- 14 "middle" parameters, after that the fifteenth is
    -- the final parameter and the trailing : is optional!
    maxMiddleParams :: Int
    maxMiddleParams :: Int
    maxMiddleParams = Int
    14

    --  Excerpt from https://tools.ietf.org/html/rfc2812#section-2.3.1

    --  message    =  [ ":" prefix SPACE ] command [ params ] crlf
    --  prefix     =  servername / ( nickname [ [ "!" user ] "@" host ] )
    --  command    =  1*letter / 3digit
    --  params     =  *14( SPACE middle ) [ SPACE ":" trailing ]
    --             =/ 14( SPACE middle ) [ SPACE [ ":" ] trailing ]

    --  nospcrlfcl =  %x01-09 / %x0B-0C / %x0E-1F / %x21-39 / %x3B-FF
    --                  ; any octet except NUL, CR, LF, " " and ":"
    --  middle     =  nospcrlfcl *( ":" / nospcrlfcl )
    --  trailing   =  *( ":" / " " / nospcrlfcl )

    --  SPACE      =  %x20        ; space character
    --  crlf       =  %x0D %x0A   ; "carriage return" "linefeed"

    -- | Parse a whole IRC message assuming that the trailing
    -- newlines have already been removed. This parser will
    -- parse valid messages correctly but will also accept some
    -- invalid messages. Presumably the server isn't sending
    -- invalid messages!
    rawIrcMsgParser :: Parser RawIrcMsg
    rawIrcMsgParser :: Parser RawIrcMsg
    rawIrcMsgParser =
      do tags   <- [TagEntry] -> Maybe [TagEntry] -> [TagEntry]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [TagEntry] -> [TagEntry])
    -> Parser Text (Maybe [TagEntry]) -> Parser Text [TagEntry]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Char -> Parser Text [TagEntry] -> Parser Text (Maybe [TagEntry])
    forall b. Char -> Parser b -> Parser (Maybe b)
    guarded Char
    '@' Parser Text [TagEntry]
    tagsParser
         prefix <- guarded ':' prefixParser
         cmd    <- simpleTokenParser
         params <- paramsParser maxMiddleParams
         return $! RawIrcMsg
           { _msgTags    = tags
           , _msgPrefix  = prefix
           , _msgCommand = cmd
           , _msgParams  = params
           }

    -- | Parse the list of parameters in a raw message. The RFC
    -- allows for up to 15 parameters.
    paramsParser ::
      Int {- ^ possible middle parameters -} -> Parser [Text]
    paramsParser :: Int -> Parser [Text]
    paramsParser !Int
    n =
      do end <- Parser Text Bool
    forall t. Chunk t => Parser t Bool
    P.atEnd
         if end
           then return []
           else do isColon <- optionalChar ':'
                   if isColon || n == 0
                     then finalParam
                     else middleParam

      where

      finalParam :: Parser [Text]
    finalParam =
        do x <- Parser Text
    takeText
           let !x' = Text -> Text
    Text.copy Text
    x
           return [x']

      middleParam :: Parser [Text]
    middleParam =
        do x  <- Parser Text
    simpleTokenParser
           xs <- paramsParser (n-1)
           return (x:xs)

    tagsParser :: Parser [TagEntry]
    tagsParser :: Parser Text [TagEntry]
    tagsParser = Parser TagEntry
    tagParser Parser TagEntry -> Parser Text Char -> Parser Text [TagEntry]
    forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
    `sepBy1` Char -> Parser Text Char
    char Char
    ';' Parser Text [TagEntry] -> Parser Text () -> Parser Text [TagEntry]
    forall a b. Parser Text a -> Parser Text b -> Parser Text a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser Text ()
    spaces

    tagParser :: Parser TagEntry
    tagParser :: Parser TagEntry
    tagParser =
      do key <- (Char -> Bool) -> Parser Text
    P.takeWhile ([Char] -> Char -> Bool
    notInClass [Char]
    "=; ")
         _   <- optional (char '=')
         val <- P.takeWhile (notInClass "; ")
         return $! TagEntry key (unescapeTagVal val)

    unescapeTagVal :: Text -> Text
    unescapeTagVal :: Text -> Text
    unescapeTagVal = [Char] -> Text
    Text.pack ([Char] -> Text) -> (Text -> [Char]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    aux ShowS -> (Text -> [Char]) -> Text -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Char]
    Text.unpack
      where
        aux :: ShowS
    aux (Char
    '\\':Char
    ':':[Char]
    xs) = Char
    ';'Char -> ShowS
    forall a. a -> [a] -> [a]
    :ShowS
    aux [Char]
    xs
        aux (Char
    '\\':Char
    's':[Char]
    xs) = Char
    ' 'Char -> ShowS
    forall a. a -> [a] -> [a]
    :ShowS
    aux [Char]
    xs
        aux (Char
    '\\':Char
    '\\':[Char]
    xs) = Char
    '\\'Char -> ShowS
    forall a. a -> [a] -> [a]
    :ShowS
    aux [Char]
    xs
        aux (Char
    '\\':Char
    'r':[Char]
    xs) = Char
    '\r'Char -> ShowS
    forall a. a -> [a] -> [a]
    :ShowS
    aux [Char]
    xs
        aux (Char
    '\\':Char
    'n':[Char]
    xs) = Char
    '\n'Char -> ShowS
    forall a. a -> [a] -> [a]
    :ShowS
    aux [Char]
    xs
        aux (Char
    x:[Char]
    xs)        = Char
    x Char -> ShowS
    forall a. a -> [a] -> [a]
    : ShowS
    aux [Char]
    xs
        aux [Char]
    ""            = [Char]
    ""

    escapeTagVal :: Text -> Text
    escapeTagVal :: Text -> Text
    escapeTagVal = (Char -> Text) -> Text -> Text
    Text.concatMap Char -> Text
    aux
      where
        aux :: Char -> Text
    aux Char
    ';'  = Text
    "\\:"
        aux Char
    ' '  = Text
    "\\s"
        aux Char
    '\\' = Text
    "\\\\"
        aux Char
    '\r' = Text
    "\\r"
        aux Char
    '\n' = Text
    "\\n"
        aux Char
    x = Char -> Text
    Text.singleton Char
    x

    -- | Parse a rendered 'UserInfo' token.
    prefixParser :: Parser UserInfo
    prefixParser :: Parser UserInfo
    prefixParser =
      do tok <- Parser Text
    simpleTokenParser
         return $! parseUserInfo tok

    -- | Take the next space-delimited lexeme
    simpleTokenParser :: Parser Text
    simpleTokenParser :: Parser Text
    simpleTokenParser =
      do xs <- (Char -> Bool) -> Parser Text
    P.takeWhile1 (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ')
         spaces
         return $! Text.copy xs

    spaces :: Parser ()
    spaces :: Parser Text ()
    spaces = (Char -> Bool) -> Parser Text ()
    P.skipWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ')

    -- | Serialize a structured IRC protocol message back into its wire
    -- format. This command adds the required trailing newline.
    renderRawIrcMsg :: RawIrcMsg -> ByteString
    renderRawIrcMsg :: RawIrcMsg -> ByteString
    renderRawIrcMsg !RawIrcMsg
    m
       = LazyByteString -> ByteString
    L.toStrict
       (LazyByteString -> ByteString) -> LazyByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> LazyByteString
    Builder.toLazyByteString
       (Builder -> LazyByteString) -> Builder -> LazyByteString
    forall a b. (a -> b) -> a -> b
    $ [TagEntry] -> Builder
    renderTags ((([TagEntry] -> Const [TagEntry] [TagEntry])
     -> RawIrcMsg -> Const [TagEntry] RawIrcMsg)
    -> RawIrcMsg -> [TagEntry]
    forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
    view ([TagEntry] -> Const [TagEntry] [TagEntry])
    -> RawIrcMsg -> Const [TagEntry] RawIrcMsg
    forall (f :: * -> *).
    Functor f =>
    ([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
    msgTags RawIrcMsg
    m)
      Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder -> (UserInfo -> Builder) -> Maybe UserInfo -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Builder
    forall a. Monoid a => a
    mempty UserInfo -> Builder
    renderPrefix (((Maybe UserInfo -> Const (Maybe UserInfo) (Maybe UserInfo))
     -> RawIrcMsg -> Const (Maybe UserInfo) RawIrcMsg)
    -> RawIrcMsg -> Maybe UserInfo
    forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
    view (Maybe UserInfo -> Const (Maybe UserInfo) (Maybe UserInfo))
    -> RawIrcMsg -> Const (Maybe UserInfo) RawIrcMsg
    forall (f :: * -> *).
    Functor f =>
    (Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
    msgPrefix RawIrcMsg
    m)
      Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    Text.encodeUtf8Builder (((Text -> Const Text Text) -> RawIrcMsg -> Const Text RawIrcMsg)
    -> RawIrcMsg -> Text
    forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
    view (Text -> Const Text Text) -> RawIrcMsg -> Const Text RawIrcMsg
    forall (f :: * -> *).
    Functor f =>
    (Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
    msgCommand RawIrcMsg
    m)
      Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Builder
    buildParams ((([Text] -> Const [Text] [Text])
     -> RawIrcMsg -> Const [Text] RawIrcMsg)
    -> RawIrcMsg -> [Text]
    forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
    view ([Text] -> Const [Text] [Text])
    -> RawIrcMsg -> Const [Text] RawIrcMsg
    forall (f :: * -> *).
    Functor f =>
    ([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
    msgParams RawIrcMsg
    m)
      Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    Builder.char8 Char
    '\r'
      Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    Builder.char8 Char
    '\n'

    -- | Construct a new 'RawIrcMsg' without a time or prefix.
    rawIrcMsg ::
      Text {- ^ command -} ->
      [Text] {- ^ parameters -} -> RawIrcMsg
    rawIrcMsg :: Text -> [Text] -> RawIrcMsg
    rawIrcMsg = [TagEntry] -> Maybe UserInfo -> Text -> [Text] -> RawIrcMsg
    RawIrcMsg [] Maybe UserInfo
    forall a. Maybe a
    Nothing

    renderTags :: [TagEntry] -> Builder
    renderTags :: [TagEntry] -> Builder
    renderTags [] = Builder
    forall a. Monoid a => a
    mempty
    renderTags [TagEntry]
    xs
        = Char -> Builder
    Builder.char8 Char
    '@'
       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat (Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    intersperse (Char -> Builder
    Builder.char8 Char
    ';') ((TagEntry -> Builder) -> [TagEntry] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map TagEntry -> Builder
    renderTag [TagEntry]
    xs))
       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    Builder.char8 Char
    ' '

    renderTag :: TagEntry -> Builder
    renderTag :: TagEntry -> Builder
    renderTag (TagEntry Text
    key Text
    val)
      | Text -> Bool
    Text.null Text
    val = Text -> Builder
    Text.encodeUtf8Builder Text
    key
      | Bool
    otherwise     = Text -> Builder
    Text.encodeUtf8Builder Text
    key
                     Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    Builder.char8 Char
    '='
                     Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    Text.encodeUtf8Builder (Text -> Text
    escapeTagVal Text
    val)

    renderPrefix :: UserInfo -> Builder
    renderPrefix :: UserInfo -> Builder
    renderPrefix UserInfo
    u
       = Char -> Builder
    Builder.char8 Char
    ':'
      Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    Text.encodeUtf8Builder (UserInfo -> Text
    renderUserInfo UserInfo
    u)
      Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    Builder.char8 Char
    ' '

    -- | Concatenate a list of parameters into a single, space-delimited
    -- bytestring. Use a colon for the last parameter if it starts with
    -- a colon or contains a space.
    buildParams :: [Text] -> Builder
    buildParams :: [Text] -> Builder
    buildParams [Text
    x]
      | Text
    " " Text -> Text -> Bool
    `Text.isInfixOf` Text
    x Bool -> Bool -> Bool
    || Text
    ":" Text -> Text -> Bool
    `Text.isPrefixOf` Text
    x Bool -> Bool -> Bool
    || Text -> Bool
    Text.null Text
    x
      = Char -> Builder
    Builder.char8 Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    Builder.char8 Char
    ':' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    Text.encodeUtf8Builder Text
    x
    buildParams (Text
    x:[Text]
    xs)
      | Text -> Bool
    Text.null Text
    x = Char -> Builder
    Builder.char8 Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    Text.encodeUtf8Builder Text
    "*" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Builder
    buildParams [Text]
    xs
      | Bool
    otherwise   = Char -> Builder
    Builder.char8 Char
    ' ' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    Text.encodeUtf8Builder Text
    x   Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Builder
    buildParams [Text]
    xs
    buildParams [] = Builder
    forall a. Monoid a => a
    mempty

    -- | When the current input matches the given character parse
    -- using the given parser.
    guarded :: Char -> Parser b -> Parser (Maybe b)
    guarded :: forall b. Char -> Parser b -> Parser (Maybe b)
    guarded Char
    c Parser b
    p =
      do success <- Char -> Parser Text Bool
    optionalChar Char
    c
         if success then Just <$> p else pure Nothing

    -- | Returns 'True' iff next character in stream matches argument.
    optionalChar :: Char -> Parser Bool
    optionalChar :: Char -> Parser Text Bool
    optionalChar Char
    c = Bool
    True Bool -> Parser Text Char -> Parser Text Bool
    forall a b. a -> Parser Text b -> Parser Text a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Char -> Parser Text Char
    char Char
    c Parser Text Bool -> Parser Text Bool -> Parser Text Bool
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> Parser Text Bool
    forall a. a -> Parser Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False

    -- | Try to decode a message as UTF-8. If that fails interpret it as Windows
    -- CP1252 This helps deal with clients like XChat that get clever and otherwise
    -- misconfigured clients.
    asUtf8 :: ByteString -> Text
    asUtf8 :: ByteString -> Text
    asUtf8 ByteString
    x = case ByteString -> Either UnicodeException Text
    Text.decodeUtf8' ByteString
    x of
                 Right Text
    txt -> Text
    txt
                 Left{}    -> ByteString -> Text
    decodeCP1252 ByteString
    x

    -- | Decode a 'ByteString' as CP1252
    decodeCP1252 :: ByteString -> Text
    decodeCP1252 :: ByteString -> Text
    decodeCP1252 ByteString
    bs = [Char] -> Text
    Text.pack [ Vector Char
    cp1252 Vector Char -> Int -> Char
    forall a. Vector a -> Int -> a
    Vector.! Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    x | Word8
    x <- ByteString -> [Word8]
    B.unpack ByteString
    bs ]

    -- | This character encoding is a superset of ISO 8859-1 in terms of printable
    -- characters, but differs from the IANA's ISO-8859-1 by using displayable
    -- characters rather than control characters in the 80 to 9F (hex) range.
    cp1252 :: Vector Char
    cp1252 :: Vector Char
    cp1252 = [Char] -> Vector Char
    forall a. [a] -> Vector a
    Vector.fromList
           ([Char] -> Vector Char) -> [Char] -> Vector Char
    forall a b. (a -> b) -> a -> b
    $ [Char
    '\x00'..Char
    '\x7f']
          [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "€\x81‚ƒ„…†‡ˆ‰Š‹Œ\x8dŽ\x8f\x90‘’“”•–—˜™š›œ\x9džŸ"
          [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char
    '\xa0'..Char
    '\xff']