module Codec.CBOR.Extras where

import Codec.CBOR.Decoding as CBOR
import Codec.Serialise (Serialise, decode, encode)
import Data.Either.Extras
import Flat qualified
import Flat.Decoder qualified as Flat


-- | Newtype to provide 'Serialise' instances for types with a 'Flat' instance that
-- just encodes the flat-serialized value as a CBOR bytestring
newtype SerialiseViaFlat a = SerialiseViaFlat a
instance Flat.Flat a => Serialise (SerialiseViaFlat a) where
  encode :: SerialiseViaFlat a -> Encoding
encode (SerialiseViaFlat a
a) = forall a. Serialise a => a -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall a. Flat a => a -> ByteString
Flat.flat a
a
  decode :: forall s. Decoder s (SerialiseViaFlat a)
decode = forall a. a -> SerialiseViaFlat a
SerialiseViaFlat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. Get a -> Decoder s a
decodeViaFlat forall a. Flat a => Get a
Flat.decode

decodeViaFlat :: Flat.Get a -> CBOR.Decoder s a
decodeViaFlat :: forall a s. Get a -> Decoder s a
decodeViaFlat Get a
decoder = do
    ByteString
bs <- forall s. Decoder s ByteString
decodeBytes
    -- lift any flat's failures to be cborg failures (MonadFail)
    forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either a b -> m b
fromRightM (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$
        forall b a. AsByteString b => Get a -> b -> Decoded a
Flat.unflatWith Get a
decoder ByteString
bs