{-# LANGUAGE GADTs,MultiParamTypeClasses,FunctionalDependencies,FlexibleInstances,DeriveDataTypeable,ScopedTypeVariables,StandaloneDeriving #-}
-- | The "Extensions" module contributes two main things.  The first
-- is the definition and implementation of extensible message
-- features.  This means that the 'ExtField' data type is exported but
-- its constructor is (in an ideal world) hidden.
--
-- This first part also includes the keys for the extension fields:
-- the 'Key' data type.  These are typically defined in code generated
-- by 'hprotoc' from '.proto' file definitions.
--
-- The second main part is the 'MessageAPI' class which defines
-- 'getVal' and 'isSet'.  These allow uniform access to normal and
-- extension fields for users.
--
-- Access to extension fields is strictly through keys.  There is not
-- currently any way to query or change or clear any other extension
-- field data.
--
-- This module is likely to get broken up into pieces.
module Text.ProtocolBuffers.Extensions
  ( -- * Query functions for 'Key'
    getKeyFieldId,getKeyFieldType,getKeyDefaultValue
  -- * External types and classes
  , Key(..),ExtKey(..),MessageAPI(..)
  , PackedSeq(..), EP(..)
  -- * Internal types, functions, and classes
  , wireSizeExtField,wirePutExtField,wirePutExtFieldWithSize,loadExtension,notExtension
  , wireGetKeyToUnPacked, wireGetKeyToPacked
  , GPB,ExtField(..),ExtendMessage(..),ExtFieldValue(..)
  ) where

import Control.Monad.Error.Class(throwError)
import qualified Data.ByteString.Lazy as L
import qualified Data.Foldable as F
import Data.Map(Map)
import qualified Data.Map as M
import Data.Maybe(fromMaybe,isJust)
import Data.Sequence((|>),(><),viewl,ViewL(..))
import qualified Data.Sequence as Seq(singleton,null,empty)
import Data.Typeable(Typeable,typeOf,cast)
import Data.Data(Data(gfoldl,gunfold,toConstr),Constr,DataType,Fixity(Prefix),mkDataType,mkConstr,dataTypeOf)

import Text.ProtocolBuffers.Basic
import Text.ProtocolBuffers.WireMessage
import Text.ProtocolBuffers.Reflections
import Text.ProtocolBuffers.Get as Get (Result(..),bytesRead)

err :: String -> b
err :: String -> b
err String
msg = String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Text.ProtocolBuffers.Extensions error\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
msg

-- | The 'Key' data type is used with the 'ExtKey' class to put, get,
-- and clear external fields of messages.  The 'Key' can also be used
-- with the 'MessagesAPI' to get a possibly default value and to check
-- whether a key has been set in a message.
--
-- The 'Key' type (opaque to the user) has a phantom type of Maybe
-- or Seq that corresponds to Optional or Repeated fields. And a
-- second phantom type that matches the message type it must be used
-- with.  The third type parameter corresponds to the Haskell value
-- type.
--
-- The 'Key' is a GADT that puts all the needed class instances into
-- scope.  The actual content is the 'FieldId' ( numeric key), the
-- 'FieldType' (for sanity checks), and @Maybe v@ (a non-standard
-- default value).
--
-- When code is generated all of the known keys are taken into account
-- in the deserialization from the wire.  Unknown extension fields are
-- read as a collection of raw byte sequences.  If a key is then
-- presented it will be used to parse the bytes.
--
-- There is no guarantee for what happens if two Keys disagree about
-- the type of a field; in particular there may be undefined values
-- and runtime errors.  The data constructor for 'Key' has to be
-- exported to the generated code, but is not exposed to the user by
-- "Text.ProtocolBuffers".
--
data Key c msg v where
  Key :: (ExtKey c,ExtendMessage msg,GPB v) => FieldId -> FieldType -> (Maybe v) -> Key c msg v
  deriving (Typeable)


-- | This allows reflection, in this case it gives the numerical
-- 'FieldId' of the key, from 1 to 2^29-1 (excluding 19,000 through
-- 19,999).
getKeyFieldId :: Key c msg v -> FieldId
getKeyFieldId :: Key c msg v -> FieldId
getKeyFieldId (Key FieldId
fi FieldType
_ Maybe v
_) = FieldId
fi

-- | This allows reflection, in this case it gives the 'FieldType'
-- enumeration value (1 to 18) of the
-- "Text.DescriptorProtos.FieldDescriptorProto.Type" of the field.
getKeyFieldType :: Key c msg v -> FieldType
getKeyFieldType :: Key c msg v -> FieldType
getKeyFieldType (Key FieldId
_ FieldType
ft Maybe v
_) = FieldType
ft

-- | This will return the default value for a given 'Key', which is
-- set in the '.proto' file, or if unset it is the 'defaultValue' of
-- that type.
getKeyDefaultValue :: Key c msg v -> v
getKeyDefaultValue :: Key c msg v -> v
getKeyDefaultValue (Key FieldId
_ FieldType
_ Maybe v
md) = v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
forall a. Default a => a
defaultValue Maybe v
md

instance (Typeable c, ExtendMessage msg, GPB v) => Show (Key c msg v) where
  show :: Key c msg v -> String
show key :: Key c msg v
key@(Key FieldId
fieldId FieldType
fieldType Maybe v
maybeDefaultValue) =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(Key (",FieldId -> String
forall a. Show a => a -> String
show FieldId
fieldId
           ,String
") (",FieldType -> String
forall a. Show a => a -> String
show FieldType
fieldType
           ,String
") (",Maybe v -> String
forall a. Show a => a -> String
show Maybe v
maybeDefaultValue
           ,String
") :: ",TypeRep -> String
forall a. Show a => a -> String
show (Key c msg v -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Key c msg v
key)
           ,String
")"]

-- | The 'GPDyn' is my specialization of 'Dynamic'.  It hides the type
-- with an existential.  This is used in 'ExtOptional' for optional fields.
data GPDyn where
    GPDyn :: (GPB a) => !a -> GPDyn
  deriving (Typeable)

-- | The 'GPDynSeq' is another specialization of 'Dynamic' and is used
-- in 'ExtRepeated' for repeated fields.
data GPDynSeq where
    GPDynSeq :: GPB a => !(Seq a) -> GPDynSeq
  deriving (Typeable)

-- | The 'PackedSeq' is needed to distinguish the packed repeated format from the repeated format.
-- This is only used in the phantom type of Key.
newtype PackedSeq a = PackedSeq { PackedSeq a -> Seq a
unPackedSeq :: Seq a }
  deriving (Typeable)

-- | The WireType is used to ensure the Seq is homogeneous.
-- The ByteString is the unparsed input after the tag.
data ExtFieldValue = ExtFromWire !(Seq EP) -- XXX must store wiretype with ByteString
                   | ExtOptional !FieldType !GPDyn
                   | ExtRepeated !FieldType !GPDynSeq
                   | ExtPacked   !FieldType !GPDynSeq
  deriving (Typeable,Eq ExtFieldValue
Eq ExtFieldValue
-> (ExtFieldValue -> ExtFieldValue -> Ordering)
-> (ExtFieldValue -> ExtFieldValue -> Bool)
-> (ExtFieldValue -> ExtFieldValue -> Bool)
-> (ExtFieldValue -> ExtFieldValue -> Bool)
-> (ExtFieldValue -> ExtFieldValue -> Bool)
-> (ExtFieldValue -> ExtFieldValue -> ExtFieldValue)
-> (ExtFieldValue -> ExtFieldValue -> ExtFieldValue)
-> Ord ExtFieldValue
ExtFieldValue -> ExtFieldValue -> Bool
ExtFieldValue -> ExtFieldValue -> Ordering
ExtFieldValue -> ExtFieldValue -> ExtFieldValue
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
min :: ExtFieldValue -> ExtFieldValue -> ExtFieldValue
$cmin :: ExtFieldValue -> ExtFieldValue -> ExtFieldValue
max :: ExtFieldValue -> ExtFieldValue -> ExtFieldValue
$cmax :: ExtFieldValue -> ExtFieldValue -> ExtFieldValue
>= :: ExtFieldValue -> ExtFieldValue -> Bool
$c>= :: ExtFieldValue -> ExtFieldValue -> Bool
> :: ExtFieldValue -> ExtFieldValue -> Bool
$c> :: ExtFieldValue -> ExtFieldValue -> Bool
<= :: ExtFieldValue -> ExtFieldValue -> Bool
$c<= :: ExtFieldValue -> ExtFieldValue -> Bool
< :: ExtFieldValue -> ExtFieldValue -> Bool
$c< :: ExtFieldValue -> ExtFieldValue -> Bool
compare :: ExtFieldValue -> ExtFieldValue -> Ordering
$ccompare :: ExtFieldValue -> ExtFieldValue -> Ordering
$cp1Ord :: Eq ExtFieldValue
Ord,Int -> ExtFieldValue -> String -> String
[ExtFieldValue] -> String -> String
ExtFieldValue -> String
(Int -> ExtFieldValue -> String -> String)
-> (ExtFieldValue -> String)
-> ([ExtFieldValue] -> String -> String)
-> Show ExtFieldValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ExtFieldValue] -> String -> String
$cshowList :: [ExtFieldValue] -> String -> String
show :: ExtFieldValue -> String
$cshow :: ExtFieldValue -> String
showsPrec :: Int -> ExtFieldValue -> String -> String
$cshowsPrec :: Int -> ExtFieldValue -> String -> String
Show)

-- | For making a Data instance for ExtField
data ExtDataPair = ExtDataPair FieldId (Seq EP)
  deriving (Typeable,Typeable ExtDataPair
DataType
Constr
Typeable ExtDataPair
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ExtDataPair -> c ExtDataPair)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ExtDataPair)
-> (ExtDataPair -> Constr)
-> (ExtDataPair -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ExtDataPair))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ExtDataPair))
-> ((forall b. Data b => b -> b) -> ExtDataPair -> ExtDataPair)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ExtDataPair -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ExtDataPair -> r)
-> (forall u. (forall d. Data d => d -> u) -> ExtDataPair -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ExtDataPair -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair)
-> Data ExtDataPair
ExtDataPair -> DataType
ExtDataPair -> Constr
(forall b. Data b => b -> b) -> ExtDataPair -> ExtDataPair
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtDataPair -> c ExtDataPair
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtDataPair
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ExtDataPair -> u
forall u. (forall d. Data d => d -> u) -> ExtDataPair -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtDataPair -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtDataPair -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtDataPair
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtDataPair -> c ExtDataPair
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExtDataPair)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExtDataPair)
$cExtDataPair :: Constr
$tExtDataPair :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair
gmapMp :: (forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair
gmapM :: (forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExtDataPair -> m ExtDataPair
gmapQi :: Int -> (forall d. Data d => d -> u) -> ExtDataPair -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExtDataPair -> u
gmapQ :: (forall d. Data d => d -> u) -> ExtDataPair -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExtDataPair -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtDataPair -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtDataPair -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtDataPair -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtDataPair -> r
gmapT :: (forall b. Data b => b -> b) -> ExtDataPair -> ExtDataPair
$cgmapT :: (forall b. Data b => b -> b) -> ExtDataPair -> ExtDataPair
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExtDataPair)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExtDataPair)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ExtDataPair)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExtDataPair)
dataTypeOf :: ExtDataPair -> DataType
$cdataTypeOf :: ExtDataPair -> DataType
toConstr :: ExtDataPair -> Constr
$ctoConstr :: ExtDataPair -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtDataPair
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtDataPair
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtDataPair -> c ExtDataPair
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtDataPair -> c ExtDataPair
$cp1Data :: Typeable ExtDataPair
Data,Int -> ExtDataPair -> String -> String
[ExtDataPair] -> String -> String
ExtDataPair -> String
(Int -> ExtDataPair -> String -> String)
-> (ExtDataPair -> String)
-> ([ExtDataPair] -> String -> String)
-> Show ExtDataPair
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ExtDataPair] -> String -> String
$cshowList :: [ExtDataPair] -> String -> String
show :: ExtDataPair -> String
$cshow :: ExtDataPair -> String
showsPrec :: Int -> ExtDataPair -> String -> String
$cshowsPrec :: Int -> ExtDataPair -> String -> String
Show)

data EP = EP {-# UNPACK #-} !WireType !ByteString
  deriving (Typeable,Typeable EP
DataType
Constr
Typeable EP
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> EP -> c EP)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EP)
-> (EP -> Constr)
-> (EP -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EP))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EP))
-> ((forall b. Data b => b -> b) -> EP -> EP)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EP -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EP -> r)
-> (forall u. (forall d. Data d => d -> u) -> EP -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> EP -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EP -> m EP)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EP -> m EP)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EP -> m EP)
-> Data EP
EP -> DataType
EP -> Constr
(forall b. Data b => b -> b) -> EP -> EP
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EP -> c EP
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EP
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EP -> u
forall u. (forall d. Data d => d -> u) -> EP -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EP -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EP -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EP -> m EP
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EP -> m EP
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EP
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EP -> c EP
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EP)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EP)
$cEP :: Constr
$tEP :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> EP -> m EP
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EP -> m EP
gmapMp :: (forall d. Data d => d -> m d) -> EP -> m EP
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EP -> m EP
gmapM :: (forall d. Data d => d -> m d) -> EP -> m EP
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EP -> m EP
gmapQi :: Int -> (forall d. Data d => d -> u) -> EP -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EP -> u
gmapQ :: (forall d. Data d => d -> u) -> EP -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EP -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EP -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EP -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EP -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EP -> r
gmapT :: (forall b. Data b => b -> b) -> EP -> EP
$cgmapT :: (forall b. Data b => b -> b) -> EP -> EP
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EP)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EP)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c EP)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EP)
dataTypeOf :: EP -> DataType
$cdataTypeOf :: EP -> DataType
toConstr :: EP -> Constr
$ctoConstr :: EP -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EP
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EP
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EP -> c EP
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EP -> c EP
$cp1Data :: Typeable EP
Data,EP -> EP -> Bool
(EP -> EP -> Bool) -> (EP -> EP -> Bool) -> Eq EP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EP -> EP -> Bool
$c/= :: EP -> EP -> Bool
== :: EP -> EP -> Bool
$c== :: EP -> EP -> Bool
Eq,Eq EP
Eq EP
-> (EP -> EP -> Ordering)
-> (EP -> EP -> Bool)
-> (EP -> EP -> Bool)
-> (EP -> EP -> Bool)
-> (EP -> EP -> Bool)
-> (EP -> EP -> EP)
-> (EP -> EP -> EP)
-> Ord EP
EP -> EP -> Bool
EP -> EP -> Ordering
EP -> EP -> EP
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
min :: EP -> EP -> EP
$cmin :: EP -> EP -> EP
max :: EP -> EP -> EP
$cmax :: EP -> EP -> EP
>= :: EP -> EP -> Bool
$c>= :: EP -> EP -> Bool
> :: EP -> EP -> Bool
$c> :: EP -> EP -> Bool
<= :: EP -> EP -> Bool
$c<= :: EP -> EP -> Bool
< :: EP -> EP -> Bool
$c< :: EP -> EP -> Bool
compare :: EP -> EP -> Ordering
$ccompare :: EP -> EP -> Ordering
$cp1Ord :: Eq EP
Ord,Int -> EP -> String -> String
[EP] -> String -> String
EP -> String
(Int -> EP -> String -> String)
-> (EP -> String) -> ([EP] -> String -> String) -> Show EP
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EP] -> String -> String
$cshowList :: [EP] -> String -> String
show :: EP -> String
$cshow :: EP -> String
showsPrec :: Int -> EP -> String -> String
$cshowsPrec :: Int -> EP -> String -> String
Show)

data DummyMessageType deriving (Typeable)

-- | ExtField is a newtype'd map from the numeric FieldId key to the
-- ExtFieldValue.  This allows for the needed class instances.
newtype ExtField = ExtField (Map FieldId ExtFieldValue)
  deriving (Typeable,ExtField -> ExtField -> Bool
(ExtField -> ExtField -> Bool)
-> (ExtField -> ExtField -> Bool) -> Eq ExtField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtField -> ExtField -> Bool
$c/= :: ExtField -> ExtField -> Bool
== :: ExtField -> ExtField -> Bool
$c== :: ExtField -> ExtField -> Bool
Eq,Eq ExtField
Eq ExtField
-> (ExtField -> ExtField -> Ordering)
-> (ExtField -> ExtField -> Bool)
-> (ExtField -> ExtField -> Bool)
-> (ExtField -> ExtField -> Bool)
-> (ExtField -> ExtField -> Bool)
-> (ExtField -> ExtField -> ExtField)
-> (ExtField -> ExtField -> ExtField)
-> Ord ExtField
ExtField -> ExtField -> Bool
ExtField -> ExtField -> Ordering
ExtField -> ExtField -> ExtField
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
min :: ExtField -> ExtField -> ExtField
$cmin :: ExtField -> ExtField -> ExtField
max :: ExtField -> ExtField -> ExtField
$cmax :: ExtField -> ExtField -> ExtField
>= :: ExtField -> ExtField -> Bool
$c>= :: ExtField -> ExtField -> Bool
> :: ExtField -> ExtField -> Bool
$c> :: ExtField -> ExtField -> Bool
<= :: ExtField -> ExtField -> Bool
$c<= :: ExtField -> ExtField -> Bool
< :: ExtField -> ExtField -> Bool
$c< :: ExtField -> ExtField -> Bool
compare :: ExtField -> ExtField -> Ordering
$ccompare :: ExtField -> ExtField -> Ordering
$cp1Ord :: Eq ExtField
Ord,Int -> ExtField -> String -> String
[ExtField] -> String -> String
ExtField -> String
(Int -> ExtField -> String -> String)
-> (ExtField -> String)
-> ([ExtField] -> String -> String)
-> Show ExtField
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ExtField] -> String -> String
$cshowList :: [ExtField] -> String -> String
show :: ExtField -> String
$cshow :: ExtField -> String
showsPrec :: Int -> ExtField -> String -> String
$cshowsPrec :: Int -> ExtField -> String -> String
Show)

-- | Used only in gfoldl for Data instance of ExtField
dataToList :: ExtField -> [ExtDataPair]
dataToList :: ExtField -> [ExtDataPair]
dataToList (ExtField Map FieldId ExtFieldValue
ef) = ((FieldId, ExtFieldValue) -> ExtDataPair)
-> [(FieldId, ExtFieldValue)] -> [ExtDataPair]
forall a b. (a -> b) -> [a] -> [b]
map (FieldId, ExtFieldValue) -> ExtDataPair
toEDP ([(FieldId, ExtFieldValue)] -> [ExtDataPair])
-> (Map FieldId ExtFieldValue -> [(FieldId, ExtFieldValue)])
-> Map FieldId ExtFieldValue
-> [ExtDataPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FieldId ExtFieldValue -> [(FieldId, ExtFieldValue)]
forall k a. Map k a -> [(k, a)]
M.toList (Map FieldId ExtFieldValue -> [ExtDataPair])
-> Map FieldId ExtFieldValue -> [ExtDataPair]
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue
ef where
  toEDP :: (FieldId, ExtFieldValue) -> ExtDataPair
toEDP (FieldId
fi,ExtFromWire Seq EP
eps) = FieldId -> Seq EP -> ExtDataPair
ExtDataPair FieldId
fi Seq EP
eps
  toEDP (FieldId
fi,ExtOptional FieldType
ft (GPDyn a
d)) =
    let p :: Put
p = WireTag -> FieldType -> Maybe a -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
wirePutOpt (FieldId -> FieldType -> WireTag
toWireTag FieldId
fi FieldType
ft) FieldType
ft (a -> Maybe a
forall a. a -> Maybe a
Just a
d)
        ep :: EP
ep = WireType -> ByteString -> EP
EP (FieldType -> WireType
toWireType FieldType
ft) (Put -> ByteString
runPut Put
p)
    in FieldId -> Seq EP -> ExtDataPair
ExtDataPair FieldId
fi (EP -> Seq EP
forall a. a -> Seq a
Seq.singleton EP
ep)
  toEDP (FieldId
fi,ExtRepeated FieldType
ft (GPDynSeq Seq a
s)) =
    let f :: forall w. Wire w => w -> EP
        f :: w -> EP
f = WireType -> ByteString -> EP
EP (FieldType -> WireType
toWireType FieldType
ft) (ByteString -> EP) -> (w -> ByteString) -> w -> EP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> (w -> Put) -> w -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> FieldType -> w -> Put
forall v. Wire v => WireTag -> FieldType -> v -> Put
wirePutReq (FieldId -> FieldType -> WireTag
toWireTag FieldId
fi FieldType
ft) FieldType
ft
    in FieldId -> Seq EP -> ExtDataPair
ExtDataPair FieldId
fi ((a -> EP) -> Seq a -> Seq EP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> EP
forall w. Wire w => w -> EP
f Seq a
s)
  toEDP (FieldId
fi,ExtPacked FieldType
ft (GPDynSeq Seq a
s)) =
    let p :: Put
p = WireTag -> FieldType -> Seq a -> Put
forall v. Wire v => WireTag -> FieldType -> Seq v -> Put
wirePutPacked (FieldId -> WireTag
toPackedWireTag FieldId
fi) FieldType
ft Seq a
s
        ep :: EP
ep = WireType -> ByteString -> EP
EP ((FieldId, WireType) -> WireType
forall a b. (a, b) -> b
snd((FieldId, WireType) -> WireType)
-> (WireTag -> (FieldId, WireType)) -> WireTag -> WireType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WireTag -> (FieldId, WireType)
splitWireTag (WireTag -> WireType) -> WireTag -> WireType
forall a b. (a -> b) -> a -> b
$ FieldId -> WireTag
toPackedWireTag FieldId
fi) (Put -> ByteString
runPut Put
p)
    in FieldId -> Seq EP -> ExtDataPair
ExtDataPair FieldId
fi (EP -> Seq EP
forall a. a -> Seq a
Seq.singleton EP
ep)

-- | Used only in gfoldl and gunfold for Data instance of ExtField
dataFromList :: [ExtDataPair] -> ExtField
dataFromList :: [ExtDataPair] -> ExtField
dataFromList = Map FieldId ExtFieldValue -> ExtField
ExtField (Map FieldId ExtFieldValue -> ExtField)
-> ([ExtDataPair] -> Map FieldId ExtFieldValue)
-> [ExtDataPair]
-> ExtField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FieldId, ExtFieldValue)] -> Map FieldId ExtFieldValue
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FieldId, ExtFieldValue)] -> Map FieldId ExtFieldValue)
-> ([ExtDataPair] -> [(FieldId, ExtFieldValue)])
-> [ExtDataPair]
-> Map FieldId ExtFieldValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExtDataPair -> (FieldId, ExtFieldValue))
-> [ExtDataPair] -> [(FieldId, ExtFieldValue)]
forall a b. (a -> b) -> [a] -> [b]
map ExtDataPair -> (FieldId, ExtFieldValue)
fromEDP where
  fromEDP :: ExtDataPair -> (FieldId, ExtFieldValue)
fromEDP (ExtDataPair FieldId
fid Seq EP
eps) = (FieldId
fid,Seq EP -> ExtFieldValue
ExtFromWire Seq EP
eps)

-- | Used only in gfoldl and gunfold for Data instance of ExtField
ty_ExtField :: DataType
ty_ExtField :: DataType
ty_ExtField = String -> [Constr] -> DataType
mkDataType String
"Text.ProtocolBuffers.Extensions.ExtField" [Constr
con_ExtField]

-- | Used only in gfoldl and gunfold for Data instance of ExtField
con_ExtField :: Constr
con_ExtField :: Constr
con_ExtField = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
ty_ExtField String
"ExtField" [] Fixity
Prefix

instance Data ExtField where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtField -> c ExtField
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z ExtField
m = ([ExtDataPair] -> ExtField) -> c ([ExtDataPair] -> ExtField)
forall g. g -> c g
z [ExtDataPair] -> ExtField
dataFromList c ([ExtDataPair] -> ExtField) -> [ExtDataPair] -> c ExtField
forall d b. Data d => c (d -> b) -> d -> c b
`f` ExtField -> [ExtDataPair]
dataToList ExtField
m
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtField
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
_ = c ([ExtDataPair] -> ExtField) -> c ExtField
forall b r. Data b => c (b -> r) -> c r
k (([ExtDataPair] -> ExtField) -> c ([ExtDataPair] -> ExtField)
forall r. r -> c r
z [ExtDataPair] -> ExtField
dataFromList)
  toConstr :: ExtField -> Constr
toConstr (ExtField Map FieldId ExtFieldValue
_) = Constr
con_ExtField
  dataTypeOf :: ExtField -> DataType
dataTypeOf ExtField
_ = DataType
ty_ExtField


instance ExtendMessage DummyMessageType where
  getExtField :: DummyMessageType -> ExtField
getExtField = DummyMessageType -> ExtField
forall a. HasCallStack => a
undefined
  putExtField :: ExtField -> DummyMessageType -> DummyMessageType
putExtField = ExtField -> DummyMessageType -> DummyMessageType
forall a. HasCallStack => a
undefined
  validExtRanges :: DummyMessageType -> [(FieldId, FieldId)]
validExtRanges = DummyMessageType -> [(FieldId, FieldId)]
forall a. HasCallStack => a
undefined

-- I want a complicated comparison here to at least allow testing of
-- setting a field, writing to wire, reading back from wire, and
-- comparing.
--
-- The comparison of ExtFromWire with ExtFromWire is conservative
-- about returning True.  It is entirely possible that if both value
-- were interpreted by the same Key that their resulting values would
-- compare True.
instance Eq ExtFieldValue where
  == :: ExtFieldValue -> ExtFieldValue -> Bool
(==) (ExtFromWire Seq EP
b) (ExtFromWire Seq EP
b') = Seq EP
bSeq EP -> Seq EP -> Bool
forall a. Eq a => a -> a -> Bool
==Seq EP
b'
  (==) (ExtOptional FieldType
a GPDyn
b) (ExtOptional FieldType
a' GPDyn
b') = FieldType
aFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
==FieldType
a' Bool -> Bool -> Bool
&& GPDyn
bGPDyn -> GPDyn -> Bool
forall a. Eq a => a -> a -> Bool
==GPDyn
b'
  (==) (ExtRepeated FieldType
a GPDynSeq
b) (ExtRepeated FieldType
a' GPDynSeq
b') = FieldType
aFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
==FieldType
a' Bool -> Bool -> Bool
&& GPDynSeq
bGPDynSeq -> GPDynSeq -> Bool
forall a. Eq a => a -> a -> Bool
==GPDynSeq
b'
  (==) (ExtPacked FieldType
a GPDynSeq
b)   (ExtPacked FieldType
a' GPDynSeq
b')   = FieldType
aFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
==FieldType
a' Bool -> Bool -> Bool
&& GPDynSeq
bGPDynSeq -> GPDynSeq -> Bool
forall a. Eq a => a -> a -> Bool
==GPDynSeq
b'
  (==) x :: ExtFieldValue
x@(ExtOptional FieldType
ft (GPDyn a
w)) (ExtFromWire Seq EP
s') =
    let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
ft
        makeKeyType :: a -> Key Maybe DummyMessageType a
        makeKeyType :: a -> Key Maybe DummyMessageType a
makeKeyType a
_ = Key Maybe DummyMessageType a
forall a. HasCallStack => a
undefined
        key :: Key Maybe DummyMessageType a
key = FieldId -> FieldType -> Maybe a -> Key Maybe DummyMessageType a
forall (c :: * -> *) msg v.
(ExtKey c, ExtendMessage msg, GPB v) =>
FieldId -> FieldType -> Maybe v -> Key c msg v
Key FieldId
0 FieldType
ft Maybe a
forall a. Maybe a
Nothing Key Maybe DummyMessageType a
-> Key Maybe DummyMessageType a -> Key Maybe DummyMessageType a
forall a. a -> a -> a
`asTypeOf` a -> Key Maybe DummyMessageType a
forall a. a -> Key Maybe DummyMessageType a
makeKeyType a
w
    in case Key Maybe DummyMessageType a
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key Maybe msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtMaybe Key Maybe DummyMessageType a
key WireType
wt Seq EP
s' of
         Right (FieldId
_,ExtFieldValue
y) -> ExtFieldValue
xExtFieldValue -> ExtFieldValue -> Bool
forall a. Eq a => a -> a -> Bool
==ExtFieldValue
y
         Either String (FieldId, ExtFieldValue)
_ -> Bool
False
  (==) y :: ExtFieldValue
y@ExtFromWire {} x :: ExtFieldValue
x@ExtOptional {}  = ExtFieldValue
x ExtFieldValue -> ExtFieldValue -> Bool
forall a. Eq a => a -> a -> Bool
== ExtFieldValue
y
  (==) x :: ExtFieldValue
x@(ExtRepeated FieldType
ft (GPDynSeq Seq a
w)) (ExtFromWire Seq EP
s') =
    let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
ft
        makeKeyType :: Seq a -> Key Seq DummyMessageType a
        makeKeyType :: Seq a -> Key Seq DummyMessageType a
makeKeyType Seq a
_ = Key Seq DummyMessageType a
forall a. HasCallStack => a
undefined
        key :: Key Seq DummyMessageType a
key = FieldId -> FieldType -> Maybe a -> Key Seq DummyMessageType a
forall (c :: * -> *) msg v.
(ExtKey c, ExtendMessage msg, GPB v) =>
FieldId -> FieldType -> Maybe v -> Key c msg v
Key FieldId
0 FieldType
ft Maybe a
forall a. Maybe a
Nothing Key Seq DummyMessageType a
-> Key Seq DummyMessageType a -> Key Seq DummyMessageType a
forall a. a -> a -> a
`asTypeOf` Seq a -> Key Seq DummyMessageType a
forall a. Seq a -> Key Seq DummyMessageType a
makeKeyType Seq a
w
    in case Key Seq DummyMessageType a
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key Seq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtSeq Key Seq DummyMessageType a
key WireType
wt Seq EP
s' of
         Right (FieldId
_,ExtFieldValue
y) -> ExtFieldValue
xExtFieldValue -> ExtFieldValue -> Bool
forall a. Eq a => a -> a -> Bool
==ExtFieldValue
y
         Either String (FieldId, ExtFieldValue)
_ -> Bool
False
  (==) y :: ExtFieldValue
y@ExtFromWire {} x :: ExtFieldValue
x@ExtRepeated {}  = ExtFieldValue
x ExtFieldValue -> ExtFieldValue -> Bool
forall a. Eq a => a -> a -> Bool
== ExtFieldValue
y
  (==) x :: ExtFieldValue
x@(ExtPacked FieldType
ft (GPDynSeq Seq a
w)) (ExtFromWire Seq EP
s') =
    let wt :: WireType
wt = WireType
2 -- all packed types have wire type 2, length delimited
        makeKeyType :: Seq a -> Key PackedSeq DummyMessageType a
        makeKeyType :: Seq a -> Key PackedSeq DummyMessageType a
makeKeyType Seq a
_ = Key PackedSeq DummyMessageType a
forall a. HasCallStack => a
undefined
        key :: Key PackedSeq DummyMessageType a
key = FieldId -> FieldType -> Maybe a -> Key PackedSeq DummyMessageType a
forall (c :: * -> *) msg v.
(ExtKey c, ExtendMessage msg, GPB v) =>
FieldId -> FieldType -> Maybe v -> Key c msg v
Key FieldId
0 FieldType
ft Maybe a
forall a. Maybe a
Nothing Key PackedSeq DummyMessageType a
-> Key PackedSeq DummyMessageType a
-> Key PackedSeq DummyMessageType a
forall a. a -> a -> a
`asTypeOf` Seq a -> Key PackedSeq DummyMessageType a
forall a. Seq a -> Key PackedSeq DummyMessageType a
makeKeyType Seq a
w
    in case Key PackedSeq DummyMessageType a
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key PackedSeq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtPackedSeq Key PackedSeq DummyMessageType a
key WireType
wt Seq EP
s' of
         Right (FieldId
_,ExtFieldValue
y) -> ExtFieldValue
xExtFieldValue -> ExtFieldValue -> Bool
forall a. Eq a => a -> a -> Bool
==ExtFieldValue
y
         Either String (FieldId, ExtFieldValue)
_ -> Bool
False
  (==) y :: ExtFieldValue
y@ExtFromWire {} x :: ExtFieldValue
x@ExtPacked {}  = ExtFieldValue
x ExtFieldValue -> ExtFieldValue -> Bool
forall a. Eq a => a -> a -> Bool
== ExtFieldValue
y
  (==) ExtFieldValue
_ ExtFieldValue
_ = Bool
False

-- | 'ExtendMessage' abstracts the operations of storing and
-- retrieving the 'ExtField' from the message, and provides the
-- reflection needed to know the valid field numbers.
--
-- This only used internally.
class Typeable msg => ExtendMessage msg where
  getExtField :: msg -> ExtField
  putExtField :: ExtField -> msg -> msg
  validExtRanges :: msg -> [(FieldId,FieldId)]

-- | wireKeyToUnPacked is used to load a repeated packed format into a repeated non-packed extension key
wireGetKeyToUnPacked :: (ExtendMessage msg,GPB v) => Key Seq msg v -> msg -> Get msg
wireGetKeyToUnPacked :: Key Seq msg v -> msg -> Get msg
wireGetKeyToUnPacked k :: Key Seq msg v
k@(Key FieldId
i FieldType
t Maybe v
mv) msg
msg = do
  let myCast :: Maybe a -> Get (Seq a)
      myCast :: Maybe a -> Get (Seq a)
myCast = Maybe a -> Get (Seq a)
forall a. HasCallStack => a
undefined
  Seq v
vv <- FieldType -> Get (Seq v)
forall b. Wire b => FieldType -> Get (Seq b)
wireGetPacked FieldType
t Get (Seq v) -> Get (Seq v) -> Get (Seq v)
forall a. a -> a -> a
`asTypeOf` Maybe v -> Get (Seq v)
forall a. Maybe a -> Get (Seq a)
myCast Maybe v
mv
  let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
  ExtFieldValue
v' <- case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
i Map FieldId ExtFieldValue
ef of
          Maybe ExtFieldValue
Nothing -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq Seq v
vv)
          Just (ExtRepeated FieldType
t' (GPDynSeq Seq a
s)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
            String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToUnPacked: Key mismatch! found wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,FieldType
t,FieldType
t')
                                                       | Bool
otherwise ->
            case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
              Maybe (Seq v)
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToUnPacked: previous Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
              Just Seq v
s' -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq v
s' Seq v -> Seq v -> Seq v
forall a. Seq a -> Seq a -> Seq a
>< Seq v
vv))
          Just (ExtFromWire Seq EP
raw) ->
            case Key Seq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key Seq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtSeq Key Seq msg v
k (FieldType -> WireType
toWireType FieldType
t) Seq EP
raw of -- was wt from ExtFromWire
              Left String
errMsg -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToUnPacked: Could not parseWireExtSeq: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Key Seq msg v -> String
forall a. Show a => a -> String
show Key Seq msg v
kString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
errMsg
              Right (FieldId
_,ExtRepeated FieldType
t' (GPDynSeq Seq a
s)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
                String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToUnPacked:: Key mismatch! parseWireExtSeq returned wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,FieldType
t,FieldType
t')
                                                              | Bool
otherwise ->
                case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
                  Maybe (Seq v)
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: previous Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
                  Just Seq v
s' -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq v
s' Seq v -> Seq v -> Seq v
forall a. Seq a -> Seq a -> Seq a
>< Seq v
vv))
              Either String (FieldId, ExtFieldValue)
wtf -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToUnPacked: Weird parseWireExtSeq return value: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, Either String (FieldId, ExtFieldValue)) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,Either String (FieldId, ExtFieldValue)
wtf)
          Just wtf :: ExtFieldValue
wtf@(ExtOptional {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToUnPacked: ExtOptional found when ExtRepeated expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,ExtFieldValue
wtf)
          Just wtf :: ExtFieldValue
wtf@(ExtPacked {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToUnPacked: ExtPacked found when ExtRepeated expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,ExtFieldValue
wtf)
  let ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
i ExtFieldValue
v' Map FieldId ExtFieldValue
ef
  ExtFieldValue -> Get msg -> Get msg
seq ExtFieldValue
v' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get msg -> Get msg
seq Map FieldId ExtFieldValue
ef' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ msg -> Get msg
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

-- | wireKeyToPacked is used to load a repeated unpacked format into a repeated packed extension key
wireGetKeyToPacked :: (ExtendMessage msg,GPB v) => Key PackedSeq msg v -> msg -> Get msg
wireGetKeyToPacked :: Key PackedSeq msg v -> msg -> Get msg
wireGetKeyToPacked k :: Key PackedSeq msg v
k@(Key FieldId
i FieldType
t Maybe v
mv) msg
msg = do
  let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
t
      myCast :: Maybe a -> Get a
      myCast :: Maybe a -> Get a
myCast = Maybe a -> Get a
forall a. HasCallStack => a
undefined
  v
v <- FieldType -> Get v
forall b. Wire b => FieldType -> Get b
wireGet FieldType
t Get v -> Get v -> Get v
forall a. a -> a -> a
`asTypeOf` Maybe v -> Get v
forall a. Maybe a -> Get a
myCast Maybe v
mv
  let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
  ExtFieldValue
v' <- case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
i Map FieldId ExtFieldValue
ef of
          Maybe ExtFieldValue
Nothing -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtPacked FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (v -> Seq v
forall a. a -> Seq a
Seq.singleton v
v))
          Just (ExtPacked FieldType
t' (GPDynSeq Seq a
s)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
            String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToPacked: Key mismatch! found wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,FieldType
t,FieldType
t')
                                                     | Bool
otherwise ->
            case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
              Maybe (Seq v)
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToPacked: previous Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
              Just Seq v
s' -> v -> Get ExtFieldValue -> Get ExtFieldValue
seq v
v (Get ExtFieldValue -> Get ExtFieldValue)
-> Get ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq v
s' Seq v -> v -> Seq v
forall a. Seq a -> a -> Seq a
|> v
v))
          Just (ExtFromWire Seq EP
raw) ->
            case Key PackedSeq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key PackedSeq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtPackedSeq Key PackedSeq msg v
k WireType
wt Seq EP
raw of
              Left String
errMsg -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToPacked: Could not parseWireExtPackedSeq: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Key PackedSeq msg v -> String
forall a. Show a => a -> String
show Key PackedSeq msg v
kString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
errMsg
              Right (FieldId
_,ExtPacked FieldType
t' (GPDynSeq Seq a
s)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
                String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToPacked: Key mismatch! parseWireExtPackedSeq returned wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,FieldType
t,FieldType
t')
                                                              | Bool
otherwise ->
                case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
                  Maybe (Seq v)
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToPacked: previous Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
                  Just Seq v
s' -> v -> Get ExtFieldValue -> Get ExtFieldValue
seq v
v (Get ExtFieldValue -> Get ExtFieldValue)
-> Get ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq v
s' Seq v -> v -> Seq v
forall a. Seq a -> a -> Seq a
|> v
v))
              Either String (FieldId, ExtFieldValue)
wtf -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToPacked: Weird parseWireExtPackedSeq return value: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, Either String (FieldId, ExtFieldValue))
-> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,Either String (FieldId, ExtFieldValue)
wtf)
          Just wtf :: ExtFieldValue
wtf@(ExtOptional {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToPacked: ExtOptional found when ExtPacked expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,ExtFieldValue
wtf)
          Just wtf :: ExtFieldValue
wtf@(ExtRepeated {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKeyToPacked: ExtRepeated found when ExtPacked expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,ExtFieldValue
wtf)
  let ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
i ExtFieldValue
v' Map FieldId ExtFieldValue
ef
  ExtFieldValue -> Get msg -> Get msg
seq ExtFieldValue
v' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get msg -> Get msg
seq Map FieldId ExtFieldValue
ef' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ msg -> Get msg
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

-- | The 'ExtKey' class has three functions for user of the API:
-- 'putExt', 'getExt', and 'clearExt'.  The 'wireGetKey' is used in
-- generated code.
--
-- There are two instances of this class, 'Maybe' for optional message
-- fields and 'Seq' for repeated message fields.  This class allows
-- for uniform treatment of these two kinds of extension fields.
class ExtKey c where
  -- | Change or clear the value of a key in a message. Passing
  -- 'Nothing' with an optional key or an empty 'Seq' with a repeated
  -- key clears the value.  This function thus maintains the invariant
  -- that having a field number in the 'ExtField' map means that the
  -- field is set and not empty.
  --
  -- This should be only way to set the contents of a extension field.
  putExt :: Key c msg v -> c v -> msg -> msg
  -- | Access the key in the message.  Optional have type @(Key Maybe
  -- msg v)@ and return type @(Maybe v)@ while repeated fields have
  -- type @(Key Seq msg v)@ and return type @(Seq v)@.
  --
  -- There are a few sources of errors with the lookup of the key:
  --
  --  * It may find unparsed bytes from loading the message. 'getExt'
  --  will attempt to parse the bytes as the key\'s value type, and
  --  may fail.  The parsing is done with the 'parseWireExt' method
  --  (which is not exported to user API).
  --
  --  * The wrong optional-key versus repeated-key type is a failure
  --
  --  * The wrong type of the value might be found in the map and
  --  * cause a failure
  --
  -- The failures above should only happen if two different keys are
  -- used with the same field number.
  getExt :: Key c msg v -> msg -> Either String (c v)
  -- 'clearExt' unsets the field of the 'Key' if it is present.
  clearExt :: Key c msg v -> msg -> msg
  -- 'wireGetKey' is used in generated code to load extension fields
  -- which are defined in the same '.proto' file as the message.  This
  -- results in the storing the parsed type instead of the raw bytes
  -- inside the message.
  wireGetKey :: Key c msg v -> msg -> Get msg

-- | The 'Key' and 'GPWitness' GADTs use 'GPB' as a shorthand for many
-- classes.
class (Mergeable a,Default a,Wire a,Show a,Typeable a,Eq a,Ord a) => GPB a

instance GPB Bool
instance GPB ByteString
instance GPB Utf8
instance GPB Double
instance GPB Float
instance GPB Int32
instance GPB Int64
instance GPB Word32
instance GPB Word64

instance Mergeable ExtField where
--  mergeEmpty = ExtField M.empty
  mergeAppend :: ExtField -> ExtField -> ExtField
mergeAppend (ExtField Map FieldId ExtFieldValue
m1) (ExtField Map FieldId ExtFieldValue
m2) = Map FieldId ExtFieldValue -> ExtField
ExtField ((ExtFieldValue -> ExtFieldValue -> ExtFieldValue)
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith ExtFieldValue -> ExtFieldValue -> ExtFieldValue
mergeExtFieldValue Map FieldId ExtFieldValue
m1 Map FieldId ExtFieldValue
m2)

mergeExtFieldValue :: ExtFieldValue -> ExtFieldValue -> ExtFieldValue
mergeExtFieldValue :: ExtFieldValue -> ExtFieldValue -> ExtFieldValue
mergeExtFieldValue (ExtFromWire Seq EP
s1) (ExtFromWire Seq EP
s2) = Seq EP -> ExtFieldValue
ExtFromWire (Seq EP -> Seq EP -> Seq EP
forall a. Monoid a => a -> a -> a
mappend Seq EP
s1 Seq EP
s2)

mergeExtFieldValue (ExtOptional FieldType
ft1 (GPDyn a
d1))
                   (ExtOptional FieldType
ft2 (GPDyn a
d2)) =
  if FieldType
ft1 FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldType
ft2 then String -> ExtFieldValue
forall b. String -> b
err (String -> ExtFieldValue) -> String -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"mergeExtFieldValue : ExtOptional FieldType mismatch "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldType, FieldType) -> String
forall a. Show a => a -> String
show (FieldType
ft1,FieldType
ft2)
    else case a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
d2 of
           Maybe a
Nothing -> String -> ExtFieldValue
forall b. String -> b
err (String -> ExtFieldValue) -> String -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"mergeExtFieldValue : ExtOptional cast failed, FieldType "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldType, TypeRep, TypeRep) -> String
forall a. Show a => a -> String
show (FieldType
ft2,a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
d1,a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
d2)
           Just a
d2' -> FieldType -> GPDyn -> ExtFieldValue
ExtOptional FieldType
ft2 (a -> GPDyn
forall a. GPB a => a -> GPDyn
GPDyn (a -> a -> a
forall a. Mergeable a => a -> a -> a
mergeAppend a
d1 a
d2'))

mergeExtFieldValue (ExtRepeated FieldType
ft1 (GPDynSeq Seq a
s1))
                   (ExtRepeated FieldType
ft2 (GPDynSeq Seq a
s2)) =
  if FieldType
ft1 FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldType
ft2 then String -> ExtFieldValue
forall b. String -> b
err (String -> ExtFieldValue) -> String -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"mergeExtFieldValue : ExtRepeated FieldType mismatch "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldType, FieldType) -> String
forall a. Show a => a -> String
show (FieldType
ft1,FieldType
ft2)
    else case Seq a -> Maybe (Seq a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s2 of
           Maybe (Seq a)
Nothing -> String -> ExtFieldValue
forall b. String -> b
err (String -> ExtFieldValue) -> String -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"mergeExtFieldValue : ExtRepeated cast failed, FieldType "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldType, TypeRep, TypeRep) -> String
forall a. Show a => a -> String
show (FieldType
ft2,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s1,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s2)
           Just Seq a
s2' -> FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
ft2 (Seq a -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq a -> Seq a -> Seq a
forall a. Monoid a => a -> a -> a
mappend Seq a
s1 Seq a
s2'))

mergeExtFieldValue (ExtPacked FieldType
ft1 (GPDynSeq Seq a
s1))
                   (ExtPacked FieldType
ft2 (GPDynSeq Seq a
s2)) =
  if FieldType
ft1 FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldType
ft2 then String -> ExtFieldValue
forall b. String -> b
err (String -> ExtFieldValue) -> String -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"mergeExtFieldValue : ExtPacked FieldType mismatch "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldType, FieldType) -> String
forall a. Show a => a -> String
show (FieldType
ft1,FieldType
ft2)
    else case Seq a -> Maybe (Seq a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s2 of
           Maybe (Seq a)
Nothing -> String -> ExtFieldValue
forall b. String -> b
err (String -> ExtFieldValue) -> String -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"mergeExtFieldValue : ExtPacked cast failed, FieldType "String -> String -> String
forall a. [a] -> [a] -> [a]
++(FieldType, TypeRep, TypeRep) -> String
forall a. Show a => a -> String
show (FieldType
ft2,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s1,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s2)
           Just Seq a
s2' -> FieldType -> GPDynSeq -> ExtFieldValue
ExtPacked FieldType
ft2 (Seq a -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq a -> Seq a -> Seq a
forall a. Monoid a => a -> a -> a
mappend Seq a
s1 Seq a
s2'))

mergeExtFieldValue ExtFieldValue
a ExtFieldValue
b = String -> ExtFieldValue
forall b. String -> b
err (String -> ExtFieldValue) -> String -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"mergeExtFieldValue : mismatch of constructors "String -> String -> String
forall a. [a] -> [a] -> [a]
++(ExtFieldValue, ExtFieldValue) -> String
forall a. Show a => a -> String
show (ExtFieldValue
a,ExtFieldValue
b)

instance Default ExtField where
  defaultValue :: ExtField
defaultValue = Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
forall k a. Map k a
M.empty

instance Eq GPDyn where
  == :: GPDyn -> GPDyn -> Bool
(==) GPDyn
a GPDyn
b = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (GPDyn -> GPDyn -> Maybe Bool
eqGPDyn GPDyn
a GPDyn
b)

instance Ord GPDyn where
  compare :: GPDyn -> GPDyn -> Ordering
compare GPDyn
a GPDyn
b = Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (GPDyn -> String
forall a. Show a => a -> String
show GPDyn
a) (GPDyn -> String
forall a. Show a => a -> String
show GPDyn
b)) (GPDyn -> GPDyn -> Maybe Ordering
ordGPDyn GPDyn
a GPDyn
b)

instance Show GPDyn where
  showsPrec :: Int -> GPDyn -> String -> String
showsPrec Int
_n (GPDyn a
a) = (String
"(GPDyn "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" ("String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String -> String
forall a. Show a => a -> String -> String
shows a
a (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"))"String -> String -> String
forall a. [a] -> [a] -> [a]
++)

instance Eq GPDynSeq where
  == :: GPDynSeq -> GPDynSeq -> Bool
(==) GPDynSeq
a GPDynSeq
b = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (GPDynSeq -> GPDynSeq -> Maybe Bool
eqGPDynSeq GPDynSeq
a GPDynSeq
b)

instance Ord GPDynSeq where
  compare :: GPDynSeq -> GPDynSeq -> Ordering
compare GPDynSeq
a GPDynSeq
b = Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (GPDynSeq -> String
forall a. Show a => a -> String
show GPDynSeq
a) (GPDynSeq -> String
forall a. Show a => a -> String
show GPDynSeq
b)) (GPDynSeq -> GPDynSeq -> Maybe Ordering
ordGPDynSeq GPDynSeq
a GPDynSeq
b)

instance Show GPDynSeq where
  showsPrec :: Int -> GPDynSeq -> String -> String
showsPrec Int
_n (GPDynSeq Seq a
s) = (String
"(GPDynSeq "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" ("String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> String -> String
forall a. Show a => a -> String -> String
shows Seq a
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"))"String -> String -> String
forall a. [a] -> [a] -> [a]
++)

ordGPDyn :: GPDyn -> GPDyn -> Maybe Ordering
ordGPDyn :: GPDyn -> GPDyn -> Maybe Ordering
ordGPDyn (GPDyn a
a1) (GPDyn a
a2) = (a -> Ordering) -> Maybe a -> Maybe Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a1) (a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a2)

eqGPDyn :: GPDyn -> GPDyn -> Maybe Bool
eqGPDyn :: GPDyn -> GPDyn -> Maybe Bool
eqGPDyn (GPDyn a
a1) (GPDyn a
a2) = (a -> Bool) -> Maybe a -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
a1a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
a2)

ordGPDynSeq :: GPDynSeq -> GPDynSeq -> Maybe Ordering
ordGPDynSeq :: GPDynSeq -> GPDynSeq -> Maybe Ordering
ordGPDynSeq (GPDynSeq Seq a
a1) (GPDynSeq  Seq a
a2) = (Seq a -> Ordering) -> Maybe (Seq a) -> Maybe Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq a -> Seq a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Seq a
a1) (Seq a -> Maybe (Seq a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
a2)

eqGPDynSeq :: GPDynSeq -> GPDynSeq -> Maybe Bool
eqGPDynSeq :: GPDynSeq -> GPDynSeq -> Maybe Bool
eqGPDynSeq (GPDynSeq Seq a
a1) (GPDynSeq Seq a
a2) = (Seq a -> Bool) -> Maybe (Seq a) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq a
a1Seq a -> Seq a -> Bool
forall a. Eq a => a -> a -> Bool
==) (Seq a -> Maybe (Seq a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
a2)

instance ExtKey Maybe where
  putExt :: Key Maybe msg v -> Maybe v -> msg -> msg
putExt Key Maybe msg v
key Maybe v
Nothing msg
msg = Key Maybe msg v -> msg -> msg
forall (c :: * -> *) msg v. ExtKey c => Key c msg v -> msg -> msg
clearExt Key Maybe msg v
key msg
msg
  putExt (Key FieldId
i FieldType
t Maybe v
_) (Just v
v) msg
msg =
    let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
        v' :: ExtFieldValue
v' = FieldType -> GPDyn -> ExtFieldValue
ExtOptional FieldType
t (v -> GPDyn
forall a. GPB a => a -> GPDyn
GPDyn v
v)
        ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
i ExtFieldValue
v' Map FieldId ExtFieldValue
ef
    in ExtFieldValue -> msg -> msg
seq ExtFieldValue
v' (msg -> msg) -> msg -> msg
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> msg -> msg
seq Map FieldId ExtFieldValue
ef' (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

  clearExt :: Key Maybe msg v -> msg -> msg
clearExt (Key FieldId
i FieldType
_ Maybe v
_ ) msg
msg =
    let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
        ef' :: Map FieldId ExtFieldValue
ef' = FieldId -> Map FieldId ExtFieldValue -> Map FieldId ExtFieldValue
forall k a. Ord k => k -> Map k a -> Map k a
M.delete FieldId
i Map FieldId ExtFieldValue
ef
    in Map FieldId ExtFieldValue -> msg -> msg
seq Map FieldId ExtFieldValue
ef' (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

  getExt :: Key Maybe msg v -> msg -> Either String (Maybe v)
getExt k :: Key Maybe msg v
k@(Key FieldId
i FieldType
t Maybe v
_) msg
msg =
    let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
t
        (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
    in case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
i Map FieldId ExtFieldValue
ef of
         Maybe ExtFieldValue
Nothing -> Maybe v -> Either String (Maybe v)
forall a b. b -> Either a b
Right Maybe v
forall a. Maybe a
Nothing
         Just (ExtFromWire Seq EP
raw) -> (String -> Either String (Maybe v))
-> ((FieldId, ExtFieldValue) -> Either String (Maybe v))
-> Either String (FieldId, ExtFieldValue)
-> Either String (Maybe v)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (Maybe v)
forall a b. a -> Either a b
Left (ExtFieldValue -> Either String (Maybe v)
getExt' (ExtFieldValue -> Either String (Maybe v))
-> ((FieldId, ExtFieldValue) -> ExtFieldValue)
-> (FieldId, ExtFieldValue)
-> Either String (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldId, ExtFieldValue) -> ExtFieldValue
forall a b. (a, b) -> b
snd) (Key Maybe msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key Maybe msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtMaybe Key Maybe msg v
k WireType
wt Seq EP
raw)
         Just ExtFieldValue
x -> ExtFieldValue -> Either String (Maybe v)
getExt' ExtFieldValue
x
   where getExt' :: ExtFieldValue -> Either String (Maybe v)
getExt' (ExtRepeated FieldType
t' GPDynSeq
_) = String -> Either String (Maybe v)
forall a b. a -> Either a b
Left (String -> Either String (Maybe v))
-> String -> Either String (Maybe v)
forall a b. (a -> b) -> a -> b
$ String
"getExt Maybe: ExtField has repeated type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,FieldType
t')
         getExt' (ExtPacked FieldType
t' GPDynSeq
_) = String -> Either String (Maybe v)
forall a b. a -> Either a b
Left (String -> Either String (Maybe v))
-> String -> Either String (Maybe v)
forall a b. (a -> b) -> a -> b
$ String
"getExt Maybe: ExtField has packed type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,FieldType
t')
         getExt' (ExtOptional FieldType
t' (GPDyn a
d)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' =
           String -> Either String (Maybe v)
forall a b. a -> Either a b
Left (String -> Either String (Maybe v))
-> String -> Either String (Maybe v)
forall a b. (a -> b) -> a -> b
$ String
"getExt Maybe: Key's FieldType does not match ExtField's: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,FieldType
t')
                                                      | Bool
otherwise =
           case a -> Maybe v
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
d of
             Maybe v
Nothing -> String -> Either String (Maybe v)
forall a b. a -> Either a b
Left (String -> Either String (Maybe v))
-> String -> Either String (Maybe v)
forall a b. (a -> b) -> a -> b
$ String
"getExt Maybe: Key's value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
d)
             Just v
d' -> Maybe v -> Either String (Maybe v)
forall a b. b -> Either a b
Right (v -> Maybe v
forall a. a -> Maybe a
Just v
d')
         getExt' ExtFromWire {} = String -> Either String (Maybe v)
forall b. String -> b
err String
"Impossible? getExt.getExt' Maybe should not have ExtFromWire case (after parseWireExt)!"

  wireGetKey :: Key Maybe msg v -> msg -> Get msg
wireGetKey k :: Key Maybe msg v
k@(Key FieldId
i FieldType
t Maybe v
mv) msg
msg = do
    let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
t
        myCast :: Maybe a -> Get a
        myCast :: Maybe a -> Get a
myCast = Maybe a -> Get a
forall a. HasCallStack => a
undefined
    v
v <- FieldType -> Get v
forall b. Wire b => FieldType -> Get b
wireGet FieldType
t Get v -> Get v -> Get v
forall a. a -> a -> a
`asTypeOf` Maybe v -> Get v
forall a. Maybe a -> Get a
myCast Maybe v
mv
    let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
    ExtFieldValue
v' <- case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
i Map FieldId ExtFieldValue
ef of
            Maybe ExtFieldValue
Nothing -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDyn -> ExtFieldValue
ExtOptional FieldType
t (v -> GPDyn
forall a. GPB a => a -> GPDyn
GPDyn v
v)
            Just (ExtOptional FieldType
t' (GPDyn a
vOld)) | FieldType
t FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldType
t' ->
              String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Maybe: Key mismatch! found wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,FieldType
t,FieldType
t')
                                                         | Bool
otherwise ->
              case a -> Maybe v
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
vOld of
                Maybe v
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Maybe: previous Maybe value case failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
vOld)
                Just v
vOld' -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDyn -> ExtFieldValue
ExtOptional FieldType
t (v -> GPDyn
forall a. GPB a => a -> GPDyn
GPDyn (v -> v -> v
forall a. Mergeable a => a -> a -> a
mergeAppend v
vOld' v
v))
            Just (ExtFromWire Seq EP
raw) ->
              case Key Maybe msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key Maybe msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtMaybe Key Maybe msg v
k WireType
wt Seq EP
raw of
                Left String
errMsg -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Maybe: Could not parseWireExtMaybe: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Key Maybe msg v -> String
forall a. Show a => a -> String
show Key Maybe msg v
kString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
errMsg
                Right (FieldId
_,ExtOptional FieldType
t' (GPDyn a
vOld)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
                  String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Maybe: Key mismatch! found wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,FieldType
t,FieldType
t')
                                                                | Bool
otherwise ->
                  case a -> Maybe v
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
vOld of
                    Maybe v
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Maybe: previous Maybe value case failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
vOld)
                    Just v
vOld' -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDyn -> ExtFieldValue
ExtOptional FieldType
t (v -> GPDyn
forall a. GPB a => a -> GPDyn
GPDyn (v -> v -> v
forall a. Mergeable a => a -> a -> a
mergeAppend v
vOld' v
v))
                Either String (FieldId, ExtFieldValue)
wtf -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Maybe: Weird parseGetWireMaybe return value: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, Either String (FieldId, ExtFieldValue)) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,Either String (FieldId, ExtFieldValue)
wtf)
            Just wtf :: ExtFieldValue
wtf@(ExtRepeated {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Maybe: ExtRepeated found with ExtOptional expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,ExtFieldValue
wtf)
            Just wtf :: ExtFieldValue
wtf@(ExtPacked {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Maybe: ExtPacked found with ExtOptional expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,ExtFieldValue
wtf)
    let ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
i ExtFieldValue
v' Map FieldId ExtFieldValue
ef
    ExtFieldValue -> Get msg -> Get msg
seq ExtFieldValue
v' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get msg -> Get msg
seq Map FieldId ExtFieldValue
ef' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ msg -> Get msg
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

-- | used by 'getVal' and 'wireGetKey' for the 'Maybe' instance
parseWireExtMaybe :: Key Maybe msg v -> WireType -> Seq EP -> Either String (FieldId,ExtFieldValue)
parseWireExtMaybe :: Key Maybe msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtMaybe k :: Key Maybe msg v
k@(Key FieldId
fi FieldType
ft Maybe v
mv)  WireType
wt Seq EP
raw | WireType
wt WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldType -> WireType
toWireType FieldType
ft =
  String -> Either String (FieldId, ExtFieldValue)
forall a b. a -> Either a b
Left (String -> Either String (FieldId, ExtFieldValue))
-> String -> Either String (FieldId, ExtFieldValue)
forall a b. (a -> b) -> a -> b
$ String
"parseWireExt Maybe: Key's FieldType does not match ExtField's wire type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Maybe msg v, WireType, WireType) -> String
forall a. Show a => a -> String
show (Key Maybe msg v
k,FieldType -> WireType
toWireType FieldType
ft,WireType
wt)
                                           | Bool
otherwise = do
  let mkWitType :: Maybe a -> FieldType -> EP -> Either String (Seq a)
      mkWitType :: Maybe a -> FieldType -> EP -> Either String (Seq a)
mkWitType = Maybe a -> FieldType -> EP -> Either String (Seq a)
forall a. HasCallStack => a
undefined
      chooseGet' :: FieldType -> EP -> Either String (Seq v)
chooseGet' = FieldType -> EP -> Either String (Seq v)
forall r. Wire r => FieldType -> EP -> Either String (Seq r)
chooseGet (FieldType -> EP -> Either String (Seq v))
-> (FieldType -> EP -> Either String (Seq v))
-> FieldType
-> EP
-> Either String (Seq v)
forall a. a -> a -> a
`asTypeOf` (Maybe v -> FieldType -> EP -> Either String (Seq v)
forall a. Maybe a -> FieldType -> EP -> Either String (Seq a)
mkWitType Maybe v
mv)
  let parsed :: [Either String (Seq v)]
parsed = (EP -> Either String (Seq v)) -> [EP] -> [Either String (Seq v)]
forall a b. (a -> b) -> [a] -> [b]
map (FieldType -> EP -> Either String (Seq v)
chooseGet' FieldType
ft) ([EP] -> [Either String (Seq v)])
-> (Seq EP -> [EP]) -> Seq EP -> [Either String (Seq v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EP -> [EP]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq EP -> [Either String (Seq v)])
-> Seq EP -> [Either String (Seq v)]
forall a b. (a -> b) -> a -> b
$ Seq EP
raw
      errs :: [String]
errs = [ String
m | Left String
m <- [Either String (Seq v)]
parsed ]
  if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs
    then case Seq v -> ViewL v
forall a. Seq a -> ViewL a
viewl ([Seq v] -> Seq v
forall a. Monoid a => [a] -> a
mconcat [ Seq v
a | Right Seq v
a <- [Either String (Seq v)]
parsed ]) of
           ViewL v
EmptyL -> String -> Either String (FieldId, ExtFieldValue)
forall a b. a -> Either a b
Left String
"Text.ProtocolBuffers.Extensions.parseWireExtMaybe: impossible empty parsed list"
           v
x :< Seq v
xs -> (FieldId, ExtFieldValue) -> Either String (FieldId, ExtFieldValue)
forall a b. b -> Either a b
Right (FieldId
fi,(FieldType -> GPDyn -> ExtFieldValue
ExtOptional FieldType
ft (v -> GPDyn
forall a. GPB a => a -> GPDyn
GPDyn ((v -> v -> v) -> v -> Seq v -> v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' v -> v -> v
forall a. Mergeable a => a -> a -> a
mergeAppend v
x Seq v
xs))))
    else String -> Either String (FieldId, ExtFieldValue)
forall a b. a -> Either a b
Left ([String] -> String
unlines [String]
errs)

-- | 'chooseGet' is an intermediate handler between parseWireExt* and applyGet.  This does not know
-- whether the EP will result in a single r or repeat r, so it always returns a Seq.  It may also
-- realize that there is a mismatch between the desired FieldType and the WireType
chooseGet :: (Wire r) => FieldType -> EP -> Either String (Seq r)
chooseGet :: FieldType -> EP -> Either String (Seq r)
chooseGet FieldType
ft (EP WireType
wt ByteString
bsIn) =
  if (WireType
2WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
==WireType
wt) Bool -> Bool -> Bool
&& (FieldType -> Bool
isValidPacked FieldType
ft)
    then Get (Seq r) -> ByteString -> Either String (Seq r)
forall r. Get r -> ByteString -> Either String r
applyGet (FieldType -> Get (Seq r)
forall b. Wire b => FieldType -> Get (Seq b)
wireGetPacked FieldType
ft) ByteString
bsIn
    else if (WireType
wt WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
== FieldType -> WireType
toWireType FieldType
ft)
           then Get (Seq r) -> ByteString -> Either String (Seq r)
forall r. Get r -> ByteString -> Either String r
applyGet ((r -> Seq r) -> Get r -> Get (Seq r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Seq r
forall a. a -> Seq a
Seq.singleton (Get r -> Get (Seq r)) -> Get r -> Get (Seq r)
forall a b. (a -> b) -> a -> b
$ FieldType -> Get r
forall b. Wire b => FieldType -> Get b
wireGet FieldType
ft) ByteString
bsIn
           else String -> Either String (Seq r)
forall a b. a -> Either a b
Left (String -> Either String (Seq r))
-> String -> Either String (Seq r)
forall a b. (a -> b) -> a -> b
$ String
"Text.ProtocolBuffers.Extensions.chooseGet: wireType mismatch "String -> String -> String
forall a. [a] -> [a] -> [a]
++(WireType, FieldType) -> String
forall a. Show a => a -> String
show(WireType
wt,FieldType
ft)

-- | Converts the the 'Result' into an 'Either' type and enforces
-- consumption of entire 'ByteString'.  Used by 'parseWireExtMaybe'
-- and 'parseWireExtSeq' to process raw wire input that has been
-- stored in an 'ExtField'.
applyGet :: Get r -> ByteString -> Either String r
applyGet :: Get r -> ByteString -> Either String r
applyGet Get r
g ByteString
bsIn = Result r -> Either String r
forall r. Result r -> Either String r
resolveEOF (Get r -> ByteString -> Result r
forall a. Get a -> ByteString -> Result a
runGet Get r
g ByteString
bsIn) where
  resolveEOF :: Result r -> Either String r
  resolveEOF :: Result r -> Either String r
resolveEOF (Failed Int64
i String
s) = String -> Either String r
forall a b. a -> Either a b
Left (String
"Failed at "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int64 -> String
forall a. Show a => a -> String
show Int64
iString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" : "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)
  resolveEOF (Finished ByteString
bs Int64
_i r
r) | ByteString -> Bool
L.null ByteString
bs = r -> Either String r
forall a b. b -> Either a b
Right r
r
                                | Bool
otherwise = String -> Either String r
forall a b. a -> Either a b
Left String
"Not all input consumed"
  resolveEOF (Partial {}) = String -> Either String r
forall a b. a -> Either a b
Left String
"Not enough input"

instance ExtKey Seq where
  putExt :: Key Seq msg v -> Seq v -> msg -> msg
putExt key :: Key Seq msg v
key@(Key FieldId
i FieldType
t Maybe v
_) Seq v
s msg
msg | Seq v -> Bool
forall a. Seq a -> Bool
Seq.null Seq v
s = Key Seq msg v -> msg -> msg
forall (c :: * -> *) msg v. ExtKey c => Key c msg v -> msg -> msg
clearExt Key Seq msg v
key msg
msg
                               | Bool
otherwise =
      let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
          v' :: ExtFieldValue
v' = FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq Seq v
s)
          ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
i ExtFieldValue
v' Map FieldId ExtFieldValue
ef
      in ExtFieldValue -> msg -> msg
seq ExtFieldValue
v' (msg -> msg) -> msg -> msg
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> msg -> msg
seq Map FieldId ExtFieldValue
ef' (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

  clearExt :: Key Seq msg v -> msg -> msg
clearExt (Key FieldId
i FieldType
_ Maybe v
_) msg
msg =
    let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
        ef' :: Map FieldId ExtFieldValue
ef' = FieldId -> Map FieldId ExtFieldValue -> Map FieldId ExtFieldValue
forall k a. Ord k => k -> Map k a -> Map k a
M.delete FieldId
i Map FieldId ExtFieldValue
ef
    in Map FieldId ExtFieldValue -> msg -> msg
seq Map FieldId ExtFieldValue
ef' (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

  getExt :: Key Seq msg v -> msg -> Either String (Seq v)
getExt k :: Key Seq msg v
k@(Key FieldId
i FieldType
t Maybe v
_) msg
msg =
    let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
t
        (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
    in case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
i Map FieldId ExtFieldValue
ef of
         Maybe ExtFieldValue
Nothing -> Seq v -> Either String (Seq v)
forall a b. b -> Either a b
Right Seq v
forall a. Seq a
Seq.empty
         Just (ExtFromWire Seq EP
raw) -> (String -> Either String (Seq v))
-> ((FieldId, ExtFieldValue) -> Either String (Seq v))
-> Either String (FieldId, ExtFieldValue)
-> Either String (Seq v)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (Seq v)
forall a b. a -> Either a b
Left (ExtFieldValue -> Either String (Seq v)
getExt' (ExtFieldValue -> Either String (Seq v))
-> ((FieldId, ExtFieldValue) -> ExtFieldValue)
-> (FieldId, ExtFieldValue)
-> Either String (Seq v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldId, ExtFieldValue) -> ExtFieldValue
forall a b. (a, b) -> b
snd) (Key Seq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key Seq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtSeq Key Seq msg v
k WireType
wt Seq EP
raw)
         Just ExtFieldValue
x -> ExtFieldValue -> Either String (Seq v)
getExt' ExtFieldValue
x
   where getExt' :: ExtFieldValue -> Either String (Seq v)
getExt' (ExtOptional FieldType
t' GPDyn
_) = String -> Either String (Seq v)
forall a b. a -> Either a b
Left (String -> Either String (Seq v))
-> String -> Either String (Seq v)
forall a b. (a -> b) -> a -> b
$ String
"getExt Seq: ExtField has optional type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,FieldType
t')
         getExt' (ExtPacked FieldType
t' GPDynSeq
_) = String -> Either String (Seq v)
forall a b. a -> Either a b
Left (String -> Either String (Seq v))
-> String -> Either String (Seq v)
forall a b. (a -> b) -> a -> b
$ String
"getExt Seq: ExtField has packed type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,FieldType
t')
         getExt' (ExtRepeated FieldType
t' (GPDynSeq Seq a
s)) | FieldType
t'FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t =
           String -> Either String (Seq v)
forall a b. a -> Either a b
Left (String -> Either String (Seq v))
-> String -> Either String (Seq v)
forall a b. (a -> b) -> a -> b
$ String
"getExt Seq: Key's FieldType does not match ExtField's: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,FieldType
t')
                                                         | Bool
otherwise =
           case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
             Maybe (Seq v)
Nothing -> String -> Either String (Seq v)
forall a b. a -> Either a b
Left (String -> Either String (Seq v))
-> String -> Either String (Seq v)
forall a b. (a -> b) -> a -> b
$ String
"getExt Seq: Key's Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
             Just Seq v
s' -> Seq v -> Either String (Seq v)
forall a b. b -> Either a b
Right Seq v
s'
         getExt' (ExtFromWire {}) = String -> Either String (Seq v)
forall b. String -> b
err (String -> Either String (Seq v))
-> String -> Either String (Seq v)
forall a b. (a -> b) -> a -> b
$ String
"Impossible? getExt.getExt' Seq should not have ExtFromWire case (after parseWireExtSeq)!"

  -- This is more complicated than the Maybe instance because the old
  -- Seq needs to be retrieved and perhaps parsed and then appended
  -- to.  All sanity checks are included below.  TODO: do enough
  -- testing to be confident in removing some checks.
  wireGetKey :: Key Seq msg v -> msg -> Get msg
wireGetKey k :: Key Seq msg v
k@(Key FieldId
i FieldType
t Maybe v
mv) msg
msg = do
    let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
t
        myCast :: Maybe a -> Get a
        myCast :: Maybe a -> Get a
myCast = Maybe a -> Get a
forall a. HasCallStack => a
undefined
    v
v <- FieldType -> Get v
forall b. Wire b => FieldType -> Get b
wireGet FieldType
t Get v -> Get v -> Get v
forall a. a -> a -> a
`asTypeOf` (Maybe v -> Get v
forall a. Maybe a -> Get a
myCast Maybe v
mv)
    let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
    ExtFieldValue
v' <- case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
i Map FieldId ExtFieldValue
ef of
            Maybe ExtFieldValue
Nothing -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (v -> Seq v
forall a. a -> Seq a
Seq.singleton v
v))
            Just (ExtRepeated FieldType
t' (GPDynSeq Seq a
s)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
              String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: Key mismatch! found wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,FieldType
t,FieldType
t')
                                                         | Bool
otherwise ->
              case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
                Maybe (Seq v)
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: previous Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
                Just Seq v
s' -> v -> Get ExtFieldValue -> Get ExtFieldValue
seq v
v (Get ExtFieldValue -> Get ExtFieldValue)
-> Get ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq v
s' Seq v -> v -> Seq v
forall a. Seq a -> a -> Seq a
|> v
v))
            Just (ExtFromWire Seq EP
raw) ->
              case Key Seq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key Seq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtSeq Key Seq msg v
k WireType
wt Seq EP
raw of
                Left String
errMsg -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: Could not parseWireExtSeq: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Key Seq msg v -> String
forall a. Show a => a -> String
show Key Seq msg v
kString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
errMsg
                Right (FieldId
_,ExtRepeated FieldType
t' (GPDynSeq Seq a
s)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
                  String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: Key mismatch! parseWireExtSeq returned wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,FieldType
t,FieldType
t')
                                                                | Bool
otherwise ->
                  case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
                    Maybe (Seq v)
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: previous Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
                    Just Seq v
s' -> v -> Get ExtFieldValue -> Get ExtFieldValue
seq v
v (Get ExtFieldValue -> Get ExtFieldValue)
-> Get ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq v
s' Seq v -> v -> Seq v
forall a. Seq a -> a -> Seq a
|> v
v))
                Either String (FieldId, ExtFieldValue)
wtf -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: Weird parseWireExtSeq return value: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, Either String (FieldId, ExtFieldValue)) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,Either String (FieldId, ExtFieldValue)
wtf)
            Just wtf :: ExtFieldValue
wtf@(ExtOptional {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: ExtOptional found when ExtRepeated expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,ExtFieldValue
wtf)
            Just wtf :: ExtFieldValue
wtf@(ExtPacked {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey Seq: ExtPacked found when ExtRepeated expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,ExtFieldValue
wtf)
    let ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
i ExtFieldValue
v' Map FieldId ExtFieldValue
ef
    ExtFieldValue -> Get msg -> Get msg
seq ExtFieldValue
v' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get msg -> Get msg
seq Map FieldId ExtFieldValue
ef' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ msg -> Get msg
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

-- | used by 'getVal' and 'wireGetKey' for the 'Seq' instance
parseWireExtSeq :: Key Seq msg v -> WireType -> Seq EP -> Either String (FieldId,ExtFieldValue)
parseWireExtSeq :: Key Seq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtSeq k :: Key Seq msg v
k@(Key FieldId
i FieldType
t Maybe v
mv)  WireType
wt Seq EP
raw | WireType
wt WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldType -> WireType
toWireType FieldType
t =
  String -> Either String (FieldId, ExtFieldValue)
forall a b. a -> Either a b
Left (String -> Either String (FieldId, ExtFieldValue))
-> String -> Either String (FieldId, ExtFieldValue)
forall a b. (a -> b) -> a -> b
$ String
"parseWireExtSeq: Key mismatch! Key's FieldType does not match ExtField's wire type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key Seq msg v, WireType, WireType) -> String
forall a. Show a => a -> String
show (Key Seq msg v
k,FieldType -> WireType
toWireType FieldType
t,WireType
wt)
                                       | Bool
otherwise = do
  let mkWitType :: Maybe a -> FieldType -> EP -> Either String (Seq a)
      mkWitType :: Maybe a -> FieldType -> EP -> Either String (Seq a)
mkWitType = Maybe a -> FieldType -> EP -> Either String (Seq a)
forall a. HasCallStack => a
undefined
      chooseGet' :: FieldType -> EP -> Either String (Seq v)
chooseGet' = FieldType -> EP -> Either String (Seq v)
forall r. Wire r => FieldType -> EP -> Either String (Seq r)
chooseGet (FieldType -> EP -> Either String (Seq v))
-> (FieldType -> EP -> Either String (Seq v))
-> FieldType
-> EP
-> Either String (Seq v)
forall a. a -> a -> a
`asTypeOf` (Maybe v -> FieldType -> EP -> Either String (Seq v)
forall a. Maybe a -> FieldType -> EP -> Either String (Seq a)
mkWitType Maybe v
mv)
  let parsed :: [Either String (Seq v)]
parsed = (EP -> Either String (Seq v)) -> [EP] -> [Either String (Seq v)]
forall a b. (a -> b) -> [a] -> [b]
map (FieldType -> EP -> Either String (Seq v)
chooseGet' FieldType
t) ([EP] -> [Either String (Seq v)])
-> (Seq EP -> [EP]) -> Seq EP -> [Either String (Seq v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EP -> [EP]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq EP -> [Either String (Seq v)])
-> Seq EP -> [Either String (Seq v)]
forall a b. (a -> b) -> a -> b
$ Seq EP
raw
      errs :: [String]
errs = [ String
m | Left String
m <- [Either String (Seq v)]
parsed ]
  if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs then (FieldId, ExtFieldValue) -> Either String (FieldId, ExtFieldValue)
forall a b. b -> Either a b
Right (FieldId
i,(FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq ([Seq v] -> Seq v
forall a. Monoid a => [a] -> a
mconcat [ Seq v
a | Right Seq v
a <- [Either String (Seq v)]
parsed ]))))
    else String -> Either String (FieldId, ExtFieldValue)
forall a b. a -> Either a b
Left ([String] -> String
unlines [String]
errs)

instance ExtKey PackedSeq where
  putExt :: Key PackedSeq msg v -> PackedSeq v -> msg -> msg
putExt key :: Key PackedSeq msg v
key@(Key FieldId
i FieldType
t Maybe v
_) (PackedSeq Seq v
s) msg
msg | Seq v -> Bool
forall a. Seq a -> Bool
Seq.null Seq v
s = Key PackedSeq msg v -> msg -> msg
forall (c :: * -> *) msg v. ExtKey c => Key c msg v -> msg -> msg
clearExt Key PackedSeq msg v
key msg
msg
                                           | Bool
otherwise =
      let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
          v' :: ExtFieldValue
v' = FieldType -> GPDynSeq -> ExtFieldValue
ExtPacked FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq Seq v
s)
          ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
i ExtFieldValue
v' Map FieldId ExtFieldValue
ef
      in ExtFieldValue -> msg -> msg
seq ExtFieldValue
v' (msg -> msg) -> msg -> msg
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> msg -> msg
seq Map FieldId ExtFieldValue
ef' (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

  clearExt :: Key PackedSeq msg v -> msg -> msg
clearExt (Key FieldId
i FieldType
_ Maybe v
_) msg
msg =
    let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
        ef' :: Map FieldId ExtFieldValue
ef' = FieldId -> Map FieldId ExtFieldValue -> Map FieldId ExtFieldValue
forall k a. Ord k => k -> Map k a -> Map k a
M.delete FieldId
i Map FieldId ExtFieldValue
ef
    in Map FieldId ExtFieldValue -> msg -> msg
seq Map FieldId ExtFieldValue
ef' (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

  getExt :: Key PackedSeq msg v -> msg -> Either String (PackedSeq v)
getExt k :: Key PackedSeq msg v
k@(Key FieldId
i FieldType
t Maybe v
_) msg
msg =
    let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
t
        (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
    in case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
i Map FieldId ExtFieldValue
ef of
         Maybe ExtFieldValue
Nothing -> PackedSeq v -> Either String (PackedSeq v)
forall a b. b -> Either a b
Right (Seq v -> PackedSeq v
forall a. Seq a -> PackedSeq a
PackedSeq Seq v
forall a. Seq a
Seq.empty)
         Just (ExtFromWire Seq EP
raw) -> (String -> Either String (PackedSeq v))
-> ((FieldId, ExtFieldValue) -> Either String (PackedSeq v))
-> Either String (FieldId, ExtFieldValue)
-> Either String (PackedSeq v)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (PackedSeq v)
forall a b. a -> Either a b
Left (ExtFieldValue -> Either String (PackedSeq v)
getExt' (ExtFieldValue -> Either String (PackedSeq v))
-> ((FieldId, ExtFieldValue) -> ExtFieldValue)
-> (FieldId, ExtFieldValue)
-> Either String (PackedSeq v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldId, ExtFieldValue) -> ExtFieldValue
forall a b. (a, b) -> b
snd) (Key PackedSeq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key PackedSeq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtPackedSeq Key PackedSeq msg v
k WireType
wt Seq EP
raw)
         Just ExtFieldValue
x -> ExtFieldValue -> Either String (PackedSeq v)
getExt' ExtFieldValue
x
   where getExt' :: ExtFieldValue -> Either String (PackedSeq v)
getExt' (ExtOptional FieldType
t' GPDyn
_) = String -> Either String (PackedSeq v)
forall a b. a -> Either a b
Left (String -> Either String (PackedSeq v))
-> String -> Either String (PackedSeq v)
forall a b. (a -> b) -> a -> b
$ String
"getExt PackedSeq: ExtField has optional type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,FieldType
t')
         getExt' (ExtRepeated FieldType
t' GPDynSeq
_) = String -> Either String (PackedSeq v)
forall a b. a -> Either a b
Left (String -> Either String (PackedSeq v))
-> String -> Either String (PackedSeq v)
forall a b. (a -> b) -> a -> b
$ String
"getExt PackedSeq: ExtField has repeated type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,FieldType
t')
         getExt' (ExtPacked FieldType
t' (GPDynSeq Seq a
s)) | FieldType
t'FieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t =
           String -> Either String (PackedSeq v)
forall a b. a -> Either a b
Left (String -> Either String (PackedSeq v))
-> String -> Either String (PackedSeq v)
forall a b. (a -> b) -> a -> b
$ String
"getExt PackedSeq: Key's FieldType does not match ExtField's: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, FieldType) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,FieldType
t')
                                                       | Bool
otherwise =
           case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
             Maybe (Seq v)
Nothing -> String -> Either String (PackedSeq v)
forall a b. a -> Either a b
Left (String -> Either String (PackedSeq v))
-> String -> Either String (PackedSeq v)
forall a b. (a -> b) -> a -> b
$ String
"getExt PackedSeq: Key's Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
             Just Seq v
s' -> PackedSeq v -> Either String (PackedSeq v)
forall a b. b -> Either a b
Right (Seq v -> PackedSeq v
forall a. Seq a -> PackedSeq a
PackedSeq Seq v
s')
         getExt' (ExtFromWire {}) = String -> Either String (PackedSeq v)
forall b. String -> b
err (String -> Either String (PackedSeq v))
-> String -> Either String (PackedSeq v)
forall a b. (a -> b) -> a -> b
$ String
"Impossible? getExt.getExt' PackedSeq should not have ExtFromWire case (after parseWireExtSeq)!"

  wireGetKey :: Key PackedSeq msg v -> msg -> Get msg
wireGetKey k :: Key PackedSeq msg v
k@(Key FieldId
i FieldType
t Maybe v
mv) msg
msg = do
    let wt :: WireType
wt = FieldType -> WireType
toWireType FieldType
t
        myCast :: Maybe a -> Get (Seq a)
        myCast :: Maybe a -> Get (Seq a)
myCast = Maybe a -> Get (Seq a)
forall a. HasCallStack => a
undefined
    Seq v
vv <- FieldType -> Get (Seq v)
forall b. Wire b => FieldType -> Get (Seq b)
wireGetPacked FieldType
t Get (Seq v) -> Get (Seq v) -> Get (Seq v)
forall a. a -> a -> a
`asTypeOf` (Maybe v -> Get (Seq v)
forall a. Maybe a -> Get (Seq a)
myCast Maybe v
mv)
    let (ExtField Map FieldId ExtFieldValue
ef) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
msg
    ExtFieldValue
v' <- case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
i Map FieldId ExtFieldValue
ef of
            Maybe ExtFieldValue
Nothing -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtPacked FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq Seq v
vv)
            Just (ExtPacked FieldType
t' (GPDynSeq Seq a
s)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
              String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey PackedSeq: Key mismatch! found wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,FieldType
t,FieldType
t')
                                                       | Bool
otherwise ->
              case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
                Maybe (Seq v)
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey PackedSeq: previous Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
                Just Seq v
s' -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq v
s' Seq v -> Seq v -> Seq v
forall a. Seq a -> Seq a -> Seq a
>< Seq v
vv))
            Just (ExtFromWire Seq EP
raw) ->
              case Key PackedSeq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
forall msg v.
Key PackedSeq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtPackedSeq Key PackedSeq msg v
k WireType
wt Seq EP
raw of
                Left String
errMsg -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey PackedSeq: Could not parseWireExtPackedSeq: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Key PackedSeq msg v -> String
forall a. Show a => a -> String
show Key PackedSeq msg v
kString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
errMsg
                Right (FieldId
_,ExtPacked FieldType
t' (GPDynSeq Seq a
s)) | FieldType
tFieldType -> FieldType -> Bool
forall a. Eq a => a -> a -> Bool
/=FieldType
t' ->
                  String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey PackedSeq: Key mismatch! parseWireExtPackedSeq returned wrong field type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, FieldType, FieldType) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,FieldType
t,FieldType
t')
                                                                | Bool
otherwise ->
                  case Seq a -> Maybe (Seq v)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Seq a
s of
                    Maybe (Seq v)
Nothing -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey PackedSeq: previous Seq value cast failed: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, TypeRep) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,Seq a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf Seq a
s)
                    Just Seq v
s' -> ExtFieldValue -> Get ExtFieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtFieldValue -> Get ExtFieldValue)
-> ExtFieldValue -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq v
s' Seq v -> Seq v -> Seq v
forall a. Seq a -> Seq a -> Seq a
>< Seq v
vv))
                Either String (FieldId, ExtFieldValue)
wtf -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey PackedSeq: Weird parseWireExtPackedSeq return value: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, Either String (FieldId, ExtFieldValue))
-> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,Either String (FieldId, ExtFieldValue)
wtf)
            Just wtf :: ExtFieldValue
wtf@(ExtOptional {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey PackedSeq: ExtOptional found when ExtPacked expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,ExtFieldValue
wtf)
-- XXX XXX XXX 2.3.0 need to add handling to the next line?
            Just wtf :: ExtFieldValue
wtf@(ExtRepeated {}) -> String -> Get ExtFieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExtFieldValue) -> String -> Get ExtFieldValue
forall a b. (a -> b) -> a -> b
$ String
"wireGetKey PackedSeq: ExtRepeated found when ExtPacked expected: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, ExtFieldValue) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,ExtFieldValue
wtf)
    let ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
i ExtFieldValue
v' Map FieldId ExtFieldValue
ef
    ExtFieldValue -> Get msg -> Get msg
seq ExtFieldValue
v' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get msg -> Get msg
seq Map FieldId ExtFieldValue
ef' (Get msg -> Get msg) -> Get msg -> Get msg
forall a b. (a -> b) -> a -> b
$ msg -> Get msg
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> msg -> msg
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') msg
msg)

parseWireExtPackedSeq :: Key PackedSeq msg v -> WireType -> Seq EP -> Either String (FieldId,ExtFieldValue)
parseWireExtPackedSeq :: Key PackedSeq msg v
-> WireType -> Seq EP -> Either String (FieldId, ExtFieldValue)
parseWireExtPackedSeq k :: Key PackedSeq msg v
k@(Key FieldId
i FieldType
t Maybe v
mv) WireType
wt Seq EP
raw | WireType
wt WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
/= WireType
2 {- packed wire type is 2, length delimited -} =
  String -> Either String (FieldId, ExtFieldValue)
forall a b. a -> Either a b
Left (String -> Either String (FieldId, ExtFieldValue))
-> String -> Either String (FieldId, ExtFieldValue)
forall a b. (a -> b) -> a -> b
$ String
"parseWireExtPackedSeq: Key mismatch! Key's FieldType does not match ExtField's wire type: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Key PackedSeq msg v, WireType, WireType) -> String
forall a. Show a => a -> String
show (Key PackedSeq msg v
k,FieldType -> WireType
toWireType FieldType
t,WireType
wt)
                                            | Bool
otherwise = do
  let mkWitType :: Maybe a -> FieldType -> EP -> Either String (Seq a)
      mkWitType :: Maybe a -> FieldType -> EP -> Either String (Seq a)
mkWitType = Maybe a -> FieldType -> EP -> Either String (Seq a)
forall a. HasCallStack => a
undefined
      chooseGet' :: FieldType -> EP -> Either String (Seq v)
chooseGet' = FieldType -> EP -> Either String (Seq v)
forall r. Wire r => FieldType -> EP -> Either String (Seq r)
chooseGet (FieldType -> EP -> Either String (Seq v))
-> (FieldType -> EP -> Either String (Seq v))
-> FieldType
-> EP
-> Either String (Seq v)
forall a. a -> a -> a
`asTypeOf` (Maybe v -> FieldType -> EP -> Either String (Seq v)
forall a. Maybe a -> FieldType -> EP -> Either String (Seq a)
mkWitType Maybe v
mv)
  let parsed :: [Either String (Seq v)]
parsed = (EP -> Either String (Seq v)) -> [EP] -> [Either String (Seq v)]
forall a b. (a -> b) -> [a] -> [b]
map (FieldType -> EP -> Either String (Seq v)
chooseGet' FieldType
t) ([EP] -> [Either String (Seq v)])
-> (Seq EP -> [EP]) -> Seq EP -> [Either String (Seq v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq EP -> [EP]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq EP -> [Either String (Seq v)])
-> Seq EP -> [Either String (Seq v)]
forall a b. (a -> b) -> a -> b
$ Seq EP
raw
      errs :: [String]
errs = [ String
m | Left String
m <- [Either String (Seq v)]
parsed ]
  if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs then (FieldId, ExtFieldValue) -> Either String (FieldId, ExtFieldValue)
forall a b. b -> Either a b
Right (FieldId
i,(FieldType -> GPDynSeq -> ExtFieldValue
ExtPacked FieldType
t (Seq v -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq ([Seq v] -> Seq v
forall a. Monoid a => [a] -> a
mconcat [ Seq v
a | Right Seq v
a <- [Either String (Seq v)]
parsed ]))))
    else String -> Either String (FieldId, ExtFieldValue)
forall a b. a -> Either a b
Left ([String] -> String
unlines [String]
errs)

-- | This is used by the generated code
wireSizeExtField :: ExtField -> WireSize
wireSizeExtField :: ExtField -> Int64
wireSizeExtField (ExtField Map FieldId ExtFieldValue
m) = (Int64 -> (FieldId, ExtFieldValue) -> Int64)
-> Int64 -> [(FieldId, ExtFieldValue)] -> Int64
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Int64 -> (FieldId, ExtFieldValue) -> Int64
aSize Int64
0 (Map FieldId ExtFieldValue -> [(FieldId, ExtFieldValue)]
forall k a. Map k a -> [(k, a)]
M.assocs Map FieldId ExtFieldValue
m)  where
  aSize :: Int64 -> (FieldId, ExtFieldValue) -> Int64
aSize Int64
old (FieldId
fi,(ExtFromWire Seq EP
raw)) =
    let toSize :: EP -> Int64
toSize (EP WireType
wt ByteString
bs) = WireTag -> Int64
size'WireTag (FieldId -> WireType -> WireTag
mkWireTag FieldId
fi WireType
wt) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
L.length ByteString
bs
    in (Int64 -> EP -> Int64) -> Int64 -> Seq EP -> Int64
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\Int64
oldVal EP
new -> Int64
oldVal Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ EP -> Int64
toSize EP
new) Int64
old Seq EP
raw
  aSize Int64
old (FieldId
fi,(ExtOptional FieldType
ft (GPDyn a
d))) = Int64
old Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
    let tagSize :: Int64
tagSize = WireTag -> Int64
size'WireTag (FieldId -> FieldType -> WireTag
toWireTag FieldId
fi FieldType
ft)
    in Int64 -> FieldType -> a -> Int64
forall v. Wire v => Int64 -> FieldType -> v -> Int64
wireSizeReq Int64
tagSize FieldType
ft a
d
  aSize Int64
old (FieldId
fi,(ExtRepeated FieldType
ft (GPDynSeq Seq a
s))) = Int64
old Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
    let tagSize :: Int64
tagSize = WireTag -> Int64
size'WireTag (FieldId -> FieldType -> WireTag
toWireTag FieldId
fi FieldType
ft)
    in Int64 -> FieldType -> Seq a -> Int64
forall v. Wire v => Int64 -> FieldType -> Seq v -> Int64
wireSizeRep Int64
tagSize FieldType
ft Seq a
s
  aSize Int64
old (FieldId
fi,(ExtPacked FieldType
ft (GPDynSeq Seq a
s))) = Int64
old Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+
    let tagSize :: Int64
tagSize = WireTag -> Int64
size'WireTag (FieldId -> WireTag
toPackedWireTag FieldId
fi)
    in Int64 -> FieldType -> Seq a -> Int64
forall v. Wire v => Int64 -> FieldType -> Seq v -> Int64
wireSizePacked Int64
tagSize FieldType
ft Seq a
s

-- | This is used by the generated code. The data is serialized in
-- order of increasing field number.
wirePutExtField :: ExtField -> Put
wirePutExtField :: ExtField -> Put
wirePutExtField (ExtField Map FieldId ExtFieldValue
m) = ((FieldId, ExtFieldValue) -> Put)
-> [(FieldId, ExtFieldValue)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FieldId, ExtFieldValue) -> Put
aPut (Map FieldId ExtFieldValue -> [(FieldId, ExtFieldValue)]
forall k a. Map k a -> [(k, a)]
M.assocs Map FieldId ExtFieldValue
m) where
  aPut :: (FieldId, ExtFieldValue) -> Put
aPut (FieldId
fi,(ExtFromWire Seq EP
raw)) = (EP -> Put) -> Seq EP -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ (\(EP WireType
wt ByteString
bs) -> Word32 -> Put
forall a. (Integral a, Bits a) => a -> Put
putVarUInt (WireTag -> Word32
getWireTag (WireTag -> Word32) -> WireTag -> Word32
forall a b. (a -> b) -> a -> b
$ FieldId -> WireType -> WireTag
mkWireTag FieldId
fi WireType
wt) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLazyByteString ByteString
bs) Seq EP
raw
  aPut (FieldId
fi,(ExtOptional FieldType
ft (GPDyn a
d))) = WireTag -> FieldType -> Maybe a -> Put
forall v. Wire v => WireTag -> FieldType -> Maybe v -> Put
wirePutOpt (FieldId -> FieldType -> WireTag
toWireTag FieldId
fi FieldType
ft) FieldType
ft (a -> Maybe a
forall a. a -> Maybe a
Just a
d)
  aPut (FieldId
fi,(ExtRepeated FieldType
ft (GPDynSeq Seq a
s))) = WireTag -> FieldType -> Seq a -> Put
forall v. Wire v => WireTag -> FieldType -> Seq v -> Put
wirePutRep (FieldId -> FieldType -> WireTag
toWireTag FieldId
fi FieldType
ft) FieldType
ft Seq a
s
  aPut (FieldId
fi,(ExtPacked   FieldType
ft (GPDynSeq Seq a
s))) = WireTag -> FieldType -> Seq a -> Put
forall v. Wire v => WireTag -> FieldType -> Seq v -> Put
wirePutPacked (FieldId -> WireTag
toPackedWireTag FieldId
fi) FieldType
ft Seq a
s

-- FIXME: implement this directly
-- | This is used by the generated code
wirePutExtFieldWithSize :: ExtField -> PutM WireSize
wirePutExtFieldWithSize :: ExtField -> PutM Int64
wirePutExtFieldWithSize ExtField
m = ExtField -> Put
wirePutExtField ExtField
m Put -> PutM Int64 -> PutM Int64
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> PutM Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> Int64
wireSizeExtField ExtField
m)

notExtension :: (ReflectDescriptor a, ExtendMessage a,Typeable a) => FieldId -> WireType -> a -> Get a
notExtension :: FieldId -> WireType -> a -> Get a
notExtension FieldId
fieldId WireType
_wireType a
msg = String -> Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
"Field id "String -> String -> String
forall a. [a] -> [a] -> [a]
++FieldId -> String
forall a. Show a => a -> String
show FieldId
fieldIdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" is not a valid extension field id for "String -> String -> String
forall a. [a] -> [a] -> [a]
++TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
msg)))

-- | get a value from the wire into the message's ExtField. This is used by generated code for
-- extensions that were not known at compile time.
loadExtension :: (ReflectDescriptor a, ExtendMessage a) => FieldId -> WireType -> a -> Get a
--loadExtension fieldId wireType msg | isValidExt fieldId msg = do -- XXX check moved to generated code
--loadExtension fieldId wireType msg = unknown fieldId wireType msg -- XXX
loadExtension :: FieldId -> WireType -> a -> Get a
loadExtension FieldId
fieldId WireType
wireType a
msg = do
  let (ExtField Map FieldId ExtFieldValue
ef) = a -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField a
msg
      badwt :: WireType -> Get a
      badwt :: WireType -> Get a
badwt WireType
wt = do Int64
here <- Get Int64
bytesRead
                    String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a) -> String -> Get a
forall a b. (a -> b) -> a -> b
$ String
"Conflicting wire types at byte position "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int64 -> String
forall a. Show a => a -> String
show Int64
here String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for extension to message: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(TypeRep, FieldId, WireType, WireType) -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
msg,FieldId
fieldId,WireType
wireType,WireType
wt)
  case FieldId -> Map FieldId ExtFieldValue -> Maybe ExtFieldValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldId
fieldId Map FieldId ExtFieldValue
ef of
    Maybe ExtFieldValue
Nothing -> do
       ByteString
bs <- FieldId -> WireType -> Get ByteString
wireGetFromWire FieldId
fieldId WireType
wireType
       let v' :: ExtFieldValue
v' = Seq EP -> ExtFieldValue
ExtFromWire (EP -> Seq EP
forall a. a -> Seq a
Seq.singleton (WireType -> ByteString -> EP
EP WireType
wireType ByteString
bs))
           ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
fieldId ExtFieldValue
v' Map FieldId ExtFieldValue
ef
       ExtFieldValue -> Get a -> Get a
seq ExtFieldValue
v' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get a -> Get a
seq Map FieldId ExtFieldValue
ef' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ ExtField -> a -> a
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') a
msg
    Just (ExtFromWire Seq EP
raw) -> do
      ByteString
bs <- FieldId -> WireType -> Get ByteString
wireGetFromWire FieldId
fieldId WireType
wireType
      let v' :: ExtFieldValue
v' = ByteString -> ExtFieldValue -> ExtFieldValue
seq ByteString
bs (ExtFieldValue -> ExtFieldValue) -> ExtFieldValue -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ Seq EP -> ExtFieldValue
ExtFromWire (Seq EP
raw Seq EP -> EP -> Seq EP
forall a. Seq a -> a -> Seq a
|> (WireType -> ByteString -> EP
EP WireType
wireType ByteString
bs))
          ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
fieldId ExtFieldValue
v' Map FieldId ExtFieldValue
ef
      ExtFieldValue -> Get a -> Get a
seq ExtFieldValue
v' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get a -> Get a
seq Map FieldId ExtFieldValue
ef' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> a -> a
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') a
msg)
    Just (ExtOptional FieldType
ft (GPDyn a
a)) | FieldType -> WireType
toWireType FieldType
ft WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
/= WireType
wireType -> WireType -> Get a
forall a. WireType -> Get a
badwt (FieldType -> WireType
toWireType FieldType
ft)
                                    | Bool
otherwise -> do
      a
b <- FieldType -> Get a
forall b. Wire b => FieldType -> Get b
wireGet FieldType
ft
      let v' :: ExtFieldValue
v' = FieldType -> GPDyn -> ExtFieldValue
ExtOptional FieldType
ft (a -> GPDyn
forall a. GPB a => a -> GPDyn
GPDyn (a -> a -> a
forall a. Mergeable a => a -> a -> a
mergeAppend a
a a
b))
          ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
fieldId ExtFieldValue
v' Map FieldId ExtFieldValue
ef
      ExtFieldValue -> Get a -> Get a
seq ExtFieldValue
v' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get a -> Get a
seq Map FieldId ExtFieldValue
ef' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> a -> a
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') a
msg)
-- handle wireType of "2" when toWireType ft is not "2" but ft could be packed by using wireGetPacked ft
    Just (ExtRepeated FieldType
ft (GPDynSeq Seq a
s)) | FieldType -> WireType
toWireType FieldType
ft WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
/= WireType
wireType -> if (WireType
wireTypeWireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
==WireType
2) Bool -> Bool -> Bool
&& (FieldType -> Bool
isValidPacked FieldType
ft)
                                                                        then do
                                                                          Seq a
aa <- FieldType -> Get (Seq a)
forall b. Wire b => FieldType -> Get (Seq b)
wireGetPacked FieldType
ft
                                                                          let v' :: ExtFieldValue
v' = FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
ft (Seq a -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq a
s Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
aa))
                                                                              ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
fieldId ExtFieldValue
v' Map FieldId ExtFieldValue
ef
                                                                          ExtFieldValue -> Get a -> Get a
seq ExtFieldValue
v' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get a -> Get a
seq Map FieldId ExtFieldValue
ef' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> a -> a
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') a
msg)
                                                                        else WireType -> Get a
forall a. WireType -> Get a
badwt (FieldType -> WireType
toWireType FieldType
ft)
                                       | Bool
otherwise -> do
      a
a <- FieldType -> Get a
forall b. Wire b => FieldType -> Get b
wireGet FieldType
ft
      let v' :: ExtFieldValue
v' = a -> ExtFieldValue -> ExtFieldValue
seq a
a (ExtFieldValue -> ExtFieldValue) -> ExtFieldValue -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtRepeated FieldType
ft (Seq a -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq a
s Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
a))
          ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
fieldId ExtFieldValue
v' Map FieldId ExtFieldValue
ef
      ExtFieldValue -> Get a -> Get a
seq ExtFieldValue
v' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get a -> Get a
seq Map FieldId ExtFieldValue
ef' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> a -> a
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') a
msg)
-- handle wireType of NOT "2" when wireType is good match for ft by using wireGet ft
    Just (ExtPacked FieldType
ft (GPDynSeq Seq a
s)) | WireType
2 WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
/= WireType
wireType -> if (FieldType -> WireType
toWireType FieldType
ft) WireType -> WireType -> Bool
forall a. Eq a => a -> a -> Bool
== WireType
wireType
                                                          then do
                                                            a
a <- FieldType -> Get a
forall b. Wire b => FieldType -> Get b
wireGet FieldType
ft
                                                            let v' :: ExtFieldValue
v' = a -> ExtFieldValue -> ExtFieldValue
seq a
a (ExtFieldValue -> ExtFieldValue) -> ExtFieldValue -> ExtFieldValue
forall a b. (a -> b) -> a -> b
$ FieldType -> GPDynSeq -> ExtFieldValue
ExtPacked FieldType
ft (Seq a -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq a
s Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
a))
                                                                ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
fieldId ExtFieldValue
v' Map FieldId ExtFieldValue
ef
                                                            ExtFieldValue -> Get a -> Get a
seq ExtFieldValue
v' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get a -> Get a
seq Map FieldId ExtFieldValue
ef' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> a -> a
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') a
msg)
                                                          else WireType -> Get a
forall a. WireType -> Get a
badwt WireType
2  {- packed uses length delimited: 2 -}
                                     | Bool
otherwise -> do
      Seq a
aa <- FieldType -> Get (Seq a)
forall b. Wire b => FieldType -> Get (Seq b)
wireGetPacked FieldType
ft
      let v' :: ExtFieldValue
v' = FieldType -> GPDynSeq -> ExtFieldValue
ExtPacked FieldType
ft (Seq a -> GPDynSeq
forall a. GPB a => Seq a -> GPDynSeq
GPDynSeq (Seq a
s Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
aa))
          ef' :: Map FieldId ExtFieldValue
ef' = FieldId
-> ExtFieldValue
-> Map FieldId ExtFieldValue
-> Map FieldId ExtFieldValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldId
fieldId ExtFieldValue
v' Map FieldId ExtFieldValue
ef
      ExtFieldValue -> Get a -> Get a
seq ExtFieldValue
v' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ Map FieldId ExtFieldValue -> Get a -> Get a
seq Map FieldId ExtFieldValue
ef' (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtField -> a -> a
forall msg. ExtendMessage msg => ExtField -> msg -> msg
putExtField (Map FieldId ExtFieldValue -> ExtField
ExtField Map FieldId ExtFieldValue
ef') a
msg)

class MessageAPI msg a b | msg a -> b where
  -- | Access data in a message.  The first argument is always the
  -- message.  The second argument can be one of 4 categories.
  --
  -- * The field name of a required field acts a simple retrieval of
  -- the data from the message.
  --
  -- * The field name of an optional field will retreive the data if
  -- it is set or lookup the default value if it is not set.
  --
  -- * The field name of a repeated field always retrieves the
  -- (possibly empty) 'Seq' of values.
  --
  -- * A Key for an optional or repeated value will act as the field
  -- name does above, but if there is a type mismatch or parse error
  -- it will use the defaultValue for optional types and an empty
  -- sequence for repeated types.
  getVal :: msg -> a -> b

  -- | Check whether data is present in the message.
  --
  -- * Required fields always return 'True'.
  --
  -- * Optional fields return whether a value is present.
  --
  -- * Repeated field return 'False' if there are no values, otherwise
  -- they return 'True'.
  --
  -- * Keys return as optional or repeated, but checks only if the
  -- field # is present.  This assumes that there are no collisions
  -- where more that one key refers to the same field number of this
  -- message type.
  isSet :: msg -> a -> Bool
  isSet msg
_ a
_ = Bool
True

instance (Default msg,Default a) => MessageAPI msg (msg -> Maybe a) a where
  getVal :: msg -> (msg -> Maybe a) -> a
getVal msg
m msg -> Maybe a
f = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Default a => a
defaultValue (msg -> Maybe a
f msg
forall a. Default a => a
defaultValue)) (msg -> Maybe a
f msg
m)
  isSet :: msg -> (msg -> Maybe a) -> Bool
isSet msg
m msg -> Maybe a
f = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (msg -> Maybe a
f msg
m)

instance MessageAPI msg (msg -> (Seq a)) (Seq a) where
  getVal :: msg -> (msg -> Seq a) -> Seq a
getVal msg
m msg -> Seq a
f = msg -> Seq a
f msg
m
  isSet :: msg -> (msg -> Seq a) -> Bool
isSet msg
m msg -> Seq a
f = Bool -> Bool
not (Seq a -> Bool
forall a. Seq a -> Bool
Seq.null (msg -> Seq a
f msg
m))

instance (Default v) => MessageAPI msg (Key Maybe msg v) v where
  getVal :: msg -> Key Maybe msg v -> v
getVal msg
m k :: Key Maybe msg v
k@(Key FieldId
_ FieldType
_ Maybe v
md) = case Key Maybe msg v -> msg -> Either String (Maybe v)
forall (c :: * -> *) msg v.
ExtKey c =>
Key c msg v -> msg -> Either String (c v)
getExt Key Maybe msg v
k msg
m of
                              Right (Just v
v) -> v
v
                              Either String (Maybe v)
_ -> v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
forall a. Default a => a
defaultValue Maybe v
md
  isSet :: msg -> Key Maybe msg v -> Bool
isSet msg
m (Key FieldId
fid FieldType
_ Maybe v
_) = let (ExtField Map FieldId ExtFieldValue
x) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
m
                          in FieldId -> Map FieldId ExtFieldValue -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member FieldId
fid Map FieldId ExtFieldValue
x

instance (Default v) => MessageAPI msg (Key Seq msg v) (Seq v) where
  getVal :: msg -> Key Seq msg v -> Seq v
getVal msg
m k :: Key Seq msg v
k@(Key FieldId
_ FieldType
_ Maybe v
_) = case Key Seq msg v -> msg -> Either String (Seq v)
forall (c :: * -> *) msg v.
ExtKey c =>
Key c msg v -> msg -> Either String (c v)
getExt Key Seq msg v
k msg
m of
                             Right Seq v
s -> Seq v
s
                             Either String (Seq v)
_ -> Seq v
forall a. Seq a
Seq.empty
  isSet :: msg -> Key Seq msg v -> Bool
isSet msg
m (Key FieldId
fid FieldType
_ Maybe v
_) = let (ExtField Map FieldId ExtFieldValue
x) = msg -> ExtField
forall msg. ExtendMessage msg => msg -> ExtField
getExtField msg
m
                          in FieldId -> Map FieldId ExtFieldValue -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member FieldId
fid Map FieldId ExtFieldValue
x

instance MessageAPI msg (msg -> ByteString) ByteString where getVal :: msg -> (msg -> ByteString) -> ByteString
getVal msg
m msg -> ByteString
f = msg -> ByteString
f msg
m
instance MessageAPI msg (msg -> Utf8) Utf8 where getVal :: msg -> (msg -> Utf8) -> Utf8
getVal msg
m msg -> Utf8
f = msg -> Utf8
f msg
m
instance MessageAPI msg (msg -> Double) Double where getVal :: msg -> (msg -> Double) -> Double
getVal msg
m msg -> Double
f = msg -> Double
f msg
m
instance MessageAPI msg (msg -> Float) Float where getVal :: msg -> (msg -> Float) -> Float
getVal msg
m msg -> Float
f = msg -> Float
f msg
m
instance MessageAPI msg (msg -> Int32) Int32 where getVal :: msg -> (msg -> Int32) -> Int32
getVal msg
m msg -> Int32
f = msg -> Int32
f msg
m
instance MessageAPI msg (msg -> Int64) Int64 where getVal :: msg -> (msg -> Int64) -> Int64
getVal msg
m msg -> Int64
f = msg -> Int64
f msg
m
instance MessageAPI msg (msg -> Word32) Word32 where getVal :: msg -> (msg -> Word32) -> Word32
getVal msg
m msg -> Word32
f = msg -> Word32
f msg
m
instance MessageAPI msg (msg -> Word64) Word64 where getVal :: msg -> (msg -> Word64) -> Word64
getVal msg
m msg -> Word64
f = msg -> Word64
f msg
m

-- Must keep synchronized with Parser.isValidPacked
isValidPacked :: FieldType -> Bool
isValidPacked :: FieldType -> Bool
isValidPacked FieldType
fieldType =
  case FieldType
fieldType of
    FieldType
9 -> Bool
False
    FieldType
10 -> Bool
False
    FieldType
11 -> Bool
False -- Impossible value for typeCode from parseType, but here for completeness
    FieldType
12 -> Bool
False
    FieldType
_ -> Bool
True