{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module RON.Text.Parse (
parseAtom,
parseObject,
parseOp,
parseOpenFrame,
parseOpenOp,
parseStateChunk,
parseStateFrame,
parseString,
parseUuid,
parseUuidKey,
parseUuidAtom,
parseWireFrame,
parseWireFrames,
uuidFromString,
uuidFromText,
) where
import RON.Prelude hiding (takeWhile)
import Attoparsec.Extra (Parser, char, definiteDouble, endOfInputEx,
isSuccessful, label, manyTill, parseOnlyL,
satisfy, (<+>), (??))
import qualified Data.Aeson as Json
import Data.Attoparsec.ByteString (takeWhile1)
import Data.Attoparsec.ByteString.Char8 (anyChar, decimal, double,
signed, skipSpace, takeWhile)
import Data.Bits (complement, shiftL, shiftR, (.&.), (.|.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, isNothing)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified RON.Base64 as Base64
import RON.Types (Atom (AFloat, AInteger, AString, AUuid),
ClosedOp (..), ObjectFrame (ObjectFrame), Op (..),
OpTerm (TClosed, THeader, TQuery, TReduced),
Payload, StateFrame, UUID (UUID),
WireChunk (Closed, Query, Value), WireFrame,
WireReducedChunk (..), WireStateChunk (..))
import RON.Util.Word (Word2, Word4, Word60, b00, b0000, b01, b10, b11,
ls60, safeCast)
import RON.UUID (UuidFields (..))
import qualified RON.UUID as UUID
parseWireFrame :: ByteStringL -> Either String WireFrame
parseWireFrame :: ByteStringL -> Either String WireFrame
parseWireFrame = Parser WireFrame -> ByteStringL -> Either String WireFrame
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL Parser WireFrame
frame
chunksTill :: Parser () -> Parser [WireChunk]
chunksTill :: Parser () -> Parser WireFrame
chunksTill Parser ()
end = String -> Parser WireFrame -> Parser WireFrame
forall a. String -> Parser a -> Parser a
label String
"[WireChunk]" (Parser WireFrame -> Parser WireFrame)
-> Parser WireFrame -> Parser WireFrame
forall a b. (a -> b) -> a -> b
$ ClosedOp -> Parser WireFrame
go ClosedOp
closedOpZero
where
go :: ClosedOp -> Parser WireFrame
go ClosedOp
prev = do
Parser ()
skipSpace
Bool
atEnd <- Parser () -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => f a -> f Bool
isSuccessful Parser ()
end
if Bool
atEnd then
WireFrame -> Parser WireFrame
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else do
(WireChunk
ch, ClosedOp
lastOp) <- ClosedOp -> Parser (WireChunk, ClosedOp)
pChunk ClosedOp
prev
(WireChunk
ch WireChunk -> WireFrame -> WireFrame
forall a. a -> [a] -> [a]
:) (WireFrame -> WireFrame) -> Parser WireFrame -> Parser WireFrame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClosedOp -> Parser WireFrame
go ClosedOp
lastOp
pChunk :: ClosedOp -> Parser (WireChunk, ClosedOp)
pChunk :: ClosedOp -> Parser (WireChunk, ClosedOp)
pChunk ClosedOp
prev = String
-> Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall a. String -> Parser a -> Parser a
label String
"WireChunk" (Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp))
-> Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall a b. (a -> b) -> a -> b
$ ClosedOp -> Parser (WireChunk, ClosedOp)
wireReducedChunk ClosedOp
prev Parser (WireChunk, ClosedOp)
-> Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall a. Parser a -> Parser a -> Parser a
<+> ClosedOp -> Parser (WireChunk, ClosedOp)
chunkClosed ClosedOp
prev
chunkClosed :: ClosedOp -> Parser (WireChunk, ClosedOp)
chunkClosed :: ClosedOp -> Parser (WireChunk, ClosedOp)
chunkClosed ClosedOp
prev = String
-> Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall a. String -> Parser a -> Parser a
label String
"WireChunk-closed" (Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp))
-> Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall a b. (a -> b) -> a -> b
$ do
Parser ()
skipSpace
(Bool
_, ClosedOp
x) <- ClosedOp -> Parser (Bool, ClosedOp)
closedOp ClosedOp
prev
Parser ()
skipSpace
Parser ByteString Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ())
-> Parser ByteString Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
char Char
';'
(WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClosedOp -> WireChunk
Closed ClosedOp
x, ClosedOp
x)
wireReducedChunk :: ClosedOp -> Parser (WireChunk, ClosedOp)
wireReducedChunk :: ClosedOp -> Parser (WireChunk, ClosedOp)
wireReducedChunk ClosedOp
prev = String
-> Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall a. String -> Parser a -> Parser a
label String
"WireChunk-reduced" (Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp))
-> Parser (WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall a b. (a -> b) -> a -> b
$ do
(ClosedOp
wrcHeader, Bool
isQuery) <- ClosedOp -> Parser (ClosedOp, Bool)
header ClosedOp
prev
let reducedOps :: Op -> Parser ByteString [Op]
reducedOps Op
y = do
Parser ()
skipSpace
(Bool
isNotEmpty, Op
x) <- UUID -> Op -> Parser (Bool, Op)
reducedOp (ClosedOp -> UUID
objectId ClosedOp
wrcHeader) Op
y
Maybe OpTerm
t <- Parser ByteString OpTerm -> Parser ByteString (Maybe OpTerm)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString OpTerm
term
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe OpTerm
t Maybe OpTerm -> Maybe OpTerm -> Bool
forall a. Eq a => a -> a -> Bool
== OpTerm -> Maybe OpTerm
forall a. a -> Maybe a
Just OpTerm
TReduced Bool -> Bool -> Bool
|| Maybe OpTerm -> Bool
forall a. Maybe a -> Bool
isNothing Maybe OpTerm
t) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"reduced op may end with `,` only"
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
isNotEmpty Bool -> Bool -> Bool
|| Maybe OpTerm
t Maybe OpTerm -> Maybe OpTerm -> Bool
forall a. Eq a => a -> a -> Bool
== OpTerm -> Maybe OpTerm
forall a. a -> Maybe a
Just OpTerm
TReduced) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty reduced op"
[Op]
xs <- Op -> Parser ByteString [Op]
reducedOps Op
x Parser ByteString [Op]
-> Parser ByteString [Op] -> Parser ByteString [Op]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString [Op]
forall a. Parser ByteString [a]
stop
[Op] -> Parser ByteString [Op]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Op] -> Parser ByteString [Op]) -> [Op] -> Parser ByteString [Op]
forall a b. (a -> b) -> a -> b
$ Op
x Op -> [Op] -> [Op]
forall a. a -> [a] -> [a]
: [Op]
xs
[Op]
wrcBody <- Op -> Parser ByteString [Op]
reducedOps (ClosedOp -> Op
op ClosedOp
wrcHeader) Parser ByteString [Op]
-> Parser ByteString [Op] -> Parser ByteString [Op]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString [Op]
forall a. Parser ByteString [a]
stop
let lastOp :: Op
lastOp = Op -> [Op] -> Op
forall a. a -> [a] -> a
lastDef (ClosedOp -> Op
op ClosedOp
wrcHeader) [Op]
wrcBody
wrap :: Op -> ClosedOp
wrap Op
op = ClosedOp :: UUID -> UUID -> Op -> ClosedOp
ClosedOp
{$sel:reducerId:ClosedOp :: UUID
reducerId = ClosedOp -> UUID
reducerId ClosedOp
wrcHeader, $sel:objectId:ClosedOp :: UUID
objectId = ClosedOp -> UUID
objectId ClosedOp
wrcHeader, Op
op :: Op
$sel:op:ClosedOp :: Op
op}
(WireChunk, ClosedOp) -> Parser (WireChunk, ClosedOp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((if Bool
isQuery then WireReducedChunk -> WireChunk
Query else WireReducedChunk -> WireChunk
Value) WireReducedChunk :: ClosedOp -> [Op] -> WireReducedChunk
WireReducedChunk{[Op]
ClosedOp
$sel:wrcBody:WireReducedChunk :: [Op]
$sel:wrcHeader:WireReducedChunk :: ClosedOp
wrcBody :: [Op]
wrcHeader :: ClosedOp
..}, Op -> ClosedOp
wrap Op
lastOp)
where
stop :: Parser ByteString [a]
stop = [a] -> Parser ByteString [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseStateChunk :: ByteStringL -> Either String WireStateChunk
parseStateChunk :: ByteStringL -> Either String WireStateChunk
parseStateChunk = Parser WireStateChunk
-> ByteStringL -> Either String WireStateChunk
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser WireStateChunk
-> ByteStringL -> Either String WireStateChunk)
-> Parser WireStateChunk
-> ByteStringL
-> Either String WireStateChunk
forall a b. (a -> b) -> a -> b
$ do
(Value WireReducedChunk
value, ClosedOp
_) <- ClosedOp -> Parser (WireChunk, ClosedOp)
wireReducedChunk ClosedOp
closedOpZero
let
WireReducedChunk{ClosedOp
wrcHeader :: ClosedOp
$sel:wrcHeader:WireReducedChunk :: WireReducedChunk -> ClosedOp
wrcHeader, [Op]
wrcBody :: [Op]
$sel:wrcBody:WireReducedChunk :: WireReducedChunk -> [Op]
wrcBody} = WireReducedChunk
value
ClosedOp{UUID
reducerId :: UUID
$sel:reducerId:ClosedOp :: ClosedOp -> UUID
reducerId} = ClosedOp
wrcHeader
WireStateChunk -> Parser WireStateChunk
forall (f :: * -> *) a. Applicative f => a -> f a
pure WireStateChunk :: UUID -> [Op] -> WireStateChunk
WireStateChunk{$sel:stateType:WireStateChunk :: UUID
stateType = UUID
reducerId, $sel:stateBody:WireStateChunk :: [Op]
stateBody = [Op]
wrcBody}
frame :: Parser WireFrame
frame :: Parser WireFrame
frame = String -> Parser WireFrame -> Parser WireFrame
forall a. String -> Parser a -> Parser a
label String
"WireFrame" (Parser WireFrame -> Parser WireFrame)
-> Parser WireFrame -> Parser WireFrame
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser WireFrame
chunksTill (Parser ()
endOfFrame Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
endOfInputEx)
parseWireFrames :: ByteStringL -> Either String [WireFrame]
parseWireFrames :: ByteStringL -> Either String [WireFrame]
parseWireFrames = Parser [WireFrame] -> ByteStringL -> Either String [WireFrame]
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser [WireFrame] -> ByteStringL -> Either String [WireFrame])
-> Parser [WireFrame] -> ByteStringL -> Either String [WireFrame]
forall a b. (a -> b) -> a -> b
$ Parser WireFrame -> Parser () -> Parser [WireFrame]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser WireFrame
frameInStream Parser ()
endOfInputEx
frameInStream :: Parser WireFrame
frameInStream :: Parser WireFrame
frameInStream = String -> Parser WireFrame -> Parser WireFrame
forall a. String -> Parser a -> Parser a
label String
"WireFrame-stream" (Parser WireFrame -> Parser WireFrame)
-> Parser WireFrame -> Parser WireFrame
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser WireFrame
chunksTill Parser ()
endOfFrame
parseOp :: ByteStringL -> Either String ClosedOp
parseOp :: ByteStringL -> Either String ClosedOp
parseOp = Parser ClosedOp -> ByteStringL -> Either String ClosedOp
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser ClosedOp -> ByteStringL -> Either String ClosedOp)
-> Parser ClosedOp -> ByteStringL -> Either String ClosedOp
forall a b. (a -> b) -> a -> b
$ do
(Bool
_, ClosedOp
x) <- ClosedOp -> Parser (Bool, ClosedOp)
closedOp ClosedOp
closedOpZero Parser (Bool, ClosedOp) -> Parser () -> Parser (Bool, ClosedOp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser (Bool, ClosedOp) -> Parser () -> Parser (Bool, ClosedOp)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfInputEx
ClosedOp -> Parser ClosedOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClosedOp
x
parseUuid :: ByteStringL -> Either String UUID
parseUuid :: ByteStringL -> Either String UUID
parseUuid = Parser UUID -> ByteStringL -> Either String UUID
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser UUID -> ByteStringL -> Either String UUID)
-> Parser UUID -> ByteStringL -> Either String UUID
forall a b. (a -> b) -> a -> b
$
UUID -> UUID -> UuidZipBase -> Parser UUID
uuid UUID
UUID.zero UUID
UUID.zero UuidZipBase
PrevOpSameKey Parser UUID -> Parser () -> Parser UUID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser UUID -> Parser () -> Parser UUID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfInputEx
uuidFromText :: Text -> Either String UUID
uuidFromText :: Text -> Either String UUID
uuidFromText = ByteStringL -> Either String UUID
parseUuid (ByteStringL -> Either String UUID)
-> (Text -> ByteStringL) -> Text -> Either String UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStringL
BSL.fromStrict (ByteString -> ByteStringL)
-> (Text -> ByteString) -> Text -> ByteStringL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
uuidFromString :: String -> Either String UUID
uuidFromString :: String -> Either String UUID
uuidFromString = Text -> Either String UUID
uuidFromText (Text -> Either String UUID)
-> (String -> Text) -> String -> Either String UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
parseUuidKey
:: UUID
-> UUID
-> ByteStringL
-> Either String UUID
parseUuidKey :: UUID -> UUID -> ByteStringL -> Either String UUID
parseUuidKey UUID
prevKey UUID
prev =
Parser UUID -> ByteStringL -> Either String UUID
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser UUID -> ByteStringL -> Either String UUID)
-> Parser UUID -> ByteStringL -> Either String UUID
forall a b. (a -> b) -> a -> b
$ UUID -> UUID -> UuidZipBase -> Parser UUID
uuid UUID
prevKey UUID
prev UuidZipBase
PrevOpSameKey Parser UUID -> Parser () -> Parser UUID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser UUID -> Parser () -> Parser UUID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfInputEx
parseUuidAtom
:: UUID
-> ByteStringL
-> Either String UUID
parseUuidAtom :: UUID -> ByteStringL -> Either String UUID
parseUuidAtom UUID
prev = Parser UUID -> ByteStringL -> Either String UUID
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser UUID -> ByteStringL -> Either String UUID)
-> Parser UUID -> ByteStringL -> Either String UUID
forall a b. (a -> b) -> a -> b
$ UUID -> Parser UUID
uuidAtom UUID
prev Parser UUID -> Parser () -> Parser UUID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser UUID -> Parser () -> Parser UUID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfInputEx
endOfFrame :: Parser ()
endOfFrame :: Parser ()
endOfFrame = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"end of frame" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Char -> Parser ())
-> Parser ByteString Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser () -> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString Char
char Char
'.'
closedOp :: ClosedOp -> Parser (Bool, ClosedOp)
closedOp :: ClosedOp -> Parser (Bool, ClosedOp)
closedOp ClosedOp
prev = String -> Parser (Bool, ClosedOp) -> Parser (Bool, ClosedOp)
forall a. String -> Parser a -> Parser a
label String
"ClosedOp-cont" (Parser (Bool, ClosedOp) -> Parser (Bool, ClosedOp))
-> Parser (Bool, ClosedOp) -> Parser (Bool, ClosedOp)
forall a b. (a -> b) -> a -> b
$ do
(Bool
hasTyp, UUID
reducerId) <- String -> Char -> UUID -> UUID -> Parser (Bool, UUID)
key String
"reducer" Char
'*' (ClosedOp -> UUID
reducerId ClosedOp
prev) UUID
UUID.zero
(Bool
hasObj, UUID
objectId) <- String -> Char -> UUID -> UUID -> Parser (Bool, UUID)
key String
"object" Char
'#' (ClosedOp -> UUID
objectId ClosedOp
prev) UUID
reducerId
(Bool
hasEvt, UUID
opId) <- String -> Char -> UUID -> UUID -> Parser (Bool, UUID)
key String
"opId" Char
'@' (Op -> UUID
opId Op
prev') UUID
objectId
(Bool
hasRef, UUID
refId) <- String -> Char -> UUID -> UUID -> Parser (Bool, UUID)
key String
"ref" Char
':' (Op -> UUID
refId Op
prev') UUID
opId
Payload
payload <- UUID -> Parser Payload
pPayload UUID
objectId
let op :: Op
op = Op :: UUID -> UUID -> Payload -> Op
Op{Payload
UUID
$sel:payload:Op :: Payload
payload :: Payload
$sel:refId:Op :: UUID
refId :: UUID
$sel:opId:Op :: UUID
opId :: UUID
..}
(Bool, ClosedOp) -> Parser (Bool, ClosedOp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Bool
hasTyp Bool -> Bool -> Bool
|| Bool
hasObj Bool -> Bool -> Bool
|| Bool
hasEvt Bool -> Bool -> Bool
|| Bool
hasRef Bool -> Bool -> Bool
|| Bool -> Bool
not (Payload -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Payload
payload)
, ClosedOp :: UUID -> UUID -> Op -> ClosedOp
ClosedOp{UUID
Op
op :: Op
objectId :: UUID
reducerId :: UUID
$sel:reducerId:ClosedOp :: UUID
$sel:op:ClosedOp :: Op
$sel:objectId:ClosedOp :: UUID
..}
)
where
prev' :: Op
prev' = ClosedOp -> Op
op ClosedOp
prev
reducedOp :: UUID -> Op -> Parser (Bool, Op)
reducedOp :: UUID -> Op -> Parser (Bool, Op)
reducedOp UUID
opObject Op
prev = String -> Parser (Bool, Op) -> Parser (Bool, Op)
forall a. String -> Parser a -> Parser a
label String
"Op-reduced-cont" (Parser (Bool, Op) -> Parser (Bool, Op))
-> Parser (Bool, Op) -> Parser (Bool, Op)
forall a b. (a -> b) -> a -> b
$ do
(Bool
hasEvt, UUID
opId) <- String -> Char -> UUID -> UUID -> Parser (Bool, UUID)
key String
"event" Char
'@' (Op -> UUID
opId Op
prev) UUID
opObject
(Bool
hasRef, UUID
refId) <- String -> Char -> UUID -> UUID -> Parser (Bool, UUID)
key String
"ref" Char
':' (Op -> UUID
refId Op
prev) UUID
opId
Payload
payload <- UUID -> Parser Payload
pPayload UUID
opObject
let op :: Op
op = Op :: UUID -> UUID -> Payload -> Op
Op{UUID
opId :: UUID
$sel:opId:Op :: UUID
opId, UUID
refId :: UUID
$sel:refId:Op :: UUID
refId, Payload
payload :: Payload
$sel:payload:Op :: Payload
payload}
(Bool, Op) -> Parser (Bool, Op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
hasEvt Bool -> Bool -> Bool
|| Bool
hasRef Bool -> Bool -> Bool
|| Bool -> Bool
not (Payload -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Payload
payload), Op
op)
openOp :: UUID -> Parser Op
openOp :: UUID -> Parser Op
openOp UUID
prev =
String -> Parser Op -> Parser Op
forall a. String -> Parser a -> Parser a
label String
"Op-open-cont" (Parser Op -> Parser Op) -> Parser Op -> Parser Op
forall a b. (a -> b) -> a -> b
$ do
UUID
opId <- String -> Char -> Parser UUID
openKey String
"event" Char
'@' Parser UUID -> Parser UUID -> Parser UUID
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> UUID
UUID.succValue UUID
prev)
UUID
refId <- String -> Char -> Parser UUID
openKey String
"ref" Char
':' Parser UUID -> Parser UUID -> Parser UUID
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure UUID
prev
Payload
payload <- UUID -> Parser Payload
pPayload UUID
opId
OpTerm
t <- Parser ByteString OpTerm
term
Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ OpTerm
t OpTerm -> OpTerm -> Bool
forall a. Eq a => a -> a -> Bool
== OpTerm
TReduced Bool -> Bool -> Bool
|| OpTerm
t OpTerm -> OpTerm -> Bool
forall a. Eq a => a -> a -> Bool
== OpTerm
TClosed
Op -> Parser Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op :: UUID -> UUID -> Payload -> Op
Op{UUID
opId :: UUID
$sel:opId:Op :: UUID
opId, UUID
refId :: UUID
$sel:refId:Op :: UUID
refId, Payload
payload :: Payload
$sel:payload:Op :: Payload
payload}
key :: String -> Char -> UUID -> UUID -> Parser (Bool, UUID)
key :: String -> Char -> UUID -> UUID -> Parser (Bool, UUID)
key String
name Char
keyChar UUID
prevOpSameKey UUID
sameOpPrevUuid =
String -> Parser (Bool, UUID) -> Parser (Bool, UUID)
forall a. String -> Parser a -> Parser a
label String
name (Parser (Bool, UUID) -> Parser (Bool, UUID))
-> Parser (Bool, UUID) -> Parser (Bool, UUID)
forall a b. (a -> b) -> a -> b
$ do
Parser ()
skipSpace
Bool
isKeyPresent <- Parser ByteString Char -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => f a -> f Bool
isSuccessful (Parser ByteString Char -> Parser ByteString Bool)
-> Parser ByteString Char -> Parser ByteString Bool
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
char Char
keyChar
if Bool
isKeyPresent then do
UUID
u <- UUID -> UUID -> UuidZipBase -> Parser UUID
uuid UUID
prevOpSameKey UUID
sameOpPrevUuid UuidZipBase
PrevOpSameKey
(Bool, UUID) -> Parser (Bool, UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, UUID
u)
else
(Bool, UUID) -> Parser (Bool, UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, UUID
prevOpSameKey)
openKey :: String -> Char -> Parser UUID
openKey :: String -> Char -> Parser UUID
openKey String
name Char
keyChar =
String -> Parser UUID -> Parser UUID
forall a. String -> Parser a -> Parser a
label String
name (Parser UUID -> Parser UUID) -> Parser UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ do
Parser ()
skipSpace
Char
_ <- Char -> Parser ByteString Char
char Char
keyChar
UUID -> UUID -> UuidZipBase -> Parser UUID
uuid UUID
UUID.zero UUID
UUID.zero UuidZipBase
PrevOpSameKey
uuid :: UUID -> UUID -> UuidZipBase -> Parser UUID
uuid :: UUID -> UUID -> UuidZipBase -> Parser UUID
uuid UUID
prevOpSameKey UUID
sameOpPrevUuid UuidZipBase
defaultZipBase = String -> Parser UUID -> Parser UUID
forall a. String -> Parser a -> Parser a
label String
"UUID" (Parser UUID -> Parser UUID) -> Parser UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$
Parser UUID
uuid22 Parser UUID -> Parser UUID -> Parser UUID
forall a. Parser a -> Parser a -> Parser a
<+> Parser UUID
uuid11 Parser UUID -> Parser UUID -> Parser UUID
forall a. Parser a -> Parser a -> Parser a
<+> UUID -> UUID -> UuidZipBase -> Parser UUID
uuidZip UUID
prevOpSameKey UUID
sameOpPrevUuid UuidZipBase
defaultZipBase
uuid11 :: Parser UUID
uuid11 :: Parser UUID
uuid11 = String -> Parser UUID -> Parser UUID
forall a. String -> Parser a -> Parser a
label String
"UUID-RON-11-letter-value" (Parser UUID -> Parser UUID) -> Parser UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ do
ByteString
rawX <- Int -> Parser ByteString
base64word Int
11
Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
rawX Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
11
Word64
x <- ByteString -> Maybe Word64
Base64.decode64 ByteString
rawX Maybe Word64
-> Parser ByteString Word64 -> Parser ByteString Word64
forall (f :: * -> *) a. Applicative f => Maybe a -> f a -> f a
?? String -> Parser ByteString Word64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Base64.decode64"
Maybe Word2
rawUuidVersion <- Parser ByteString Word2 -> Parser ByteString (Maybe Word2)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Word2
pUuidVersion
Word64
y <- case Maybe Word2
rawUuidVersion of
Maybe Word2
Nothing -> Word64 -> Parser ByteString Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
Maybe Word2
_ -> do
Maybe ByteString
rawOrigin <- Parser ByteString -> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString -> Parser ByteString (Maybe ByteString))
-> Parser ByteString -> Parser ByteString (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString
base64word (Int -> Parser ByteString) -> Int -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (Word2 -> Int) -> Maybe Word2 -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
11 (Int -> Word2 -> Int
forall a b. a -> b -> a
const Int
10) Maybe Word2
rawUuidVersion
Word60
origin <- case Maybe ByteString
rawOrigin of
Maybe ByteString
Nothing -> Word60 -> Parser ByteString Word60
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word60 -> Parser ByteString Word60)
-> Word60 -> Parser ByteString Word60
forall a b. (a -> b) -> a -> b
$ Word64 -> Word60
ls60 Word64
0
Just ByteString
origin -> ByteString -> Maybe Word60
Base64.decode60 ByteString
origin Maybe Word60
-> Parser ByteString Word60 -> Parser ByteString Word60
forall (f :: * -> *) a. Applicative f => Maybe a -> f a -> f a
?? String -> Parser ByteString Word60
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Base64.decode60"
Word64 -> Parser ByteString Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Parser ByteString Word64)
-> Word64 -> Parser ByteString Word64
forall a b. (a -> b) -> a -> b
$ Word2 -> Word2 -> Word60 -> Word64
UUID.buildY Word2
b00 (Word2 -> Maybe Word2 -> Word2
forall a. a -> Maybe a -> a
fromMaybe Word2
b00 Maybe Word2
rawUuidVersion) Word60
origin
UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> Parser UUID) -> UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> UUID
UUID Word64
x Word64
y
data UuidZipBase = PrevOpSameKey | SameOpPrevUuid
uuidZip' :: Parser UUID
uuidZip' :: Parser UUID
uuidZip' = String -> Parser UUID -> Parser UUID
forall a. String -> Parser a -> Parser a
label String
"UUID-zip'" (Parser UUID -> Parser UUID) -> Parser UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ do
Maybe Word4
rawVariety <- Parser ByteString Word4 -> Parser ByteString (Maybe Word4)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Word4
pVariety
Word60
rawValue <- Int -> Parser ByteString Word60
base64word60 Int
10
Maybe Word2
rawUuidVersion <- Parser ByteString Word2 -> Parser ByteString (Maybe Word2)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Word2
pUuidVersion
Maybe Word60
rawOrigin <- case Maybe Word2
rawUuidVersion of
Just Word2
_ -> Parser ByteString Word60 -> Parser ByteString (Maybe Word60)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Word60 -> Parser ByteString (Maybe Word60))
-> Parser ByteString Word60 -> Parser ByteString (Maybe Word60)
forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString Word60
base64word60 Int
10
Maybe Word2
Nothing -> Maybe Word60 -> Parser ByteString (Maybe Word60)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word60
forall a. Maybe a
Nothing
UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> Parser UUID) -> UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ UuidFields -> UUID
UUID.build UuidFields :: Word4 -> Word60 -> Word2 -> Word2 -> Word60 -> UuidFields
UuidFields
{ uuidVariety :: Word4
uuidVariety = Word4 -> Maybe Word4 -> Word4
forall a. a -> Maybe a -> a
fromMaybe Word4
b0000 Maybe Word4
rawVariety
, uuidValue :: Word60
uuidValue = Word60
rawValue
, uuidVariant :: Word2
uuidVariant = Word2
b00
, uuidVersion :: Word2
uuidVersion = Word2 -> Maybe Word2 -> Word2
forall a. a -> Maybe a -> a
fromMaybe Word2
b00 Maybe Word2
rawUuidVersion
, uuidOrigin :: Word60
uuidOrigin = Word60 -> Maybe Word60 -> Word60
forall a. a -> Maybe a -> a
fromMaybe (Word64 -> Word60
ls60 Word64
0) Maybe Word60
rawOrigin
}
{-# DEPRECATED uuidZip "Deprecated since RON 2.1 ." #-}
uuidZip :: UUID -> UUID -> UuidZipBase -> Parser UUID
uuidZip :: UUID -> UUID -> UuidZipBase -> Parser UUID
uuidZip UUID
prevOpSameKey UUID
sameOpPrevUuid UuidZipBase
defaultZipBase = String -> Parser UUID -> Parser UUID
forall a. String -> Parser a -> Parser a
label String
"UUID-zip" (Parser UUID -> Parser UUID) -> Parser UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ do
Bool
changeZipBase <- Parser ByteString Char -> Parser ByteString Bool
forall (f :: * -> *) a. Alternative f => f a -> f Bool
isSuccessful (Parser ByteString Char -> Parser ByteString Bool)
-> Parser ByteString Char -> Parser ByteString Bool
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Char
char Char
'`'
Maybe Word4
rawVariety <- Parser ByteString Word4 -> Parser ByteString (Maybe Word4)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Word4
pVariety
Maybe Int
rawReuseValue <- Parser ByteString Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Int
pReuse
Maybe Word60
rawValue <- Parser ByteString Word60 -> Parser ByteString (Maybe Word60)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Word60 -> Parser ByteString (Maybe Word60))
-> Parser ByteString Word60 -> Parser ByteString (Maybe Word60)
forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString Word60
base64word60 (Int -> Parser ByteString Word60)
-> Int -> Parser ByteString Word60
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
rawReuseValue
Maybe Word2
rawUuidVersion <- Parser ByteString Word2 -> Parser ByteString (Maybe Word2)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Word2
pUuidVersion
Maybe Int
rawReuseOrigin <- Parser ByteString Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Int
pReuse
Maybe Word60
rawOrigin <- Parser ByteString Word60 -> Parser ByteString (Maybe Word60)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Word60 -> Parser ByteString (Maybe Word60))
-> Parser ByteString Word60 -> Parser ByteString (Maybe Word60)
forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString Word60
base64word60 (Int -> Parser ByteString Word60)
-> Int -> Parser ByteString Word60
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
rawReuseOrigin
let prev :: UuidFields
prev = UUID -> UuidFields
UUID.split (UUID -> UuidFields) -> UUID -> UuidFields
forall a b. (a -> b) -> a -> b
$ Bool -> UUID
whichPrev Bool
changeZipBase
let isSimple :: Bool
isSimple
= UuidFields -> Word2
uuidVariant UuidFields
prev Word2 -> Word2 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word2
b00
Bool -> Bool -> Bool
|| ( Bool -> Bool
not Bool
changeZipBase
Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
rawReuseValue Bool -> Bool -> Bool
&& Maybe Word60 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Word60
rawValue
Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
rawReuseOrigin
Bool -> Bool -> Bool
&& (Maybe Word2 -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Word2
rawUuidVersion Bool -> Bool -> Bool
|| Maybe Word60 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Word60
rawOrigin)
)
if Bool
isSimple then
UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> Parser UUID) -> UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ UuidFields -> UUID
UUID.build UuidFields :: Word4 -> Word60 -> Word2 -> Word2 -> Word60 -> UuidFields
UuidFields
{ uuidVariety :: Word4
uuidVariety = Word4 -> Maybe Word4 -> Word4
forall a. a -> Maybe a -> a
fromMaybe Word4
b0000 Maybe Word4
rawVariety
, uuidValue :: Word60
uuidValue = Word60 -> Maybe Word60 -> Word60
forall a. a -> Maybe a -> a
fromMaybe (Word64 -> Word60
ls60 Word64
0) Maybe Word60
rawValue
, uuidVariant :: Word2
uuidVariant = Word2
b00
, uuidVersion :: Word2
uuidVersion = Word2 -> Maybe Word2 -> Word2
forall a. a -> Maybe a -> a
fromMaybe Word2
b00 Maybe Word2
rawUuidVersion
, uuidOrigin :: Word60
uuidOrigin = Word60 -> Maybe Word60 -> Word60
forall a. a -> Maybe a -> a
fromMaybe (Word64 -> Word60
ls60 Word64
0) Maybe Word60
rawOrigin
}
else do
Word4
uuidVariety <- Word4 -> Parser ByteString Word4
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word4 -> Parser ByteString Word4)
-> Word4 -> Parser ByteString Word4
forall a b. (a -> b) -> a -> b
$ Word4 -> Maybe Word4 -> Word4
forall a. a -> Maybe a -> a
fromMaybe (UuidFields -> Word4
uuidVariety UuidFields
prev) Maybe Word4
rawVariety
Word60
uuidValue <- Word60 -> Parser ByteString Word60
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word60 -> Parser ByteString Word60)
-> Word60 -> Parser ByteString Word60
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Word60 -> Word60 -> Word60
reuse Maybe Int
rawReuseValue Maybe Word60
rawValue (UuidFields -> Word60
uuidValue UuidFields
prev)
let uuidVariant :: Word2
uuidVariant = Word2
b00
Word2
uuidVersion <- Word2 -> Parser ByteString Word2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word2 -> Parser ByteString Word2)
-> Word2 -> Parser ByteString Word2
forall a b. (a -> b) -> a -> b
$ Word2 -> Maybe Word2 -> Word2
forall a. a -> Maybe a -> a
fromMaybe (UuidFields -> Word2
uuidVersion UuidFields
prev) Maybe Word2
rawUuidVersion
Word60
uuidOrigin <-
Word60 -> Parser ByteString Word60
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word60 -> Parser ByteString Word60)
-> Word60 -> Parser ByteString Word60
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Word60 -> Word60 -> Word60
reuse Maybe Int
rawReuseOrigin Maybe Word60
rawOrigin (UuidFields -> Word60
uuidOrigin UuidFields
prev)
UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> Parser UUID) -> UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ UuidFields -> UUID
UUID.build UuidFields :: Word4 -> Word60 -> Word2 -> Word2 -> Word60 -> UuidFields
UuidFields{Word60
Word4
Word2
uuidOrigin :: Word60
uuidVersion :: Word2
uuidVariant :: Word2
uuidValue :: Word60
uuidVariety :: Word4
uuidOrigin :: Word60
uuidVersion :: Word2
uuidVariant :: Word2
uuidValue :: Word60
uuidVariety :: Word4
..}
where
whichPrev :: Bool -> UUID
whichPrev Bool
changeZipBase
| Bool
changeZipBase = UUID
sameOpPrevUuid
| Bool
otherwise = case UuidZipBase
defaultZipBase of
UuidZipBase
PrevOpSameKey -> UUID
prevOpSameKey
UuidZipBase
SameOpPrevUuid -> UUID
sameOpPrevUuid
reuse :: Maybe Int -> Maybe Word60 -> Word60 -> Word60
reuse :: Maybe Int -> Maybe Word60 -> Word60 -> Word60
reuse Maybe Int
Nothing Maybe Word60
Nothing Word60
prev = Word60
prev
reuse Maybe Int
Nothing (Just Word60
new) Word60
_ = Word60
new
reuse (Just Int
prefixLen) Maybe Word60
Nothing Word60
prev =
Word64 -> Word60
ls60 (Word64 -> Word60) -> Word64 -> Word60
forall a b. (a -> b) -> a -> b
$ Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
prev Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
prefixLen)
reuse (Just Int
prefixLen) (Just Word60
new) Word60
prev = Word64 -> Word60
ls60 (Word64 -> Word60) -> Word64 -> Word60
forall a b. (a -> b) -> a -> b
$ Word64
prefix Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
postfix
where
prefix :: Word64
prefix = Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
prev Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
prefixLen)
postfix :: Word64
postfix = Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
new Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
prefixLen)
pReuse :: Parser Int
pReuse :: Parser ByteString Int
pReuse = Parser ByteString Char
anyChar Parser ByteString Char
-> (Char -> Parser ByteString Int) -> Parser ByteString Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Char
'(' -> Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
4
Char
'[' -> Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
5
Char
'{' -> Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
6
Char
'}' -> Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
7
Char
']' -> Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
8
Char
')' -> Int -> Parser ByteString Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
9
Char
_ -> String -> Parser ByteString Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a reuse symbol"
uuid22 :: Parser UUID
uuid22 :: Parser UUID
uuid22 = String -> Parser UUID -> Parser UUID
forall a. String -> Parser a -> Parser a
label String
"UUID-Base64-double-word" (Parser UUID -> Parser UUID) -> Parser UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ do
ByteString
xy <- Int -> Parser ByteString
base64word Int
22
Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
xy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
22
Parser UUID -> (UUID -> Parser UUID) -> Maybe UUID -> Parser UUID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Base64 decoding error") UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UUID -> Parser UUID) -> Maybe UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$
Word64 -> Word64 -> UUID
UUID
(Word64 -> Word64 -> UUID)
-> Maybe Word64 -> Maybe (Word64 -> UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Word64
Base64.decode64 (Int -> ByteString -> ByteString
BS.take Int
11 ByteString
xy)
Maybe (Word64 -> UUID) -> Maybe Word64 -> Maybe UUID
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe Word64
Base64.decode64 (Int -> ByteString -> ByteString
BS.drop Int
11 ByteString
xy)
base64word :: Int -> Parser ByteString
base64word :: Int -> Parser ByteString
base64word Int
maxSize = String -> Parser ByteString -> Parser ByteString
forall a. String -> Parser a -> Parser a
label String
"Base64 word" (Parser ByteString -> Parser ByteString)
-> Parser ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString
word <- (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
Base64.isLetter
Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
word Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxSize
ByteString -> Parser ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
word
base64word60 :: Int -> Parser Word60
base64word60 :: Int -> Parser ByteString Word60
base64word60 Int
maxSize = String -> Parser ByteString Word60 -> Parser ByteString Word60
forall a. String -> Parser a -> Parser a
label String
"Base64 word60" (Parser ByteString Word60 -> Parser ByteString Word60)
-> Parser ByteString Word60 -> Parser ByteString Word60
forall a b. (a -> b) -> a -> b
$ do
ByteString
word <- Int -> Parser ByteString
base64word Int
maxSize
ByteString -> Maybe Word60
Base64.decode60 ByteString
word Maybe Word60
-> Parser ByteString Word60 -> Parser ByteString Word60
forall (f :: * -> *) a. Applicative f => Maybe a -> f a -> f a
?? String -> Parser ByteString Word60
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decode60"
isUpperHexDigit :: Word8 -> Bool
isUpperHexDigit :: Word8 -> Bool
isUpperHexDigit Word8
c =
(Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'0')) :: Word) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
9 Bool -> Bool -> Bool
||
(Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'A')) :: Word) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
5
pVariety :: Parser Word4
pVariety :: Parser ByteString Word4
pVariety = String -> Parser ByteString Word4 -> Parser ByteString Word4
forall a. String -> Parser a -> Parser a
label String
"variety" (Parser ByteString Word4 -> Parser ByteString Word4)
-> Parser ByteString Word4 -> Parser ByteString Word4
forall a b. (a -> b) -> a -> b
$ do
Word8
letter <- (Word8 -> Bool) -> Parser Word8
satisfy Word8 -> Bool
isUpperHexDigit Parser Word8 -> Parser ByteString -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString
"/"
Word8 -> Maybe Word4
Base64.decodeLetter4 Word8
letter Maybe Word4 -> Parser ByteString Word4 -> Parser ByteString Word4
forall (f :: * -> *) a. Applicative f => Maybe a -> f a -> f a
?? String -> Parser ByteString Word4
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Base64.decodeLetter4"
pUuidVersion :: Parser Word2
pUuidVersion :: Parser ByteString Word2
pUuidVersion = String -> Parser ByteString Word2 -> Parser ByteString Word2
forall a. String -> Parser a -> Parser a
label String
"UUID-version" (Parser ByteString Word2 -> Parser ByteString Word2)
-> Parser ByteString Word2 -> Parser ByteString Word2
forall a b. (a -> b) -> a -> b
$
Parser ByteString Char
anyChar Parser ByteString Char
-> (Char -> Parser ByteString Word2) -> Parser ByteString Word2
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Char
'$' -> Word2 -> Parser ByteString Word2
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word2
b00
Char
'%' -> Word2 -> Parser ByteString Word2
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word2
b01
Char
'+' -> Word2 -> Parser ByteString Word2
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word2
b10
Char
'-' -> Word2 -> Parser ByteString Word2
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word2
b11
Char
_ -> String -> Parser ByteString Word2
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a UUID-version"
pPayload :: UUID -> Parser Payload
pPayload :: UUID -> Parser Payload
pPayload = String -> Parser Payload -> Parser Payload
forall a. String -> Parser a -> Parser a
label String
"payload" (Parser Payload -> Parser Payload)
-> (UUID -> Parser Payload) -> UUID -> Parser Payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Parser Payload
go
where
go :: UUID -> Parser Payload
go UUID
prevUuid = do
Maybe Atom
ma <- Parser ByteString Atom -> Parser ByteString (Maybe Atom)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Atom -> Parser ByteString (Maybe Atom))
-> Parser ByteString Atom -> Parser ByteString (Maybe Atom)
forall a b. (a -> b) -> a -> b
$ UUID -> Parser ByteString Atom
atom UUID
prevUuid
case Maybe Atom
ma of
Maybe Atom
Nothing -> Payload -> Parser Payload
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just Atom
a -> (Atom
a Atom -> Payload -> Payload
forall a. a -> [a] -> [a]
:) (Payload -> Payload) -> Parser Payload -> Parser Payload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UUID -> Parser Payload
go UUID
newUuid
where
newUuid :: UUID
newUuid = case Atom
a of
AUuid UUID
u -> UUID
u
Atom
_ -> UUID
prevUuid
atom :: UUID -> Parser Atom
atom :: UUID -> Parser ByteString Atom
atom UUID
prevUuid = Parser ()
skipSpace Parser () -> Parser ByteString Atom -> Parser ByteString Atom
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Atom
atom'
where
atom' :: Parser ByteString Atom
atom' =
Char -> Parser ByteString Char
char Char
'^' Parser ByteString Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Atom -> Parser ByteString Atom
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Double -> Atom
AFloat (Double -> Atom)
-> Parser ByteString Double -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Double
double ) Parser ByteString Atom
-> Parser ByteString Atom -> Parser ByteString Atom
forall a. Parser a -> Parser a -> Parser a
<+>
Char -> Parser ByteString Char
char Char
'=' Parser ByteString Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Atom -> Parser ByteString Atom
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Atom
AInteger (Int64 -> Atom)
-> Parser ByteString Int64 -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
integer) Parser ByteString Atom
-> Parser ByteString Atom -> Parser ByteString Atom
forall a. Parser a -> Parser a -> Parser a
<+>
Char -> Parser ByteString Char
char Char
'>' Parser ByteString Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser ByteString Atom -> Parser ByteString Atom
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UUID -> Atom
AUuid (UUID -> Atom) -> Parser UUID -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UUID
uuid' ) Parser ByteString Atom
-> Parser ByteString Atom -> Parser ByteString Atom
forall a. Parser a -> Parser a -> Parser a
<+>
(Text -> Atom
AString (Text -> Atom) -> Parser ByteString Text -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
string ) Parser ByteString Atom
-> Parser ByteString Atom -> Parser ByteString Atom
forall a. Parser a -> Parser a -> Parser a
<+>
Parser ByteString Atom
atomUnprefixed
integer :: Parser ByteString Int64
integer = Parser ByteString Int64 -> Parser ByteString Int64
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int64
forall a. Integral a => Parser a
decimal
uuid' :: Parser UUID
uuid' = UUID -> Parser UUID
uuidAtom UUID
prevUuid
atomUnprefixed :: Parser Atom
atomUnprefixed :: Parser ByteString Atom
atomUnprefixed =
(Double -> Atom
AFloat (Double -> Atom)
-> Parser ByteString Double -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Double
definiteDouble) Parser ByteString Atom
-> Parser ByteString Atom -> Parser ByteString Atom
forall a. Parser a -> Parser a -> Parser a
<+>
(Int64 -> Atom
AInteger (Int64 -> Atom)
-> Parser ByteString Int64 -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
integer ) Parser ByteString Atom
-> Parser ByteString Atom -> Parser ByteString Atom
forall a. Parser a -> Parser a -> Parser a
<+>
(UUID -> Atom
AUuid (UUID -> Atom) -> Parser UUID -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UUID
uuidUnzipped )
where
integer :: Parser ByteString Int64
integer = Parser ByteString Int64 -> Parser ByteString Int64
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int64
forall a. Integral a => Parser a
decimal
uuidUnzipped :: Parser UUID
uuidUnzipped = Parser UUID
uuid22 Parser UUID -> Parser UUID -> Parser UUID
forall a. Parser a -> Parser a -> Parser a
<+> Parser UUID
uuid11 Parser UUID -> Parser UUID -> Parser UUID
forall a. Parser a -> Parser a -> Parser a
<+> Parser UUID
uuidZip'
uuidAtom :: UUID -> Parser UUID
uuidAtom :: UUID -> Parser UUID
uuidAtom UUID
prev = UUID -> UUID -> UuidZipBase -> Parser UUID
uuid UUID
UUID.zero UUID
prev UuidZipBase
SameOpPrevUuid
parseAtom :: ByteStringL -> Either String Atom
parseAtom :: ByteStringL -> Either String Atom
parseAtom = Parser ByteString Atom -> ByteStringL -> Either String Atom
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser ByteString Atom -> ByteStringL -> Either String Atom)
-> Parser ByteString Atom -> ByteStringL -> Either String Atom
forall a b. (a -> b) -> a -> b
$ UUID -> Parser ByteString Atom
atom UUID
UUID.zero Parser ByteString Atom -> Parser () -> Parser ByteString Atom
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfInputEx
string :: Parser Text
string :: Parser ByteString Text
string = do
ByteString
bs <- Char -> Parser ByteString Char
char Char
'\'' Parser ByteString Char -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString
content
case ByteString -> Maybe Text
forall a. FromJSON a => ByteString -> Maybe a
Json.decodeStrict (ByteString -> Maybe Text) -> ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Char
'"' Char -> ByteString -> ByteString
`BSC.cons` (ByteString
bs ByteString -> Char -> ByteString
`BSC.snoc` Char
'"') of
Just Text
s -> Text -> Parser ByteString Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
Maybe Text
Nothing -> String -> Parser ByteString Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad string"
where
content :: Parser ByteString
content = do
ByteString
chunk <- (Char -> Bool) -> Parser ByteString
takeWhile ((Char -> Bool) -> Parser ByteString)
-> (Char -> Bool) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\'
Parser ByteString Char
anyChar Parser ByteString Char
-> (Char -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Char
'\'' -> ByteString -> Parser ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
chunk
Char
'\\' -> Parser ByteString Char
anyChar Parser ByteString Char
-> (Char -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Char
'\'' -> (ByteString
chunk ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
BSC.cons Char
'\'' (ByteString -> ByteString)
-> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
content
Char
c -> (ByteString
chunk ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
BSC.cons Char
'\\' (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
BSC.cons Char
c (ByteString -> ByteString)
-> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
content
Char
_ -> String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot happen"
parseString :: ByteStringL -> Either String Text
parseString :: ByteStringL -> Either String Text
parseString = Parser ByteString Text -> ByteStringL -> Either String Text
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser ByteString Text -> ByteStringL -> Either String Text)
-> Parser ByteString Text -> ByteStringL -> Either String Text
forall a b. (a -> b) -> a -> b
$ Parser ByteString Text
string Parser ByteString Text -> Parser () -> Parser ByteString Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfInputEx
header :: ClosedOp -> Parser (ClosedOp, Bool)
ClosedOp
prev = do
(Bool
_, ClosedOp
x) <- ClosedOp -> Parser (Bool, ClosedOp)
closedOp ClosedOp
prev
OpTerm
t <- Parser ByteString OpTerm
term
case OpTerm
t of
OpTerm
THeader -> (ClosedOp, Bool) -> Parser (ClosedOp, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClosedOp
x, Bool
False)
OpTerm
TQuery -> (ClosedOp, Bool) -> Parser (ClosedOp, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClosedOp
x, Bool
True)
OpTerm
_ -> String -> Parser (ClosedOp, Bool)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a header"
term :: Parser OpTerm
term :: Parser ByteString OpTerm
term = do
Parser ()
skipSpace
Parser ByteString Char
anyChar Parser ByteString Char
-> (Char -> Parser ByteString OpTerm) -> Parser ByteString OpTerm
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Char
'!' -> OpTerm -> Parser ByteString OpTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpTerm
THeader
Char
'?' -> OpTerm -> Parser ByteString OpTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpTerm
TQuery
Char
',' -> OpTerm -> Parser ByteString OpTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpTerm
TReduced
Char
';' -> OpTerm -> Parser ByteString OpTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpTerm
TClosed
Char
_ -> String -> Parser ByteString OpTerm
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a term"
parseStateFrame :: ByteStringL -> Either String StateFrame
parseStateFrame :: ByteStringL -> Either String StateFrame
parseStateFrame = ByteStringL -> Either String WireFrame
parseWireFrame (ByteStringL -> Either String WireFrame)
-> (WireFrame -> Either String StateFrame)
-> ByteStringL
-> Either String StateFrame
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> WireFrame -> Either String StateFrame
findObjects
parseObject :: UUID -> ByteStringL -> Either String (ObjectFrame a)
parseObject :: UUID -> ByteStringL -> Either String (ObjectFrame a)
parseObject UUID
oid ByteStringL
bytes = UUID -> StateFrame -> ObjectFrame a
forall a. UUID -> StateFrame -> ObjectFrame a
ObjectFrame UUID
oid (StateFrame -> ObjectFrame a)
-> Either String StateFrame -> Either String (ObjectFrame a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteStringL -> Either String StateFrame
parseStateFrame ByteStringL
bytes
findObjects :: WireFrame -> Either String StateFrame
findObjects :: WireFrame -> Either String StateFrame
findObjects = ([(UUID, WireStateChunk)] -> StateFrame)
-> Either String [(UUID, WireStateChunk)]
-> Either String StateFrame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(UUID, WireStateChunk)] -> StateFrame
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Either String [(UUID, WireStateChunk)]
-> Either String StateFrame)
-> (WireFrame -> Either String [(UUID, WireStateChunk)])
-> WireFrame
-> Either String StateFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WireChunk -> Either String (UUID, WireStateChunk))
-> WireFrame -> Either String [(UUID, WireStateChunk)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse WireChunk -> Either String (UUID, WireStateChunk)
loadBody where
loadBody :: WireChunk -> Either String (UUID, WireStateChunk)
loadBody = \case
Value WireReducedChunk{ClosedOp
wrcHeader :: ClosedOp
$sel:wrcHeader:WireReducedChunk :: WireReducedChunk -> ClosedOp
wrcHeader, [Op]
wrcBody :: [Op]
$sel:wrcBody:WireReducedChunk :: WireReducedChunk -> [Op]
wrcBody} -> do
let ClosedOp{UUID
reducerId :: UUID
$sel:reducerId:ClosedOp :: ClosedOp -> UUID
reducerId, UUID
objectId :: UUID
$sel:objectId:ClosedOp :: ClosedOp -> UUID
objectId} = ClosedOp
wrcHeader
(UUID, WireStateChunk) -> Either String (UUID, WireStateChunk)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( UUID
objectId
, WireStateChunk :: UUID -> [Op] -> WireStateChunk
WireStateChunk{$sel:stateType:WireStateChunk :: UUID
stateType = UUID
reducerId, $sel:stateBody:WireStateChunk :: [Op]
stateBody = [Op]
wrcBody}
)
WireChunk
_ -> String -> Either String (UUID, WireStateChunk)
forall a b. a -> Either a b
Left String
"expected reduced chunk"
closedOpZero :: ClosedOp
closedOpZero :: ClosedOp
closedOpZero =
ClosedOp :: UUID -> UUID -> Op -> ClosedOp
ClosedOp{$sel:reducerId:ClosedOp :: UUID
reducerId = UUID
UUID.zero, $sel:objectId:ClosedOp :: UUID
objectId = UUID
UUID.zero, $sel:op:ClosedOp :: Op
op = Op
opZero}
opZero :: Op
opZero :: Op
opZero = Op :: UUID -> UUID -> Payload -> Op
Op{$sel:opId:Op :: UUID
opId = UUID
UUID.zero, $sel:refId:Op :: UUID
refId = UUID
UUID.zero, $sel:payload:Op :: Payload
payload = []}
parseOpenFrame :: ByteStringL -> Either String [Op]
parseOpenFrame :: ByteStringL -> Either String [Op]
parseOpenFrame =
Parser ByteString [Op] -> ByteStringL -> Either String [Op]
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser ByteString [Op] -> ByteStringL -> Either String [Op])
-> Parser ByteString [Op] -> ByteStringL -> Either String [Op]
forall a b. (a -> b) -> a -> b
$ UUID -> Parser ByteString [Op]
go UUID
UUID.zero Parser ByteString [Op] -> Parser () -> Parser ByteString [Op]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser ByteString [Op] -> Parser () -> Parser ByteString [Op]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfInputEx
where
go :: UUID -> Parser [Op]
go :: UUID -> Parser ByteString [Op]
go UUID
prev =
do
op :: Op
op@Op{UUID
opId :: UUID
$sel:opId:Op :: Op -> UUID
opId} <- UUID -> Parser Op
openOp UUID
prev
(Op
op Op -> [Op] -> [Op]
forall a. a -> [a] -> [a]
:) ([Op] -> [Op]) -> Parser ByteString [Op] -> Parser ByteString [Op]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UUID -> Parser ByteString [Op]
go UUID
opId
Parser ByteString [Op]
-> Parser ByteString [Op] -> Parser ByteString [Op]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
[Op] -> Parser ByteString [Op]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseOpenOp :: ByteStringL -> Either String Op
parseOpenOp :: ByteStringL -> Either String Op
parseOpenOp = Parser Op -> ByteStringL -> Either String Op
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Parser Op -> ByteStringL -> Either String Op)
-> Parser Op -> ByteStringL -> Either String Op
forall a b. (a -> b) -> a -> b
$ UUID -> Parser Op
openOp UUID
UUID.zero Parser Op -> Parser () -> Parser Op
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Op -> Parser () -> Parser Op
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfInputEx