{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Codec.Extras.SerialiseViaFlat
( SerialiseViaFlat (..)
, decodeViaFlatWith
, DeserialiseFailureInfo (..)
, DeserialiseFailureReason (..)
, readDeserialiseFailureInfo
) where
import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Codec.Serialise (Serialise, decode, encode)
import Data.Either.Extras (fromRightM)
import Flat qualified
import Flat.Decoder qualified as Flat
import Prettyprinter (Pretty (pretty), (<+>))
newtype SerialiseViaFlat a = SerialiseViaFlat { forall a. SerialiseViaFlat a -> a
unSerialiseViaFlat :: a }
instance (Flat.Flat a) => Serialise (SerialiseViaFlat a) where
encode :: SerialiseViaFlat a -> Encoding
encode = ByteString -> Encoding
forall a. Serialise a => a -> Encoding
encode (ByteString -> Encoding)
-> (SerialiseViaFlat a -> ByteString)
-> SerialiseViaFlat a
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Flat a => a -> ByteString
Flat.flat (a -> ByteString)
-> (SerialiseViaFlat a -> a) -> SerialiseViaFlat a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialiseViaFlat a -> a
forall a. SerialiseViaFlat a -> a
unSerialiseViaFlat
decode :: forall s. Decoder s (SerialiseViaFlat a)
decode = a -> SerialiseViaFlat a
forall a. a -> SerialiseViaFlat a
SerialiseViaFlat (a -> SerialiseViaFlat a)
-> Decoder s a -> Decoder s (SerialiseViaFlat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a -> Decoder s a
forall a s. Get a -> Decoder s a
decodeViaFlatWith Get a
forall a. Flat a => Get a
Flat.decode
decodeViaFlatWith :: Flat.Get a -> CBOR.Decoder s a
decodeViaFlatWith :: forall a s. Get a -> Decoder s a
decodeViaFlatWith Get a
decoder = do
ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
(DecodeException -> Decoder s a)
-> Either DecodeException a -> Decoder s a
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either a b -> m b
fromRightM (String -> Decoder s a
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s a)
-> (DecodeException -> String) -> DecodeException -> Decoder s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeException -> String
forall a. Show a => a -> String
show) (Either DecodeException a -> Decoder s a)
-> Either DecodeException a -> Decoder s a
forall a b. (a -> b) -> a -> b
$ Get a -> ByteString -> Either DecodeException a
forall b a. AsByteString b => Get a -> b -> Decoded a
Flat.unflatWith Get a
decoder ByteString
bs
readDeserialiseFailureInfo :: CBOR.DeserialiseFailure -> DeserialiseFailureInfo
readDeserialiseFailureInfo :: DeserialiseFailure -> DeserialiseFailureInfo
readDeserialiseFailureInfo (CBOR.DeserialiseFailure ByteOffset
byteOffset String
reason) =
ByteOffset -> DeserialiseFailureReason -> DeserialiseFailureInfo
DeserialiseFailureInfo ByteOffset
byteOffset (DeserialiseFailureReason -> DeserialiseFailureInfo)
-> DeserialiseFailureReason -> DeserialiseFailureInfo
forall a b. (a -> b) -> a -> b
$ String -> DeserialiseFailureReason
interpretReason String
reason
where
interpretReason :: String -> DeserialiseFailureReason
interpretReason :: String -> DeserialiseFailureReason
interpretReason = \case
String
"end of input" -> DeserialiseFailureReason
EndOfInput
String
"expected bytes" -> DeserialiseFailureReason
ExpectedBytes
String
msg -> String -> DeserialiseFailureReason
OtherReason String
msg
data DeserialiseFailureInfo = DeserialiseFailureInfo
{ DeserialiseFailureInfo -> ByteOffset
dfOffset :: CBOR.ByteOffset
, DeserialiseFailureInfo -> DeserialiseFailureReason
dfReason :: DeserialiseFailureReason
}
deriving stock (DeserialiseFailureInfo -> DeserialiseFailureInfo -> Bool
(DeserialiseFailureInfo -> DeserialiseFailureInfo -> Bool)
-> (DeserialiseFailureInfo -> DeserialiseFailureInfo -> Bool)
-> Eq DeserialiseFailureInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeserialiseFailureInfo -> DeserialiseFailureInfo -> Bool
== :: DeserialiseFailureInfo -> DeserialiseFailureInfo -> Bool
$c/= :: DeserialiseFailureInfo -> DeserialiseFailureInfo -> Bool
/= :: DeserialiseFailureInfo -> DeserialiseFailureInfo -> Bool
Eq, Int -> DeserialiseFailureInfo -> ShowS
[DeserialiseFailureInfo] -> ShowS
DeserialiseFailureInfo -> String
(Int -> DeserialiseFailureInfo -> ShowS)
-> (DeserialiseFailureInfo -> String)
-> ([DeserialiseFailureInfo] -> ShowS)
-> Show DeserialiseFailureInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeserialiseFailureInfo -> ShowS
showsPrec :: Int -> DeserialiseFailureInfo -> ShowS
$cshow :: DeserialiseFailureInfo -> String
show :: DeserialiseFailureInfo -> String
$cshowList :: [DeserialiseFailureInfo] -> ShowS
showList :: [DeserialiseFailureInfo] -> ShowS
Show)
instance Pretty DeserialiseFailureInfo where
pretty :: forall ann. DeserialiseFailureInfo -> Doc ann
pretty (DeserialiseFailureInfo ByteOffset
offset DeserialiseFailureReason
reason) =
Doc ann
"CBOR deserialisation failed at the offset"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ByteOffset -> Doc ann
forall ann. ByteOffset -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ByteOffset
offset
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"for the following reason:"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DeserialiseFailureReason -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DeserialiseFailureReason -> Doc ann
pretty DeserialiseFailureReason
reason
data DeserialiseFailureReason
=
EndOfInput
|
ExpectedBytes
|
OtherReason String
deriving stock (DeserialiseFailureReason -> DeserialiseFailureReason -> Bool
(DeserialiseFailureReason -> DeserialiseFailureReason -> Bool)
-> (DeserialiseFailureReason -> DeserialiseFailureReason -> Bool)
-> Eq DeserialiseFailureReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeserialiseFailureReason -> DeserialiseFailureReason -> Bool
== :: DeserialiseFailureReason -> DeserialiseFailureReason -> Bool
$c/= :: DeserialiseFailureReason -> DeserialiseFailureReason -> Bool
/= :: DeserialiseFailureReason -> DeserialiseFailureReason -> Bool
Eq, Int -> DeserialiseFailureReason -> ShowS
[DeserialiseFailureReason] -> ShowS
DeserialiseFailureReason -> String
(Int -> DeserialiseFailureReason -> ShowS)
-> (DeserialiseFailureReason -> String)
-> ([DeserialiseFailureReason] -> ShowS)
-> Show DeserialiseFailureReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeserialiseFailureReason -> ShowS
showsPrec :: Int -> DeserialiseFailureReason -> ShowS
$cshow :: DeserialiseFailureReason -> String
show :: DeserialiseFailureReason -> String
$cshowList :: [DeserialiseFailureReason] -> ShowS
showList :: [DeserialiseFailureReason] -> ShowS
Show)
instance Pretty DeserialiseFailureReason where
pretty :: forall ann. DeserialiseFailureReason -> Doc ann
pretty = \case
DeserialiseFailureReason
EndOfInput -> Doc ann
"reached the end of input while more data was expected."
DeserialiseFailureReason
ExpectedBytes -> Doc ann
"the bytes inside the input are malformed."
OtherReason String
msg -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
msg