{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Serializer
(
Serializer(..)
, runGetS
, runPutS
, SimpleSerializer
, runGetSimple
, runPutSimple
, lift2
, liftSerialize
, mapIsoSerializer
, mapPrismSerializer
, tup
, GetSerializerError(..)
, transformGetError
, transformPutError
, 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
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 ()
}
runPutS
:: ( Monad (t PutM)
, MonadTrans t
)
=> Serializer t a
-> (t PutM () -> PutM b)
-> a
-> (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
runGetS
:: ( Monad (t Get)
, MonadTrans t
)
=> Serializer t a
-> (t Get a -> Get b)
-> ByteString
-> 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
type SimpleSerializer a = Serializer IdentityT a
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
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
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
}
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
mapIsoSerializer
:: Functor (t Get)
=> (a -> b)
-> (b -> a)
-> 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
}
mapPrismSerializer
:: MonadError eGet (t Get)
=> (a -> Either eGet b)
-> (b -> a)
-> 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
}
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
}
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)
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
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