{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | RON-Text parsing
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

-- | Parse a common frame
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

-- | Returns a chunk and the last op in it
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)

-- | Returns a chunk and the last op (converted to closed) in it
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)

-- | Parse a sequence of common frames
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

-- | Parse a single context-free op
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

-- | Parse a single context-free UUID
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

-- | Parse a UUID in key position
parseUuidKey
    :: UUID  -- ^ same key in the previous op (default is 'UUID.zero')
    -> UUID  -- ^ previous key of the same op (default is 'UUID.zero')
    -> 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

-- | Parse a UUID in value (atom) position
parseUuidAtom
    :: UUID  -- ^ previous
    -> 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
      -- no key => use previous key
      (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

-- | Parse an atom
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"

-- | Parse a string atom
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

-- | Return 'ClosedOp' and 'chunkIsQuery'
header :: ClosedOp -> Parser (ClosedOp, Bool)
header :: ClosedOp -> Parser (ClosedOp, Bool)
header 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"

-- | Parse a state frame
-- TODO deprecate multi-object states
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

-- | Parse a state frame as an object
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

-- | Extract object states from a common frame
-- TODO deprecate multi-object states
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