{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Serializer.Example
  (
  -- * Simple protocol
    OpCode(..)
  , Cmd(..)
  -- * Cmd Serializer
  , cmdS
  -- * Runners
  , runG
  , runP
  -- * Custom errors
  , MyGetError(..)
  , MyPutError(..)
  -- ** Erroring variants of cmdS
  -- *** putS with throwError and MyPutError
  , cmdSPutError
  -- *** getS with throwError and MyGetError
  , cmdSGetError
  -- *** getS with fail
  , cmdSGetFail
  -- *** putS with fail
  , cmdSPutFail
  -- * Elaborate
  , cmdSRest
  , runGRest
  , runPRest
  ) where

import Control.Monad.Except (MonadError, throwError)
import Control.Monad.Reader (MonadReader, ask)
import Control.Monad.State (MonadState)
import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Control.Monad.Trans.State (StateT, runStateT)
import Data.Bifunctor (first, second)
import Data.ByteString (ByteString)
import Data.Int (Int8)
import Data.GADT.Show (GShow(..), defaultGshowsPrec)
import Data.Kind (Type)
import Data.Type.Equality (TestEquality(..), (:~:)(Refl))
import Data.Serialize.Get (Get, getInt8)
import Data.Serialize.Put (Putter, PutM, putInt8)
import Data.Serializer
  ( Serializer(..)
  , GetSerializerError
  , runGetS
  , runPutS
  , transformGetError
  , transformPutError
  )
import Data.Some (Some(..))
import GHC.Generics (Generic)

import Test.QuickCheck (Arbitrary(..), oneof)

-- * Simple protocol

-- | OpCode used to differentiate between operations
data OpCode = OpCode_Int | OpCode_Bool
  deriving (OpCode
OpCode -> OpCode -> Bounded OpCode
forall a. a -> a -> Bounded a
$cminBound :: OpCode
minBound :: OpCode
$cmaxBound :: OpCode
maxBound :: OpCode
Bounded, OpCode -> OpCode -> Bool
(OpCode -> OpCode -> Bool)
-> (OpCode -> OpCode -> Bool) -> Eq OpCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpCode -> OpCode -> Bool
== :: OpCode -> OpCode -> Bool
$c/= :: OpCode -> OpCode -> Bool
/= :: OpCode -> OpCode -> Bool
Eq, Int -> OpCode
OpCode -> Int
OpCode -> [OpCode]
OpCode -> OpCode
OpCode -> OpCode -> [OpCode]
OpCode -> OpCode -> OpCode -> [OpCode]
(OpCode -> OpCode)
-> (OpCode -> OpCode)
-> (Int -> OpCode)
-> (OpCode -> Int)
-> (OpCode -> [OpCode])
-> (OpCode -> OpCode -> [OpCode])
-> (OpCode -> OpCode -> [OpCode])
-> (OpCode -> OpCode -> OpCode -> [OpCode])
-> Enum OpCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OpCode -> OpCode
succ :: OpCode -> OpCode
$cpred :: OpCode -> OpCode
pred :: OpCode -> OpCode
$ctoEnum :: Int -> OpCode
toEnum :: Int -> OpCode
$cfromEnum :: OpCode -> Int
fromEnum :: OpCode -> Int
$cenumFrom :: OpCode -> [OpCode]
enumFrom :: OpCode -> [OpCode]
$cenumFromThen :: OpCode -> OpCode -> [OpCode]
enumFromThen :: OpCode -> OpCode -> [OpCode]
$cenumFromTo :: OpCode -> OpCode -> [OpCode]
enumFromTo :: OpCode -> OpCode -> [OpCode]
$cenumFromThenTo :: OpCode -> OpCode -> OpCode -> [OpCode]
enumFromThenTo :: OpCode -> OpCode -> OpCode -> [OpCode]
Enum, (forall x. OpCode -> Rep OpCode x)
-> (forall x. Rep OpCode x -> OpCode) -> Generic OpCode
forall x. Rep OpCode x -> OpCode
forall x. OpCode -> Rep OpCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OpCode -> Rep OpCode x
from :: forall x. OpCode -> Rep OpCode x
$cto :: forall x. Rep OpCode x -> OpCode
to :: forall x. Rep OpCode x -> OpCode
Generic, Eq OpCode
Eq OpCode =>
(OpCode -> OpCode -> Ordering)
-> (OpCode -> OpCode -> Bool)
-> (OpCode -> OpCode -> Bool)
-> (OpCode -> OpCode -> Bool)
-> (OpCode -> OpCode -> Bool)
-> (OpCode -> OpCode -> OpCode)
-> (OpCode -> OpCode -> OpCode)
-> Ord OpCode
OpCode -> OpCode -> Bool
OpCode -> OpCode -> Ordering
OpCode -> OpCode -> OpCode
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
$ccompare :: OpCode -> OpCode -> Ordering
compare :: OpCode -> OpCode -> Ordering
$c< :: OpCode -> OpCode -> Bool
< :: OpCode -> OpCode -> Bool
$c<= :: OpCode -> OpCode -> Bool
<= :: OpCode -> OpCode -> Bool
$c> :: OpCode -> OpCode -> Bool
> :: OpCode -> OpCode -> Bool
$c>= :: OpCode -> OpCode -> Bool
>= :: OpCode -> OpCode -> Bool
$cmax :: OpCode -> OpCode -> OpCode
max :: OpCode -> OpCode -> OpCode
$cmin :: OpCode -> OpCode -> OpCode
min :: OpCode -> OpCode -> OpCode
Ord, Int -> OpCode -> ShowS
[OpCode] -> ShowS
OpCode -> String
(Int -> OpCode -> ShowS)
-> (OpCode -> String) -> ([OpCode] -> ShowS) -> Show OpCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpCode -> ShowS
showsPrec :: Int -> OpCode -> ShowS
$cshow :: OpCode -> String
show :: OpCode -> String
$cshowList :: [OpCode] -> ShowS
showList :: [OpCode] -> ShowS
Show)

-- | Protocol operations
data Cmd :: Type -> Type where
  Cmd_Int :: Int8 -> Cmd Int8
  Cmd_Bool :: Bool -> Cmd Bool

deriving instance Eq (Cmd a)
deriving instance Show (Cmd a)

instance GShow Cmd where
  gshowsPrec :: forall a. Int -> Cmd a -> ShowS
gshowsPrec = Int -> Cmd a -> ShowS
forall {k} (t :: k -> *) (a :: k).
Show (t a) =>
Int -> t a -> ShowS
defaultGshowsPrec

instance TestEquality Cmd where
    testEquality :: forall a b. Cmd a -> Cmd b -> Maybe (a :~: b)
testEquality (Cmd_Int Int8
_) (Cmd_Int Int8
_) = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
    testEquality (Cmd_Bool Bool
_) (Cmd_Bool Bool
_) = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
    testEquality Cmd a
_ Cmd b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

-- constructors only
-- import Data.GADT.Compare
-- instance GEq Cmd where
--   geq = testEquality

instance {-# OVERLAPPING #-} Eq (Some Cmd) where
  Some (Cmd_Int Int8
a) == :: Some Cmd -> Some Cmd -> Bool
== Some (Cmd_Int Int8
b) = Int8
a Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
b
  Some (Cmd_Bool Bool
a) == Some (Cmd_Bool Bool
b) = Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b
  Some Cmd
_ == Some Cmd
_ = Bool
False

instance Arbitrary (Some Cmd) where
  arbitrary :: Gen (Some Cmd)
arbitrary = [Gen (Some Cmd)] -> Gen (Some Cmd)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ Cmd Int8 -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Int8 -> Some Cmd) -> (Int8 -> Cmd Int8) -> Int8 -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Cmd Int8
Cmd_Int (Int8 -> Some Cmd) -> Gen Int8 -> Gen (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int8
forall a. Arbitrary a => Gen a
arbitrary
    , Cmd Bool -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Bool -> Some Cmd) -> (Bool -> Cmd Bool) -> Bool -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Cmd Bool
Cmd_Bool (Bool -> Some Cmd) -> Gen Bool -> Gen (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    ]

-- | @OpCode@ @Serializer@
opcode :: MonadTrans t => Serializer t OpCode
opcode :: forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode = Serializer
  { getS :: t Get OpCode
getS = Get OpCode -> t Get OpCode
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 OpCode
forall a. (Bounded a, Enum a) => Get a
getEnum
  , putS :: OpCode -> 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 ())
-> (OpCode -> PutM ()) -> OpCode -> t PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpCode -> PutM ()
forall a. Enum a => Putter a
putEnum
  }

-- * Cmd Serializer

-- | @Cmd@ @Serializer@
cmdS
  :: forall t . ( MonadTrans t
     , Monad (t Get)
     , Monad (t PutM)
     )
  => Serializer t (Some Cmd)
cmdS :: forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t Get), Monad (t PutM)) =>
Serializer t (Some Cmd)
cmdS = Serializer
  { getS :: t Get (Some Cmd)
getS = Serializer t OpCode -> t Get OpCode
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer t OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode t Get OpCode -> (OpCode -> t Get (Some Cmd)) -> t Get (Some Cmd)
forall a b. t Get a -> (a -> t Get b) -> t Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      OpCode
OpCode_Int -> Cmd Int8 -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Int8 -> Some Cmd) -> (Int8 -> Cmd Int8) -> Int8 -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Cmd Int8
Cmd_Int (Int8 -> Some Cmd) -> t Get Int8 -> t Get (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8 -> t Get Int8
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 Int8
getInt8
      OpCode
OpCode_Bool -> Cmd Bool -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Bool -> Some Cmd) -> (Bool -> Cmd Bool) -> Bool -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Cmd Bool
Cmd_Bool (Bool -> Some Cmd) -> t Get Bool -> t Get (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool -> t Get Bool
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 Bool
getBool
  , putS :: Some Cmd -> t PutM ()
putS = \case
      Some (Cmd_Int Int8
i) -> Serializer t OpCode -> OpCode -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode OpCode
OpCode_Int t PutM () -> t PutM () -> t PutM ()
forall a b. t PutM a -> t PutM b -> t PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 (Putter Int8
putInt8 Int8
i)
      Some (Cmd_Bool Bool
b) -> Serializer t OpCode -> OpCode -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode OpCode
OpCode_Bool t PutM () -> t PutM () -> t PutM ()
forall a b. t PutM a -> t PutM b -> t PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 (Putter Bool
putBool Bool
b)
  }

-- * Runners

-- | @runGetS@ specialized to @ExceptT e@
runG
  :: Serializer (ExceptT e) a
  -> ByteString
  -> Either (GetSerializerError e) a
runG :: forall e a.
Serializer (ExceptT e) a
-> ByteString -> Either (GetSerializerError e) a
runG Serializer (ExceptT e) a
s =
  Either String (Either e a) -> Either (GetSerializerError e) a
forall customGetError b.
Either String (Either customGetError b)
-> Either (GetSerializerError customGetError) b
transformGetError
  (Either String (Either e a) -> Either (GetSerializerError e) a)
-> (ByteString -> Either String (Either e a))
-> ByteString
-> Either (GetSerializerError e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serializer (ExceptT e) a
-> (ExceptT e Get a -> Get (Either e a))
-> ByteString
-> Either String (Either e a)
forall (t :: (* -> *) -> * -> *) a b.
(Monad (t Get), MonadTrans t) =>
Serializer t a
-> (t Get a -> Get b) -> ByteString -> Either String b
runGetS Serializer (ExceptT e) a
s ExceptT e Get a -> Get (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- | @runPutS@ specialized to @ExceptT e@
runP
  :: Serializer (ExceptT e) a
  -> a
  -> Either e ByteString
runP :: forall e a. Serializer (ExceptT e) a -> a -> Either e ByteString
runP Serializer (ExceptT e) a
s =
   (\(Either e ()
e, ByteString
r) -> (e -> Either e ByteString)
-> (() -> Either e ByteString)
-> Either e ()
-> Either e ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Either e ByteString
forall a b. a -> Either a b
Left (Either e ByteString -> () -> Either e ByteString
forall a. a -> () -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e ByteString -> () -> Either e ByteString)
-> Either e ByteString -> () -> Either e ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either e ByteString
forall a b. b -> Either a b
Right ByteString
r) Either e ()
e)
  ((Either e (), ByteString) -> Either e ByteString)
-> (a -> (Either e (), ByteString)) -> a -> Either e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serializer (ExceptT e) a
-> (ExceptT e PutM () -> PutM (Either e ()))
-> a
-> (Either e (), ByteString)
forall (t :: (* -> *) -> * -> *) a b.
(Monad (t PutM), MonadTrans t) =>
Serializer t a -> (t PutM () -> PutM b) -> a -> (b, ByteString)
runPutS Serializer (ExceptT e) a
s ExceptT e PutM () -> PutM (Either e ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- * Custom errors

data MyGetError
  = MyGetError_Example
  deriving (MyGetError -> MyGetError -> Bool
(MyGetError -> MyGetError -> Bool)
-> (MyGetError -> MyGetError -> Bool) -> Eq MyGetError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MyGetError -> MyGetError -> Bool
== :: MyGetError -> MyGetError -> Bool
$c/= :: MyGetError -> MyGetError -> Bool
/= :: MyGetError -> MyGetError -> Bool
Eq, Int -> MyGetError -> ShowS
[MyGetError] -> ShowS
MyGetError -> String
(Int -> MyGetError -> ShowS)
-> (MyGetError -> String)
-> ([MyGetError] -> ShowS)
-> Show MyGetError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MyGetError -> ShowS
showsPrec :: Int -> MyGetError -> ShowS
$cshow :: MyGetError -> String
show :: MyGetError -> String
$cshowList :: [MyGetError] -> ShowS
showList :: [MyGetError] -> ShowS
Show)

data MyPutError
  = MyPutError_NoLongerSupported -- no longer supported protocol version
  deriving (MyPutError -> MyPutError -> Bool
(MyPutError -> MyPutError -> Bool)
-> (MyPutError -> MyPutError -> Bool) -> Eq MyPutError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MyPutError -> MyPutError -> Bool
== :: MyPutError -> MyPutError -> Bool
$c/= :: MyPutError -> MyPutError -> Bool
/= :: MyPutError -> MyPutError -> Bool
Eq, Int -> MyPutError -> ShowS
[MyPutError] -> ShowS
MyPutError -> String
(Int -> MyPutError -> ShowS)
-> (MyPutError -> String)
-> ([MyPutError] -> ShowS)
-> Show MyPutError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MyPutError -> ShowS
showsPrec :: Int -> MyPutError -> ShowS
$cshow :: MyPutError -> String
show :: MyPutError -> String
$cshowList :: [MyPutError] -> ShowS
showList :: [MyPutError] -> ShowS
Show)

-- ** Erroring variants of cmdS

-- *** putS with throwError and MyPutError

cmdSPutError :: Serializer (ExceptT MyPutError) (Some Cmd)
cmdSPutError :: Serializer (ExceptT MyPutError) (Some Cmd)
cmdSPutError = Serializer
  { getS :: ExceptT MyPutError Get (Some Cmd)
getS = Serializer (ExceptT MyPutError) (Some Cmd)
-> ExceptT MyPutError Get (Some Cmd)
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer (ExceptT MyPutError) (Some Cmd)
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t Get), Monad (t PutM)) =>
Serializer t (Some Cmd)
cmdS
  , putS :: Some Cmd -> ExceptT MyPutError PutM ()
putS = \case
      Some (Cmd_Int Int8
i) -> Serializer (ExceptT MyPutError) OpCode
-> OpCode -> ExceptT MyPutError PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer (ExceptT MyPutError) OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode OpCode
OpCode_Int ExceptT MyPutError PutM ()
-> ExceptT MyPutError PutM () -> ExceptT MyPutError PutM ()
forall a b.
ExceptT MyPutError PutM a
-> ExceptT MyPutError PutM b -> ExceptT MyPutError PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutM () -> ExceptT MyPutError PutM ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT MyPutError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Putter Int8
putInt8 Int8
i)
      Some (Cmd_Bool Bool
_b) -> MyPutError -> ExceptT MyPutError PutM ()
forall a. MyPutError -> ExceptT MyPutError PutM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MyPutError
MyPutError_NoLongerSupported
  }

-- *** getS with throwError and MyGetError

cmdSGetError :: Serializer (ExceptT MyGetError) (Some Cmd)
cmdSGetError :: Serializer (ExceptT MyGetError) (Some Cmd)
cmdSGetError = Serializer
  { getS :: ExceptT MyGetError Get (Some Cmd)
getS = Serializer (ExceptT MyGetError) OpCode
-> ExceptT MyGetError Get OpCode
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer (ExceptT MyGetError) OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode ExceptT MyGetError Get OpCode
-> (OpCode -> ExceptT MyGetError Get (Some Cmd))
-> ExceptT MyGetError Get (Some Cmd)
forall a b.
ExceptT MyGetError Get a
-> (a -> ExceptT MyGetError Get b) -> ExceptT MyGetError Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      OpCode
OpCode_Int -> Cmd Int8 -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Int8 -> Some Cmd) -> (Int8 -> Cmd Int8) -> Int8 -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Cmd Int8
Cmd_Int (Int8 -> Some Cmd)
-> ExceptT MyGetError Get Int8 -> ExceptT MyGetError Get (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8 -> ExceptT MyGetError Get Int8
forall (m :: * -> *) a. Monad m => m a -> ExceptT MyGetError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Int8
getInt8
      OpCode
OpCode_Bool -> MyGetError -> ExceptT MyGetError Get (Some Cmd)
forall a. MyGetError -> ExceptT MyGetError Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MyGetError
MyGetError_Example
  , putS :: Some Cmd -> ExceptT MyGetError PutM ()
putS = Serializer (ExceptT MyGetError) (Some Cmd)
-> Some Cmd -> ExceptT MyGetError PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer (ExceptT MyGetError) (Some Cmd)
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t Get), Monad (t PutM)) =>
Serializer t (Some Cmd)
cmdS
  }

-- *** getS with fail

cmdSGetFail
  :: ( MonadTrans t
     , MonadFail (t Get)
     , Monad (t PutM)
     )
  => Serializer t (Some Cmd)
cmdSGetFail :: forall (t :: (* -> *) -> * -> *).
(MonadTrans t, MonadFail (t Get), Monad (t PutM)) =>
Serializer t (Some Cmd)
cmdSGetFail = Serializer
  { getS :: t Get (Some Cmd)
getS = Serializer t OpCode -> t Get OpCode
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer t OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode t Get OpCode -> (OpCode -> t Get (Some Cmd)) -> t Get (Some Cmd)
forall a b. t Get a -> (a -> t Get b) -> t Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      OpCode
OpCode_Int -> Cmd Int8 -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Int8 -> Some Cmd) -> (Int8 -> Cmd Int8) -> Int8 -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Cmd Int8
Cmd_Int (Int8 -> Some Cmd) -> t Get Int8 -> t Get (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8 -> t Get Int8
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 Int8
getInt8
      OpCode
OpCode_Bool -> String -> t Get (Some Cmd)
forall a. String -> t Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no parse"
  , putS :: Some Cmd -> t PutM ()
putS = Serializer t (Some Cmd) -> Some Cmd -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t (Some Cmd)
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t Get), Monad (t PutM)) =>
Serializer t (Some Cmd)
cmdS
  }

-- *** putS with fail

-- | Unused as PutM doesn't have @MonadFail@
-- >>> serializerPutFail = cmdPutFail @(ExceptT MyGetError)
-- No instance for (MonadFail PutM)
-- as expected
cmdSPutFail
  :: ( MonadTrans t
     , MonadFail (t PutM)
     , Monad (t Get)
     )
  => Serializer t (Some Cmd)
cmdSPutFail :: forall (t :: (* -> *) -> * -> *).
(MonadTrans t, MonadFail (t PutM), Monad (t Get)) =>
Serializer t (Some Cmd)
cmdSPutFail = Serializer
  { getS :: t Get (Some Cmd)
getS = Serializer t (Some Cmd) -> t Get (Some Cmd)
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer t (Some Cmd)
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t Get), Monad (t PutM)) =>
Serializer t (Some Cmd)
cmdS
  , putS :: Some Cmd -> t PutM ()
putS = \case
      Some (Cmd_Int Int8
i) -> Serializer t OpCode -> OpCode -> t PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer t OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode OpCode
OpCode_Int t PutM () -> t PutM () -> t PutM ()
forall a b. t PutM a -> t PutM b -> t PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 (Putter Int8
putInt8 Int8
i)
      Some (Cmd_Bool Bool
_b) -> String -> t PutM ()
forall a. String -> t PutM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"can't"
  }

-- * Elaborate

-- | Transformer for @Serializer@
newtype REST r e s m a = REST
  { forall r e s (m :: * -> *) a.
REST r e s m a -> ExceptT e (StateT s (ReaderT r m)) a
_unREST :: ExceptT e (StateT s (ReaderT r m)) a }
  deriving
    ( Functor (REST r e s m)
Functor (REST r e s m) =>
(forall a. a -> REST r e s m a)
-> (forall a b.
    REST r e s m (a -> b) -> REST r e s m a -> REST r e s m b)
-> (forall a b c.
    (a -> b -> c)
    -> REST r e s m a -> REST r e s m b -> REST r e s m c)
-> (forall a b. REST r e s m a -> REST r e s m b -> REST r e s m b)
-> (forall a b. REST r e s m a -> REST r e s m b -> REST r e s m a)
-> Applicative (REST r e s m)
forall a. a -> REST r e s m a
forall a b. REST r e s m a -> REST r e s m b -> REST r e s m a
forall a b. REST r e s m a -> REST r e s m b -> REST r e s m b
forall a b.
REST r e s m (a -> b) -> REST r e s m a -> REST r e s m b
forall a b c.
(a -> b -> c) -> REST r e s m a -> REST r e s m b -> REST r e s m c
forall r e s (m :: * -> *). Monad m => Functor (REST r e s m)
forall r e s (m :: * -> *) a. Monad m => a -> REST r e s m a
forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m a -> REST r e s m b -> REST r e s m a
forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m a -> REST r e s m b -> REST r e s m b
forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m (a -> b) -> REST r e s m a -> REST r e s m b
forall r e s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> REST r e s m a -> REST r e s m b -> REST r e s m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall r e s (m :: * -> *) a. Monad m => a -> REST r e s m a
pure :: forall a. a -> REST r e s m a
$c<*> :: forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m (a -> b) -> REST r e s m a -> REST r e s m b
<*> :: forall a b.
REST r e s m (a -> b) -> REST r e s m a -> REST r e s m b
$cliftA2 :: forall r e s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> REST r e s m a -> REST r e s m b -> REST r e s m c
liftA2 :: forall a b c.
(a -> b -> c) -> REST r e s m a -> REST r e s m b -> REST r e s m c
$c*> :: forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m a -> REST r e s m b -> REST r e s m b
*> :: forall a b. REST r e s m a -> REST r e s m b -> REST r e s m b
$c<* :: forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m a -> REST r e s m b -> REST r e s m a
<* :: forall a b. REST r e s m a -> REST r e s m b -> REST r e s m a
Applicative
    , (forall a b. (a -> b) -> REST r e s m a -> REST r e s m b)
-> (forall a b. a -> REST r e s m b -> REST r e s m a)
-> Functor (REST r e s m)
forall a b. a -> REST r e s m b -> REST r e s m a
forall a b. (a -> b) -> REST r e s m a -> REST r e s m b
forall r e s (m :: * -> *) a b.
Functor m =>
a -> REST r e s m b -> REST r e s m a
forall r e s (m :: * -> *) a b.
Functor m =>
(a -> b) -> REST r e s m a -> REST r e s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r e s (m :: * -> *) a b.
Functor m =>
(a -> b) -> REST r e s m a -> REST r e s m b
fmap :: forall a b. (a -> b) -> REST r e s m a -> REST r e s m b
$c<$ :: forall r e s (m :: * -> *) a b.
Functor m =>
a -> REST r e s m b -> REST r e s m a
<$ :: forall a b. a -> REST r e s m b -> REST r e s m a
Functor
    , Applicative (REST r e s m)
Applicative (REST r e s m) =>
(forall a b.
 REST r e s m a -> (a -> REST r e s m b) -> REST r e s m b)
-> (forall a b. REST r e s m a -> REST r e s m b -> REST r e s m b)
-> (forall a. a -> REST r e s m a)
-> Monad (REST r e s m)
forall a. a -> REST r e s m a
forall a b. REST r e s m a -> REST r e s m b -> REST r e s m b
forall a b.
REST r e s m a -> (a -> REST r e s m b) -> REST r e s m b
forall r e s (m :: * -> *). Monad m => Applicative (REST r e s m)
forall r e s (m :: * -> *) a. Monad m => a -> REST r e s m a
forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m a -> REST r e s m b -> REST r e s m b
forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m a -> (a -> REST r e s m b) -> REST r e s m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m a -> (a -> REST r e s m b) -> REST r e s m b
>>= :: forall a b.
REST r e s m a -> (a -> REST r e s m b) -> REST r e s m b
$c>> :: forall r e s (m :: * -> *) a b.
Monad m =>
REST r e s m a -> REST r e s m b -> REST r e s m b
>> :: forall a b. REST r e s m a -> REST r e s m b -> REST r e s m b
$creturn :: forall r e s (m :: * -> *) a. Monad m => a -> REST r e s m a
return :: forall a. a -> REST r e s m a
Monad
    , MonadError e
    , MonadReader r
    , MonadState s
    , Monad (REST r e s m)
Monad (REST r e s m) =>
(forall a. String -> REST r e s m a) -> MonadFail (REST r e s m)
forall a. String -> REST r e s m a
forall r e s (m :: * -> *). MonadFail m => Monad (REST r e s m)
forall r e s (m :: * -> *) a.
MonadFail m =>
String -> REST r e s m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall r e s (m :: * -> *) a.
MonadFail m =>
String -> REST r e s m a
fail :: forall a. String -> REST r e s m a
MonadFail
    )

instance MonadTrans (REST r e s) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> REST r e s m a
lift = ExceptT e (StateT s (ReaderT r m)) a -> REST r e s m a
forall r e s (m :: * -> *) a.
ExceptT e (StateT s (ReaderT r m)) a -> REST r e s m a
REST (ExceptT e (StateT s (ReaderT r m)) a -> REST r e s m a)
-> (m a -> ExceptT e (StateT s (ReaderT r m)) a)
-> m a
-> REST r e s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s (ReaderT r m) a -> ExceptT e (StateT s (ReaderT r m)) a
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s (ReaderT r m) a -> ExceptT e (StateT s (ReaderT r m)) a)
-> (m a -> StateT s (ReaderT r m) a)
-> m a
-> ExceptT e (StateT s (ReaderT r m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m a -> StateT s (ReaderT r m) a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT r m a -> StateT s (ReaderT r m) a)
-> (m a -> ReaderT r m a) -> m a -> StateT s (ReaderT r m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Runner for @REST@
restRunner
  :: Monad m
  => r
  -> s
  -> REST r e s m a
  -> m ((Either e a), s)
restRunner :: forall (m :: * -> *) r s e a.
Monad m =>
r -> s -> REST r e s m a -> m (Either e a, s)
restRunner r
r s
s =
    (ReaderT r m (Either e a, s) -> r -> m (Either e a, s)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r)
  (ReaderT r m (Either e a, s) -> m (Either e a, s))
-> (REST r e s m a -> ReaderT r m (Either e a, s))
-> REST r e s m a
-> m (Either e a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT s (ReaderT r m) (Either e a)
-> s -> ReaderT r m (Either e a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` s
s)
  (StateT s (ReaderT r m) (Either e a)
 -> ReaderT r m (Either e a, s))
-> (REST r e s m a -> StateT s (ReaderT r m) (Either e a))
-> REST r e s m a
-> ReaderT r m (Either e a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e (StateT s (ReaderT r m)) a
-> StateT s (ReaderT r m) (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  (ExceptT e (StateT s (ReaderT r m)) a
 -> StateT s (ReaderT r m) (Either e a))
-> (REST r e s m a -> ExceptT e (StateT s (ReaderT r m)) a)
-> REST r e s m a
-> StateT s (ReaderT r m) (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REST r e s m a -> ExceptT e (StateT s (ReaderT r m)) a
forall r e s (m :: * -> *) a.
REST r e s m a -> ExceptT e (StateT s (ReaderT r m)) a
_unREST

runGRest
  :: Serializer (REST r e s) a
  -> r
  -> s
  -> ByteString
  -> Either (GetSerializerError e) a
runGRest :: forall r e s a.
Serializer (REST r e s) a
-> r -> s -> ByteString -> Either (GetSerializerError e) a
runGRest Serializer (REST r e s) a
serializer r
r s
s =
    Either String (Either e a) -> Either (GetSerializerError e) a
forall customGetError b.
Either String (Either customGetError b)
-> Either (GetSerializerError customGetError) b
transformGetError
  (Either String (Either e a) -> Either (GetSerializerError e) a)
-> (ByteString -> Either String (Either e a))
-> ByteString
-> Either (GetSerializerError e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either e a, s) -> Either e a)
-> Either String (Either e a, s) -> Either String (Either e a)
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Either e a, s) -> Either e a
forall a b. (a, b) -> a
fst
  (Either String (Either e a, s) -> Either String (Either e a))
-> (ByteString -> Either String (Either e a, s))
-> ByteString
-> Either String (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serializer (REST r e s) a
-> (REST r e s Get a -> Get (Either e a, s))
-> ByteString
-> Either String (Either e a, s)
forall (t :: (* -> *) -> * -> *) a b.
(Monad (t Get), MonadTrans t) =>
Serializer t a
-> (t Get a -> Get b) -> ByteString -> Either String b
runGetS
      Serializer (REST r e s) a
serializer
      (r -> s -> REST r e s Get a -> Get (Either e a, s)
forall (m :: * -> *) r s e a.
Monad m =>
r -> s -> REST r e s m a -> m (Either e a, s)
restRunner r
r s
s)

runPRest
  :: Serializer (REST r e s) a
  -> r
  -> s
  -> a
  -> Either e ByteString
runPRest :: forall r e s a.
Serializer (REST r e s) a -> r -> s -> a -> Either e ByteString
runPRest Serializer (REST r e s) a
serializer r
r s
s =
    (Either e (), ByteString) -> Either e ByteString
forall customPutError.
(Either customPutError (), ByteString)
-> Either customPutError ByteString
transformPutError
  ((Either e (), ByteString) -> Either e ByteString)
-> (a -> (Either e (), ByteString)) -> a -> Either e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either e (), s) -> Either e ())
-> ((Either e (), s), ByteString) -> (Either e (), ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Either e (), s) -> Either e ()
forall a b. (a, b) -> a
fst
  (((Either e (), s), ByteString) -> (Either e (), ByteString))
-> (a -> ((Either e (), s), ByteString))
-> a
-> (Either e (), ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serializer (REST r e s) a
-> (REST r e s PutM () -> PutM (Either e (), s))
-> a
-> ((Either e (), s), ByteString)
forall (t :: (* -> *) -> * -> *) a b.
(Monad (t PutM), MonadTrans t) =>
Serializer t a -> (t PutM () -> PutM b) -> a -> (b, ByteString)
runPutS
      Serializer (REST r e s) a
serializer
      (r -> s -> REST r e s PutM () -> PutM (Either e (), s)
forall (m :: * -> *) r s e a.
Monad m =>
r -> s -> REST r e s m a -> m (Either e a, s)
restRunner r
r s
s)

cmdSRest
  :: Serializer (REST Bool e Int) (Some Cmd)
cmdSRest :: forall e. Serializer (REST Bool e Int) (Some Cmd)
cmdSRest = Serializer
  { getS :: REST Bool e Int Get (Some Cmd)
getS = Serializer (REST Bool e Int) OpCode -> REST Bool e Int Get OpCode
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
getS Serializer (REST Bool e Int) OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode REST Bool e Int Get OpCode
-> (OpCode -> REST Bool e Int Get (Some Cmd))
-> REST Bool e Int Get (Some Cmd)
forall a b.
REST Bool e Int Get a
-> (a -> REST Bool e Int Get b) -> REST Bool e Int Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      OpCode
OpCode_Int -> do
        Bool
isTrue <- REST Bool e Int Get Bool
forall r (m :: * -> *). MonadReader r m => m r
ask
        if Bool
isTrue
        then Cmd Int8 -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Int8 -> Some Cmd) -> (Int8 -> Cmd Int8) -> Int8 -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Cmd Int8
Cmd_Int (Int8 -> Cmd Int8) -> (Int8 -> Int8) -> Int8 -> Cmd Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1) (Int8 -> Some Cmd)
-> REST Bool e Int Get Int8 -> REST Bool e Int Get (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8 -> REST Bool e Int Get Int8
forall (m :: * -> *) a. Monad m => m a -> REST Bool e Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Int8
getInt8
        else Cmd Int8 -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Int8 -> Some Cmd) -> (Int8 -> Cmd Int8) -> Int8 -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Cmd Int8
Cmd_Int (Int8 -> Some Cmd)
-> REST Bool e Int Get Int8 -> REST Bool e Int Get (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8 -> REST Bool e Int Get Int8
forall (m :: * -> *) a. Monad m => m a -> REST Bool e Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Int8
getInt8
      OpCode
OpCode_Bool -> Cmd Bool -> Some Cmd
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Cmd Bool -> Some Cmd) -> (Bool -> Cmd Bool) -> Bool -> Some Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Cmd Bool
Cmd_Bool (Bool -> Some Cmd)
-> REST Bool e Int Get Bool -> REST Bool e Int Get (Some Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool -> REST Bool e Int Get Bool
forall (m :: * -> *) a. Monad m => m a -> REST Bool e Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Bool
getBool
  , putS :: Some Cmd -> REST Bool e Int PutM ()
putS = \case
      Some (Cmd_Int Int8
i) -> do
        Serializer (REST Bool e Int) OpCode
-> OpCode -> REST Bool e Int PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer (REST Bool e Int) OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode OpCode
OpCode_Int
        Bool
isTrue <- REST Bool e Int PutM Bool
forall r (m :: * -> *). MonadReader r m => m r
ask
        if Bool
isTrue
        then PutM () -> REST Bool e Int PutM ()
forall (m :: * -> *) a. Monad m => m a -> REST Bool e Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Putter Int8
putInt8 (Int8
i Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
1))
        else PutM () -> REST Bool e Int PutM ()
forall (m :: * -> *) a. Monad m => m a -> REST Bool e Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Putter Int8
putInt8 Int8
i)
      Some (Cmd_Bool Bool
b) -> Serializer (REST Bool e Int) OpCode
-> OpCode -> REST Bool e Int PutM ()
forall (t :: (* -> *) -> * -> *) a.
Serializer t a -> a -> t PutM ()
putS Serializer (REST Bool e Int) OpCode
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
Serializer t OpCode
opcode OpCode
OpCode_Bool REST Bool e Int PutM ()
-> REST Bool e Int PutM () -> REST Bool e Int PutM ()
forall a b.
REST Bool e Int PutM a
-> REST Bool e Int PutM b -> REST Bool e Int PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PutM () -> REST Bool e Int PutM ()
forall (m :: * -> *) a. Monad m => m a -> REST Bool e Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Putter Bool
putBool Bool
b)
  }

-- Primitives helpers

getInt :: Integral a => Get a
getInt :: forall a. Integral a => Get a
getInt = Int8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> a) -> Get Int8 -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8

putInt :: Integral a => Putter a
putInt :: forall a. Integral a => Putter a
putInt = Putter Int8
putInt8 Putter Int8 -> (a -> Int8) -> a -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Deserialize @Bool@ from integer
getBool :: Get Bool
getBool :: Get Bool
getBool = (Get Int8
forall a. Integral a => Get a
getInt :: Get Int8) Get Int8 -> (Int8 -> Get Bool) -> Get Bool
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Int8
0 -> Bool -> Get Bool
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Int8
1 -> Bool -> Get Bool
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  Int8
x -> String -> Get Bool
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Bool) -> String -> Get Bool
forall a b. (a -> b) -> a -> b
$ String
"illegal bool value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int8 -> String
forall a. Show a => a -> String
show Int8
x

-- | Serialize @Bool@ into integer
putBool :: Putter Bool
putBool :: Putter Bool
putBool Bool
True  = Putter Int8
forall a. Integral a => Putter a
putInt (Int8
1 :: Int8)
putBool Bool
False = Putter Int8
forall a. Integral a => Putter a
putInt (Int8
0 :: Int8)

-- | Utility toEnum version checking bounds using Bounded class
toEnumCheckBounds
  :: forall a
   . ( Bounded a
     , Enum a
     )
  => Int
  -> Either String a
toEnumCheckBounds :: forall a. (Bounded a, Enum a) => Int -> Either String a
toEnumCheckBounds = \case
  Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int
forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound @a) -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"enum out of min bound " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
  Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Int
forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound @a) -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"enum out of max bound " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
  Int
x | Bool
otherwise -> a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Enum a => Int -> a
toEnum Int
x

-- | Deserialize @Enum@ to integer
getEnum
  :: ( Bounded a
     , Enum a
     )
  => Get a
getEnum :: forall a. (Bounded a, Enum a) => Get a
getEnum =
  Int -> Either String a
forall a. (Bounded a, Enum a) => Int -> Either String a
toEnumCheckBounds (Int -> Either String a) -> Get Int -> Get (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall a. Integral a => Get a
getInt
  Get (Either String a) -> (Either String a -> Get a) -> Get a
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get a) -> (a -> Get a) -> Either String a -> Get a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Get a
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Serialize @Enum@ to integer
putEnum :: Enum a => Putter a
putEnum :: forall a. Enum a => Putter a
putEnum = Putter Int
forall a. Integral a => Putter a
putInt Putter Int -> (a -> Int) -> a -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum