{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds             #-}
{-# language ScopedTypeVariables   #-}
{-# language TypeApplications      #-}
{-# language UndecidableInstances  #-}
{-# OPTIONS_GHC -fno-warn-simplifiable-class-constraints -fno-warn-orphans #-}
{-|
Description : Wrappers to customize Protocol Buffers serialization

In order to interoperate with the @proto3-wire@ library,
we sometimes need an instance of 'Proto3WireEncoder'.
By using the wrappers in this module, such instances can
be obtained automatically if the type can be turned
into a 'Schema'.
-}
module Mu.Adapter.ProtoBuf.Via where

import           Network.GRPC.HTTP2.Proto3Wire
import qualified Proto3.Wire.Decode            as PBDec
import qualified Proto3.Wire.Encode            as PBEnc

import           Mu.Adapter.ProtoBuf
import           Mu.Rpc
import           Mu.Schema

-- | Specifies that a type is turned into a Protocol Buffers
--   message by using the schema as intermediate representation.
newtype ViaToProtoBufTypeRef (ref :: TypeRef snm) t
  = ViaToProtoBufTypeRef { ViaToProtoBufTypeRef ref t -> t
unViaToProtoBufTypeRef :: t }
-- | Specifies that a type can be parsed from a Protocol Buffers
--   message by using the schema as intermediate representation.
newtype ViaFromProtoBufTypeRef (ref :: TypeRef snm) t
  = ViaFromProtoBufTypeRef { ViaFromProtoBufTypeRef ref t -> t
unViaFromProtoBufTypeRef :: t }

instance ToProtoBufTypeRef ref t
         => Proto3WireEncoder (ViaToProtoBufTypeRef ref t) where
  proto3WireEncode :: ViaToProtoBufTypeRef ref t -> MessageBuilder
proto3WireEncode = Proxy ref -> t -> MessageBuilder
forall snm (ref :: TypeRef snm) t.
ToProtoBufTypeRef ref t =>
Proxy ref -> t -> MessageBuilder
toProtoBufTypeRef (Proxy ref
forall k (t :: k). Proxy t
Proxy @ref) (t -> MessageBuilder)
-> (ViaToProtoBufTypeRef ref t -> t)
-> ViaToProtoBufTypeRef ref t
-> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViaToProtoBufTypeRef ref t -> t
forall snm (ref :: TypeRef snm) t. ViaToProtoBufTypeRef ref t -> t
unViaToProtoBufTypeRef
  proto3WireDecode :: Parser RawMessage (ViaToProtoBufTypeRef ref t)
proto3WireDecode = [Char] -> Parser RawMessage (ViaToProtoBufTypeRef ref t)
forall a. HasCallStack => [Char] -> a
error [Char]
"this should never be called, use FromProtoBufTypeRef"
instance FromProtoBufTypeRef ref t
         => Proto3WireEncoder (ViaFromProtoBufTypeRef ref t) where
  proto3WireEncode :: ViaFromProtoBufTypeRef ref t -> MessageBuilder
proto3WireEncode = [Char] -> ViaFromProtoBufTypeRef ref t -> MessageBuilder
forall a. HasCallStack => [Char] -> a
error [Char]
"this should never be called, use ToProtoBufTypeRef"
  proto3WireDecode :: Parser RawMessage (ViaFromProtoBufTypeRef ref t)
proto3WireDecode = t -> ViaFromProtoBufTypeRef ref t
forall snm (ref :: TypeRef snm) t.
t -> ViaFromProtoBufTypeRef ref t
ViaFromProtoBufTypeRef (t -> ViaFromProtoBufTypeRef ref t)
-> Parser RawMessage t
-> Parser RawMessage (ViaFromProtoBufTypeRef ref t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ref -> Parser RawMessage t
forall snm (ref :: TypeRef snm) t.
FromProtoBufTypeRef ref t =>
Proxy ref -> Parser RawMessage t
fromProtoBufTypeRef (Proxy ref
forall k (t :: k). Proxy t
Proxy @ref)

instance Proto3WireEncoder () where
  proto3WireEncode :: () -> MessageBuilder
proto3WireEncode ()
_ = MessageBuilder
forall a. Monoid a => a
mempty
  proto3WireDecode :: Parser RawMessage ()
proto3WireDecode = () -> Parser RawMessage ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Types which can be parsed from a Protocol Buffers message.
class FromProtoBufTypeRef (ref :: TypeRef snm) t where
  fromProtoBufTypeRef :: Proxy ref -> PBDec.Parser PBDec.RawMessage t
-- | Types which can be turned into a Protocol Buffers message.
class ToProtoBufTypeRef (ref :: TypeRef snm) t where
  toProtoBufTypeRef   :: Proxy ref -> t -> PBEnc.MessageBuilder

instance (IsProtoSchema sch sty, FromSchema sch sty t)
         => FromProtoBufTypeRef ('SchemaRef sch sty) t where
  fromProtoBufTypeRef :: Proxy ('SchemaRef sch sty) -> Parser RawMessage t
fromProtoBufTypeRef Proxy ('SchemaRef sch sty)
_ = forall a (sty :: typeName).
(IsProtoSchema sch sty, FromSchema sch sty a) =>
Parser RawMessage a
forall t f (sch :: Schema t f) a (sty :: t).
(IsProtoSchema sch sty, FromSchema sch sty a) =>
Parser RawMessage a
fromProtoViaSchema @_ @_ @sch
instance (IsProtoSchema sch sty, ToSchema sch sty t)
         => ToProtoBufTypeRef ('SchemaRef sch sty) t where
  toProtoBufTypeRef :: Proxy ('SchemaRef sch sty) -> t -> MessageBuilder
toProtoBufTypeRef   Proxy ('SchemaRef sch sty)
_ = forall a (sty :: typeName).
(IsProtoSchema sch sty, ToSchema sch sty a) =>
a -> MessageBuilder
forall t f (sch :: Schema t f) a (sty :: t).
(IsProtoSchema sch sty, ToSchema sch sty a) =>
a -> MessageBuilder
toProtoViaSchema @_ @_ @sch

instance ( FromProtoBufRegistry r t
         , IsProtoSchema (MappingRight r last) sty
         , FromSchema (MappingRight r last) sty t )
         => FromProtoBufTypeRef ('RegistryRef r t last) t where
  fromProtoBufTypeRef :: Proxy ('RegistryRef r t last) -> Parser RawMessage t
fromProtoBufTypeRef Proxy ('RegistryRef r t last)
_ = forall (r :: Mappings Nat Schema') t.
FromProtoBufRegistry r t =>
Parser RawMessage t
forall t. FromProtoBufRegistry r t => Parser RawMessage t
fromProtoBufWithRegistry @r
instance ( FromProtoBufRegistry r t
         , IsProtoSchema (MappingRight r last) sty
         , ToSchema (MappingRight r last) sty t )
         => ToProtoBufTypeRef ('RegistryRef r t last) t where
  toProtoBufTypeRef :: Proxy ('RegistryRef r t last) -> t -> MessageBuilder
toProtoBufTypeRef   Proxy ('RegistryRef r t last)
_ = forall t f (sch :: Schema t f) a (sty :: t).
(IsProtoSchema sch sty, ToSchema sch sty a) =>
a -> MessageBuilder
forall a (sty :: Symbol).
(IsProtoSchema (MappingRight r last) sty,
 ToSchema (MappingRight r last) sty a) =>
a -> MessageBuilder
toProtoViaSchema @_ @_ @(MappingRight r last)