{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module Codec.Borsh.Incremental.Decoder (
Decoder(..)
, liftDecoder
, decodeLittleEndian
, decodeLargeToken
, decodeIncremental
, decodeIncremental_
, DecodeResult(..)
, deserialiseByteString
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Fail
import Control.Monad.ST
import Data.Word
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Codec.Borsh.Incremental.Located
import Codec.Borsh.Incremental.Monad
import Codec.Borsh.Internal.Util.ByteString
import Codec.Borsh.Internal.Util.ByteSwap
newtype Decoder s a = Decoder {
forall s a.
Decoder s a
-> LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
matchChunk :: LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
}
liftDecoder :: ST s a -> Decoder s a
liftDecoder :: forall s a. ST s a -> Decoder s a
liftDecoder ST s a
sa = forall s a.
(LocatedChunk -> ST s (LocatedChunk, DecodeResult s a))
-> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \LocatedChunk
chunk -> (LocatedChunk
chunk, ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. a -> DecodeResult s a
DecodeDone forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ST s a
sa
decodeLittleEndian :: forall s a. ByteSwap a => Decoder s a
decodeLittleEndian :: forall s a. ByteSwap a => Decoder s a
decodeLittleEndian = forall s a.
(LocatedChunk -> ST s (LocatedChunk, DecodeResult s a))
-> Decoder s a
Decoder LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
aux
where
aux :: LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
aux :: LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
aux chunk :: LocatedChunk
chunk@(L ByteString
bs ByteOffset
off) =
case forall a.
ByteSwap a =>
ByteString -> Maybe (a, ByteOffset, ByteString)
peekByteString ByteString
bs of
Just (a
x, ByteOffset
sizeX, ByteString
bs') ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> ByteOffset -> Located a
L ByteString
bs' (ByteOffset
off forall a. Num a => a -> a -> a
+ ByteOffset
sizeX), forall a s. a -> DecodeResult s a
DecodeDone a
x)
Maybe (a, ByteOffset, ByteString)
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk, forall s a. Decoder s a -> DecodeResult s a
DecodeNeedsData forall s a. ByteSwap a => Decoder s a
decodeLittleEndian)
decodeLargeToken ::
Word32
-> Decoder s L.ByteString
decodeLargeToken :: forall s. ByteOffset -> Decoder s ByteString
decodeLargeToken ByteOffset
n = forall s a.
(LocatedChunk -> ST s (LocatedChunk, DecodeResult s a))
-> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \LocatedChunk
chunk ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk, forall s a.
ByteOffset -> (ByteString -> Decoder s a) -> DecodeResult s a
DecodeLargeToken ByteOffset
n forall (m :: * -> *) a. Monad m => a -> m a
return)
decodeIncremental ::
Word32
-> Decoder s a
-> Decoder s [a]
decodeIncremental :: forall s a. ByteOffset -> Decoder s a -> Decoder s [a]
decodeIncremental ByteOffset
n Decoder s a
d = forall s a.
(LocatedChunk -> ST s (LocatedChunk, DecodeResult s a))
-> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \LocatedChunk
chunk ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk, forall s a b.
ByteOffset
-> Decoder s a -> ([a] -> Decoder s b) -> DecodeResult s b
DecodeIncremental ByteOffset
n Decoder s a
d forall (m :: * -> *) a. Monad m => a -> m a
return)
decodeIncremental_ ::
Word32
-> Decoder s ()
-> Decoder s ()
decodeIncremental_ :: forall s. ByteOffset -> Decoder s () -> Decoder s ()
decodeIncremental_ ByteOffset
n Decoder s ()
d = forall s a.
(LocatedChunk -> ST s (LocatedChunk, DecodeResult s a))
-> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \LocatedChunk
chunk ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk, forall s a.
ByteOffset -> Decoder s () -> Decoder s a -> DecodeResult s a
DecodeIncremental_ ByteOffset
n Decoder s ()
d forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
data DecodeResult s a where
DecodeDone :: a -> DecodeResult s a
DecodeFail :: String -> DecodeResult s a
DecodeNeedsData :: Decoder s a -> DecodeResult s a
DecodeLargeToken ::
Word32
-> (L.ByteString -> Decoder s a)
-> DecodeResult s a
DecodeIncremental ::
Word32
-> Decoder s a
-> ([a] -> Decoder s b)
-> DecodeResult s b
DecodeIncremental_ ::
Word32
-> Decoder s ()
-> Decoder s a
-> DecodeResult s a
instance Functor (Decoder s) where
fmap :: forall a b. (a -> b) -> Decoder s a -> Decoder s b
fmap = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA
instance Applicative (Decoder s) where
pure :: forall a. a -> Decoder s a
pure a
x = forall s a.
(LocatedChunk -> ST s (LocatedChunk, DecodeResult s a))
-> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \LocatedChunk
chunk -> forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk, forall a s. a -> DecodeResult s a
DecodeDone a
x)
<*> :: forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (Decoder s) where
return :: forall a. a -> Decoder s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Decoder s a
x >>= :: forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
>>= a -> Decoder s b
f = forall s a.
(LocatedChunk -> ST s (LocatedChunk, DecodeResult s a))
-> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \LocatedChunk
chunk -> do
(LocatedChunk
chunk', DecodeResult s a
result) <- forall s a.
Decoder s a
-> LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
matchChunk Decoder s a
x LocatedChunk
chunk
case DecodeResult s a
result of
DecodeDone a
a ->
forall s a.
Decoder s a
-> LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
matchChunk (a -> Decoder s b
f a
a) LocatedChunk
chunk'
DecodeFail String
e ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk', forall s a. String -> DecodeResult s a
DecodeFail String
e)
DecodeNeedsData Decoder s a
d ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk', forall s a. Decoder s a -> DecodeResult s a
DecodeNeedsData (Decoder s a
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Decoder s b
f))
DecodeLargeToken ByteOffset
reqLen ByteString -> Decoder s a
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk', forall s a.
ByteOffset -> (ByteString -> Decoder s a) -> DecodeResult s a
DecodeLargeToken ByteOffset
reqLen (ByteString -> Decoder s a
k forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Decoder s b
f))
DecodeIncremental ByteOffset
count Decoder s a
d [a] -> Decoder s a
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk', forall s a b.
ByteOffset
-> Decoder s a -> ([a] -> Decoder s b) -> DecodeResult s b
DecodeIncremental ByteOffset
count Decoder s a
d ([a] -> Decoder s a
k forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Decoder s b
f))
DecodeIncremental_ ByteOffset
count Decoder s ()
d Decoder s a
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk', forall s a.
ByteOffset -> Decoder s () -> Decoder s a -> DecodeResult s a
DecodeIncremental_ ByteOffset
count Decoder s ()
d (Decoder s a
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Decoder s b
f))
instance MonadFail (Decoder s) where
fail :: forall a. String -> Decoder s a
fail String
e = forall s a.
(LocatedChunk -> ST s (LocatedChunk, DecodeResult s a))
-> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \LocatedChunk
chunk -> forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk, forall s a. String -> DecodeResult s a
DecodeFail String
e)
runDecoder :: Decoder s a -> Incr s (LocatedChunk, a)
runDecoder :: forall s a. Decoder s a -> Incr s (LocatedChunk, a)
runDecoder = forall s a. LocatedChunk -> Decoder s a -> Incr s (LocatedChunk, a)
runWith forall a b. (a -> b) -> a -> b
$ forall a. a -> ByteOffset -> Located a
L ByteString
S.empty ByteOffset
0
runWith :: LocatedChunk -> Decoder s a -> Incr s (LocatedChunk, a)
runWith :: forall s a. LocatedChunk -> Decoder s a -> Incr s (LocatedChunk, a)
runWith LocatedChunk
chunk Decoder s a
d = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall s a.
LocatedChunk -> DecodeResult s a -> Incr s (LocatedChunk, a)
processResult forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s a. ST s a -> Incr s a
liftIncr (forall s a.
Decoder s a
-> LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
matchChunk Decoder s a
d LocatedChunk
chunk)
processResult :: LocatedChunk -> DecodeResult s a -> Incr s (LocatedChunk, a)
processResult :: forall s a.
LocatedChunk -> DecodeResult s a -> Incr s (LocatedChunk, a)
processResult LocatedChunk
chunk = \case
DecodeDone a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedChunk
chunk, a
x)
DecodeFail String
e -> forall s a. LocatedChunk -> String -> Incr s a
decodeFail LocatedChunk
chunk String
e
DecodeNeedsData Decoder s a
d -> forall s a. Decoder s a -> LocatedChunk -> Incr s (LocatedChunk, a)
processNeedsData Decoder s a
d LocatedChunk
chunk
DecodeLargeToken ByteOffset
n ByteString -> Decoder s a
k -> forall s a.
ByteOffset
-> (ByteString -> Decoder s a)
-> LocatedChunk
-> Incr s (LocatedChunk, a)
processLargeToken ByteOffset
n ByteString -> Decoder s a
k LocatedChunk
chunk
DecodeIncremental ByteOffset
n Decoder s a
d [a] -> Decoder s a
k -> forall s a b.
ByteOffset
-> Decoder s a
-> ([a] -> Decoder s b)
-> LocatedChunk
-> Incr s (LocatedChunk, b)
processIncremental ByteOffset
n Decoder s a
d [a] -> Decoder s a
k LocatedChunk
chunk
DecodeIncremental_ ByteOffset
n Decoder s ()
d Decoder s a
k -> forall s a.
ByteOffset
-> Decoder s ()
-> Decoder s a
-> LocatedChunk
-> Incr s (LocatedChunk, a)
processIncremental_ ByteOffset
n Decoder s ()
d Decoder s a
k LocatedChunk
chunk
processNeedsData ::
Decoder s a
-> Located S.ByteString
-> Incr s (LocatedChunk, a)
processNeedsData :: forall s a. Decoder s a -> LocatedChunk -> Incr s (LocatedChunk, a)
processNeedsData Decoder s a
d chunk :: LocatedChunk
chunk@(L ByteString
bs ByteOffset
off) = forall s. Incr s (Maybe ByteString)
needChunk forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ByteString
Nothing -> forall s a. LocatedChunk -> String -> Incr s a
decodeFail LocatedChunk
chunk String
"end of input"
Just ByteString
next -> forall s a. LocatedChunk -> Decoder s a -> Incr s (LocatedChunk, a)
runWith (forall a. a -> ByteOffset -> Located a
L (ByteString
bs forall a. Semigroup a => a -> a -> a
<> ByteString
next) ByteOffset
off) Decoder s a
d
processLargeToken :: forall s a.
Word32
-> (L.ByteString -> Decoder s a)
-> LocatedChunk
-> Incr s (LocatedChunk, a)
processLargeToken :: forall s a.
ByteOffset
-> (ByteString -> Decoder s a)
-> LocatedChunk
-> Incr s (LocatedChunk, a)
processLargeToken ByteOffset
reqLen ByteString -> Decoder s a
k = LocatedChunks -> Incr s (LocatedChunk, a)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedChunk -> LocatedChunks
toLocatedChunks
where
go :: LocatedChunks -> Incr s (LocatedChunk, a)
go :: LocatedChunks -> Incr s (LocatedChunk, a)
go LocatedChunks
acc =
case ByteOffset -> LocatedChunks -> Maybe (ByteString, LocatedChunk)
splitChunks ByteOffset
reqLen LocatedChunks
acc of
Maybe (ByteString, LocatedChunk)
Nothing -> forall s. Incr s (Maybe ByteString)
needChunk forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ByteString
Nothing -> forall s a. LocatedChunk -> String -> Incr s a
decodeFail (LocatedChunks -> LocatedChunk
fromLocatedChunks LocatedChunks
acc) String
"end of input"
Just ByteString
next -> LocatedChunks -> Incr s (LocatedChunk, a)
go (ByteString -> LocatedChunks -> LocatedChunks
addChunk ByteString
next LocatedChunks
acc)
Just (ByteString
large, LocatedChunk
left) ->
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall s a.
LocatedChunk -> DecodeResult s a -> Incr s (LocatedChunk, a)
processResult forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s a. ST s a -> Incr s a
liftIncr (forall s a.
Decoder s a
-> LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
matchChunk (ByteString -> Decoder s a
k ByteString
large) LocatedChunk
left)
processIncremental :: forall s a b.
Word32
-> Decoder s a
-> ([a] -> Decoder s b)
-> LocatedChunk
-> Incr s (LocatedChunk, b)
processIncremental :: forall s a b.
ByteOffset
-> Decoder s a
-> ([a] -> Decoder s b)
-> LocatedChunk
-> Incr s (LocatedChunk, b)
processIncremental ByteOffset
count Decoder s a
d [a] -> Decoder s b
k = [a] -> ByteOffset -> LocatedChunk -> Incr s (LocatedChunk, b)
go [] ByteOffset
count
where
go :: [a] -> Word32 -> LocatedChunk -> Incr s (LocatedChunk, b)
go :: [a] -> ByteOffset -> LocatedChunk -> Incr s (LocatedChunk, b)
go [a]
acc ByteOffset
0 LocatedChunk
chunk = do (LocatedChunk, DecodeResult s b)
result <- forall s a. ST s a -> Incr s a
liftIncr (forall s a.
Decoder s a
-> LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
matchChunk ([a] -> Decoder s b
k (forall a. [a] -> [a]
reverse [a]
acc)) LocatedChunk
chunk)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall s a.
LocatedChunk -> DecodeResult s a -> Incr s (LocatedChunk, a)
processResult (LocatedChunk, DecodeResult s b)
result
go [a]
acc ByteOffset
n LocatedChunk
chunk = do (LocatedChunk
chunk', a
a) <- forall s a. LocatedChunk -> Decoder s a -> Incr s (LocatedChunk, a)
runWith LocatedChunk
chunk Decoder s a
d
[a] -> ByteOffset -> LocatedChunk -> Incr s (LocatedChunk, b)
go (a
aforall a. a -> [a] -> [a]
:[a]
acc) (ByteOffset
n forall a. Num a => a -> a -> a
- ByteOffset
1) LocatedChunk
chunk'
processIncremental_ :: forall s a.
Word32
-> Decoder s ()
-> Decoder s a
-> LocatedChunk
-> Incr s (LocatedChunk, a)
processIncremental_ :: forall s a.
ByteOffset
-> Decoder s ()
-> Decoder s a
-> LocatedChunk
-> Incr s (LocatedChunk, a)
processIncremental_ ByteOffset
count Decoder s ()
d Decoder s a
k = ByteOffset -> LocatedChunk -> Incr s (LocatedChunk, a)
go ByteOffset
count
where
go :: Word32 -> LocatedChunk -> Incr s (LocatedChunk, a)
go :: ByteOffset -> LocatedChunk -> Incr s (LocatedChunk, a)
go ByteOffset
0 LocatedChunk
chunk = do (LocatedChunk, DecodeResult s a)
result <- forall s a. ST s a -> Incr s a
liftIncr (forall s a.
Decoder s a
-> LocatedChunk -> ST s (LocatedChunk, DecodeResult s a)
matchChunk Decoder s a
k LocatedChunk
chunk)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall s a.
LocatedChunk -> DecodeResult s a -> Incr s (LocatedChunk, a)
processResult (LocatedChunk, DecodeResult s a)
result
go ByteOffset
n LocatedChunk
chunk = do (LocatedChunk
chunk', ()) <- forall s a. LocatedChunk -> Decoder s a -> Incr s (LocatedChunk, a)
runWith LocatedChunk
chunk Decoder s ()
d
ByteOffset -> LocatedChunk -> Incr s (LocatedChunk, a)
go (ByteOffset
n forall a. Num a => a -> a -> a
- ByteOffset
1) LocatedChunk
chunk'
deserialiseByteString ::
(forall s. Decoder s a)
-> L.ByteString
-> Either DeserialiseFailure (L.ByteString, ByteOffset, a)
deserialiseByteString :: forall a.
(forall s. Decoder s a)
-> ByteString
-> Either DeserialiseFailure (ByteString, ByteOffset, a)
deserialiseByteString forall s. Decoder s a
d = forall a.
(forall s. ST s (IDecode s a))
-> ByteString
-> Either DeserialiseFailure (ByteString, ByteOffset, a)
runIDecode (forall s a. Incr s (LocatedChunk, a) -> ST s (IDecode s a)
runIncr (forall s a. Decoder s a -> Incr s (LocatedChunk, a)
runDecoder forall s. Decoder s a
d))