{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-|
Description : Serializer data type
Copyright   : (c) John Ericson, 2023
                  Sorki, 2023
Stability   : experimental

@Serializer@ ties @Get@ and @PutM@ monads
into a single datatype and allows
transforming both monads with a monad transformer
for adding extra layers like @ExceptT@
(for example when @putS@ can fail due to unsupported
version of a protocol) or @ReaderT@ (when we need
to serialize a data type based differently based
on a protocol version).

See "Data.Serializer.Example"
-}

module Data.Serializer
  (
  -- * Serializer
    Serializer(..)
  -- ** Runners
  , runGetS
  , runPutS
  -- * Simple serializer
  , SimpleSerializer
  -- ** Simple runners
  , runGetSimple
  , runPutSimple
  -- * From Get/Put, Serialize
  , lift2
  , liftSerialize
  -- * Combinators
  , mapIsoSerializer
  , mapPrismSerializer
  , tup
  -- * Utility
  , GetSerializerError(..)
  , transformGetError
  , transformPutError
  -- * Re-exports
  , Get
  , PutM
  ) where

#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
import Control.Monad.Except (MonadError, throwError)
import Control.Monad.Trans (lift)
import Control.Monad.Trans (MonadTrans)
import Control.Monad.Trans.Identity (IdentityT, runIdentityT)
import Data.ByteString (ByteString)
import Data.Serialize (Serialize)
import Data.Serialize.Get (Get, runGet)
import Data.Serialize.Put (Putter, PutM, runPutM)

import qualified Data.Serialize

-- * Serializer

-- | @Serializer@ ties @Get@ and @PutM@ monads
-- into a single datatype and allows
-- transforming the monads with a monad transformer
-- for e.g. adding @ExceptT@ or @ReaderT@ layers.
data Serializer t a = Serializer
  { forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS :: t Get a
  , forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS :: a -> t PutM ()
  }

-- ** Runners

-- | Runner for putS of @Serializer@
runPutS
  :: ( Monad (t PutM)
     , MonadTrans t
     )
  => Serializer t a        -- ^ Serializer
  -> (t PutM () -> PutM b) -- ^ Tranformer runner
  -> a                     -- ^ Value to (out)put
  -> (b, ByteString)
runPutS :: forall (t :: (* -> *) -> * -> *) a b.
(Monad (t PutM), MonadTrans t) =>
Serializer t a -> (t PutM () -> PutM b) -> a -> (b, ByteString)
runPutS Serializer t a
s t PutM () -> PutM b
run a
a = PutM b -> (b, ByteString)
forall a. PutM a -> (a, ByteString)
runPutM (PutM b -> (b, ByteString)) -> PutM b -> (b, ByteString)
forall a b. (a -> b) -> a -> b
$ t PutM () -> PutM b
run (t PutM () -> PutM b) -> t PutM () -> PutM b
forall a b. (a -> b) -> a -> b
$ (Serializer t a -> a -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t a
s) a
a

-- | Runner for getS of @Serializer@
runGetS
  :: ( Monad (t Get)
     , MonadTrans t
     )
  => Serializer t a     -- ^ Serializer
  -> (t Get a -> Get b) -- ^ Tranformer runner
  -> ByteString         -- ^ ByteString to parse
  -> Either String b
runGetS :: forall (t :: (* -> *) -> * -> *) a b.
(Monad (t Get), MonadTrans t) =>
Serializer t a
-> (t Get a -> Get b) -> ByteString -> Either String b
runGetS Serializer t a
s t Get a -> Get b
run ByteString
b = Get b -> ByteString -> Either String b
forall a. Get a -> ByteString -> Either String a
runGet (t Get a -> Get b
run (Serializer t a -> t Get a
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer t a
s)) ByteString
b

-- * Simple serializer

-- | Simple @Serializer@
type SimpleSerializer a = Serializer IdentityT a

-- ** Simple runners

-- | Runner for getS of @SimpleSerializer@
runGetSimple
  :: SimpleSerializer a
  -> ByteString
  -> Either String a
runGetSimple :: forall a. SimpleSerializer a -> ByteString -> Either String a
runGetSimple SimpleSerializer a
s ByteString
b =
  SimpleSerializer a
-> (IdentityT Get a -> Get a) -> ByteString -> Either String a
forall (t :: (* -> *) -> * -> *) a b.
(Monad (t Get), MonadTrans t) =>
Serializer t a
-> (t Get a -> Get b) -> ByteString -> Either String b
runGetS SimpleSerializer a
s (IdentityT Get a -> Get a
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT) ByteString
b

-- | Runner for putS of @SimpleSerializer@
runPutSimple
  :: SimpleSerializer a
  -> a
  -> ByteString
runPutSimple :: forall a. SimpleSerializer a -> a -> ByteString
runPutSimple SimpleSerializer a
s =
    ((), ByteString) -> ByteString
forall a b. (a, b) -> b
snd
  (((), ByteString) -> ByteString)
-> (a -> ((), ByteString)) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleSerializer a
-> (IdentityT PutM () -> PutM ()) -> a -> ((), ByteString)
forall (t :: (* -> *) -> * -> *) a b.
(Monad (t PutM), MonadTrans t) =>
Serializer t a -> (t PutM () -> PutM b) -> a -> (b, ByteString)
runPutS SimpleSerializer a
s IdentityT PutM () -> PutM ()
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT

-- * From Get/Put, Serialize

-- | Lift @Get a@ and @Putter a@ into @Serializer@
lift2
  :: forall a t
   . MonadTrans t
  => Get a
  -> Putter a
  -> Serializer t a
lift2 :: forall a (t :: (* -> *) -> * -> *).
MonadTrans t =>
Get a -> Putter a -> Serializer t a
lift2 Get a
f Putter a
g = Serializer
  { getS :: t Get a
getS = Get a -> t Get a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get a
f
  , putS :: a -> t PutM ()
putS = PutM () -> t PutM ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PutM () -> t PutM ()) -> Putter a -> a -> t PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter a
g
  }

-- | Lift @Serialize a@ instance into @Serializer@
liftSerialize
  :: ( Serialize a
     , MonadTrans t
     )
  => Serializer t a
liftSerialize :: forall a (t :: (* -> *) -> * -> *).
(Serialize a, MonadTrans t) =>
Serializer t a
liftSerialize =
  Get a -> Putter a -> Serializer t a
forall a (t :: (* -> *) -> * -> *).
MonadTrans t =>
Get a -> Putter a -> Serializer t a
lift2
    Get a
forall t. Serialize t => Get t
Data.Serialize.get
    Putter a
forall t. Serialize t => Putter t
Data.Serialize.put

-- * Combinators

-- | Map over @Serializer@
mapIsoSerializer
  :: Functor (t Get)
  => (a -> b) -- ^ Map over @getS@
  -> (b -> a) -- ^ Map over @putS@
  -> Serializer t a
  -> Serializer t b
mapIsoSerializer :: forall (t :: (* -> *) -> * -> *) a b.
Functor (t Get) =>
(a -> b) -> (b -> a) -> Serializer t a -> Serializer t b
mapIsoSerializer a -> b
f b -> a
g Serializer t a
s = Serializer
  { getS :: t Get b
getS = a -> b
f (a -> b) -> t Get a -> t Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Serializer t a -> t Get a
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer t a
s
  , putS :: b -> t PutM ()
putS = Serializer t a -> a -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t a
s (a -> t PutM ()) -> (b -> a) -> b -> t PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g
  }

-- | Map over @Serializer@ where @getS@
-- can return @Either@
mapPrismSerializer
  :: MonadError eGet (t Get)
  => (a -> Either eGet b) -- ^ Map over @getS@
  -> (b -> a)             -- ^ Map over @putS@
  -> Serializer t a
  -> Serializer t b
mapPrismSerializer :: forall eGet (t :: (* -> *) -> * -> *) a b.
MonadError eGet (t Get) =>
(a -> Either eGet b)
-> (b -> a) -> Serializer t a -> Serializer t b
mapPrismSerializer a -> Either eGet b
f b -> a
g Serializer t a
s = Serializer
  { getS :: t Get b
getS = (eGet -> t Get b) -> (b -> t Get b) -> Either eGet b -> t Get b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either eGet -> t Get b
forall a. eGet -> t Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError b -> t Get b
forall a. a -> t Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either eGet b -> t Get b) -> (a -> Either eGet b) -> a -> t Get b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either eGet b
f (a -> t Get b) -> t Get a -> t Get b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Serializer t a -> t Get a
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer t a
s
  , putS :: b -> t PutM ()
putS = Serializer t a -> a -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t a
s (a -> t PutM ()) -> (b -> a) -> b -> t PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g
  }

-- | Tuple combinator
tup
  :: ( Applicative (t Get)
     , Monad (t PutM)
     )
  => Serializer t a
  -> Serializer t b
  -> Serializer t (a, b)
tup :: forall (t :: (* -> *) -> * -> *) a b.
(Applicative (t Get), Monad (t PutM)) =>
Serializer t a -> Serializer t b -> Serializer t (a, b)
tup Serializer t a
a Serializer t b
b = Serializer
  { getS :: t Get (a, b)
getS = (a -> b -> (a, b)) -> t Get a -> t Get b -> t Get (a, b)
forall a b c. (a -> b -> c) -> t Get a -> t Get b -> t Get c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Serializer t a -> t Get a
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer t a
a) (Serializer t b -> t Get b
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer t b
b)
  , putS :: (a, b) -> t PutM ()
putS = \(a
x, b
y) -> do
      Serializer t a -> a -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t a
a a
x
      Serializer t b -> b -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t b
b b
y
  }

-- * Utilities

-- | Wrapper for both GetS errors
--
--   * the one that occurs when @fail@ is called
--   * custom one when @ExceptT@ is used
data GetSerializerError customGetError
  = SerializerError_GetFail String
  | SerializerError_Get customGetError
  deriving (GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
(GetSerializerError customGetError
 -> GetSerializerError customGetError -> Bool)
-> (GetSerializerError customGetError
    -> GetSerializerError customGetError -> Bool)
-> Eq (GetSerializerError customGetError)
forall customGetError.
Eq customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall customGetError.
Eq customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
== :: GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
$c/= :: forall customGetError.
Eq customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
/= :: GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
Eq, Eq (GetSerializerError customGetError)
Eq (GetSerializerError customGetError) =>
(GetSerializerError customGetError
 -> GetSerializerError customGetError -> Ordering)
-> (GetSerializerError customGetError
    -> GetSerializerError customGetError -> Bool)
-> (GetSerializerError customGetError
    -> GetSerializerError customGetError -> Bool)
-> (GetSerializerError customGetError
    -> GetSerializerError customGetError -> Bool)
-> (GetSerializerError customGetError
    -> GetSerializerError customGetError -> Bool)
-> (GetSerializerError customGetError
    -> GetSerializerError customGetError
    -> GetSerializerError customGetError)
-> (GetSerializerError customGetError
    -> GetSerializerError customGetError
    -> GetSerializerError customGetError)
-> Ord (GetSerializerError customGetError)
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
GetSerializerError customGetError
-> GetSerializerError customGetError -> Ordering
GetSerializerError customGetError
-> GetSerializerError customGetError
-> GetSerializerError customGetError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall customGetError.
Ord customGetError =>
Eq (GetSerializerError customGetError)
forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Ordering
forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError
-> GetSerializerError customGetError
$ccompare :: forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Ordering
compare :: GetSerializerError customGetError
-> GetSerializerError customGetError -> Ordering
$c< :: forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
< :: GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
$c<= :: forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
<= :: GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
$c> :: forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
> :: GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
$c>= :: forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
>= :: GetSerializerError customGetError
-> GetSerializerError customGetError -> Bool
$cmax :: forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError
-> GetSerializerError customGetError
max :: GetSerializerError customGetError
-> GetSerializerError customGetError
-> GetSerializerError customGetError
$cmin :: forall customGetError.
Ord customGetError =>
GetSerializerError customGetError
-> GetSerializerError customGetError
-> GetSerializerError customGetError
min :: GetSerializerError customGetError
-> GetSerializerError customGetError
-> GetSerializerError customGetError
Ord, Int -> GetSerializerError customGetError -> ShowS
[GetSerializerError customGetError] -> ShowS
GetSerializerError customGetError -> String
(Int -> GetSerializerError customGetError -> ShowS)
-> (GetSerializerError customGetError -> String)
-> ([GetSerializerError customGetError] -> ShowS)
-> Show (GetSerializerError customGetError)
forall customGetError.
Show customGetError =>
Int -> GetSerializerError customGetError -> ShowS
forall customGetError.
Show customGetError =>
[GetSerializerError customGetError] -> ShowS
forall customGetError.
Show customGetError =>
GetSerializerError customGetError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall customGetError.
Show customGetError =>
Int -> GetSerializerError customGetError -> ShowS
showsPrec :: Int -> GetSerializerError customGetError -> ShowS
$cshow :: forall customGetError.
Show customGetError =>
GetSerializerError customGetError -> String
show :: GetSerializerError customGetError -> String
$cshowList :: forall customGetError.
Show customGetError =>
[GetSerializerError customGetError] -> ShowS
showList :: [GetSerializerError customGetError] -> ShowS
Show)

-- | Helper for transforming nested Eithers
-- into @GetSerializerError@ wrapper
transformGetError
  :: Either String (Either customGetError b)
  -> Either (GetSerializerError customGetError) b
transformGetError :: forall customGetError b.
Either String (Either customGetError b)
-> Either (GetSerializerError customGetError) b
transformGetError = \case
  Left String
stringyRunGetError -> GetSerializerError customGetError
-> Either (GetSerializerError customGetError) b
forall a b. a -> Either a b
Left (String -> GetSerializerError customGetError
forall customGetError. String -> GetSerializerError customGetError
SerializerError_GetFail String
stringyRunGetError)
  Right (Left customGetError
myGetError) -> GetSerializerError customGetError
-> Either (GetSerializerError customGetError) b
forall a b. a -> Either a b
Left (customGetError -> GetSerializerError customGetError
forall customGetError.
customGetError -> GetSerializerError customGetError
SerializerError_Get customGetError
myGetError)
  Right (Right b
res) -> b -> Either (GetSerializerError customGetError) b
forall a b. b -> Either a b
Right b
res

-- | Helper for transforming @runPutM@ result
transformPutError
  :: (Either customPutError (), ByteString)
  -> Either customPutError ByteString
transformPutError :: forall customPutError.
(Either customPutError (), ByteString)
-> Either customPutError ByteString
transformPutError (Either customPutError ()
e, ByteString
r) = (customPutError -> Either customPutError ByteString)
-> (() -> Either customPutError ByteString)
-> Either customPutError ()
-> Either customPutError ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either customPutError -> Either customPutError ByteString
forall a b. a -> Either a b
Left (Either customPutError ByteString
-> () -> Either customPutError ByteString
forall a. a -> () -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either customPutError ByteString
 -> () -> Either customPutError ByteString)
-> Either customPutError ByteString
-> ()
-> Either customPutError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either customPutError ByteString
forall a b. b -> Either a b
Right ByteString
r) Either customPutError ()
e