module Codec.Extras.FlatViaSerialise
( FlatViaSerialise (..)
) where
import Codec.Serialise (Serialise, deserialiseOrFail, serialise)
import Data.ByteString.Lazy qualified as BSL (toStrict)
import Flat
newtype FlatViaSerialise a = FlatViaSerialise { forall a. FlatViaSerialise a -> a
unFlatViaSerialise :: a }
instance Serialise a => Flat (FlatViaSerialise a) where
encode :: FlatViaSerialise a -> Encoding
encode = ByteString -> Encoding
forall a. Flat a => a -> Encoding
encode (ByteString -> Encoding)
-> (FlatViaSerialise a -> ByteString)
-> FlatViaSerialise a
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (FlatViaSerialise a -> ByteString)
-> FlatViaSerialise a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Serialise a => a -> ByteString
serialise (a -> ByteString)
-> (FlatViaSerialise a -> a) -> FlatViaSerialise a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatViaSerialise a -> a
forall a. FlatViaSerialise a -> a
unFlatViaSerialise
decode :: Get (FlatViaSerialise a)
decode = do
Either DeserialiseFailure a
errOrX <- ByteString -> Either DeserialiseFailure a
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail (ByteString -> Either DeserialiseFailure a)
-> Get ByteString -> Get (Either DeserialiseFailure a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall a. Flat a => Get a
decode
case Either DeserialiseFailure a
errOrX of
Left DeserialiseFailure
err -> String -> Get (FlatViaSerialise a)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (FlatViaSerialise a))
-> String -> Get (FlatViaSerialise a)
forall a b. (a -> b) -> a -> b
$ DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
err
Right a
x -> FlatViaSerialise a -> Get (FlatViaSerialise a)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FlatViaSerialise a -> Get (FlatViaSerialise a))
-> FlatViaSerialise a -> Get (FlatViaSerialise a)
forall a b. (a -> b) -> a -> b
$ a -> FlatViaSerialise a
forall a. a -> FlatViaSerialise a
FlatViaSerialise a
x
size :: FlatViaSerialise a -> NumBits -> NumBits
size = ByteString -> NumBits -> NumBits
forall a. Flat a => a -> NumBits -> NumBits
size (ByteString -> NumBits -> NumBits)
-> (FlatViaSerialise a -> ByteString)
-> FlatViaSerialise a
-> NumBits
-> NumBits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (FlatViaSerialise a -> ByteString)
-> FlatViaSerialise a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Serialise a => a -> ByteString
serialise (a -> ByteString)
-> (FlatViaSerialise a -> a) -> FlatViaSerialise a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatViaSerialise a -> a
forall a. FlatViaSerialise a -> a
unFlatViaSerialise