{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module RON.Binary.Parse (
parse,
parseAtom,
parseString,
) where
import RON.Prelude
import Attoparsec.Extra (Parser, anyWord8, endOfInputEx, label,
parseOnlyL, takeL, withInputSize)
import qualified Attoparsec.Extra as Atto
import qualified Data.Binary as Binary
import Data.Binary.Get (getDoublebe, runGet)
import Data.Bits (shiftR, testBit, (.&.))
import Data.ByteString.Lazy (cons, toStrict)
import qualified Data.ByteString.Lazy as BSL
import Data.Text.Encoding (decodeUtf8)
import Data.ZigZag (zzDecode64)
import RON.Binary.Types (Desc (..), Size, descIsOp)
import RON.Types (Atom (AFloat, AInteger, AString, AUuid),
ClosedOp (..), Op (..),
OpTerm (TClosed, THeader, TQuery, TReduced),
Payload, UUID (UUID),
WireChunk (Closed, Query, Value), WireFrame,
WireReducedChunk (..))
import RON.Util.Word (safeCast)
parseDesc :: Parser (Desc, Size)
parseDesc :: Parser (Desc, Size)
parseDesc = String -> Parser (Desc, Size) -> Parser (Desc, Size)
forall a. String -> Parser a -> Parser a
label String
"desc" (Parser (Desc, Size) -> Parser (Desc, Size))
-> Parser (Desc, Size) -> Parser (Desc, Size)
forall a b. (a -> b) -> a -> b
$ do
Word8
b <- String -> Parser Word8 -> Parser Word8
forall a. String -> Parser a -> Parser a
label String
"start byte" Parser Word8
anyWord8
let typeCode :: Word8
typeCode = Word8
b Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
let sizeCode :: Word8
sizeCode = Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b1111
let desc :: Desc
desc = Int -> Desc
forall a. Enum a => Int -> a
toEnum (Int -> Desc) -> Int -> Desc
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
typeCode
Size
size <- case (Word8
sizeCode, Desc
desc) of
(Word8
0, Desc
DAtomString) -> Parser ByteString Size
extendedLength
(Word8
0, Desc
d) | Desc -> Bool
descIsOp Desc
d -> Size -> Parser ByteString Size
forall (f :: * -> *) a. Applicative f => a -> f a
pure Size
0
(Word8
0, Desc
_) -> Size -> Parser ByteString Size
forall (f :: * -> *) a. Applicative f => a -> f a
pure Size
16
(Word8, Desc)
_ -> Size -> Parser ByteString Size
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Size -> Parser ByteString Size) -> Size -> Parser ByteString Size
forall a b. (a -> b) -> a -> b
$ Word8 -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
sizeCode
(Desc, Size) -> Parser (Desc, Size)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Desc
desc, Size
size)
extendedLength :: Parser Size
extendedLength :: Parser ByteString Size
extendedLength = do
Word8
b <- Parser Word8
anyWord8
if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
b Int
7 then do
ByteStringL
bbb <- Int -> Parser ByteStringL
takeL Int
3
Size -> Parser ByteString Size
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Size -> Parser ByteString Size) -> Size -> Parser ByteString Size
forall a b. (a -> b) -> a -> b
$ Size -> Size
leastSignificant31 (Size -> Size) -> Size -> Size
forall a b. (a -> b) -> a -> b
$ ByteStringL -> Size
forall a. Binary a => ByteStringL -> a
Binary.decode (Word8
b Word8 -> ByteStringL -> ByteStringL
`cons` ByteStringL
bbb)
else
Size -> Parser ByteString Size
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Size -> Parser ByteString Size) -> Size -> Parser ByteString Size
forall a b. (a -> b) -> a -> b
$ Word8 -> Size
forall v w. SafeCast v w => v -> w
safeCast Word8
b
parse :: ByteStringL -> Either String WireFrame
parse :: ByteStringL -> Either String WireFrame
parse = 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
parseFrame Parser WireFrame -> Parser ByteString () -> Parser WireFrame
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfInputEx
parseFrame :: Parser WireFrame
parseFrame :: Parser WireFrame
parseFrame = 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
$ do
ByteString
_ <- ByteString -> Parser ByteString
Atto.string ByteString
"RON2" Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
ByteStringL
magic <- Int -> Parser ByteStringL
takeL Int
4
String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString) -> String -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ String
"unsupported magic sequence " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteStringL -> String
forall a s. (Show a, IsString s) => a -> s
show ByteStringL
magic
Parser WireFrame
parseChunks
parseChunks :: Parser [WireChunk]
parseChunks :: Parser WireFrame
parseChunks = do
Size
size :: Size <- ByteStringL -> Size
forall a. Binary a => ByteStringL -> a
Binary.decode (ByteStringL -> Size)
-> Parser ByteStringL -> Parser ByteString Size
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteStringL
takeL Int
4
if | Size -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Size
size Int
31 ->
(WireChunk -> WireFrame -> WireFrame)
-> Parser ByteString WireChunk
-> Parser WireFrame
-> Parser WireFrame
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Size -> Parser ByteString WireChunk
parseChunk (Size -> Parser ByteString WireChunk)
-> Size -> Parser ByteString WireChunk
forall a b. (a -> b) -> a -> b
$ Size -> Size
leastSignificant31 Size
size) Parser WireFrame
parseChunks
| Size
size Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
0 ->
(WireChunk -> WireFrame -> WireFrame
forall a. a -> [a] -> [a]
:[]) (WireChunk -> WireFrame)
-> Parser ByteString WireChunk -> Parser WireFrame
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Parser ByteString WireChunk
parseChunk Size
size
| Bool
True ->
WireFrame -> Parser WireFrame
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
leastSignificant31 :: Word32 -> Word32
leastSignificant31 :: Size -> Size
leastSignificant31 Size
x = Size
x Size -> Size -> Size
forall a. Bits a => a -> a -> a
.&. Size
0x7FFFFFFF
parseChunk
:: Size
-> Parser WireChunk
parseChunk :: Size -> Parser ByteString WireChunk
parseChunk Size
size = String
-> Parser ByteString WireChunk -> Parser ByteString WireChunk
forall a. String -> Parser a -> Parser a
label String
"WireChunk" (Parser ByteString WireChunk -> Parser ByteString WireChunk)
-> Parser ByteString WireChunk -> Parser ByteString WireChunk
forall a b. (a -> b) -> a -> b
$ do
(Int
consumed0, (OpTerm
term, ClosedOp
op)) <- Parser (OpTerm, ClosedOp) -> Parser (Int, (OpTerm, ClosedOp))
forall a. Parser a -> Parser (Int, a)
withInputSize Parser (OpTerm, ClosedOp)
parseDescAndClosedOp
let parseReducedChunk :: ClosedOp -> Bool -> Parser ByteString WireChunk
parseReducedChunk ClosedOp
wrcHeader Bool
isQuery = do
[Op]
wrcBody <- Int -> Parser [Op]
parseReducedOps (Int -> Parser [Op]) -> Int -> Parser [Op]
forall a b. (a -> b) -> a -> b
$ Size -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
consumed0
WireChunk -> Parser ByteString WireChunk
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WireChunk -> Parser ByteString WireChunk)
-> WireChunk -> Parser ByteString WireChunk
forall a b. (a -> b) -> a -> b
$ (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
..}
case OpTerm
term of
OpTerm
THeader -> ClosedOp -> Bool -> Parser ByteString WireChunk
parseReducedChunk ClosedOp
op Bool
False
OpTerm
TQuery -> ClosedOp -> Bool -> Parser ByteString WireChunk
parseReducedChunk ClosedOp
op Bool
True
OpTerm
TReduced -> String -> Parser ByteString WireChunk
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"reduced op without a chunk"
OpTerm
TClosed -> Size -> Int -> Parser ByteString ()
forall (f :: * -> *). MonadFail f => Size -> Int -> f ()
assertSize Size
size Int
consumed0 Parser ByteString () -> WireChunk -> Parser ByteString WireChunk
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ClosedOp -> WireChunk
Closed ClosedOp
op
assertSize :: MonadFail f => Size -> Int -> f ()
assertSize :: Size -> Int -> f ()
assertSize Size
expected Int
consumed =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
consumed Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Size -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
expected) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
String -> f ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$
String
"size mismatch: expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Size -> String
forall a s. (Show a, IsString s) => a -> s
show Size
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a s. (Show a, IsString s) => a -> s
show Int
consumed
parseReducedOps :: Int -> Parser [Op]
parseReducedOps :: Int -> Parser [Op]
parseReducedOps = String -> Parser [Op] -> Parser [Op]
forall a. String -> Parser a -> Parser a
label String
"[Op]" (Parser [Op] -> Parser [Op])
-> (Int -> Parser [Op]) -> Int -> Parser [Op]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser [Op]
go
where
go :: Int -> Parser [Op]
go = \case
Int
0 -> [Op] -> Parser [Op]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Int
expected -> do
(Int
consumed, (OpTerm
TReduced, Op
op)) <- Parser (OpTerm, Op) -> Parser (Int, (OpTerm, Op))
forall a. Parser a -> Parser (Int, a)
withInputSize Parser (OpTerm, Op)
parseDescAndReducedOp
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
consumed Int
expected of
Ordering
LT -> (Op
op Op -> [Op] -> [Op]
forall a. a -> [a] -> [a]
:) ([Op] -> [Op]) -> Parser [Op] -> Parser [Op]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser [Op]
go (Int
expected Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
consumed)
Ordering
EQ -> [Op] -> Parser [Op]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Op
op]
Ordering
GT -> String -> Parser [Op]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"impossible"
parseDescAndClosedOp :: Parser (OpTerm, ClosedOp)
parseDescAndClosedOp :: Parser (OpTerm, ClosedOp)
parseDescAndClosedOp = String -> Parser (OpTerm, ClosedOp) -> Parser (OpTerm, ClosedOp)
forall a. String -> Parser a -> Parser a
label String
"d+ClosedOp" (Parser (OpTerm, ClosedOp) -> Parser (OpTerm, ClosedOp))
-> Parser (OpTerm, ClosedOp) -> Parser (OpTerm, ClosedOp)
forall a b. (a -> b) -> a -> b
$ do
(Desc
desc, Size
size) <- Parser (Desc, Size)
parseDesc
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Size
size Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
0) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ()) -> String -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String
"desc = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Desc -> String
forall a s. (Show a, IsString s) => a -> s
show Desc
desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", size = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Size -> String
forall a s. (Show a, IsString s) => a -> s
show Size
size
case Desc
desc of
Desc
DOpClosed -> (OpTerm
TClosed,) (ClosedOp -> (OpTerm, ClosedOp))
-> Parser ByteString ClosedOp -> Parser (OpTerm, ClosedOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ClosedOp
parseClosedOp
Desc
DOpHeader -> (OpTerm
THeader,) (ClosedOp -> (OpTerm, ClosedOp))
-> Parser ByteString ClosedOp -> Parser (OpTerm, ClosedOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ClosedOp
parseClosedOp
Desc
DOpQueryHeader -> (OpTerm
TQuery,) (ClosedOp -> (OpTerm, ClosedOp))
-> Parser ByteString ClosedOp -> Parser (OpTerm, ClosedOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ClosedOp
parseClosedOp
Desc
_ -> String -> Parser (OpTerm, ClosedOp)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (OpTerm, ClosedOp))
-> String -> Parser (OpTerm, ClosedOp)
forall a b. (a -> b) -> a -> b
$ String
"unimplemented " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Desc -> String
forall a s. (Show a, IsString s) => a -> s
show Desc
desc
parseDescAndReducedOp :: Parser (OpTerm, Op)
parseDescAndReducedOp :: Parser (OpTerm, Op)
parseDescAndReducedOp = String -> Parser (OpTerm, Op) -> Parser (OpTerm, Op)
forall a. String -> Parser a -> Parser a
label String
"d+ClosedOp" (Parser (OpTerm, Op) -> Parser (OpTerm, Op))
-> Parser (OpTerm, Op) -> Parser (OpTerm, Op)
forall a b. (a -> b) -> a -> b
$ do
(Desc
desc, Size
size) <- Parser (Desc, Size)
parseDesc
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Size
size Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
0) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ()) -> String -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String
"desc = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Desc -> String
forall a s. (Show a, IsString s) => a -> s
show Desc
desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", size = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Size -> String
forall a s. (Show a, IsString s) => a -> s
show Size
size
case Desc
desc of
Desc
DOpReduced -> (OpTerm
TReduced,) (Op -> (OpTerm, Op)) -> Parser ByteString Op -> Parser (OpTerm, Op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Op
parseOpenOp
Desc
_ -> String -> Parser (OpTerm, Op)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (OpTerm, Op)) -> String -> Parser (OpTerm, Op)
forall a b. (a -> b) -> a -> b
$ String
"unimplemented " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Desc -> String
forall a s. (Show a, IsString s) => a -> s
show Desc
desc
parseClosedOp :: Parser ClosedOp
parseClosedOp :: Parser ByteString ClosedOp
parseClosedOp = String -> Parser ByteString ClosedOp -> Parser ByteString ClosedOp
forall a. String -> Parser a -> Parser a
label String
"ClosedOp" (Parser ByteString ClosedOp -> Parser ByteString ClosedOp)
-> Parser ByteString ClosedOp -> Parser ByteString ClosedOp
forall a b. (a -> b) -> a -> b
$ do
UUID
reducerId <- Desc -> Parser UUID
parseOpKey Desc
DUuidReducer
UUID
objectId <- Desc -> Parser UUID
parseOpKey Desc
DUuidObject
Op
op <- Parser ByteString Op
parseOpenOp
ClosedOp -> Parser ByteString ClosedOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClosedOp :: UUID -> UUID -> Op -> ClosedOp
ClosedOp{UUID
Op
$sel:op:ClosedOp :: Op
$sel:objectId:ClosedOp :: UUID
$sel:reducerId:ClosedOp :: UUID
op :: Op
objectId :: UUID
reducerId :: UUID
..}
parseOpenOp :: Parser Op
parseOpenOp :: Parser ByteString Op
parseOpenOp = String -> Parser ByteString Op -> Parser ByteString Op
forall a. String -> Parser a -> Parser a
label String
"Op" (Parser ByteString Op -> Parser ByteString Op)
-> Parser ByteString Op -> Parser ByteString Op
forall a b. (a -> b) -> a -> b
$ do
UUID
opId <- Desc -> Parser UUID
parseOpKey Desc
DUuidOp
UUID
refId <- Desc -> Parser UUID
parseOpKey Desc
DUuidRef
Payload
payload <- Parser Payload
parsePayload
Op -> Parser ByteString Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op :: UUID -> UUID -> Payload -> Op
Op{Payload
UUID
$sel:payload:Op :: Payload
$sel:refId:Op :: UUID
$sel:opId:Op :: UUID
payload :: Payload
refId :: UUID
opId :: UUID
..}
parseOpKey :: Desc -> Parser UUID
parseOpKey :: Desc -> Parser UUID
parseOpKey Desc
expectedType = String -> Parser UUID -> Parser UUID
forall a. String -> Parser a -> Parser a
label String
"OpKey" (Parser UUID -> Parser UUID) -> Parser UUID -> Parser UUID
forall a b. (a -> b) -> a -> b
$ do
(Desc
desc, Size
size) <- Parser (Desc, Size)
parseDesc
let go :: Parser UUID
go = do
Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ByteString ()) -> Bool -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Desc
desc Desc -> Desc -> Bool
forall a. Eq a => a -> a -> Bool
== Desc
expectedType
Size -> Parser UUID
uuid Size
size
case Desc
desc of
Desc
DUuidReducer -> Parser UUID
go
Desc
DUuidObject -> Parser UUID
go
Desc
DUuidOp -> Parser UUID
go
Desc
DUuidRef -> Parser UUID
go
Desc
_ -> String -> Parser UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser UUID) -> String -> Parser UUID
forall a b. (a -> b) -> a -> b
$ Desc -> String
forall a s. (Show a, IsString s) => a -> s
show Desc
desc
uuid
:: Size
-> Parser UUID
uuid :: Size -> Parser UUID
uuid Size
size = 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
$
case Size
size of
Size
16 -> do
Word64
x <- ByteStringL -> Word64
forall a. Binary a => ByteStringL -> a
Binary.decode (ByteStringL -> Word64)
-> Parser ByteStringL -> Parser ByteString Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteStringL
takeL Int
8
Word64
y <- ByteStringL -> Word64
forall a. Binary a => ByteStringL -> a
Binary.decode (ByteStringL -> Word64)
-> Parser ByteStringL -> Parser ByteString Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteStringL
takeL Int
8
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
Size
_ -> String -> Parser UUID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected uuid of size 16"
parsePayload :: Parser Payload
parsePayload :: Parser Payload
parsePayload = String -> Parser Payload -> Parser Payload
forall a. String -> Parser a -> Parser a
label String
"payload" (Parser Payload -> Parser Payload)
-> Parser Payload -> Parser Payload
forall a b. (a -> b) -> a -> b
$ Parser ByteString Atom -> Parser Payload
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString Atom
atom
atom :: Parser Atom
atom :: Parser ByteString Atom
atom = String -> Parser ByteString Atom -> Parser ByteString Atom
forall a. String -> Parser a -> Parser a
label String
"Atom" (Parser ByteString Atom -> Parser ByteString Atom)
-> Parser ByteString Atom -> Parser ByteString Atom
forall a b. (a -> b) -> a -> b
$ do
(Desc
desc, Size
size) <- Parser (Desc, Size)
parseDesc
case Desc
desc of
Desc
DAtomFloat -> Double -> Atom
AFloat (Double -> Atom)
-> Parser ByteString Double -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Parser ByteString Double
float Size
size
Desc
DAtomInteger -> Int64 -> Atom
AInteger (Int64 -> Atom)
-> Parser ByteString Int64 -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Parser ByteString Int64
integer Size
size
Desc
DAtomString -> Text -> Atom
AString (Text -> Atom) -> Parser ByteString Text -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Parser ByteString Text
string Size
size
Desc
DAtomUuid -> UUID -> Atom
AUuid (UUID -> Atom) -> Parser UUID -> Parser ByteString Atom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Size -> Parser UUID
uuid Size
size
Desc
_ -> String -> Parser ByteString Atom
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected 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
$ Parser ByteString Atom
atom Parser ByteString Atom
-> Parser ByteString () -> Parser ByteString Atom
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfInputEx
float
:: Size
-> Parser Double
float :: Size -> Parser ByteString Double
float = \case
Size
8 -> Get Double -> ByteStringL -> Double
forall a. Get a -> ByteStringL -> a
runGet Get Double
getDoublebe (ByteStringL -> Double)
-> Parser ByteStringL -> Parser ByteString Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteStringL
takeL Int
8
Size
_ -> Parser ByteString Double
forall a. HasCallStack => a
undefined
integer
:: Size
-> Parser Int64
integer :: Size -> Parser ByteString Int64
integer Size
size = String -> Parser ByteString Int64 -> Parser ByteString Int64
forall a. String -> Parser a -> Parser a
label String
"Integer" (Parser ByteString Int64 -> Parser ByteString Int64)
-> Parser ByteString Int64 -> Parser ByteString Int64
forall a b. (a -> b) -> a -> b
$ do
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Size
size Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Size
1 Bool -> Bool -> Bool
&& Size
size Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
8) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer size must be 1..8"
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Size
size Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
8) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer size /=8 not implemented"
Word64 -> Int64
zzDecode64 (Word64 -> Int64)
-> (ByteStringL -> Word64) -> ByteStringL -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringL -> Word64
forall a. Binary a => ByteStringL -> a
Binary.decode (ByteStringL -> Int64)
-> Parser ByteStringL -> Parser ByteString Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteStringL
takeL (Size -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
size)
string
:: Size
-> Parser Text
string :: Size -> Parser ByteString Text
string Size
size = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteStringL -> ByteString) -> ByteStringL -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringL -> ByteString
toStrict (ByteStringL -> Text)
-> Parser ByteStringL -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteStringL
takeL (Size -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Size
size)
parseString :: ByteStringL -> Either String Text
parseString :: ByteStringL -> Either String Text
parseString ByteStringL
bs =
Parser ByteString Text -> ByteStringL -> Either String Text
forall a. Parser a -> ByteStringL -> Either String a
parseOnlyL (Size -> Parser ByteString Text
string (Int64 -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Size) -> Int64 -> Size
forall a b. (a -> b) -> a -> b
$ ByteStringL -> Int64
BSL.length ByteStringL
bs) Parser ByteString Text
-> Parser ByteString () -> Parser ByteString Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfInputEx) ByteStringL
bs