{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Trustworthy           #-}
{-# OPTIONS_GHC -Wno-orphans #-}
--------------------------------------------------------------------
-- |
-- Module    : Data.MessagePack
-- Copyright : (c) Hideyuki Tanaka, 2009-2015
-- License   : BSD3
--
-- Maintainer:  tanaka.hideyuki@gmail.com
-- Stability :  experimental
-- Portability: portable
--
-- Simple interface to pack and unpack MessagePack data.
--
--------------------------------------------------------------------

module Data.MessagePack (
    -- * Simple interface to pack and unpack msgpack binary
      pack
    , unpack
    , unpackEither
    , unpackValidate

    -- * Re-export modules
    -- $reexports
    , module X
    ) where

import           Control.Applicative    (Applicative)
import           Control.Monad          ((>=>))
import           Control.Monad.Validate (MonadValidate (..), Validate,
                                         runValidate)
import           Data.Binary            (Binary (..), decodeOrFail, encode)
import           Data.Binary.Get        (Get)
import qualified Data.ByteString.Lazy   as L

import           Data.MessagePack.Get   as X
import           Data.MessagePack.Put   as X
import           Data.MessagePack.Types as X


-- | Pack a Haskell value to MessagePack binary.
pack :: MessagePack a => a -> L.ByteString
pack :: a -> ByteString
pack = Object -> ByteString
forall a. Binary a => a -> ByteString
encode (Object -> ByteString) -> (a -> Object) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> Object
forall a. MessagePack a => Config -> a -> Object
toObject Config
defaultConfig

-- | Unpack MessagePack binary to a Haskell value.
--
-- On failure, returns a list of error messages.
unpackValidate :: MessagePack a
               => L.ByteString -> Validate DecodeError a
unpackValidate :: ByteString -> Validate DecodeError a
unpackValidate = Either
  (ByteString, ByteOffset, String) (ByteString, ByteOffset, Object)
-> ValidateT DecodeError Identity Object
forall (m :: * -> *) a b a b a.
MonadValidate DecodeError m =>
Either (a, b, String) (a, b, a) -> m a
eitherToM (Either
   (ByteString, ByteOffset, String) (ByteString, ByteOffset, Object)
 -> ValidateT DecodeError Identity Object)
-> (ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, Object))
-> ByteString
-> ValidateT DecodeError Identity Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Object)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail (ByteString -> ValidateT DecodeError Identity Object)
-> (Object -> Validate DecodeError a)
-> ByteString
-> Validate DecodeError a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Config -> Object -> Validate DecodeError a
forall a (m :: * -> *).
(MessagePack a, Applicative m, Monad m,
 MonadValidate DecodeError m) =>
Config -> Object -> m a
fromObjectWith Config
defaultConfig
  where
    eitherToM :: Either (a, b, String) (a, b, a) -> m a
eitherToM (Left  (a
_, b
_, String
msg)) = DecodeError -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (DecodeError -> m a) -> DecodeError -> m a
forall a b. (a -> b) -> a -> b
$ String -> DecodeError
decodeError String
msg
    eitherToM (Right (a
_, b
_, a
res)) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res


unpackEither :: (MessagePack a)
               => L.ByteString -> Either DecodeError a
unpackEither :: ByteString -> Either DecodeError a
unpackEither = 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
. ByteString -> Validate DecodeError a
forall a. MessagePack a => ByteString -> Validate DecodeError a
unpackValidate


-- | 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 :: (Applicative m, Monad m, MonadFail m, MessagePack a)
#else
unpack :: (Applicative m, Monad m, MessagePack a)
#endif
       => L.ByteString -> m a
unpack :: ByteString -> m a
unpack = 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
. ByteString -> Either DecodeError a
forall a. MessagePack a => ByteString -> Either DecodeError a
unpackEither
  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


instance Binary Object where
    get :: Get Object
get = Get Object
getObject
    {-# INLINE get #-}

    put :: Object -> Put
put = Object -> Put
putObject
    {-# INLINE put #-}


instance MonadValidate DecodeError Get where
    refute :: DecodeError -> Get a
refute = String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a)
-> (DecodeError -> String) -> DecodeError -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeError -> String
forall a. Show a => a -> String
show
    tolerate :: Get a -> Get (Maybe a)
tolerate Get a
m = Get a
m Get a -> Get (Maybe a) -> Get (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> Get (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing