-- | Compat layer for serialization
--
-- Wraps @persist@ library
module Compat.Binary
    ( Persist(put, get)

    , runPut', runPut, runPutLazy, Put, PutM
    , runGet', runGet, Get

    , getWord64be, putWord64be
    , getWord32be, putWord32be
    , getWord16be, putWord16be
    , getWord8   , putWord8

    , getInt64be, putInt64be
    , getInt32be, putInt32be
    , getInt16be, putInt16be
    , getInt8   , putInt8

    , getFloat64be, putFloat64be

    , getByteString, putByteString
    ) where

import           Compat.Prelude

import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as BL
import           Data.Kind            (Type)
import qualified Data.Text            as T

import           Data.Persist         (Persist(put, get), Get)
import qualified Data.Persist         as P
import           GHC.Float            (castDoubleToWord64, castWord64ToDouble)

-- | The serialization monad (alias for @persist@'s 'P.Put' @()@).
type Put :: Type
type Put = P.Put ()

-- | The serialization monad parameterized by its result type.
type PutM :: Type -> Type
type PutM = P.Put

-- | Run a 'Put' action and return a strict 'BS.ByteString'.
runPut :: Put -> BS.ByteString
runPut :: Put -> ByteString
runPut = Put -> ByteString
forall a. Put a -> ByteString
P.runPut

-- | Alias for 'runPut'.
runPut' :: Put -> BS.ByteString
runPut' :: Put -> ByteString
runPut' = Put -> ByteString
forall a. Put a -> ByteString
P.runPut

-- | Run a 'Put' action and return a lazy 'BL.ByteString'.
runPutLazy :: Put -> BL.ByteString
runPutLazy :: Put -> ByteString
runPutLazy = Put -> ByteString
forall a. Put a -> ByteString
P.runPutLazy

-- | Run a 'Get' parser on a strict 'BS.ByteString'.
runGet' :: BS.ByteString -> Get a -> Either T.Text a
runGet' :: forall a. ByteString -> Get a -> Either Text a
runGet' ByteString
bs Get a
g = case Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
P.runGet Get a
g ByteString
bs of
  Left String
e  -> Text -> Either Text a
forall a b. a -> Either a b
Left (String -> Text
T.pack String
e)
  Right a
x -> a -> Either Text a
forall a b. b -> Either a b
Right a
x

-- | Run a 'Get' parser on a lazy 'BL.ByteString'.
runGet :: BL.ByteString -> Get a -> Either T.Text a
runGet :: forall a. ByteString -> Get a -> Either Text a
runGet ByteString
bs Get a
g = ByteString -> Get a -> Either Text a
forall a. ByteString -> Get a -> Either Text a
runGet' (ByteString -> ByteString
BL.toStrict ByteString
bs) Get a
g

-- | Deserialize a single byte.
{-# INLINE getWord8 #-}
getWord8 :: Get Word8
getWord8 :: Get Word8
getWord8 = Get Word8
forall t. Persist t => Get t
P.get

-- | Serialize a single byte.
{-# INLINE putWord8 #-}
putWord8 :: Word8 -> Put
putWord8 :: Word8 -> Put
putWord8 = Word8 -> Put
forall t. Persist t => t -> Put
P.put

-- | Deserialize a big-endian 'Word16'.
{-# INLINE getWord16be #-}
getWord16be :: Get Word16
getWord16be :: Get Word16
getWord16be = Get Word16
forall a. Persist (BigEndian a) => Get a
P.getBE

-- | Serialize a big-endian 'Word16'.
{-# INLINE putWord16be #-}
putWord16be :: Word16 -> Put
putWord16be :: Word16 -> Put
putWord16be = Word16 -> Put
forall a. Persist (BigEndian a) => a -> Put
P.putBE

-- | Deserialize a big-endian 'Word32'.
{-# INLINE getWord32be #-}
getWord32be :: Get Word32
getWord32be :: Get Word32
getWord32be = Get Word32
forall a. Persist (BigEndian a) => Get a
P.getBE

-- | Serialize a big-endian 'Word32'.
{-# INLINE putWord32be #-}
putWord32be :: Word32 -> Put
putWord32be :: Word32 -> Put
putWord32be = Word32 -> Put
forall a. Persist (BigEndian a) => a -> Put
P.putBE

-- | Deserialize a big-endian 'Word64'.
{-# INLINE getWord64be #-}
getWord64be :: Get Word64
getWord64be :: Get Word64
getWord64be = Get Word64
forall a. Persist (BigEndian a) => Get a
P.getBE

-- | Serialize a big-endian 'Word64'.
{-# INLINE putWord64be #-}
putWord64be :: Word64 -> Put
putWord64be :: Word64 -> Put
putWord64be = Word64 -> Put
forall a. Persist (BigEndian a) => a -> Put
P.putBE

-- | Deserialize a signed 8-bit integer.
{-# INLINE getInt8 #-}
getInt8 :: Get Int8
getInt8 :: Get Int8
getInt8 = Word8 -> Int8
forall a b.
(Integral a, Integral b, IsIntTypeIso a b ~ 'True) =>
a -> b
intCastIso (Word8 -> Int8) -> Get Word8 -> Get Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Persist t => Get t
P.get @Word8

-- | Deserialize a big-endian signed 16-bit integer.
{-# INLINE getInt16be #-}
getInt16be :: Get Int16
getInt16be :: Get Int16
getInt16be = Word16 -> Int16
forall a b.
(Integral a, Integral b, IsIntTypeIso a b ~ 'True) =>
a -> b
intCastIso (Word16 -> Int16) -> Get Word16 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Persist (BigEndian a) => Get a
P.getBE @Word16

-- | Deserialize a big-endian signed 32-bit integer.
{-# INLINE getInt32be #-}
getInt32be :: Get Int32
getInt32be :: Get Int32
getInt32be = Word32 -> Int32
forall a b.
(Integral a, Integral b, IsIntTypeIso a b ~ 'True) =>
a -> b
intCastIso (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Persist (BigEndian a) => Get a
P.getBE @Word32

-- | Deserialize a big-endian signed 64-bit integer.
{-# INLINE getInt64be #-}
getInt64be :: Get Int64
getInt64be :: Get Int64
getInt64be = Word64 -> Int64
forall a b.
(Integral a, Integral b, IsIntTypeIso a b ~ 'True) =>
a -> b
intCastIso (Word64 -> Int64) -> Get Word64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Persist (BigEndian a) => Get a
P.getBE @Word64

-- | Serialize a signed 8-bit integer.
{-# INLINE putInt8 #-}
putInt8 :: Int8 -> Put
putInt8 :: Int8 -> Put
putInt8 Int8
x = Word8 -> Put
forall t. Persist t => t -> Put
P.put (Int8 -> Word8
forall a b.
(Integral a, Integral b, IsIntTypeIso a b ~ 'True) =>
a -> b
intCastIso Int8
x :: Word8)

-- | Serialize a big-endian signed 16-bit integer.
{-# INLINE putInt16be #-}
putInt16be :: Int16 -> Put
putInt16be :: Int16 -> Put
putInt16be Int16
x = Word16 -> Put
forall a. Persist (BigEndian a) => a -> Put
P.putBE (Int16 -> Word16
forall a b.
(Integral a, Integral b, IsIntTypeIso a b ~ 'True) =>
a -> b
intCastIso Int16
x :: Word16)

-- | Serialize a big-endian signed 32-bit integer.
{-# INLINE putInt32be #-}
putInt32be :: Int32 -> Put
putInt32be :: Int32 -> Put
putInt32be Int32
x = Word32 -> Put
forall a. Persist (BigEndian a) => a -> Put
P.putBE (Int32 -> Word32
forall a b.
(Integral a, Integral b, IsIntTypeIso a b ~ 'True) =>
a -> b
intCastIso Int32
x :: Word32)

-- | Serialize a big-endian signed 64-bit integer.
{-# INLINE putInt64be #-}
putInt64be :: Int64 -> Put
putInt64be :: Int64 -> Put
putInt64be Int64
x = Word64 -> Put
forall a. Persist (BigEndian a) => a -> Put
P.putBE (Int64 -> Word64
forall a b.
(Integral a, Integral b, IsIntTypeIso a b ~ 'True) =>
a -> b
intCastIso Int64
x :: Word64)

-- | Serialize a big-endian 64-bit IEEE 754 double.
{-# INLINE putFloat64be #-}
putFloat64be :: Double -> Put
putFloat64be :: Double -> Put
putFloat64be Double
x = Word64 -> Put
forall a. Persist (BigEndian a) => a -> Put
P.putBE (Double -> Word64
castDoubleToWord64 Double
x)

-- | Deserialize a big-endian 64-bit IEEE 754 double.
{-# INLINE getFloat64be #-}
getFloat64be :: Get Double
getFloat64be :: Get Double
getFloat64be = Word64 -> Double
castWord64ToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Persist (BigEndian a) => Get a
P.getBE @Word64

-- | Deserialize exactly @n@ bytes into a strict 'BS.ByteString'.
{-# INLINE getByteString #-}
getByteString :: Int -> Get BS.ByteString
getByteString :: Int -> Get ByteString
getByteString = Int -> Get ByteString
P.getByteString

-- | Serialize a strict 'BS.ByteString' directly into the output.
{-# INLINE putByteString #-}
putByteString :: BS.ByteString -> Put
putByteString :: ByteString -> Put
putByteString = ByteString -> Put
P.putByteString