-- Copyright 2016 Google Inc. All Rights Reserved.
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

-- | Functions for converting protocol buffers to a human-readable text format.
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Data.ProtoLens.TextFormat(
    showMessage,
    showMessageWithRegistry,
    showMessageShort,
    pprintMessage,
    pprintMessageWithRegistry,
    readMessage,
    readMessageWithRegistry,
    readMessageOrDie,
    ) where

import Lens.Family2 ((&),(^.),(.~), set, over, view)
import Control.Arrow (left)
import Data.Bifunctor (first)
import qualified Data.ByteString
import Data.Char (isPrint, isAscii, chr)
import Data.Foldable (foldlM, foldl')
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Proxy (Proxy(Proxy))
import qualified Data.Set as Set
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as Lazy
import qualified Data.Text as Text (unpack)
import Numeric (showOct)
import Text.Parsec (parse)
import Text.PrettyPrint

#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif

import Data.ProtoLens.Encoding (decodeMessage, encodeMessage)
import Data.ProtoLens.Encoding.Bytes (runParser)
import Data.ProtoLens.Encoding.Wire
import Data.ProtoLens.Message hiding (buildMessage, parseMessage)
import qualified Data.ProtoLens.TextFormat.Parser as Parser

-- TODO: This code is newer and missing some edge cases,
-- including:
-- - Serialize directly to Text
-- - String/bytestring serialization
--   - Strings delimited by single quotes
--   - Concatenate multiple strings one after another
--   - control characters and non-UTF8 text
--   - characters in bytes fields should fit in Word8
-- - More output formats for floats like exponentials
-- - Print/parse enums by textual name in addition to integer value
-- - More compact printing/parsing for packed fields
-- - Decide what to do for values that don't fit in the field (e.g., overflow)
-- - Add more tests for:
--   - edge cases of deserialization ("deserializeFrom")


-- | Pretty-print the given message into a human-readable form.
pprintMessage :: Message msg => msg -> Doc
pprintMessage :: forall msg. Message msg => msg -> Doc
pprintMessage = forall msg. Message msg => Registry -> msg -> Doc
pprintMessageWithRegistry forall a. Monoid a => a
mempty

-- | Pretty-print the given message into human-readable form, using the given
-- 'Registry' to decode @google.protobuf.Any@ values.
pprintMessageWithRegistry :: Message msg => Registry -> msg -> Doc
pprintMessageWithRegistry :: forall msg. Message msg => Registry -> msg -> Doc
pprintMessageWithRegistry Registry
reg msg
msg
    -- Either put all fields together on a single line, or use a separate line
    -- for each field.  We use a single "sep" for all fields (and all elements
    -- of all the repeated fields) to avoid putting some repeated fields on one
    -- line and other fields on multiple lines, which is less readable.
    = [Doc] -> Doc
sep forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall msg. Registry -> msg -> FieldDescriptor msg -> [Doc]
pprintField Registry
reg msg
msg) forall msg. Message msg => [FieldDescriptor msg]
allFields
              forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map TaggedValue -> Doc
pprintTaggedValue (msg
msg forall s a t b. s -> FoldLike a s t a b -> a
^. forall msg. Message msg => Lens' msg [TaggedValue]
unknownFields)

-- | Convert the given message into a human-readable 'String'.
showMessage :: Message msg => msg -> String
showMessage :: forall msg. Message msg => msg -> String
showMessage = Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg. Message msg => msg -> Doc
pprintMessage

-- | Convert the given message into a human-readable 'String', using the
-- 'Registry' to encode @google.protobuf.Any@ values.
showMessageWithRegistry :: Message msg => Registry -> msg -> String
showMessageWithRegistry :: forall msg. Message msg => Registry -> msg -> String
showMessageWithRegistry Registry
reg = Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg. Message msg => Registry -> msg -> Doc
pprintMessageWithRegistry Registry
reg

-- | Serializes a proto as a string on a single line.  Useful for debugging
-- and error messages like @.DebugString()@ in other languages.
showMessageShort :: Message msg => msg -> String
showMessageShort :: forall msg. Message msg => msg -> String
showMessageShort = Style -> Doc -> String
renderStyle (Mode -> Int -> Float -> Style
Style Mode
OneLineMode forall a. Bounded a => a
maxBound Float
1.5) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg. Message msg => msg -> Doc
pprintMessage

pprintField :: Registry -> msg -> FieldDescriptor msg -> [Doc]
pprintField :: forall msg. Registry -> msg -> FieldDescriptor msg -> [Doc]
pprintField Registry
reg msg
msg (FieldDescriptor String
name FieldTypeDescriptor value
typeDescr FieldAccessor msg value
accessor)
    = forall a b. (a -> b) -> [a] -> [b]
map (forall value.
Registry -> String -> FieldTypeDescriptor value -> value -> Doc
pprintFieldValue Registry
reg String
name FieldTypeDescriptor value
typeDescr) forall a b. (a -> b) -> a -> b
$ case FieldAccessor msg value
accessor of
        PlainField WireDefault value
d Lens' msg value
f
            | WireDefault value
Optional <- WireDefault value
d, value
val forall a. Eq a => a -> a -> Bool
== forall value. FieldDefault value => value
fieldDefault -> []
            | Bool
otherwise -> [value
val]
          where val :: value
val = msg
msg forall s a t b. s -> FoldLike a s t a b -> a
^. Lens' msg value
f
        OptionalField Lens' msg (Maybe value)
f -> forall a. [Maybe a] -> [a]
catMaybes [msg
msg forall s a t b. s -> FoldLike a s t a b -> a
^. Lens' msg (Maybe value)
f]
        -- TODO: better printing for packed fields
        RepeatedField Packing
_ Lens' msg [value]
f -> msg
msg forall s a t b. s -> FoldLike a s t a b -> a
^. Lens' msg [value]
f
        MapField Lens' value key
k Lens' value value
v Lens' msg (Map key value)
f -> (key, value) -> value
pairToMsg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.assocs (msg
msg forall s a t b. s -> FoldLike a s t a b -> a
^. Lens' msg (Map key value)
f)
          where pairToMsg :: (key, value) -> value
pairToMsg (key
x,value
y) = forall msg. Message msg => msg
defMessage
                                    forall s t. s -> (s -> t) -> t
& Lens' value key
k forall s t a b. Setter s t a b -> b -> s -> t
.~ key
x
                                    forall s t. s -> (s -> t) -> t
& Lens' value value
v forall s t a b. Setter s t a b -> b -> s -> t
.~ value
y

pprintFieldValue :: Registry -> String -> FieldTypeDescriptor value -> value -> Doc
pprintFieldValue :: forall value.
Registry -> String -> FieldTypeDescriptor value -> value -> Doc
pprintFieldValue Registry
reg String
name field :: FieldTypeDescriptor value
field@(MessageField MessageOrGroup
MessageType) value
m
  | Just AnyMessageDescriptor { Lens' value Text
anyTypeUrlLens :: forall msg. AnyMessageDescriptor msg -> Lens' msg Text
anyTypeUrlLens :: Lens' value Text
anyTypeUrlLens, Lens' value ByteString
anyValueLens :: forall msg. AnyMessageDescriptor msg -> Lens' msg ByteString
anyValueLens :: Lens' value ByteString
anyValueLens } <- forall value.
FieldTypeDescriptor value -> Maybe (AnyMessageDescriptor value)
matchAnyMessage FieldTypeDescriptor value
field,
    Text
typeUri <- forall a s t b. FoldLike a s t a b -> s -> a
view Lens' value Text
anyTypeUrlLens value
m,
    ByteString
fieldData <- forall a s t b. FoldLike a s t a b -> s -> a
view Lens' value ByteString
anyValueLens value
m,
    Just (SomeMessageType (Proxy msg
Proxy :: Proxy value')) <- Text -> Registry -> Maybe SomeMessageType
lookupRegistered Text
typeUri Registry
reg,
    Right (msg
anyValue :: value') <- forall msg. Message msg => ByteString -> Either String msg
decodeMessage ByteString
fieldData =
      String -> Doc -> Doc
pprintSubmessage String
name
          forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep
            [ Doc
lbrack Doc -> Doc -> Doc
<> String -> Doc
text (Text -> String
Text.unpack Text
typeUri) Doc -> Doc -> Doc
<> Doc
rbrack Doc -> Doc -> Doc
<+> Doc
lbrace
            , Int -> Doc -> Doc
nest Int
2 (forall msg. Message msg => Registry -> msg -> Doc
pprintMessageWithRegistry Registry
reg msg
anyValue)
            , Doc
rbrace ]
  | Bool
otherwise =
      String -> Doc -> Doc
pprintSubmessage String
name (forall msg. Message msg => Registry -> msg -> Doc
pprintMessageWithRegistry Registry
reg value
m)
pprintFieldValue Registry
reg String
name (MessageField MessageOrGroup
GroupType) value
m
    = String -> Doc -> Doc
pprintSubmessage String
name (forall msg. Message msg => Registry -> msg -> Doc
pprintMessageWithRegistry Registry
reg value
m)
pprintFieldValue Registry
_ String
name (ScalarField ScalarField value
f) value
x = String -> Doc -> Doc
named String
name forall a b. (a -> b) -> a -> b
$ forall value. ScalarField value -> value -> Doc
pprintScalarValue ScalarField value
f value
x

named :: String -> Doc -> Doc
named :: String -> Doc -> Doc
named String
n Doc
x = String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> Doc
x


pprintScalarValue :: ScalarField value -> value -> Doc
pprintScalarValue :: forall value. ScalarField value -> value -> Doc
pprintScalarValue ScalarField value
EnumField value
x = String -> Doc
text (forall a. MessageEnum a => a -> String
showEnum value
x)
pprintScalarValue ScalarField value
Int32Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
Int64Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
UInt32Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
UInt64Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
SInt32Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
SInt64Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
Fixed32Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
Fixed64Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
SFixed32Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
SFixed64Field value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
FloatField value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
DoubleField value
x = forall value. Show value => value -> Doc
primField value
x
pprintScalarValue ScalarField value
BoolField value
x = Bool -> Doc
boolValue value
x
pprintScalarValue ScalarField value
StringField value
x = ByteString -> Doc
pprintByteString (Text -> ByteString
Text.encodeUtf8 value
x)
pprintScalarValue ScalarField value
BytesField value
x = ByteString -> Doc
pprintByteString value
x

pprintSubmessage :: String -> Doc -> Doc
pprintSubmessage :: String -> Doc -> Doc
pprintSubmessage String
name Doc
contents =
    [Doc] -> Doc
sep [String -> Doc
text String
name Doc -> Doc -> Doc
<+> Doc
lbrace, Int -> Doc -> Doc
nest Int
2 Doc
contents, Doc
rbrace]

-- | Formats a string in a way that mostly matches the C-compatible escaping
-- used by the Protocol Buffer distribution.  We depart a bit by escaping all
-- non-ASCII characters, which depending on the locale, the distribution might
-- not do.
--
-- This uses three-digit octal escapes, e.g. "\011" plus \n, \r,, \t, \', \",
-- and \\ only.  Note that Haskell string-literal syntax calls for "\011" to be
-- interpreted as decimal 11, rather than the decimal 9 it actually represent,
-- so you can't use Prelude.read to parse the strings created here.
pprintByteString :: Data.ByteString.ByteString -> Doc
pprintByteString :: ByteString -> Doc
pprintByteString ByteString
x = Char -> Doc
char Char
'\"'
    Doc -> Doc -> Doc
<> String -> Doc
text (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. (Integral a, Show a) => a -> String
escape forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
Data.ByteString.unpack ByteString
x) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'\"'
  where escape :: a -> String
escape a
w8 | Char
ch forall a. Eq a => a -> a -> Bool
== Char
'\n'               = String
"\\n"
                  | Char
ch forall a. Eq a => a -> a -> Bool
== Char
'\r'               = String
"\\r"
                  | Char
ch forall a. Eq a => a -> a -> Bool
== Char
'\t'               = String
"\\t"
                  | Char
ch forall a. Eq a => a -> a -> Bool
== Char
'\"'               = String
"\\\""
                  | Char
ch forall a. Eq a => a -> a -> Bool
== Char
'\''               = String
"\\\'"
                  | Char
ch forall a. Eq a => a -> a -> Bool
== Char
'\\'               = String
"\\\\"
                  | Char -> Bool
isPrint Char
ch Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
ch = Char
ch forall a. a -> [a] -> [a]
: String
""
                  | Bool
otherwise                = String
"\\" forall a. [a] -> [a] -> [a]
++ String -> String
pad (forall a. (Integral a, Show a) => a -> String -> String
showOct a
w8 String
"")
          where
            ch :: Char
ch = Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w8
            pad :: String -> String
pad String
str = forall a. Int -> a -> [a]
replicate (Int
3 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) Char
'0' forall a. [a] -> [a] -> [a]
++ String
str

primField :: Show value => value -> Doc
primField :: forall value. Show value => value -> Doc
primField value
x = String -> Doc
text (forall a. Show a => a -> String
show value
x)

boolValue :: Bool -> Doc
boolValue :: Bool -> Doc
boolValue Bool
True = String -> Doc
text String
"true"
boolValue Bool
False = String -> Doc
text String
"false"

pprintTaggedValue :: TaggedValue -> Doc
pprintTaggedValue :: TaggedValue -> Doc
pprintTaggedValue (TaggedValue Tag
t WireValue
wv) = case WireValue
wv of
    VarInt Word64
x -> String -> Doc -> Doc
named String
name forall a b. (a -> b) -> a -> b
$ forall value. Show value => value -> Doc
primField Word64
x
    Fixed64 Word64
x -> String -> Doc -> Doc
named String
name forall a b. (a -> b) -> a -> b
$ forall value. Show value => value -> Doc
primField Word64
x
    Fixed32 Word32
x -> String -> Doc -> Doc
named String
name forall a b. (a -> b) -> a -> b
$ forall value. Show value => value -> Doc
primField Word32
x
    Lengthy ByteString
x -> case forall a. Parser a -> ByteString -> Either String a
runParser Parser [TaggedValue]
parseFieldSet ByteString
x of
                  Left String
_ -> String -> Doc -> Doc
named String
name forall a b. (a -> b) -> a -> b
$ ByteString -> Doc
pprintByteString ByteString
x
                  Right [TaggedValue]
ts -> String -> Doc -> Doc
pprintSubmessage String
name
                                forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map TaggedValue -> Doc
pprintTaggedValue [TaggedValue]
ts
    -- TODO: implement better printing for unknown groups
    WireValue
StartGroup -> String -> Doc -> Doc
named String
name forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"start_group"
    WireValue
EndGroup -> String -> Doc -> Doc
named String
name forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"end_group"
  where
    name :: String
name = forall a. Show a => a -> String
show (Tag -> Int
unTag Tag
t)


--------------------------------------------------------------------------------
-- Parsing

-- | Parse a 'Message' from the human-readable protocol buffer text format.
readMessage :: Message msg => Lazy.Text -> Either String msg
readMessage :: forall msg. Message msg => Text -> Either String msg
readMessage = forall msg. Message msg => Registry -> Text -> Either String msg
readMessageWithRegistry forall a. Monoid a => a
mempty

-- | Parse a 'Message' from the human-readable protocol buffer text format.
-- Throws an error if the parse was not successful.
readMessageOrDie :: Message msg => Lazy.Text -> msg
readMessageOrDie :: forall msg. Message msg => Text -> msg
readMessageOrDie Text
str = case forall msg. Message msg => Text -> Either String msg
readMessage Text
str of
    Left String
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"readMessageOrDie: " forall a. [a] -> [a] -> [a]
++ String
e
    Right msg
x -> msg
x

-- | Parse a 'Message' from a human-readable protocol buffer text format, using
-- the given 'Registry' to decode 'Any' fields
readMessageWithRegistry :: Message msg => Registry -> Lazy.Text -> Either String msg
readMessageWithRegistry :: forall msg. Message msg => Registry -> Text -> Either String msg
readMessageWithRegistry Registry
reg Text
str = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall a. Show a => a -> String
show (forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser Message
Parser.parser String
"" Text
str) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall msg. Message msg => Registry -> Message -> Either String msg
buildMessage Registry
reg

buildMessage :: forall msg . Message msg => Registry -> Parser.Message -> Either String msg
buildMessage :: forall msg. Message msg => Registry -> Message -> Either String msg
buildMessage Registry
reg Message
fields
    | [String]
missing <- forall msg. Message msg => Proxy msg -> Message -> [String]
missingFields (forall {k} (t :: k). Proxy t
Proxy @msg) Message
fields, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
missing
        = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Missing fields " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
missing
    | Bool
otherwise = forall k msg. Map k (FieldDescriptor msg) -> msg -> msg
reverseRepeatedFields forall msg. Message msg => Map Tag (FieldDescriptor msg)
fieldsByTag
                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall msg.
Message msg =>
Registry -> msg -> Message -> Either String msg
buildMessageFromDescriptor Registry
reg forall msg. Message msg => msg
defMessage Message
fields

missingFields :: forall msg . Message msg => Proxy msg -> Parser.Message -> [String]
missingFields :: forall msg. Message msg => Proxy msg -> Message -> [String]
missingFields Proxy msg
_ = forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set String -> Field -> Set String
deleteField Set String
requiredFieldNames
  where
    requiredFieldNames :: Set.Set String
    requiredFieldNames :: Set String
requiredFieldNames = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys
                            forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter forall msg. FieldDescriptor msg -> Bool
isRequired
                            forall a b. (a -> b) -> a -> b
$ forall msg. Message msg => Map String (FieldDescriptor msg)
fieldsByTextFormatName @msg
    deleteField :: Set.Set String -> Parser.Field -> Set.Set String
    deleteField :: Set String -> Field -> Set String
deleteField Set String
fs (Parser.Field (Parser.Key String
name) Value
_) = forall a. Ord a => a -> Set a -> Set a
Set.delete String
name Set String
fs
    deleteField Set String
fs (Parser.Field (Parser.UnknownKey Integer
n) Value
_)
        | Just FieldDescriptor msg
d <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> Tag
Tag (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)) (forall msg. Message msg => Map Tag (FieldDescriptor msg)
fieldsByTag @msg)
        = forall a. Ord a => a -> Set a -> Set a
Set.delete (forall msg. FieldDescriptor msg -> String
fieldDescriptorName FieldDescriptor msg
d) Set String
fs
    deleteField Set String
fs Field
_ = Set String
fs


buildMessageFromDescriptor
    :: Message msg => Registry -> msg -> Parser.Message -> Either String msg
buildMessageFromDescriptor :: forall msg.
Message msg =>
Registry -> msg -> Message -> Either String msg
buildMessageFromDescriptor Registry
reg = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (forall msg.
Message msg =>
Registry -> msg -> Field -> Either String msg
addField Registry
reg)

addField :: forall msg . Message msg => Registry -> msg -> Parser.Field -> Either String msg
addField :: forall msg.
Message msg =>
Registry -> msg -> Field -> Either String msg
addField Registry
reg msg
msg (Parser.Field Key
key Value
rawValue) = do
    FieldDescriptor String
name FieldTypeDescriptor value
typeDescriptor FieldAccessor msg value
accessor <- Either String (FieldDescriptor msg)
getFieldDescriptor
    value
value <- forall value.
String
-> Registry
-> FieldTypeDescriptor value
-> Value
-> Either String value
makeValue String
name Registry
reg FieldTypeDescriptor value
typeDescriptor Value
rawValue
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall msg value. FieldAccessor msg value -> value -> msg -> msg
modifyField FieldAccessor msg value
accessor value
value msg
msg
  where
    getFieldDescriptor :: Either String (FieldDescriptor msg)
getFieldDescriptor
        | Parser.Key String
name <- Key
key, Just FieldDescriptor msg
f <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name
                                                forall msg. Message msg => Map String (FieldDescriptor msg)
fieldsByTextFormatName
            = forall (m :: * -> *) a. Monad m => a -> m a
return FieldDescriptor msg
f
        | Parser.UnknownKey Integer
tag <- Key
key, Just FieldDescriptor msg
f <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tag)
                                                      forall msg. Message msg => Map Tag (FieldDescriptor msg)
fieldsByTag
            = forall (m :: * -> *) a. Monad m => a -> m a
return FieldDescriptor msg
f
        | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unrecognized field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Key
key

modifyField :: FieldAccessor msg value -> value -> msg -> msg
modifyField :: forall msg value. FieldAccessor msg value -> value -> msg -> msg
modifyField (PlainField WireDefault value
_ Lens' msg value
f) value
value = forall s t a b. Setter s t a b -> b -> s -> t
set Lens' msg value
f value
value
modifyField (OptionalField Lens' msg (Maybe value)
f) value
value = forall s t a b. Setter s t a b -> b -> s -> t
set Lens' msg (Maybe value)
f (forall a. a -> Maybe a
Just value
value)
modifyField (RepeatedField Packing
_ Lens' msg [value]
f) value
value = forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Lens' msg [value]
f (value
value forall a. a -> [a] -> [a]
:)
modifyField (MapField Lens' value key
key Lens' value value
value Lens' msg (Map key value)
f) value
mapElem
    = forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over Lens' msg (Map key value)
f (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (value
mapElem forall s a t b. s -> FoldLike a s t a b -> a
^. Lens' value key
key) (value
mapElem forall s a t b. s -> FoldLike a s t a b -> a
^. Lens' value value
value))

makeValue
    :: forall value
     . String -- ^ name of field
    -> Registry
    -> FieldTypeDescriptor value
    -> Parser.Value
    -> Either String value
makeValue :: forall value.
String
-> Registry
-> FieldTypeDescriptor value
-> Value
-> Either String value
makeValue String
name Registry
_ (ScalarField ScalarField value
f) Value
v =
    forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((String
"Error parsing field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
name forall a. [a] -> [a] -> [a]
++ String
": ") forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ forall value. ScalarField value -> Value -> Either String value
makeScalarValue ScalarField value
f Value
v
makeValue String
name Registry
reg field :: FieldTypeDescriptor value
field@(MessageField MessageOrGroup
MessageType) (Parser.MessageValue (Just Text
typeUri) Message
x)
    | Just AnyMessageDescriptor { Lens' value Text
anyTypeUrlLens :: Lens' value Text
anyTypeUrlLens :: forall msg. AnyMessageDescriptor msg -> Lens' msg Text
anyTypeUrlLens, Lens' value ByteString
anyValueLens :: Lens' value ByteString
anyValueLens :: forall msg. AnyMessageDescriptor msg -> Lens' msg ByteString
anyValueLens } <- forall value.
FieldTypeDescriptor value -> Maybe (AnyMessageDescriptor value)
matchAnyMessage FieldTypeDescriptor value
field =
        case Text -> Registry -> Maybe SomeMessageType
lookupRegistered Text
typeUri Registry
reg of
          Maybe SomeMessageType
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Could not decode google.protobuf.Any for field "
                                forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
name forall a. [a] -> [a] -> [a]
++ String
": unregistered type URI "
                                forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
typeUri
          Just (SomeMessageType (Proxy msg
Proxy :: Proxy value')) ->
            case forall msg. Message msg => Registry -> Message -> Either String msg
buildMessage Registry
reg Message
x :: Either String value' of
              Left String
err -> forall a b. a -> Either a b
Left String
err
              Right msg
value' -> forall a b. b -> Either a b
Right (forall msg. Message msg => msg
defMessage
                                        forall s t. s -> (s -> t) -> t
& Lens' value Text
anyTypeUrlLens forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
typeUri
                                        forall s t. s -> (s -> t) -> t
& Lens' value ByteString
anyValueLens forall s t a b. Setter s t a b -> b -> s -> t
.~ forall msg. Message msg => msg -> ByteString
encodeMessage msg
value')
    | Bool
otherwise = forall a b. a -> Either a b
Left (String
"Type mismatch parsing explicitly typed message. Expected " forall a. [a] -> [a] -> [a]
++
                        forall a. Show a => a -> String
show (forall msg. Message msg => Proxy msg -> Text
messageName (forall {k} (t :: k). Proxy t
Proxy @value))  forall a. [a] -> [a] -> [a]
++
                        String
", got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
typeUri)
makeValue String
_ Registry
reg (MessageField MessageOrGroup
_) (Parser.MessageValue Maybe Text
_ Message
x) = forall msg. Message msg => Registry -> Message -> Either String msg
buildMessage Registry
reg Message
x
makeValue String
name Registry
_ (MessageField MessageOrGroup
_) Value
val =
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Type mismatch for field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
name forall a. [a] -> [a] -> [a]
++
            String
": expected message, found " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
val

makeScalarValue :: ScalarField value -> Parser.Value -> Either String value
makeScalarValue :: forall value. ScalarField value -> Value -> Either String value
makeScalarValue ScalarField value
Int32Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
Int64Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
UInt32Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
UInt64Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
SInt32Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
SInt64Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
Fixed32Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
Fixed64Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
SFixed32Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
SFixed64Field (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
FloatField (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
DoubleField (Parser.IntValue Integer
x) = forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
BoolField (Parser.IntValue Integer
x)
    | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a b. b -> Either a b
Right Bool
False
    | Integer
x forall a. Eq a => a -> a -> Bool
== Integer
1 = forall a b. b -> Either a b
Right Bool
True
    | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unrecognized bool value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
x
makeScalarValue ScalarField value
DoubleField (Parser.DoubleValue Double
x) = forall a b. b -> Either a b
Right Double
x
makeScalarValue ScalarField value
FloatField (Parser.DoubleValue Double
x) = forall a b. b -> Either a b
Right (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
makeScalarValue ScalarField value
BoolField (Parser.EnumValue String
x)
    | String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"true", String
"True", String
"t"] = forall a b. b -> Either a b
Right Bool
True
    | String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"false", String
"False", String
"f"] = forall a b. b -> Either a b
Right Bool
False
    | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unrecognized bool value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
x
makeScalarValue ScalarField value
StringField (Parser.ByteStringValue ByteString
x) = forall a b. b -> Either a b
Right (ByteString -> Text
Text.decodeUtf8 ByteString
x)
makeScalarValue ScalarField value
BytesField (Parser.ByteStringValue ByteString
x) = forall a b. b -> Either a b
Right ByteString
x
makeScalarValue ScalarField value
EnumField (Parser.IntValue Integer
x) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unrecognized enum value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
x) forall a b. b -> Either a b
Right
        (forall a. MessageEnum a => Int -> Maybe a
maybeToEnum forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
x)
makeScalarValue ScalarField value
EnumField (Parser.EnumValue String
x) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unrecognized enum value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
x) forall a b. b -> Either a b
Right
        (forall a. MessageEnum a => String -> Maybe a
readEnum String
x)
makeScalarValue ScalarField value
f Value
val = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Type mismatch: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ScalarField value
f, Value
val)