-- | Support for the protobuf @Any@ type
--
-- Official docs at <https://protobuf.dev/programming-guides/proto3/#any>.
--
-- Intended for qualified import.
--
-- > import Network.GRPC.Common.Protobuf.Any (Any)
-- > import Network.GRPC.Common.Protobuf.Any qualified as Any
module Network.GRPC.Common.Protobuf.Any (
    Any

    -- * Packing and unpacking
  , UnpackError(..)
  , pack
  , unpack
  ) where

import Data.Bifunctor
import Data.ProtoLens.Any (Any, UnpackError(..))
import Data.ProtoLens.Any qualified as Any
import Data.ProtoLens.Message (Message)

import Network.GRPC.Spec

{-------------------------------------------------------------------------------
  Pack and unpack
-------------------------------------------------------------------------------}

pack :: Message a => Proto a -> Proto Any
pack :: forall a. Message a => Proto a -> Proto Any
pack = Any -> Proto Any
forall msg. msg -> Proto msg
Proto (Any -> Proto Any) -> (Proto a -> Any) -> Proto a -> Proto Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Any
forall a. Message a => a -> Any
Any.pack (a -> Any) -> (Proto a -> a) -> Proto a -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto a -> a
forall msg. Proto msg -> msg
getProto

unpack :: Message a => Proto Any -> Either UnpackError (Proto a)
unpack :: forall a. Message a => Proto Any -> Either UnpackError (Proto a)
unpack = (a -> Proto a)
-> Either UnpackError a -> Either UnpackError (Proto 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 a -> Proto a
forall msg. msg -> Proto msg
Proto (Either UnpackError a -> Either UnpackError (Proto a))
-> (Proto Any -> Either UnpackError a)
-> Proto Any
-> Either UnpackError (Proto a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Any -> Either UnpackError a
forall a. Message a => Any -> Either UnpackError a
Any.unpack (Any -> Either UnpackError a)
-> (Proto Any -> Any) -> Proto Any -> Either UnpackError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto Any -> Any
forall msg. Proto msg -> msg
getProto