{-# LANGUAGE OverloadedStrings #-}
module Network.Zyre2.ZMsg
( ZMsg (..),
ZFrame,
pop,
pushText,
addText,
popText,
pushMem,
addMem,
popMem,
mkFrame,
frameData,
msgWhisper,
msgShout,
)
where
import Control.Exception (throw)
import qualified Data.Bifunctor
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BSC
import qualified Data.List as List
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
import Network.Zyre2.Types (ZyreException (ZyreMsgDontSupportFramesException))
data ZMsg
=
Enter
{
ZMsg -> Text
_zmsgFromNode :: Text,
ZMsg -> Text
_zmsgName :: Text,
:: [(Text, Text)],
ZMsg -> Text
_zmsgIpPort :: Text
}
|
Evasive
{ _zmsgFromNode :: Text,
_zmsgName :: Text
}
|
Silent
{ _zmsgFromNode :: Text,
_zmsgName :: Text
}
|
Exit
{ _zmsgFromNode :: Text,
_zmsgName :: Text
}
|
Join
{ _zmsgFromNode :: Text,
_zmsgName :: Text,
ZMsg -> Text
_zmsgGroupName :: Text
}
|
Leave
{ _zmsgFromNode :: Text,
_zmsgName :: Text,
_zmsgGroupName :: Text
}
|
Whisper
{ _zmsgFromNode :: Text,
_zmsgName :: Text,
ZMsg -> [ZFrame]
_zmsgMessage :: [ZFrame]
}
|
Shout
{ _zmsgFromNode :: Text,
_zmsgName :: Text,
_zmsgGroupName :: Text,
_zmsgMessage :: [ZFrame]
}
|
Stop
deriving (Int -> ZMsg -> ShowS
[ZMsg] -> ShowS
ZMsg -> String
(Int -> ZMsg -> ShowS)
-> (ZMsg -> String) -> ([ZMsg] -> ShowS) -> Show ZMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZMsg] -> ShowS
$cshowList :: [ZMsg] -> ShowS
show :: ZMsg -> String
$cshow :: ZMsg -> String
showsPrec :: Int -> ZMsg -> ShowS
$cshowsPrec :: Int -> ZMsg -> ShowS
Show)
newtype ZFrame = ZFrame ByteString
instance Show ZFrame where
show :: ZFrame -> String
show (ZFrame ByteString
_) = String
"ZFrame[Bytes]"
pushFrame :: ZMsg -> ZFrame -> ZMsg
pushFrame :: ZMsg -> ZFrame -> ZMsg
pushFrame zmsg :: ZMsg
zmsg@Whisper {} ZFrame
zframe = ZMsg
zmsg {_zmsgMessage :: [ZFrame]
_zmsgMessage = ZFrame
zframe ZFrame -> [ZFrame] -> [ZFrame]
forall a. a -> [a] -> [a]
: ZMsg -> [ZFrame]
_zmsgMessage ZMsg
zmsg}
pushFrame zmsg :: ZMsg
zmsg@Shout {} ZFrame
zframe = ZMsg
zmsg {_zmsgMessage :: [ZFrame]
_zmsgMessage = ZFrame
zframe ZFrame -> [ZFrame] -> [ZFrame]
forall a. a -> [a] -> [a]
: ZMsg -> [ZFrame]
_zmsgMessage ZMsg
zmsg}
pushFrame ZMsg
_ ZFrame
_ = ZyreException -> ZMsg
forall a e. Exception e => e -> a
throw ZyreException
ZyreMsgDontSupportFramesException
addFrame :: ZMsg -> ZFrame -> ZMsg
addFrame :: ZMsg -> ZFrame -> ZMsg
addFrame zmsg :: ZMsg
zmsg@Whisper {} ZFrame
zframe = ZMsg
zmsg {_zmsgMessage :: [ZFrame]
_zmsgMessage = ZMsg -> [ZFrame]
_zmsgMessage ZMsg
zmsg [ZFrame] -> [ZFrame] -> [ZFrame]
forall a. Semigroup a => a -> a -> a
<> [ZFrame
zframe]}
addFrame zmsg :: ZMsg
zmsg@Shout {} ZFrame
zframe = ZMsg
zmsg {_zmsgMessage :: [ZFrame]
_zmsgMessage = ZMsg -> [ZFrame]
_zmsgMessage ZMsg
zmsg [ZFrame] -> [ZFrame] -> [ZFrame]
forall a. Semigroup a => a -> a -> a
<> [ZFrame
zframe]}
addFrame ZMsg
_ ZFrame
_ = ZyreException -> ZMsg
forall a e. Exception e => e -> a
throw ZyreException
ZyreMsgDontSupportFramesException
append :: ZMsg -> ZFrame -> ZMsg
append :: ZMsg -> ZFrame -> ZMsg
append = ZMsg -> ZFrame -> ZMsg
addFrame
prepend :: ZMsg -> ZFrame -> ZMsg
prepend :: ZMsg -> ZFrame -> ZMsg
prepend = ZMsg -> ZFrame -> ZMsg
pushFrame
pop :: ZMsg -> (Maybe ZFrame, ZMsg)
pop :: ZMsg -> (Maybe ZFrame, ZMsg)
pop zmsg :: ZMsg
zmsg@Whisper {} = ZMsg -> (Maybe ZFrame, ZMsg)
_popMsg ZMsg
zmsg
pop zmsg :: ZMsg
zmsg@Shout {} = ZMsg -> (Maybe ZFrame, ZMsg)
_popMsg ZMsg
zmsg
pop ZMsg
_ = ZyreException -> (Maybe ZFrame, ZMsg)
forall a e. Exception e => e -> a
throw ZyreException
ZyreMsgDontSupportFramesException
_popMsg :: ZMsg -> (Maybe ZFrame, ZMsg)
_popMsg :: ZMsg -> (Maybe ZFrame, ZMsg)
_popMsg ZMsg
m = case ZMsg -> [ZFrame]
_zmsgMessage ZMsg
m of
[] -> (Maybe ZFrame
forall a. Maybe a
Nothing, ZMsg
m)
[ZFrame
x] -> (ZFrame -> Maybe ZFrame
forall a. a -> Maybe a
Just ZFrame
x, ZMsg
m {_zmsgMessage :: [ZFrame]
_zmsgMessage = []})
(ZFrame
x : [ZFrame]
_) -> (ZFrame -> Maybe ZFrame
forall a. a -> Maybe a
Just ZFrame
x, ZMsg
m {_zmsgMessage :: [ZFrame]
_zmsgMessage = [ZFrame] -> [ZFrame]
forall a. [a] -> [a]
List.tail (ZMsg -> [ZFrame]
_zmsgMessage ZMsg
m)})
pushText :: Text -> ZMsg -> ZMsg
pushText :: Text -> ZMsg -> ZMsg
pushText Text
str ZMsg
zmsg = ZMsg
zmsg ZMsg -> ZFrame -> ZMsg
`pushFrame` ByteString -> ZFrame
ZFrame (String -> ByteString
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
str))
addText :: Text -> ZMsg -> ZMsg
addText :: Text -> ZMsg -> ZMsg
addText Text
str ZMsg
zmsg = ZMsg
zmsg ZMsg -> ZFrame -> ZMsg
`addFrame` ByteString -> ZFrame
ZFrame (String -> ByteString
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
str))
pushMem :: ByteString -> ZMsg -> ZMsg
pushMem :: ByteString -> ZMsg -> ZMsg
pushMem ByteString
bs ZMsg
zmsg = ZMsg
zmsg ZMsg -> ZFrame -> ZMsg
`pushFrame` ByteString -> ZFrame
ZFrame ByteString
bs
addMem :: ByteString -> ZMsg -> ZMsg
addMem :: ByteString -> ZMsg -> ZMsg
addMem ByteString
bs ZMsg
zmsg = ZMsg
zmsg ZMsg -> ZFrame -> ZMsg
`addFrame` ByteString -> ZFrame
ZFrame ByteString
bs
popText :: ZMsg -> (Maybe Text, ZMsg)
popText :: ZMsg -> (Maybe Text, ZMsg)
popText ZMsg
zmsg =
(Maybe ZFrame -> Maybe Text)
-> (Maybe ZFrame, ZMsg) -> (Maybe Text, ZMsg)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
((ZFrame -> Text) -> Maybe ZFrame -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ZFrame ByteString
bs) -> String -> Text
T.pack (ByteString -> String
BSC.unpack ByteString
bs)))
(ZMsg -> (Maybe ZFrame, ZMsg)
pop ZMsg
zmsg)
popMem :: ZMsg -> (Maybe ByteString, ZMsg)
popMem :: ZMsg -> (Maybe ByteString, ZMsg)
popMem ZMsg
zmsg =
(Maybe ZFrame -> Maybe ByteString)
-> (Maybe ZFrame, ZMsg) -> (Maybe ByteString, ZMsg)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
((ZFrame -> ByteString) -> Maybe ZFrame -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ZFrame ByteString
bs) -> ByteString
bs))
(ZMsg -> (Maybe ZFrame, ZMsg)
pop ZMsg
zmsg)
mkFrame :: ByteString -> ZFrame
mkFrame :: ByteString -> ZFrame
mkFrame = ByteString -> ZFrame
ZFrame
frameData :: ZFrame -> ByteString
frameData :: ZFrame -> ByteString
frameData (ZFrame ByteString
bs) = ByteString
bs
msgWhisper :: ZMsg
msgWhisper :: ZMsg
msgWhisper =
Whisper :: Text -> Text -> [ZFrame] -> ZMsg
Whisper
{ _zmsgFromNode :: Text
_zmsgFromNode = Text
"Not set",
_zmsgName :: Text
_zmsgName = Text
"Not set",
_zmsgMessage :: [ZFrame]
_zmsgMessage = []
}
msgShout :: ZMsg
msgShout :: ZMsg
msgShout =
Shout :: Text -> Text -> Text -> [ZFrame] -> ZMsg
Shout
{ _zmsgFromNode :: Text
_zmsgFromNode = Text
"Not set",
_zmsgName :: Text
_zmsgName = Text
"Not set",
_zmsgGroupName :: Text
_zmsgGroupName = Text
"Not set",
_zmsgMessage :: [ZFrame]
_zmsgMessage = []
}