diff --git a/Changelog.md b/Changelog.md new file mode 100644 --- /dev/null +++ b/Changelog.md @@ -0,0 +1,10 @@ +# Changelog for `proto-lens-protobuf-types` + +## Unreleased changes + +## v0.2.2.0 +- Add the `Data.ProtoLens.Any` module for storing arbitrary Messages (#88). +- Bump the dependency on `base` to support `ghc-8.2.1`. + +## v0.2.1.0 +Initial version. diff --git a/dist/build/autogen/Proto/Google/Protobuf/Any.hs b/dist/build/autogen/Proto/Google/Protobuf/Any.hs --- a/dist/build/autogen/Proto/Google/Protobuf/Any.hs +++ b/dist/build/autogen/Proto/Google/Protobuf/Any.hs @@ -27,23 +27,27 @@ data Any = Any{_Any'typeUrl :: !Data.Text.Text, _Any'value :: !Data.ByteString.ByteString} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Data.Text.Text, b ~ Data.Text.Text, Prelude.Functor f) => Lens.Labels.HasLens "typeUrl" f Any Any a b where lensOf _ - = Lens.Family2.Unchecked.lens _Any'typeUrl - (\ x__ y__ -> x__{_Any'typeUrl = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _Any'typeUrl + (\ x__ y__ -> x__{_Any'typeUrl = y__})) + Prelude.id instance (a ~ Data.ByteString.ByteString, b ~ Data.ByteString.ByteString, Prelude.Functor f) => Lens.Labels.HasLens "value" f Any Any a b where lensOf _ - = Lens.Family2.Unchecked.lens _Any'value - (\ x__ y__ -> x__{_Any'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _Any'value + (\ x__ y__ -> x__{_Any'value = y__})) + Prelude.id instance Data.Default.Class.Default Any where def @@ -66,6 +70,7 @@ :: Data.ProtoLens.FieldDescriptor Any in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.Any") (Data.Map.fromList [(Data.ProtoLens.Tag 1, typeUrl__field_descriptor), (Data.ProtoLens.Tag 2, value__field_descriptor)]) diff --git a/dist/build/autogen/Proto/Google/Protobuf/Duration.hs b/dist/build/autogen/Proto/Google/Protobuf/Duration.hs --- a/dist/build/autogen/Proto/Google/Protobuf/Duration.hs +++ b/dist/build/autogen/Proto/Google/Protobuf/Duration.hs @@ -27,23 +27,27 @@ data Duration = Duration{_Duration'seconds :: !Data.Int.Int64, _Duration'nanos :: !Data.Int.Int32} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Data.Int.Int64, b ~ Data.Int.Int64, Prelude.Functor f) => Lens.Labels.HasLens "seconds" f Duration Duration a b where lensOf _ - = Lens.Family2.Unchecked.lens _Duration'seconds - (\ x__ y__ -> x__{_Duration'seconds = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _Duration'seconds + (\ x__ y__ -> x__{_Duration'seconds = y__})) + Prelude.id instance (a ~ Data.Int.Int32, b ~ Data.Int.Int32, Prelude.Functor f) => Lens.Labels.HasLens "nanos" f Duration Duration a b where lensOf _ - = Lens.Family2.Unchecked.lens _Duration'nanos - (\ x__ y__ -> x__{_Duration'nanos = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _Duration'nanos + (\ x__ y__ -> x__{_Duration'nanos = y__})) + Prelude.id instance Data.Default.Class.Default Duration where def @@ -66,6 +70,7 @@ :: Data.ProtoLens.FieldDescriptor Duration in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.Duration") (Data.Map.fromList [(Data.ProtoLens.Tag 1, seconds__field_descriptor), (Data.ProtoLens.Tag 2, nanos__field_descriptor)]) diff --git a/dist/build/autogen/Proto/Google/Protobuf/Wrappers.hs b/dist/build/autogen/Proto/Google/Protobuf/Wrappers.hs --- a/dist/build/autogen/Proto/Google/Protobuf/Wrappers.hs +++ b/dist/build/autogen/Proto/Google/Protobuf/Wrappers.hs @@ -26,14 +26,16 @@ import qualified Data.ProtoLens.Reexport.Lens.Labels as Lens.Labels data BoolValue = BoolValue{_BoolValue'value :: !Prelude.Bool} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Prelude.Bool, b ~ Prelude.Bool, Prelude.Functor f) => Lens.Labels.HasLens "value" f BoolValue BoolValue a b where lensOf _ - = Lens.Family2.Unchecked.lens _BoolValue'value - (\ x__ y__ -> x__{_BoolValue'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _BoolValue'value + (\ x__ y__ -> x__{_BoolValue'value = y__})) + Prelude.id instance Data.Default.Class.Default BoolValue where def = BoolValue{_BoolValue'value = Data.ProtoLens.fieldDefault} @@ -48,21 +50,24 @@ :: Data.ProtoLens.FieldDescriptor BoolValue in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.BoolValue") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) data BytesValue = BytesValue{_BytesValue'value :: !Data.ByteString.ByteString} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Data.ByteString.ByteString, b ~ Data.ByteString.ByteString, Prelude.Functor f) => Lens.Labels.HasLens "value" f BytesValue BytesValue a b where lensOf _ - = Lens.Family2.Unchecked.lens _BytesValue'value - (\ x__ y__ -> x__{_BytesValue'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _BytesValue'value + (\ x__ y__ -> x__{_BytesValue'value = y__})) + Prelude.id instance Data.Default.Class.Default BytesValue where def = BytesValue{_BytesValue'value = Data.ProtoLens.fieldDefault} @@ -77,21 +82,24 @@ :: Data.ProtoLens.FieldDescriptor BytesValue in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.BytesValue") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) data DoubleValue = DoubleValue{_DoubleValue'value :: !Prelude.Double} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Prelude.Double, b ~ Prelude.Double, Prelude.Functor f) => Lens.Labels.HasLens "value" f DoubleValue DoubleValue a b where lensOf _ - = Lens.Family2.Unchecked.lens _DoubleValue'value - (\ x__ y__ -> x__{_DoubleValue'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _DoubleValue'value + (\ x__ y__ -> x__{_DoubleValue'value = y__})) + Prelude.id instance Data.Default.Class.Default DoubleValue where def = DoubleValue{_DoubleValue'value = Data.ProtoLens.fieldDefault} @@ -106,20 +114,23 @@ :: Data.ProtoLens.FieldDescriptor DoubleValue in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.DoubleValue") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) data FloatValue = FloatValue{_FloatValue'value :: !Prelude.Float} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Prelude.Float, b ~ Prelude.Float, Prelude.Functor f) => Lens.Labels.HasLens "value" f FloatValue FloatValue a b where lensOf _ - = Lens.Family2.Unchecked.lens _FloatValue'value - (\ x__ y__ -> x__{_FloatValue'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _FloatValue'value + (\ x__ y__ -> x__{_FloatValue'value = y__})) + Prelude.id instance Data.Default.Class.Default FloatValue where def = FloatValue{_FloatValue'value = Data.ProtoLens.fieldDefault} @@ -134,20 +145,23 @@ :: Data.ProtoLens.FieldDescriptor FloatValue in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.FloatValue") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) data Int32Value = Int32Value{_Int32Value'value :: !Data.Int.Int32} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Data.Int.Int32, b ~ Data.Int.Int32, Prelude.Functor f) => Lens.Labels.HasLens "value" f Int32Value Int32Value a b where lensOf _ - = Lens.Family2.Unchecked.lens _Int32Value'value - (\ x__ y__ -> x__{_Int32Value'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _Int32Value'value + (\ x__ y__ -> x__{_Int32Value'value = y__})) + Prelude.id instance Data.Default.Class.Default Int32Value where def = Int32Value{_Int32Value'value = Data.ProtoLens.fieldDefault} @@ -162,20 +176,23 @@ :: Data.ProtoLens.FieldDescriptor Int32Value in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.Int32Value") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) data Int64Value = Int64Value{_Int64Value'value :: !Data.Int.Int64} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Data.Int.Int64, b ~ Data.Int.Int64, Prelude.Functor f) => Lens.Labels.HasLens "value" f Int64Value Int64Value a b where lensOf _ - = Lens.Family2.Unchecked.lens _Int64Value'value - (\ x__ y__ -> x__{_Int64Value'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _Int64Value'value + (\ x__ y__ -> x__{_Int64Value'value = y__})) + Prelude.id instance Data.Default.Class.Default Int64Value where def = Int64Value{_Int64Value'value = Data.ProtoLens.fieldDefault} @@ -190,21 +207,24 @@ :: Data.ProtoLens.FieldDescriptor Int64Value in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.Int64Value") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) data StringValue = StringValue{_StringValue'value :: !Data.Text.Text} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Data.Text.Text, b ~ Data.Text.Text, Prelude.Functor f) => Lens.Labels.HasLens "value" f StringValue StringValue a b where lensOf _ - = Lens.Family2.Unchecked.lens _StringValue'value - (\ x__ y__ -> x__{_StringValue'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _StringValue'value + (\ x__ y__ -> x__{_StringValue'value = y__})) + Prelude.id instance Data.Default.Class.Default StringValue where def = StringValue{_StringValue'value = Data.ProtoLens.fieldDefault} @@ -219,64 +239,71 @@ :: Data.ProtoLens.FieldDescriptor StringValue in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.StringValue") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) -data UInt32Value = UInt32Value{_UInt32Value'value :: +data Uint32Value = Uint32Value{_Uint32Value'value :: !Data.Word.Word32} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Data.Word.Word32, b ~ Data.Word.Word32, Prelude.Functor f) => - Lens.Labels.HasLens "value" f UInt32Value UInt32Value a b + Lens.Labels.HasLens "value" f Uint32Value Uint32Value a b where lensOf _ - = Lens.Family2.Unchecked.lens _UInt32Value'value - (\ x__ y__ -> x__{_UInt32Value'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _Uint32Value'value + (\ x__ y__ -> x__{_Uint32Value'value = y__})) + Prelude.id -instance Data.Default.Class.Default UInt32Value where - def = UInt32Value{_UInt32Value'value = Data.ProtoLens.fieldDefault} +instance Data.Default.Class.Default Uint32Value where + def = Uint32Value{_Uint32Value'value = Data.ProtoLens.fieldDefault} -instance Data.ProtoLens.Message UInt32Value where +instance Data.ProtoLens.Message Uint32Value where descriptor = let value__field_descriptor = Data.ProtoLens.FieldDescriptor "value" (Data.ProtoLens.UInt32Field :: Data.ProtoLens.FieldTypeDescriptor Data.Word.Word32) (Data.ProtoLens.PlainField Data.ProtoLens.Optional value) - :: Data.ProtoLens.FieldDescriptor UInt32Value + :: Data.ProtoLens.FieldDescriptor Uint32Value in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.UInt32Value") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) -data UInt64Value = UInt64Value{_UInt64Value'value :: +data Uint64Value = Uint64Value{_Uint64Value'value :: !Data.Word.Word64} - deriving (Prelude.Show, Prelude.Eq) + deriving (Prelude.Show, Prelude.Eq, Prelude.Ord) instance (a ~ Data.Word.Word64, b ~ Data.Word.Word64, Prelude.Functor f) => - Lens.Labels.HasLens "value" f UInt64Value UInt64Value a b + Lens.Labels.HasLens "value" f Uint64Value Uint64Value a b where lensOf _ - = Lens.Family2.Unchecked.lens _UInt64Value'value - (\ x__ y__ -> x__{_UInt64Value'value = y__}) + = (Prelude..) + (Lens.Family2.Unchecked.lens _Uint64Value'value + (\ x__ y__ -> x__{_Uint64Value'value = y__})) + Prelude.id -instance Data.Default.Class.Default UInt64Value where - def = UInt64Value{_UInt64Value'value = Data.ProtoLens.fieldDefault} +instance Data.Default.Class.Default Uint64Value where + def = Uint64Value{_Uint64Value'value = Data.ProtoLens.fieldDefault} -instance Data.ProtoLens.Message UInt64Value where +instance Data.ProtoLens.Message Uint64Value where descriptor = let value__field_descriptor = Data.ProtoLens.FieldDescriptor "value" (Data.ProtoLens.UInt64Field :: Data.ProtoLens.FieldTypeDescriptor Data.Word.Word64) (Data.ProtoLens.PlainField Data.ProtoLens.Optional value) - :: Data.ProtoLens.FieldDescriptor UInt64Value + :: Data.ProtoLens.FieldDescriptor Uint64Value in Data.ProtoLens.MessageDescriptor + (Data.Text.pack "google.protobuf.UInt64Value") (Data.Map.fromList [(Data.ProtoLens.Tag 1, value__field_descriptor)]) (Data.Map.fromList [("value", value__field_descriptor)]) diff --git a/proto-lens-protobuf-types.cabal b/proto-lens-protobuf-types.cabal --- a/proto-lens-protobuf-types.cabal +++ b/proto-lens-protobuf-types.cabal @@ -1,5 +1,5 @@ name: proto-lens-protobuf-types -version: 0.2.1.0 +version: 0.2.2.0 synopsis: Basic protocol buffer message types. description: This package provides bindings standard protocol message types, @@ -15,17 +15,24 @@ build-type: Custom cabal-version: >=1.8 extra-source-files: + Changelog.md proto-src/google/protobuf/any.proto proto-src/google/protobuf/duration.proto proto-src/google/protobuf/wrappers.proto custom-setup - setup-depends: base >= 4.8 && < 4.10 + setup-depends: base >= 4.8 && < 4.11 , Cabal , proto-lens-protoc == 0.2.* library - exposed-modules: Proto.Google.Protobuf.Any - Proto.Google.Protobuf.Duration - Proto.Google.Protobuf.Wrappers - build-depends: proto-lens-protoc == 0.2.* + hs-source-dirs: src + exposed-modules: Data.ProtoLens.Any + Proto.Google.Protobuf.Any + Proto.Google.Protobuf.Duration + Proto.Google.Protobuf.Wrappers + build-depends: base >= 4.8 && < 4.11 + , lens-family + , proto-lens >= 0.2.2 && < 0.3 + , proto-lens-protoc >= 0.2.2 && < 0.3 + , text == 1.2.* diff --git a/src/Data/ProtoLens/Any.hs b/src/Data/ProtoLens/Any.hs new file mode 100644 --- /dev/null +++ b/src/Data/ProtoLens/Any.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Data.ProtoLens.Any + ( Any + , pack + , packWithPrefix + , unpack + , UnpackError(..) + ) where + +import Control.Exception (Exception(..)) +import Data.Monoid ((<>)) +import qualified Data.Text as Text +import Data.Text (Text) +import Data.Typeable (Typeable) +import Data.ProtoLens + ( decodeMessage + , def + , encodeMessage + , Message(..) + , MessageDescriptor(..) + ) +import Lens.Family2 ((&), (.~), (^.)) +import Proto.Google.Protobuf.Any + +-- | Packs the given message into an 'Any' using the default type URL prefix +-- "type.googleapis.com". +pack :: forall a . Message a => a -> Any +pack = packWithPrefix googleApisPrefix + +googleApisPrefix :: Text +googleApisPrefix = "type.googleapis.com" + +-- | Packs the given message into an 'Any' using the given type URL prefix. +packWithPrefix :: forall a . Message a => Text -> a -> Any +packWithPrefix prefix x = + def & typeUrl .~ (prefix <> "/" <> name) + & value .~ encodeMessage x + where + name = messageName (descriptor :: MessageDescriptor a) + +-- | A description of a failure during `unpack` to decode an `Any` message +-- into the expected type. +data UnpackError + = DifferentType + { expectedMessageType :: Text -- ^ The expected @packagename.messagename@ + , actualUrl :: Text -- ^ The typeUrl in the 'Any' being unpacked + } + | DecodingError Text -- ^ The error from decodeMessage + deriving (Show, Eq, Typeable) + +instance Exception UnpackError + +-- | Unpacks the given 'Any' into the given message type. Returns 'Nothing' +-- if the type doesn't match or parsing the payload has failed. +-- +-- Ignores the type URL prefix. +unpack :: forall a . Message a => Any -> Either UnpackError a +unpack a + | expectedName /= snd (Text.breakOnEnd "/" $ a ^. typeUrl) + = Left DifferentType + { expectedMessageType = expectedName + , actualUrl = a ^. typeUrl + } + | otherwise = case decodeMessage (a ^. value) of + Left e -> Left $ DecodingError $ Text.pack e + Right x -> Right x + where + expectedName = messageName (descriptor :: MessageDescriptor a)