module Data.Beamable
( Beamable
, beam
, unbeam
, typeSign
, encode
, decode
, encodeSigned
, decodeSigned
, Decoder
, encodeLive
, decodeLive
, feed
, Builder
, toByteString
) where
import Data.Beamable.Internal
import Blaze.ByteString.Builder
import qualified Data.ByteString as B
import Data.Word (Word)
data Decoder a
= WantAnyData
| WantPrefix B.ByteString
| WantBytes Int B.ByteString
encode :: Beamable a => a -> B.ByteString
encode = toByteString . beam
decode :: Beamable a => B.ByteString -> a
decode bs = case unbeam bs of
(a, rest) | B.null rest -> a
_ -> error $ "Beam decode failed: There are some leftovers!"
encodeSigned :: Beamable a => a -> B.ByteString
encodeSigned a = toByteString $ beam (TypeSign (typeSign a), a)
decodeSigned :: Beamable a => B.ByteString -> a
decodeSigned bs = case unbeam bs of
((s, a), rest) | B.null rest && s == TypeSign (typeSign a) -> a
_ -> error $ "Beam decode failed: Type signature mismatch!"
encodeLive :: Beamable a => a -> B.ByteString
encodeLive a = toByteString . beam . toByteString . beam $ (TypeSign (typeSign a), a)
decodeLive :: Beamable a => Decoder a
decodeLive = WantAnyData
feed :: Beamable a => Decoder a -> B.ByteString -> Either (Decoder a) (a, B.ByteString)
feed state next = case state of
WantAnyData | validPrefix next -> handlePrefix next
WantAnyData -> Left (WantPrefix next)
WantPrefix prev ->
let bs = prev `B.append` next
in if validPrefix bs
then handlePrefix bs
else Left (WantPrefix bs)
WantBytes l prev ->
let bs = prev `B.append` next
in if B.length bs >= l
then doneDecoding bs
else Left (WantBytes l bs)
where
handlePrefix :: Beamable a => B.ByteString -> Either (Decoder a) (a, B.ByteString)
handlePrefix bs | B.null bs = Left WantAnyData
handlePrefix bs =
let bsLength = (fromIntegral :: Word -> Int) $ fst $ unbeam bs
Just prefixLength = succ `fmap` B.findIndex (<128) bs
fullLength = bsLength + prefixLength
in if fullLength <= B.length bs
then doneDecoding bs
else Left (WantBytes fullLength bs)
validPrefix :: B.ByteString -> Bool
validPrefix = B.any (<128)
doneDecoding :: Beamable a => B.ByteString -> Either (Decoder a) (a, B.ByteString)
doneDecoding bs = let (bs', rest) = unbeam bs
((s, a), _) = unbeam bs'
in if s == TypeSign (typeSign a)
then Right (a, rest)
else error $ "Beam decode failed: Type signature mismatch!"