{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module RON.Text.Serialize (
serializeAtom,
serializeObject,
serializeOp,
serializeOpenOp,
serializePayload,
serializeRawOp,
serializeStateFrame,
serializeString,
serializeUuid,
serializeWireFrame,
serializeWireFrames,
uuidToString,
uuidToText,
) where
import RON.Prelude hiding (elem)
import Control.Monad.State.Strict (state)
import qualified Data.Aeson as Json
import Data.ByteString.Lazy.Char8 (cons, elem, snoc)
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Map.Strict as Map
import RON.Text.Serialize.UUID (serializeUuid, serializeUuidAtom,
serializeUuidKey, uuidToString,
uuidToText)
import RON.Types (Atom (AFloat, AInteger, AString, AUuid),
ClosedOp (..), ObjectFrame (..), Op (..), Payload,
StateFrame, WireChunk (Closed, Query, Value),
WireFrame, WireReducedChunk (..),
WireStateChunk (..))
import RON.UUID (UUID, zero)
import qualified RON.UUID as UUID
serializeWireFrame :: WireFrame -> ByteStringL
serializeWireFrame :: WireFrame -> ByteStringL
serializeWireFrame =
(ByteStringL -> Char -> ByteStringL
`snoc` Char
'.') (ByteStringL -> ByteStringL)
-> (WireFrame -> ByteStringL) -> WireFrame -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteStringL] -> ByteStringL
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([ByteStringL] -> ByteStringL)
-> (WireFrame -> [ByteStringL]) -> WireFrame -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State ClosedOp [ByteStringL] -> ClosedOp -> [ByteStringL]
forall s a. State s a -> s -> a
`evalState` ClosedOp
opZero) (State ClosedOp [ByteStringL] -> [ByteStringL])
-> (WireFrame -> State ClosedOp [ByteStringL])
-> WireFrame
-> [ByteStringL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WireChunk -> StateT ClosedOp Identity ByteStringL)
-> WireFrame -> State ClosedOp [ByteStringL]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse WireChunk -> StateT ClosedOp Identity ByteStringL
serializeChunk
serializeWireFrames :: [WireFrame] -> ByteStringL
serializeWireFrames :: [WireFrame] -> ByteStringL
serializeWireFrames = (WireFrame -> ByteStringL) -> [WireFrame] -> ByteStringL
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WireFrame -> ByteStringL
serializeWireFrame
serializeChunk :: WireChunk -> State ClosedOp ByteStringL
serializeChunk :: WireChunk -> StateT ClosedOp Identity ByteStringL
serializeChunk = \case
Closed ClosedOp
op -> (ByteStringL -> ByteStringL -> ByteStringL
forall a. Semigroup a => a -> a -> a
<> ByteStringL
" ;\n") (ByteStringL -> ByteStringL)
-> StateT ClosedOp Identity ByteStringL
-> StateT ClosedOp Identity ByteStringL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClosedOp -> StateT ClosedOp Identity ByteStringL
serializeClosedOpZip ClosedOp
op
Value WireReducedChunk
chunk -> Bool -> WireReducedChunk -> StateT ClosedOp Identity ByteStringL
serializeReducedChunk Bool
False WireReducedChunk
chunk
Query WireReducedChunk
chunk -> Bool -> WireReducedChunk -> StateT ClosedOp Identity ByteStringL
serializeReducedChunk Bool
True WireReducedChunk
chunk
serializeReducedChunk :: Bool -> WireReducedChunk -> State ClosedOp ByteStringL
serializeReducedChunk :: Bool -> WireReducedChunk -> StateT ClosedOp Identity ByteStringL
serializeReducedChunk Bool
isQuery WireReducedChunk {ClosedOp
$sel:wrcHeader:WireReducedChunk :: WireReducedChunk -> ClosedOp
wrcHeader :: ClosedOp
wrcHeader, [Op]
$sel:wrcBody:WireReducedChunk :: WireReducedChunk -> [Op]
wrcBody :: [Op]
wrcBody} =
[ByteStringL] -> ByteStringL
BSL.unlines ([ByteStringL] -> ByteStringL)
-> State ClosedOp [ByteStringL]
-> StateT ClosedOp Identity ByteStringL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteStringL -> [ByteStringL] -> [ByteStringL])
-> StateT ClosedOp Identity ByteStringL
-> State ClosedOp [ByteStringL]
-> State ClosedOp [ByteStringL]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) StateT ClosedOp Identity ByteStringL
serializeHeader State ClosedOp [ByteStringL]
serializeBody
where
serializeHeader :: StateT ClosedOp Identity ByteStringL
serializeHeader = do
ByteStringL
h <- ClosedOp -> StateT ClosedOp Identity ByteStringL
serializeClosedOpZip ClosedOp
wrcHeader
ByteStringL -> StateT ClosedOp Identity ByteStringL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteStringL -> StateT ClosedOp Identity ByteStringL)
-> ByteStringL -> StateT ClosedOp Identity ByteStringL
forall a b. (a -> b) -> a -> b
$ ByteStringL -> [ByteStringL] -> ByteStringL
BSL.intercalate ByteStringL
"\t" [ByteStringL
h, if Bool
isQuery then ByteStringL
"?" else ByteStringL
"!"]
serializeBody :: State ClosedOp [ByteStringL]
serializeBody = (ClosedOp -> ([ByteStringL], ClosedOp))
-> State ClosedOp [ByteStringL]
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((ClosedOp -> ([ByteStringL], ClosedOp))
-> State ClosedOp [ByteStringL])
-> (ClosedOp -> ([ByteStringL], ClosedOp))
-> State ClosedOp [ByteStringL]
forall a b. (a -> b) -> a -> b
$ \ClosedOp {$sel:op:ClosedOp :: ClosedOp -> Op
op = Op
opBefore, UUID
$sel:objectId:ClosedOp :: ClosedOp -> UUID
$sel:reducerId:ClosedOp :: ClosedOp -> UUID
objectId :: UUID
reducerId :: UUID
..} ->
let ([ByteStringL]
body, Op
opAfter) =
(State Op [ByteStringL] -> Op -> ([ByteStringL], Op)
forall s a. State s a -> s -> (a, s)
`runState` Op
opBefore)
(State Op [ByteStringL] -> ([ByteStringL], Op))
-> State Op [ByteStringL] -> ([ByteStringL], Op)
forall a b. (a -> b) -> a -> b
$ [Op]
-> (Op -> StateT Op Identity ByteStringL) -> State Op [ByteStringL]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Op]
wrcBody
((Op -> StateT Op Identity ByteStringL) -> State Op [ByteStringL])
-> (Op -> StateT Op Identity ByteStringL) -> State Op [ByteStringL]
forall a b. (a -> b) -> a -> b
$ (ByteStringL -> ByteStringL)
-> StateT Op Identity ByteStringL -> StateT Op Identity ByteStringL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteStringL
"\t" ByteStringL -> ByteStringL -> ByteStringL
forall a. Semigroup a => a -> a -> a
<>)
(StateT Op Identity ByteStringL -> StateT Op Identity ByteStringL)
-> (Op -> StateT Op Identity ByteStringL)
-> Op
-> StateT Op Identity ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Op -> StateT Op Identity ByteStringL
serializeReducedOpZip UUID
objectId
in ([ByteStringL]
body, ClosedOp :: UUID -> UUID -> Op -> ClosedOp
ClosedOp {$sel:op:ClosedOp :: Op
op = Op
opAfter, UUID
$sel:objectId:ClosedOp :: UUID
$sel:reducerId:ClosedOp :: UUID
objectId :: UUID
reducerId :: UUID
..})
serializeRawOp :: ClosedOp -> ByteStringL
serializeRawOp :: ClosedOp -> ByteStringL
serializeRawOp ClosedOp
op = StateT ClosedOp Identity ByteStringL -> ClosedOp -> ByteStringL
forall s a. State s a -> s -> a
evalState (ClosedOp -> StateT ClosedOp Identity ByteStringL
serializeClosedOpZip ClosedOp
op) ClosedOp
opZero
serializeClosedOpZip :: ClosedOp -> State ClosedOp ByteStringL
serializeClosedOpZip :: ClosedOp -> StateT ClosedOp Identity ByteStringL
serializeClosedOpZip ClosedOp
this = (ClosedOp -> (ByteStringL, ClosedOp))
-> StateT ClosedOp Identity ByteStringL
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((ClosedOp -> (ByteStringL, ClosedOp))
-> StateT ClosedOp Identity ByteStringL)
-> (ClosedOp -> (ByteStringL, ClosedOp))
-> StateT ClosedOp Identity ByteStringL
forall a b. (a -> b) -> a -> b
$ \ClosedOp
prev ->
let prev' :: Op
prev' = ClosedOp -> Op
op ClosedOp
prev
typ :: ByteStringL
typ = UUID -> UUID -> UUID -> ByteStringL
serializeUuidKey (ClosedOp -> UUID
reducerId ClosedOp
prev) UUID
zero (ClosedOp -> UUID
reducerId ClosedOp
this)
obj :: ByteStringL
obj = UUID -> UUID -> UUID -> ByteStringL
serializeUuidKey (ClosedOp -> UUID
objectId ClosedOp
prev) (ClosedOp -> UUID
reducerId ClosedOp
this) (ClosedOp -> UUID
objectId ClosedOp
this)
evt :: ByteStringL
evt = UUID -> UUID -> UUID -> ByteStringL
serializeUuidKey (Op -> UUID
opId Op
prev') (ClosedOp -> UUID
objectId ClosedOp
this) (Op -> UUID
opId Op
this')
ref :: ByteStringL
ref = UUID -> UUID -> UUID -> ByteStringL
serializeUuidKey (Op -> UUID
refId Op
prev') (Op -> UUID
opId Op
this') (Op -> UUID
refId Op
this')
payloadAtoms :: ByteStringL
payloadAtoms = UUID -> Payload -> ByteStringL
serializePayloadZip (ClosedOp -> UUID
objectId ClosedOp
this) (Op -> Payload
payload Op
this')
in ( ByteStringL -> [ByteStringL] -> ByteStringL
BSL.intercalate ByteStringL
"\t"
([ByteStringL] -> ByteStringL) -> [ByteStringL] -> ByteStringL
forall a b. (a -> b) -> a -> b
$ Char -> ByteStringL -> [ByteStringL]
key Char
'*' ByteStringL
typ
[ByteStringL] -> [ByteStringL] -> [ByteStringL]
forall a. [a] -> [a] -> [a]
++ Char -> ByteStringL -> [ByteStringL]
key Char
'#' ByteStringL
obj
[ByteStringL] -> [ByteStringL] -> [ByteStringL]
forall a. [a] -> [a] -> [a]
++ Char -> ByteStringL -> [ByteStringL]
key Char
'@' ByteStringL
evt
[ByteStringL] -> [ByteStringL] -> [ByteStringL]
forall a. [a] -> [a] -> [a]
++ Char -> ByteStringL -> [ByteStringL]
key Char
':' ByteStringL
ref
[ByteStringL] -> [ByteStringL] -> [ByteStringL]
forall a. [a] -> [a] -> [a]
++ [ByteStringL
payloadAtoms | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteStringL -> Bool
BSL.null ByteStringL
payloadAtoms],
ClosedOp
this
)
where
this' :: Op
this' = ClosedOp -> Op
op ClosedOp
this
key :: Char -> ByteStringL -> [ByteStringL]
key Char
c ByteStringL
u = [Char
c Char -> ByteStringL -> ByteStringL
`cons` ByteStringL
u | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteStringL -> Bool
BSL.null ByteStringL
u]
serializeReducedOpZip
:: UUID
-> Op
-> State Op ByteStringL
serializeReducedOpZip :: UUID -> Op -> StateT Op Identity ByteStringL
serializeReducedOpZip UUID
opObject Op
this = (Op -> (ByteStringL, Op)) -> StateT Op Identity ByteStringL
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Op -> (ByteStringL, Op)) -> StateT Op Identity ByteStringL)
-> (Op -> (ByteStringL, Op)) -> StateT Op Identity ByteStringL
forall a b. (a -> b) -> a -> b
$ \Op
prev ->
let evt :: ByteStringL
evt = UUID -> UUID -> UUID -> ByteStringL
serializeUuidKey (Op -> UUID
opId Op
prev) UUID
opObject (Op -> UUID
opId Op
this)
ref :: ByteStringL
ref = UUID -> UUID -> UUID -> ByteStringL
serializeUuidKey (Op -> UUID
refId Op
prev) (Op -> UUID
opId Op
this) (Op -> UUID
refId Op
this)
payloadAtoms :: ByteStringL
payloadAtoms = UUID -> Payload -> ByteStringL
serializePayloadZip UUID
opObject (Op -> Payload
payload Op
this)
keys :: [ByteStringL]
keys
| ByteStringL -> Bool
BSL.null ByteStringL
evt Bool -> Bool -> Bool
&& ByteStringL -> Bool
BSL.null ByteStringL
ref = [ByteStringL
"@"]
| Bool
otherwise = Char -> ByteStringL -> [ByteStringL]
key Char
'@' ByteStringL
evt [ByteStringL] -> [ByteStringL] -> [ByteStringL]
forall a. [a] -> [a] -> [a]
++ Char -> ByteStringL -> [ByteStringL]
key Char
':' ByteStringL
ref
op :: [ByteStringL]
op = [ByteStringL]
keys [ByteStringL] -> [ByteStringL] -> [ByteStringL]
forall a. [a] -> [a] -> [a]
++ [ByteStringL
payloadAtoms | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteStringL -> Bool
BSL.null ByteStringL
payloadAtoms]
in (ByteStringL -> [ByteStringL] -> ByteStringL
BSL.intercalate ByteStringL
"\t" [ByteStringL]
op, Op
this)
where
key :: Char -> ByteStringL -> [ByteStringL]
key Char
c ByteStringL
u = [Char
c Char -> ByteStringL -> ByteStringL
`cons` ByteStringL
u | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteStringL -> Bool
BSL.null ByteStringL
u]
serializeOp :: Op -> ByteStringL
serializeOp :: Op -> ByteStringL
serializeOp Op{UUID
opId :: UUID
$sel:opId:Op :: Op -> UUID
opId, UUID
refId :: UUID
$sel:refId:Op :: Op -> UUID
refId, Payload
payload :: Payload
$sel:payload:Op :: Op -> Payload
payload} =
ByteStringL -> [ByteStringL] -> ByteStringL
BSL.intercalate ByteStringL
"\t"
[ Char
'@' Char -> ByteStringL -> ByteStringL
`cons` UUID -> ByteStringL
serializeUuid UUID
opId
, Char
':' Char -> ByteStringL -> ByteStringL
`cons` UUID -> ByteStringL
serializeUuid UUID
refId
, UUID -> Payload -> ByteStringL
serializePayloadZip UUID
opId Payload
payload
]
serializeOpenOp ::
UUID ->
Op ->
ByteStringL
serializeOpenOp :: UUID -> Op -> ByteStringL
serializeOpenOp UUID
prevId Op{UUID
opId :: UUID
$sel:opId:Op :: Op -> UUID
opId, UUID
refId :: UUID
$sel:refId:Op :: Op -> UUID
refId, Payload
payload :: Payload
$sel:payload:Op :: Op -> Payload
payload} =
ByteStringL -> [ByteStringL] -> ByteStringL
BSL.intercalate ByteStringL
"\t" ([ByteStringL] -> ByteStringL) -> [ByteStringL] -> ByteStringL
forall a b. (a -> b) -> a -> b
$ ByteStringL
idS ByteStringL -> [ByteStringL] -> [ByteStringL]
forall a. a -> [a] -> [a]
: ByteStringL
refS ByteStringL -> [ByteStringL] -> [ByteStringL]
forall a. a -> [a] -> [a]
: [ByteStringL]
payloadS
where
idS :: ByteStringL
idS
| UUID
opId UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
/= UUID -> UUID
UUID.succValue UUID
prevId = Char
'@' Char -> ByteStringL -> ByteStringL
`cons` UUID -> ByteStringL
serializeUuid UUID
opId
| Bool
otherwise = ByteStringL
""
refS :: ByteStringL
refS
| UUID
refId UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
/= UUID
prevId = Char
':' Char -> ByteStringL -> ByteStringL
`cons` UUID -> ByteStringL
serializeUuid UUID
refId
| Bool
otherwise = ByteStringL
""
payloadS :: [ByteStringL]
payloadS = [UUID -> Payload -> ByteStringL
serializePayloadZip UUID
opId Payload
payload | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Payload -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Payload
payload]
serializeAtom :: Atom -> ByteStringL
serializeAtom :: Atom -> ByteStringL
serializeAtom Atom
a = State UUID ByteStringL -> UUID -> ByteStringL
forall s a. State s a -> s -> a
evalState (Atom -> State UUID ByteStringL
serializeAtomZip Atom
a) UUID
zero
serializeAtomZip :: Atom -> State UUID ByteStringL
serializeAtomZip :: Atom -> State UUID ByteStringL
serializeAtomZip = \case
AFloat Double
f -> ByteStringL -> State UUID ByteStringL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteStringL -> State UUID ByteStringL)
-> ByteStringL -> State UUID ByteStringL
forall a b. (a -> b) -> a -> b
$ Double -> ByteStringL
serializeFloatAtom Double
f
AInteger Int64
i -> ByteStringL -> State UUID ByteStringL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteStringL -> State UUID ByteStringL)
-> ByteStringL -> State UUID ByteStringL
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteStringL
serializeIntegerAtom Int64
i
AString Text
s -> ByteStringL -> State UUID ByteStringL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteStringL -> State UUID ByteStringL)
-> ByteStringL -> State UUID ByteStringL
forall a b. (a -> b) -> a -> b
$ Text -> ByteStringL
serializeString Text
s
AUuid UUID
u -> UUID -> State UUID ByteStringL
serializeUuidAtom' UUID
u
serializeFloatAtom :: Double -> ByteStringL
serializeFloatAtom :: Double -> ByteStringL
serializeFloatAtom Double
float
| Bool
isDistinguishableFromUuid = ByteStringL
bs
| Bool
otherwise = Char
'^' Char -> ByteStringL -> ByteStringL
`cons` ByteStringL
bs
where
isDistinguishableFromUuid :: Bool
isDistinguishableFromUuid = Char
'.' Char -> ByteStringL -> Bool
`elem` ByteStringL
bs Bool -> Bool -> Bool
|| Char
'e' Char -> ByteStringL -> Bool
`elem` ByteStringL
bs Bool -> Bool -> Bool
|| Char
'E' Char -> ByteStringL -> Bool
`elem` ByteStringL
bs
bs :: ByteStringL
bs = [Char] -> ByteStringL
BSL.pack ([Char] -> ByteStringL) -> [Char] -> ByteStringL
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a s. (Show a, IsString s) => a -> s
show Double
float
serializeIntegerAtom :: Int64 -> ByteStringL
serializeIntegerAtom :: Int64 -> ByteStringL
serializeIntegerAtom = [Char] -> ByteStringL
BSL.pack ([Char] -> ByteStringL)
-> (Int64 -> [Char]) -> Int64 -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> [Char]
forall a s. (Show a, IsString s) => a -> s
show
serializeString :: Text -> ByteStringL
serializeString :: Text -> ByteStringL
serializeString =
ByteStringL -> ByteStringL
wrapSingleQuotes (ByteStringL -> ByteStringL)
-> (Text -> ByteStringL) -> Text -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringL -> ByteStringL
escapeApostrophe (ByteStringL -> ByteStringL)
-> (Text -> ByteStringL) -> Text -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringL -> ByteStringL
stripDoubleQuotes (ByteStringL -> ByteStringL)
-> (Text -> ByteStringL) -> Text -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteStringL
forall a. ToJSON a => a -> ByteStringL
Json.encode
where
wrapSingleQuotes :: ByteStringL -> ByteStringL
wrapSingleQuotes = (ByteStringL -> Char -> ByteStringL
`snoc` Char
'\'') (ByteStringL -> ByteStringL)
-> (ByteStringL -> ByteStringL) -> ByteStringL -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteStringL -> ByteStringL
cons Char
'\''
stripDoubleQuotes :: ByteStringL -> ByteStringL
stripDoubleQuotes = ByteStringL -> ByteStringL
BSL.init (ByteStringL -> ByteStringL)
-> (ByteStringL -> ByteStringL) -> ByteStringL -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringL -> ByteStringL
BSL.tail
escapeApostrophe :: ByteStringL -> ByteStringL
escapeApostrophe ByteStringL
s
| ByteStringL -> Bool
BSL.null ByteStringL
s2 = ByteStringL
s1
| Bool
otherwise = ByteStringL
s1 ByteStringL -> ByteStringL -> ByteStringL
forall a. Semigroup a => a -> a -> a
<> ByteStringL
"\\'" ByteStringL -> ByteStringL -> ByteStringL
forall a. Semigroup a => a -> a -> a
<> ByteStringL -> ByteStringL
escapeApostrophe (ByteStringL -> ByteStringL
BSL.tail ByteStringL
s2)
where
(ByteStringL
s1, ByteStringL
s2) = (Char -> Bool) -> ByteStringL -> (ByteStringL, ByteStringL)
BSL.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') ByteStringL
s
serializeUuidAtom' :: UUID -> State UUID ByteStringL
serializeUuidAtom' :: UUID -> State UUID ByteStringL
serializeUuidAtom' UUID
u =
(UUID -> (ByteStringL, UUID)) -> State UUID ByteStringL
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((UUID -> (ByteStringL, UUID)) -> State UUID ByteStringL)
-> (UUID -> (ByteStringL, UUID)) -> State UUID ByteStringL
forall a b. (a -> b) -> a -> b
$ \UUID
prev -> (Char -> ByteStringL -> ByteStringL
cons Char
'>' (ByteStringL -> ByteStringL) -> ByteStringL -> ByteStringL
forall a b. (a -> b) -> a -> b
$ UUID -> UUID -> ByteStringL
serializeUuidAtom UUID
prev UUID
u, UUID
u)
serializePayloadZip
:: UUID
-> Payload
-> ByteStringL
serializePayloadZip :: UUID -> Payload -> ByteStringL
serializePayloadZip UUID
prev =
[ByteStringL] -> ByteStringL
BSL.unwords ([ByteStringL] -> ByteStringL)
-> (Payload -> [ByteStringL]) -> Payload -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State UUID [ByteStringL] -> UUID -> [ByteStringL]
forall s a. State s a -> s -> a
`evalState` UUID
prev) (State UUID [ByteStringL] -> [ByteStringL])
-> (Payload -> State UUID [ByteStringL])
-> Payload
-> [ByteStringL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Atom -> State UUID ByteStringL)
-> Payload -> State UUID [ByteStringL]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Atom -> State UUID ByteStringL
serializeAtomZip
serializePayload :: Payload -> ByteStringL
serializePayload :: Payload -> ByteStringL
serializePayload = UUID -> Payload -> ByteStringL
serializePayloadZip UUID
UUID.zero
serializeStateFrame :: StateFrame -> ByteStringL
serializeStateFrame :: StateFrame -> ByteStringL
serializeStateFrame = WireFrame -> ByteStringL
serializeWireFrame (WireFrame -> ByteStringL)
-> (StateFrame -> WireFrame) -> StateFrame -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UUID, WireStateChunk) -> WireChunk)
-> [(UUID, WireStateChunk)] -> WireFrame
forall a b. (a -> b) -> [a] -> [b]
map (UUID, WireStateChunk) -> WireChunk
wrapChunk ([(UUID, WireStateChunk)] -> WireFrame)
-> (StateFrame -> [(UUID, WireStateChunk)])
-> StateFrame
-> WireFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateFrame -> [(UUID, WireStateChunk)]
forall k a. Map k a -> [(k, a)]
Map.assocs
where
wrapChunk :: (UUID, WireStateChunk) -> WireChunk
wrapChunk (UUID
objectId, WireStateChunk {UUID
$sel:stateType:WireStateChunk :: WireStateChunk -> UUID
stateType :: UUID
stateType, [Op]
$sel:stateBody:WireStateChunk :: WireStateChunk -> [Op]
stateBody :: [Op]
stateBody}) =
WireReducedChunk -> WireChunk
Value WireReducedChunk :: ClosedOp -> [Op] -> WireReducedChunk
WireReducedChunk
{ $sel:wrcHeader:WireReducedChunk :: ClosedOp
wrcHeader = ClosedOp
opZero {$sel:reducerId:ClosedOp :: UUID
reducerId = UUID
stateType, UUID
objectId :: UUID
$sel:objectId:ClosedOp :: UUID
objectId},
$sel:wrcBody:WireReducedChunk :: [Op]
wrcBody = [Op]
stateBody
}
serializeObject :: ObjectFrame a -> (UUID, ByteStringL)
serializeObject :: ObjectFrame a -> (UUID, ByteStringL)
serializeObject (ObjectFrame UUID
oid StateFrame
frame) = (UUID
oid, StateFrame -> ByteStringL
serializeStateFrame StateFrame
frame)
opZero :: ClosedOp
opZero :: ClosedOp
opZero = ClosedOp :: UUID -> UUID -> Op -> ClosedOp
ClosedOp
{ $sel:reducerId:ClosedOp :: UUID
reducerId = UUID
zero
, $sel:objectId:ClosedOp :: UUID
objectId = UUID
zero
, $sel:op:ClosedOp :: Op
op = Op :: UUID -> UUID -> Payload -> Op
Op{$sel:opId:Op :: UUID
opId = UUID
zero, $sel:refId:Op :: UUID
refId = UUID
zero, $sel:payload:Op :: Payload
payload = []}
}