80 lines
2.2 KiB
Haskell
80 lines
2.2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
module Pipes.IRC.Message.Render
|
|
( renderIrcMessage )
|
|
where
|
|
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString.Char8 as C8
|
|
import Data.ByteString.Lazy (toStrict)
|
|
import Data.ByteString.Lazy.Builder
|
|
import Data.ByteString.Lazy.Builder.ASCII (intDec)
|
|
import Data.Monoid
|
|
import Pipes.IRC.Message.Types
|
|
|
|
renderIrcMessage :: IrcMessage -> C8.ByteString
|
|
renderIrcMessage = toStrict . toLazyByteString . buildIrcMessage
|
|
|
|
buildIrcMessage :: IrcMessage -> Builder
|
|
buildIrcMessage IrcMessage {..} =
|
|
buildMsgPrefix prefix
|
|
<> buildMsgCommand command
|
|
<> buildIrcParams params
|
|
<> byteString "\r\n"
|
|
|
|
buildMsgPrefix :: Maybe MsgPrefix -> Builder
|
|
buildMsgPrefix Nothing = mempty
|
|
buildMsgPrefix mp =
|
|
char8 ':'
|
|
<> case mp of
|
|
Just (Left sn) -> buildServerName sn
|
|
Just (Right nn) -> buildNickName nn
|
|
_ -> mempty
|
|
<> char8 ' '
|
|
|
|
buildServerName :: ServerName -> Builder
|
|
buildServerName = byteString
|
|
|
|
buildNickName :: NickName -> Builder
|
|
buildNickName NickName {..} =
|
|
byteString nick
|
|
<> buildUser user
|
|
<> buildHost host
|
|
|
|
buildUser :: Maybe ByteString -> Builder
|
|
buildUser user =
|
|
case user of
|
|
Nothing -> mempty
|
|
Just name -> byteString "!" <> byteString name
|
|
|
|
buildHost :: Maybe ByteString -> Builder
|
|
buildHost host =
|
|
case host of
|
|
Nothing -> mempty
|
|
Just name -> byteString "@" <> byteString name
|
|
|
|
buildMsgCommand :: MsgCommand -> Builder
|
|
buildMsgCommand cmd =
|
|
case cmd of
|
|
Left ircCmd -> buildIrcCommand ircCmd
|
|
Right ircReply -> buildIrcReply ircReply
|
|
<> byteString " "
|
|
|
|
buildIrcCommand :: IrcCommand -> Builder
|
|
buildIrcCommand cmd =
|
|
case cmd of
|
|
(Unknown name) -> byteString name
|
|
_ -> byteString . C8.pack . show $ cmd
|
|
|
|
buildIrcReply :: IrcReply -> Builder
|
|
buildIrcReply IrcReply {..} = intDec replyCode
|
|
|
|
buildIrcParams :: [IrcParam] -> Builder
|
|
buildIrcParams [] = mempty
|
|
buildIrcParams (p:ps) =
|
|
buildParam p <> mconcat [char8 ' ' <> buildParam p' | p' <- ps ]
|
|
|
|
buildParam :: IrcParam -> Builder
|
|
buildParam = byteString
|