{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MagicHash              #-}
{-# LANGUAGE OverloadedStrings      #-}

-- | gRPC with Protobuf
module Network.GRPC.Spec.RPC.Protobuf (
    Protobuf
  , Proto(..)
  , getProto
  ) where

import Control.DeepSeq (NFData)
import Control.Lens hiding (lens)
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Char8 qualified as BS.Char8
import Data.Int
import Data.Kind
import Data.Map (Map)
import Data.ProtoLens
import Data.ProtoLens.Field qualified as ProtoLens
import Data.ProtoLens.Service.Types
import Data.Proxy
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Vector qualified as Boxed (Vector)
import Data.Vector.Unboxed qualified as Unboxed (Vector)
import Data.Word
import GHC.Exts (Proxy#, proxy#)
import GHC.Records qualified as GHC
import GHC.Records.Compat qualified as GHC.Compat
import GHC.TypeLits

import Network.GRPC.Spec.CustomMetadata.Typed
import Network.GRPC.Spec.RPC
import Network.GRPC.Spec.RPC.StreamType
import Network.GRPC.Spec.Util.Protobuf qualified as Protobuf

{-------------------------------------------------------------------------------
  The spec defines the following in Appendix A, "GRPC for Protobuf":

  > Service-Name → ?( {proto package name} "." ) {service name}
  > Message-Type → {fully qualified proto message name}
  > Content-Type → "application/grpc+proto"
-------------------------------------------------------------------------------}

-- | Protobuf RPC
--
-- This exists only as a type-level marker
data Protobuf (serv :: Type) (meth :: Symbol)

type instance Input  (Protobuf serv meth) = Proto (MethodInput  serv meth)
type instance Output (Protobuf serv meth) = Proto (MethodOutput serv meth)

instance ( HasMethodImpl      serv meth

           -- Debugging
         , Show (MethodInput  serv meth)
         , Show (MethodOutput serv meth)

           -- Serialization
         , NFData (MethodInput  serv meth)
         , NFData (MethodOutput serv meth)

           -- Metadata constraints
         , Show (RequestMetadata (Protobuf serv meth))
         , Show (ResponseInitialMetadata (Protobuf serv meth))
         , Show (ResponseTrailingMetadata (Protobuf serv meth))
         ) => IsRPC (Protobuf serv meth) where
  rpcContentType :: Proxy (Protobuf serv meth) -> ByteString
rpcContentType Proxy (Protobuf serv meth)
_ = ByteString -> ByteString
defaultRpcContentType ByteString
"proto"
  rpcServiceName :: HasCallStack => Proxy (Protobuf serv meth) -> ByteString
rpcServiceName Proxy (Protobuf serv meth)
_ = String -> ByteString
BS.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
                         Proxy (ServicePackage serv) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (ServicePackage serv) -> String)
-> Proxy (ServicePackage serv) -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(ServicePackage serv)
                       , String
"."
                       , Proxy (ServiceName serv) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (ServiceName serv) -> String)
-> Proxy (ServiceName serv) -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(ServiceName serv)
                       ]
  rpcMethodName :: HasCallStack => Proxy (Protobuf serv meth) -> ByteString
rpcMethodName  Proxy (Protobuf serv meth)
_ = String -> ByteString
BS.Char8.pack (String -> ByteString)
-> (Proxy (MethodName serv meth) -> String)
-> Proxy (MethodName serv meth)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (MethodName serv meth) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (MethodName serv meth) -> ByteString)
-> Proxy (MethodName serv meth) -> ByteString
forall a b. (a -> b) -> a -> b
$
                       forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @(MethodName  serv meth)
  rpcMessageType :: HasCallStack => Proxy (Protobuf serv meth) -> Maybe ByteString
rpcMessageType Proxy (Protobuf serv meth)
_ = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Proxy (MethodInput serv meth) -> ByteString)
-> Proxy (MethodInput serv meth)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.Char8.pack (String -> ByteString)
-> (Proxy (MethodInput serv meth) -> String)
-> Proxy (MethodInput serv meth)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String)
-> (Proxy (MethodInput serv meth) -> Text)
-> Proxy (MethodInput serv meth)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (MethodInput serv meth) -> Text
forall msg. Message msg => Proxy msg -> Text
messageName (Proxy (MethodInput serv meth) -> Maybe ByteString)
-> Proxy (MethodInput serv meth) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
                       forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(MethodInput serv meth)

instance ( IsRPC (Protobuf serv meth)
         , HasMethodImpl serv meth

           -- Metadata constraints
         , BuildMetadata (RequestMetadata (Protobuf serv meth))
         , ParseMetadata (ResponseInitialMetadata (Protobuf serv meth))
         , ParseMetadata (ResponseTrailingMetadata (Protobuf serv meth))
         ) => SupportsClientRpc (Protobuf serv meth) where
  rpcSerializeInput :: Proxy (Protobuf serv meth)
-> Input (Protobuf serv meth) -> ByteString
rpcSerializeInput    Proxy (Protobuf serv meth)
_ = Input (Protobuf serv meth) -> ByteString
Proto (MethodInput serv meth) -> ByteString
forall msg. Message msg => msg -> ByteString
Protobuf.buildLazy
  rpcDeserializeOutput :: Proxy (Protobuf serv meth)
-> ByteString -> Either String (Output (Protobuf serv meth))
rpcDeserializeOutput Proxy (Protobuf serv meth)
_ = ByteString -> Either String (Output (Protobuf serv meth))
ByteString -> Either String (Proto (MethodOutput serv meth))
forall msg. Message msg => ByteString -> Either String msg
Protobuf.parseLazy

instance ( IsRPC (Protobuf serv meth)
         , HasMethodImpl serv meth

           -- Metadata constraints
         , ParseMetadata (RequestMetadata (Protobuf serv meth))
         , BuildMetadata (ResponseInitialMetadata (Protobuf serv meth))
         , StaticMetadata (ResponseTrailingMetadata (Protobuf serv meth))
         ) => SupportsServerRpc (Protobuf serv meth) where
  rpcDeserializeInput :: Proxy (Protobuf serv meth)
-> ByteString -> Either String (Input (Protobuf serv meth))
rpcDeserializeInput Proxy (Protobuf serv meth)
_ = ByteString -> Either String (Input (Protobuf serv meth))
ByteString -> Either String (Proto (MethodInput serv meth))
forall msg. Message msg => ByteString -> Either String msg
Protobuf.parseLazy
  rpcSerializeOutput :: Proxy (Protobuf serv meth)
-> Output (Protobuf serv meth) -> ByteString
rpcSerializeOutput  Proxy (Protobuf serv meth)
_ = Output (Protobuf serv meth) -> ByteString
Proto (MethodOutput serv meth) -> ByteString
forall msg. Message msg => msg -> ByteString
Protobuf.buildLazy

instance ( styp ~ MethodStreamingType serv meth
         , ValidStreamingType styp
         )
      => SupportsStreamingType (Protobuf serv meth) styp

instance ValidStreamingType (MethodStreamingType serv meth)
      => HasStreamingType (Protobuf serv meth) where
  type RpcStreamingType (Protobuf serv meth) = MethodStreamingType serv meth

{-------------------------------------------------------------------------------
  Wrapper around Protobuf messages
-------------------------------------------------------------------------------}

-- | Wrapper around Protobuf messages and Protobuf enums
--
-- Protobuf messages and enums behave differently to normal Haskell datatypes.
-- Fields in messages always have defaults, enums can have unknown values, etc.
-- We therefore mark them at the type-level with this t'Proto' wrapper. Most of
-- the time you can work with t'Proto' values as if the wrapper is not there,
-- because @Proto msg@ inherits 'Message' and @Data.ProtoLens.Field@
-- 'ProtoLens.HasField' instances from @msg@. For example, you can create a
-- 'Proto Point' value as
--
-- > p = defMessage
-- >       & #latitude  .~ ..
-- >       & #longitude .~ ..
--
-- and access fields /from/ such a value using
--
-- > p ^. #latitude
--
-- as per usual.
--
-- One advantage of the t'Proto' wrapper is that we can give blanket instances
-- for /all/ Protobuf messages; we use this to provide @GHC.Records@
-- 'GHC.HasField' and @GHC.Records.Compat@ 'GHC.Compat.HasField' instances.
-- This means that you can also use @OverloadedRecordDot@ to access fields
--
-- > p.latitude
--
-- or even @OverloadedRecordUpdate@ to set fields
--
-- > p{latitude = ..}
newtype Proto msg = Proto msg
  deriving stock (Int -> Proto msg -> String -> String
[Proto msg] -> String -> String
Proto msg -> String
(Int -> Proto msg -> String -> String)
-> (Proto msg -> String)
-> ([Proto msg] -> String -> String)
-> Show (Proto msg)
forall msg. Show msg => Int -> Proto msg -> String -> String
forall msg. Show msg => [Proto msg] -> String -> String
forall msg. Show msg => Proto msg -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall msg. Show msg => Int -> Proto msg -> String -> String
showsPrec :: Int -> Proto msg -> String -> String
$cshow :: forall msg. Show msg => Proto msg -> String
show :: Proto msg -> String
$cshowList :: forall msg. Show msg => [Proto msg] -> String -> String
showList :: [Proto msg] -> String -> String
Show)
  deriving newtype (
      Proto msg -> Proto msg -> Bool
(Proto msg -> Proto msg -> Bool)
-> (Proto msg -> Proto msg -> Bool) -> Eq (Proto msg)
forall msg. Eq msg => Proto msg -> Proto msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall msg. Eq msg => Proto msg -> Proto msg -> Bool
== :: Proto msg -> Proto msg -> Bool
$c/= :: forall msg. Eq msg => Proto msg -> Proto msg -> Bool
/= :: Proto msg -> Proto msg -> Bool
Eq
    , Eq (Proto msg)
Eq (Proto msg) =>
(Proto msg -> Proto msg -> Ordering)
-> (Proto msg -> Proto msg -> Bool)
-> (Proto msg -> Proto msg -> Bool)
-> (Proto msg -> Proto msg -> Bool)
-> (Proto msg -> Proto msg -> Bool)
-> (Proto msg -> Proto msg -> Proto msg)
-> (Proto msg -> Proto msg -> Proto msg)
-> Ord (Proto msg)
Proto msg -> Proto msg -> Bool
Proto msg -> Proto msg -> Ordering
Proto msg -> Proto msg -> Proto msg
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 msg. Ord msg => Eq (Proto msg)
forall msg. Ord msg => Proto msg -> Proto msg -> Bool
forall msg. Ord msg => Proto msg -> Proto msg -> Ordering
forall msg. Ord msg => Proto msg -> Proto msg -> Proto msg
$ccompare :: forall msg. Ord msg => Proto msg -> Proto msg -> Ordering
compare :: Proto msg -> Proto msg -> Ordering
$c< :: forall msg. Ord msg => Proto msg -> Proto msg -> Bool
< :: Proto msg -> Proto msg -> Bool
$c<= :: forall msg. Ord msg => Proto msg -> Proto msg -> Bool
<= :: Proto msg -> Proto msg -> Bool
$c> :: forall msg. Ord msg => Proto msg -> Proto msg -> Bool
> :: Proto msg -> Proto msg -> Bool
$c>= :: forall msg. Ord msg => Proto msg -> Proto msg -> Bool
>= :: Proto msg -> Proto msg -> Bool
$cmax :: forall msg. Ord msg => Proto msg -> Proto msg -> Proto msg
max :: Proto msg -> Proto msg -> Proto msg
$cmin :: forall msg. Ord msg => Proto msg -> Proto msg -> Proto msg
min :: Proto msg -> Proto msg -> Proto msg
Ord
    , Proto msg
Proto msg -> Proto msg -> Bounded (Proto msg)
forall a. a -> a -> Bounded a
forall msg. Bounded msg => Proto msg
$cminBound :: forall msg. Bounded msg => Proto msg
minBound :: Proto msg
$cmaxBound :: forall msg. Bounded msg => Proto msg
maxBound :: Proto msg
Bounded
    , Int -> Proto msg
Proto msg -> Int
Proto msg -> [Proto msg]
Proto msg -> Proto msg
Proto msg -> Proto msg -> [Proto msg]
Proto msg -> Proto msg -> Proto msg -> [Proto msg]
(Proto msg -> Proto msg)
-> (Proto msg -> Proto msg)
-> (Int -> Proto msg)
-> (Proto msg -> Int)
-> (Proto msg -> [Proto msg])
-> (Proto msg -> Proto msg -> [Proto msg])
-> (Proto msg -> Proto msg -> [Proto msg])
-> (Proto msg -> Proto msg -> Proto msg -> [Proto msg])
-> Enum (Proto msg)
forall msg. Enum msg => Int -> Proto msg
forall msg. Enum msg => Proto msg -> Int
forall msg. Enum msg => Proto msg -> [Proto msg]
forall msg. Enum msg => Proto msg -> Proto msg
forall msg. Enum msg => Proto msg -> Proto msg -> [Proto msg]
forall msg.
Enum msg =>
Proto msg -> Proto msg -> Proto msg -> [Proto msg]
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 :: forall msg. Enum msg => Proto msg -> Proto msg
succ :: Proto msg -> Proto msg
$cpred :: forall msg. Enum msg => Proto msg -> Proto msg
pred :: Proto msg -> Proto msg
$ctoEnum :: forall msg. Enum msg => Int -> Proto msg
toEnum :: Int -> Proto msg
$cfromEnum :: forall msg. Enum msg => Proto msg -> Int
fromEnum :: Proto msg -> Int
$cenumFrom :: forall msg. Enum msg => Proto msg -> [Proto msg]
enumFrom :: Proto msg -> [Proto msg]
$cenumFromThen :: forall msg. Enum msg => Proto msg -> Proto msg -> [Proto msg]
enumFromThen :: Proto msg -> Proto msg -> [Proto msg]
$cenumFromTo :: forall msg. Enum msg => Proto msg -> Proto msg -> [Proto msg]
enumFromTo :: Proto msg -> Proto msg -> [Proto msg]
$cenumFromThenTo :: forall msg.
Enum msg =>
Proto msg -> Proto msg -> Proto msg -> [Proto msg]
enumFromThenTo :: Proto msg -> Proto msg -> Proto msg -> [Proto msg]
Enum
    , Proto msg
Proto msg -> FieldDefault (Proto msg)
forall value. value -> FieldDefault value
forall msg. FieldDefault msg => Proto msg
$cfieldDefault :: forall msg. FieldDefault msg => Proto msg
fieldDefault :: Proto msg
FieldDefault
    , Bounded (Proto msg)
Enum (Proto msg)
(Enum (Proto msg), Bounded (Proto msg)) =>
(Int -> Maybe (Proto msg))
-> (Proto msg -> String)
-> (String -> Maybe (Proto msg))
-> MessageEnum (Proto msg)
Int -> Maybe (Proto msg)
String -> Maybe (Proto msg)
Proto msg -> String
forall a.
(Enum a, Bounded a) =>
(Int -> Maybe a)
-> (a -> String) -> (String -> Maybe a) -> MessageEnum a
forall msg. MessageEnum msg => Bounded (Proto msg)
forall msg. MessageEnum msg => Enum (Proto msg)
forall msg. MessageEnum msg => Int -> Maybe (Proto msg)
forall msg. MessageEnum msg => String -> Maybe (Proto msg)
forall msg. MessageEnum msg => Proto msg -> String
$cmaybeToEnum :: forall msg. MessageEnum msg => Int -> Maybe (Proto msg)
maybeToEnum :: Int -> Maybe (Proto msg)
$cshowEnum :: forall msg. MessageEnum msg => Proto msg -> String
showEnum :: Proto msg -> String
$creadEnum :: forall msg. MessageEnum msg => String -> Maybe (Proto msg)
readEnum :: String -> Maybe (Proto msg)
MessageEnum
    , Proto msg -> ()
(Proto msg -> ()) -> NFData (Proto msg)
forall msg. NFData msg => Proto msg -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall msg. NFData msg => Proto msg -> ()
rnf :: Proto msg -> ()
NFData
    )

-- | Field accessor for t'Proto'
getProto :: Proto msg -> msg
-- Implementation note: This /must/ be defined separately from the 'Proto'
-- newtype, otherwise ghc won't let us define a 'GHC.HasField' instance.
getProto :: forall msg. Proto msg -> msg
getProto (Proto msg
msg) = msg
msg

instance Message msg => Message (Proto msg) where
  messageName :: Proxy (Proto msg) -> Text
messageName             Proxy (Proto msg)
_ = Proxy msg -> Text
forall msg. Message msg => Proxy msg -> Text
messageName             (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @msg)
  packedMessageDescriptor :: Proxy (Proto msg) -> ByteString
packedMessageDescriptor Proxy (Proto msg)
_ = Proxy msg -> ByteString
forall msg. Message msg => Proxy msg -> ByteString
packedMessageDescriptor (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @msg)
  packedFileDescriptor :: Proxy (Proto msg) -> ByteString
packedFileDescriptor    Proxy (Proto msg)
_ = Proxy msg -> ByteString
forall msg. Message msg => Proxy msg -> ByteString
packedFileDescriptor    (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @msg)

  defMessage :: Proto msg
defMessage    = msg -> Proto msg
forall msg. msg -> Proto msg
Proto msg
forall msg. Message msg => msg
defMessage
  buildMessage :: Proto msg -> Builder
buildMessage  = msg -> Builder
forall msg. Message msg => msg -> Builder
buildMessage (msg -> Builder) -> (Proto msg -> msg) -> Proto msg -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto msg -> msg
forall msg. Proto msg -> msg
getProto
  parseMessage :: Parser (Proto msg)
parseMessage  = msg -> Proto msg
forall msg. msg -> Proto msg
Proto (msg -> Proto msg) -> Parser msg -> Parser (Proto msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser msg
forall msg. Message msg => Parser msg
parseMessage
  unknownFields :: Lens' (Proto msg) FieldSet
unknownFields = (msg -> f msg) -> Proto msg -> f (Proto msg)
forall msg (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p msg (f msg) -> p (Proto msg) (f (Proto msg))
_proto ((msg -> f msg) -> Proto msg -> f (Proto msg))
-> ((FieldSet -> f FieldSet) -> msg -> f msg)
-> (FieldSet -> f FieldSet)
-> Proto msg
-> f (Proto msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldSet -> f FieldSet) -> msg -> f msg
forall msg. Message msg => Lens' msg FieldSet
Lens' msg FieldSet
unknownFields
  fieldsByTag :: Map Tag (FieldDescriptor (Proto msg))
fieldsByTag   = FieldDescriptor msg -> FieldDescriptor (Proto msg)
forall msg. FieldDescriptor msg -> FieldDescriptor (Proto msg)
protoFieldDescriptor (FieldDescriptor msg -> FieldDescriptor (Proto msg))
-> Map Tag (FieldDescriptor msg)
-> Map Tag (FieldDescriptor (Proto msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Tag (FieldDescriptor msg)
forall msg. Message msg => Map Tag (FieldDescriptor msg)
fieldsByTag

{-------------------------------------------------------------------------------
  ProtoLens.HasField instance for Proto

  We want to piggy-back on the generated HasField instance, but re-wrap nested
  messages in 'Proto' (but not primitive fields).

  See

  * <https://protobuf.dev/programming-guides/proto3/>
  * @Data.ProtoLens.Compiler.Generate.Field@ in @proto-lens-protoc@
-------------------------------------------------------------------------------}

-- | Field description
data FieldDesc = MkFieldDesc FieldLabel IsScalar

-- | Is this a scalar field or an enum/nested message?
data IsScalar = Scalar | NotScalar

-- | Field label
--
-- <https://protobuf.dev/programming-guides/proto3/#field-labels>
data FieldLabel =
    LabelImplicit
  | LabelOptional
  | LabelRepeated
  | LabelMap

type family Describe (a :: Type) :: FieldDesc where
  Describe (Maybe a)          = MkFieldDesc LabelOptional (CheckIsScalar a)
  Describe [a]                = MkFieldDesc LabelRepeated (CheckIsScalar a)
  Describe (Unboxed.Vector a) = MkFieldDesc LabelRepeated Scalar
  Describe (Boxed.Vector a)   = MkFieldDesc LabelRepeated (CheckIsScalar a)
  Describe (Map _ a)          = MkFieldDesc LabelMap      (CheckIsScalar a)
  Describe a                  = MkFieldDesc LabelImplicit (CheckIsScalar a)

type family CheckIsScalar (a :: Type) :: IsScalar where
  CheckIsScalar Bool              = Scalar
  CheckIsScalar Double            = Scalar
  CheckIsScalar Float             = Scalar
  CheckIsScalar Int32             = Scalar
  CheckIsScalar Int64             = Scalar
  CheckIsScalar Strict.ByteString = Scalar
  CheckIsScalar Text              = Scalar
  CheckIsScalar Word32            = Scalar
  CheckIsScalar Word64            = Scalar
  CheckIsScalar _                 = NotScalar

class RewrapField (desc :: FieldDesc) (x :: Type) (y :: Type) | desc x -> y where
  rewrapField :: Proxy# desc -> Lens' x y

instance RewrapField (MkFieldDesc label Scalar) a a where
  rewrapField :: Proxy# ('MkFieldDesc label 'Scalar) -> Lens' a a
rewrapField Proxy# ('MkFieldDesc label 'Scalar)
_ = (a -> f a) -> a -> f a
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso a a a a
coerced

instance RewrapField (MkFieldDesc LabelImplicit NotScalar) a (Proto a) where
  rewrapField :: Proxy# ('MkFieldDesc 'LabelImplicit 'NotScalar)
-> Lens' a (Proto a)
rewrapField Proxy# ('MkFieldDesc 'LabelImplicit 'NotScalar)
_ = (Proto a -> f (Proto a)) -> a -> f a
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso a a (Proto a) (Proto a)
coerced

instance RewrapField (MkFieldDesc LabelOptional NotScalar) (Maybe a) (Maybe (Proto a)) where
  rewrapField :: Proxy# ('MkFieldDesc 'LabelOptional 'NotScalar)
-> Lens' (Maybe a) (Maybe (Proto a))
rewrapField Proxy# ('MkFieldDesc 'LabelOptional 'NotScalar)
_ = (Maybe (Proto a) -> f (Maybe (Proto a))) -> Maybe a -> f (Maybe a)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (Maybe a) (Maybe a) (Maybe (Proto a)) (Maybe (Proto a))
coerced

instance RewrapField (MkFieldDesc LabelRepeated NotScalar) [a] [Proto a] where
  rewrapField :: Proxy# ('MkFieldDesc 'LabelRepeated 'NotScalar)
-> Lens' [a] [Proto a]
rewrapField Proxy# ('MkFieldDesc 'LabelRepeated 'NotScalar)
_ = ([Proto a] -> f [Proto a]) -> [a] -> f [a]
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso [a] [a] [Proto a] [Proto a]
coerced

instance RewrapField (MkFieldDesc LabelRepeated NotScalar) (Boxed.Vector a) (Boxed.Vector (Proto a)) where
  rewrapField :: Proxy# ('MkFieldDesc 'LabelRepeated 'NotScalar)
-> Lens' (Vector a) (Vector (Proto a))
rewrapField Proxy# ('MkFieldDesc 'LabelRepeated 'NotScalar)
_ = (Vector (Proto a) -> f (Vector (Proto a)))
-> Vector a -> f (Vector a)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (Vector a) (Vector a) (Vector (Proto a)) (Vector (Proto a))
coerced

instance RewrapField (MkFieldDesc LabelMap NotScalar) (Map k a) (Map k (Proto a)) where
  rewrapField :: Proxy# ('MkFieldDesc 'LabelMap 'NotScalar)
-> Lens' (Map k a) (Map k (Proto a))
rewrapField Proxy# ('MkFieldDesc 'LabelMap 'NotScalar)
_ = (Map k (Proto a) -> f (Map k (Proto a))) -> Map k a -> f (Map k a)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (Map k a) (Map k a) (Map k (Proto a)) (Map k (Proto a))
coerced

instance
       ( ProtoLens.HasField rec fldName x
       , RewrapField (Describe x) x fldType
       )
    => ProtoLens.HasField (Proto rec) fldName fldType where
  fieldOf :: forall (f :: * -> *).
Functor f =>
Proxy# fldName
-> (fldType -> f fldType) -> Proto rec -> f (Proto rec)
fieldOf Proxy# fldName
p = (rec -> f rec) -> Proto rec -> f (Proto rec)
forall msg (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p msg (f msg) -> p (Proto msg) (f (Proto msg))
_proto ((rec -> f rec) -> Proto rec -> f (Proto rec))
-> ((fldType -> f fldType) -> rec -> f rec)
-> (fldType -> f fldType)
-> Proto rec
-> f (Proto rec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy# fldName -> (x -> f x) -> rec -> f rec
forall s (x :: Symbol) a (f :: * -> *).
(HasField s x a, Functor f) =>
Proxy# x -> (a -> f a) -> s -> f s
forall (f :: * -> *).
Functor f =>
Proxy# fldName -> (x -> f x) -> rec -> f rec
ProtoLens.fieldOf Proxy# fldName
p ((x -> f x) -> rec -> f rec)
-> ((fldType -> f fldType) -> x -> f x)
-> (fldType -> f fldType)
-> rec
-> f rec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy# (Describe x) -> Lens' x fldType
forall (desc :: FieldDesc) x y.
RewrapField desc x y =>
Proxy# desc -> Lens' x y
rewrapField (forall {k} (a :: k). Proxy# a
forall (a :: FieldDesc). Proxy# a
proxy# @(Describe x))

instance ProtoLens.HasField (Proto rec) fldName fldType
      => GHC.HasField fldName (Proto rec) fldType where
  getField :: Proto rec -> fldType
getField Proto rec
r = (
        Proto rec
r Proto rec -> Getting fldType (Proto rec) fldType -> fldType
forall s a. s -> Getting a s a -> a
^. Proxy# fldName -> Getting fldType (Proto rec) fldType
forall s (x :: Symbol) a (f :: * -> *).
(HasField s x a, Functor f) =>
Proxy# x -> (a -> f a) -> s -> f s
forall (f :: * -> *).
Functor f =>
Proxy# fldName
-> (fldType -> f fldType) -> Proto rec -> f (Proto rec)
ProtoLens.fieldOf (forall {k} (a :: k). Proxy# a
forall (a :: Symbol). Proxy# a
proxy# @fldName)
      )

instance ProtoLens.HasField (Proto rec) fldName fldType
      => GHC.Compat.HasField fldName (Proto rec) fldType where
  hasField :: Proto rec -> (fldType -> Proto rec, fldType)
hasField Proto rec
r = (
        \fldType
a -> Proto rec
r Proto rec -> (Proto rec -> Proto rec) -> Proto rec
forall a b. a -> (a -> b) -> b
& Proxy# fldName
-> (fldType -> Identity fldType)
-> Proto rec
-> Identity (Proto rec)
forall s (x :: Symbol) a (f :: * -> *).
(HasField s x a, Functor f) =>
Proxy# x -> (a -> f a) -> s -> f s
forall (f :: * -> *).
Functor f =>
Proxy# fldName
-> (fldType -> f fldType) -> Proto rec -> f (Proto rec)
ProtoLens.fieldOf (forall {k} (a :: k). Proxy# a
forall (a :: Symbol). Proxy# a
proxy# @fldName) ((fldType -> Identity fldType)
 -> Proto rec -> Identity (Proto rec))
-> fldType -> Proto rec -> Proto rec
forall s t a b. ASetter s t a b -> b -> s -> t
.~ fldType
a
      , Proto rec
r Proto rec -> Getting fldType (Proto rec) fldType -> fldType
forall s a. s -> Getting a s a -> a
^. Proxy# fldName -> Getting fldType (Proto rec) fldType
forall s (x :: Symbol) a (f :: * -> *).
(HasField s x a, Functor f) =>
Proxy# x -> (a -> f a) -> s -> f s
forall (f :: * -> *).
Functor f =>
Proxy# fldName
-> (fldType -> f fldType) -> Proto rec -> f (Proto rec)
ProtoLens.fieldOf (forall {k} (a :: k). Proxy# a
forall (a :: Symbol). Proxy# a
proxy# @fldName)
      )

{-------------------------------------------------------------------------------
  Internal auxiliary: Proto wrapper
-------------------------------------------------------------------------------}

_proto :: Iso' (Proto msg) msg
_proto :: forall msg (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p msg (f msg) -> p (Proto msg) (f (Proto msg))
_proto = p msg (f msg) -> p (Proto msg) (f (Proto msg))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (Proto msg) (Proto msg) msg msg
coerced

protoFieldDescriptor :: FieldDescriptor msg -> FieldDescriptor (Proto msg)
protoFieldDescriptor :: forall msg. FieldDescriptor msg -> FieldDescriptor (Proto msg)
protoFieldDescriptor (FieldDescriptor String
name FieldTypeDescriptor value
typ FieldAccessor msg value
acc) =
    String
-> FieldTypeDescriptor value
-> FieldAccessor (Proto msg) value
-> FieldDescriptor (Proto msg)
forall value msg.
String
-> FieldTypeDescriptor value
-> FieldAccessor msg value
-> FieldDescriptor msg
FieldDescriptor String
name FieldTypeDescriptor value
typ (FieldAccessor msg value -> FieldAccessor (Proto msg) value
forall msg value.
FieldAccessor msg value -> FieldAccessor (Proto msg) value
protoFieldAccessor FieldAccessor msg value
acc)

protoFieldAccessor :: FieldAccessor msg value -> FieldAccessor (Proto msg) value
protoFieldAccessor :: forall msg value.
FieldAccessor msg value -> FieldAccessor (Proto msg) value
protoFieldAccessor (PlainField WireDefault value
def Lens' msg value
lens) =
    WireDefault value
-> Lens' (Proto msg) value -> FieldAccessor (Proto msg) value
forall value msg.
WireDefault value -> Lens' msg value -> FieldAccessor msg value
PlainField WireDefault value
def ((msg -> f msg) -> Proto msg -> f (Proto msg)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (Proto msg) (Proto msg) msg msg
coerced ((msg -> f msg) -> Proto msg -> f (Proto msg))
-> ((value -> f value) -> msg -> f msg)
-> (value -> f value)
-> Proto msg
-> f (Proto msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (value -> f value) -> msg -> f msg
Lens' msg value
lens)
protoFieldAccessor (OptionalField Lens' msg (Maybe value)
lens) =
    Lens' (Proto msg) (Maybe value) -> FieldAccessor (Proto msg) value
forall msg value.
Lens' msg (Maybe value) -> FieldAccessor msg value
OptionalField ((msg -> f msg) -> Proto msg -> f (Proto msg)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (Proto msg) (Proto msg) msg msg
coerced ((msg -> f msg) -> Proto msg -> f (Proto msg))
-> ((Maybe value -> f (Maybe value)) -> msg -> f msg)
-> (Maybe value -> f (Maybe value))
-> Proto msg
-> f (Proto msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe value -> f (Maybe value)) -> msg -> f msg
Lens' msg (Maybe value)
lens)
protoFieldAccessor (RepeatedField Packing
packing Lens' msg [value]
lens) =
    Packing
-> Lens' (Proto msg) [value] -> FieldAccessor (Proto msg) value
forall msg value.
Packing -> Lens' msg [value] -> FieldAccessor msg value
RepeatedField Packing
packing ((msg -> f msg) -> Proto msg -> f (Proto msg)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (Proto msg) (Proto msg) msg msg
coerced ((msg -> f msg) -> Proto msg -> f (Proto msg))
-> (([value] -> f [value]) -> msg -> f msg)
-> ([value] -> f [value])
-> Proto msg
-> f (Proto msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([value] -> f [value]) -> msg -> f msg
Lens' msg [value]
lens)
protoFieldAccessor (MapField Lens' value key
lensKey Lens' value value1
lensValue Lens' msg (Map key value1)
lensMap) =
    Lens' value key
-> Lens' value value1
-> Lens' (Proto msg) (Map key value1)
-> FieldAccessor (Proto msg) value
forall key value value1 msg.
(Ord key, Message value) =>
Lens' value key
-> Lens' value value1
-> Lens' msg (Map key value1)
-> FieldAccessor msg value
MapField LensLike' f value key
Lens' value key
lensKey LensLike' f value value1
Lens' value value1
lensValue ((msg -> f msg) -> Proto msg -> f (Proto msg)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (Proto msg) (Proto msg) msg msg
coerced ((msg -> f msg) -> Proto msg -> f (Proto msg))
-> ((Map key value1 -> f (Map key value1)) -> msg -> f msg)
-> (Map key value1 -> f (Map key value1))
-> Proto msg
-> f (Proto msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map key value1 -> f (Map key value1)) -> msg -> f msg
Lens' msg (Map key value1)
lensMap)