{-# LANGUAGE CPP #-}
module Test.MessagePack.BytePacker
    ( BytePacker (..)
    , unpackEither, unpack
    ) where

import           Control.Monad.Validate (Validate, runValidate)
import qualified Data.ByteString.Lazy   as LBS
import           Data.MessagePack.Types (DecodeError, MessagePack (..))


class BytePacker p where
    -- | Pack a Haskell value to MessagePack binary.
    pack :: MessagePack a => p -> a -> LBS.ByteString
    -- | Unpack MessagePack binary to a Haskell value.
    --
    -- On failure, returns a list of error messages.
    unpackValidate :: MessagePack a => p -> LBS.ByteString -> Validate DecodeError a


unpackEither :: (BytePacker p, MessagePack a) => p -> LBS.ByteString -> Either DecodeError a
unpackEither :: p -> ByteString -> Either DecodeError a
unpackEither p
p = Validate DecodeError a -> Either DecodeError a
forall e a. Validate e a -> Either e a
runValidate (Validate DecodeError a -> Either DecodeError a)
-> (ByteString -> Validate DecodeError a)
-> ByteString
-> Either DecodeError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> ByteString -> Validate DecodeError a
forall p a.
(BytePacker p, MessagePack a) =>
p -> ByteString -> Validate DecodeError a
unpackValidate p
p


-- | Unpack MessagePack binary to a Haskell value. If it fails, it fails in the
-- Monad. In the Maybe monad, failure returns Nothing.
#if (MIN_VERSION_base(4,13,0))
unpack :: (BytePacker p, Monad m, MonadFail m, MessagePack a)
#else
unpack :: (BytePacker p, Monad m, MessagePack a)
#endif
       => p -> LBS.ByteString -> m a
unpack :: p -> ByteString -> m a
unpack p
p = Either DecodeError a -> m a
forall (m :: * -> *) a a.
(MonadFail m, Show a) =>
Either a a -> m a
eitherToM (Either DecodeError a -> m a)
-> (ByteString -> Either DecodeError a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> ByteString -> Either DecodeError a
forall p a.
(BytePacker p, MessagePack a) =>
p -> ByteString -> Either DecodeError a
unpackEither p
p
  where
    eitherToM :: Either a a -> m a
eitherToM (Left a
msgs) = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
msgs
    eitherToM (Right a
res) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res