-- | Provides the 'Serial' class.
module Charon.Class.Serial
  ( -- * Class
    Serial (..),

    -- * Encoding
    encodeThrowM,

    -- * Decoding
    decodeUnit,
    decodeUnitThrowM,
  )
where

import Charon.Prelude

-- | Class for (de)serializing data. This differs from the Serialise class
-- in that Serialise is specifically used for the Cbor backend, whereas this
-- is meant as a general interface.
--
-- For instance, the Cbor PathData implements Serial in terms of its
-- Serialise (binary) instance. We then use the common Serial interface
-- when (en|de)coding to/from a file.
--
-- Thus this interface is primarily intended for the various PathDatas to
-- implement. Less commonly, however, there are some types that implement
-- Serial as a general to/from ByteString, e.g. Timestampe implements it,
-- which is used by the Fdo backend.
class Serial a where
  -- | Extra data used for decoding.
  type DecodeExtra a

  -- | Encode to bytestring.
  encode :: a -> Either String ByteString

  -- | Decode from a bytestring.
  decode :: DecodeExtra a -> ByteString -> Either String a

-- | Encodes the value, throwing an exception for any failures.
encodeThrowM :: (HasCallStack, MonadThrow m, Serial a) => a -> m ByteString
encodeThrowM :: forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Serial a) =>
a -> m ByteString
encodeThrowM a
x = case a -> Either String ByteString
forall a. Serial a => a -> Either String ByteString
encode a
x of
  Left String
s -> String -> m ByteString
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
throwString String
s
  Right ByteString
y -> ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
y

-- | Decodes the value, throwing an exception for any failures.
decodeThrowM ::
  ( HasCallStack,
    Serial a,
    MonadThrow m
  ) =>
  DecodeExtra a ->
  ByteString ->
  m a
decodeThrowM :: forall a (m :: * -> *).
(HasCallStack, Serial a, MonadThrow m) =>
DecodeExtra a -> ByteString -> m a
decodeThrowM DecodeExtra a
extra ByteString
bs = case DecodeExtra a -> ByteString -> Either String a
forall a.
Serial a =>
DecodeExtra a -> ByteString -> Either String a
decode DecodeExtra a
extra ByteString
bs of
  Left String
s -> String -> m a
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
throwString String
s
  Right a
y -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
y

-- | Convenience function for when decoding takes no extra data.
decodeUnit :: (DecodeExtra a ~ (), Serial a) => ByteString -> Either String a
decodeUnit :: forall a.
(DecodeExtra a ~ (), Serial a) =>
ByteString -> Either String a
decodeUnit = DecodeExtra a -> ByteString -> Either String a
forall a.
Serial a =>
DecodeExtra a -> ByteString -> Either String a
decode ()

-- | Convenience function for when 'decodeThrowM' takes no extra data.
decodeUnitThrowM ::
  ( DecodeExtra a ~ (),
    HasCallStack,
    MonadThrow m,
    Serial a
  ) =>
  ByteString ->
  m a
decodeUnitThrowM :: forall a (m :: * -> *).
(DecodeExtra a ~ (), HasCallStack, MonadThrow m, Serial a) =>
ByteString -> m a
decodeUnitThrowM = DecodeExtra a -> ByteString -> m a
forall a (m :: * -> *).
(HasCallStack, Serial a, MonadThrow m) =>
DecodeExtra a -> ByteString -> m a
decodeThrowM ()