protocol-buffers 2.4.11 → 2.4.12

raw patch · 12 files changed

+118/−51 lines, 12 filesdep +aesondep +base16-bytestringdep +textdep −semigroupsdep ~base

Dependencies added: aeson, base16-bytestring, text, vector

Dependencies removed: semigroups

Dependency ranges changed: base

Files

• README.md +1/−1
• Text/ProtocolBuffers.hs +2/−0
• Text/ProtocolBuffers/Basic.hs +12/−3
• Text/ProtocolBuffers/Extensions.hs +0/−3
• Text/ProtocolBuffers/Get.hs +0/−15
• Text/ProtocolBuffers/Header.hs +20/−2
• Text/ProtocolBuffers/Identifiers.hs +0/−5
• Text/ProtocolBuffers/ProtoJSON.hs +45/−0
• Text/ProtocolBuffers/Reflections.hs +2/−0
• Text/ProtocolBuffers/TextMessage.hs +0/−3
• Text/ProtocolBuffers/Unknown.hs +28/−14
• protocol-buffers.cabal +8/−5

@@ -6,7 +6,7 @@ interdependent Haskell packages originally written by Chris Kuklewicz.  Currently, maintainership was taken by Timo von Holtz. It is-planned to only support GHC 7.10 and newer unless someone explicitly+planned to only support GHC 8.0 and newer unless someone explicitly asks for support of earlier versions.  (Needs check) This README was updated most recently to reflect version

@@ -47,6 +47,7 @@   , module Text.ProtocolBuffers.Reflections   , module Text.ProtocolBuffers.TextMessage   , module Text.ProtocolBuffers.WireMessage+  , module Text.ProtocolBuffers.ProtoJSON   ) where  import Text.ProtocolBuffers.Basic@@ -62,6 +63,7 @@   , KeyInfo,FieldInfo(..),DescriptorInfo(..),EnumInfo(..),ProtoInfo(..),makePNF ) import Text.ProtocolBuffers.TextMessage   ( messagePutText, messageGetText )+import Text.ProtocolBuffers.ProtoJSON import Text.ProtocolBuffers.WireMessage   ( Wire,Put,Get,runPut,runGet,runGetOnLazy   , messageSize,messagePut,messageGet,messagePutM,messageGetM

@@ -13,6 +13,7 @@   , isValidUTF8, toUtf8, utf8, uToString, uFromString   ) where +import Data.Aeson import Data.Bits(Bits) import Data.ByteString.Lazy(ByteString) import Data.Foldable as F(Foldable(foldl))@@ -20,15 +21,14 @@ import Data.Int(Int32,Int64) import Data.Ix(Ix) import Data.Semigroup (Semigroup(..))-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid(Monoid(..))-#endif import Data.Sequence(Seq,(><)) import Data.Typeable(Typeable) import Data.Word(Word8,Word32,Word64)  import qualified Data.ByteString.Lazy as L(unpack) import Data.ByteString.Lazy.UTF8 as U (toString,fromString)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL  -- Num instances are derived below for the purpose of getting fromInteger for case matching @@ -58,6 +58,15 @@ instance Monoid Utf8 where   mempty = Utf8 mempty   mappend = (<>)++instance ToJSON Utf8 where+    toJSON (Utf8 t) = toJSON (TL.decodeUtf8 t)++instance FromJSON Utf8 where+    parseJSON value =+        case value of+          String t -> return . Utf8 . TL.encodeUtf8 . TL.fromStrict $ t+          _ -> fail ("Value " ++ show value ++ " is not a UTF-8 string")  -- | 'WireTag' is the 32 bit value with the upper 29 bits being the -- 'FieldId' and the lower 3 bits being the 'WireType'

@@ -35,9 +35,6 @@ import Data.Map(Map) import qualified Data.Map as M import Data.Maybe(fromMaybe,isJust)-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid(mappend,mconcat)-#endif import Data.Sequence((|>),(><),viewl,ViewL(..)) import qualified Data.Sequence as Seq(singleton,null,empty) import Data.Typeable(Typeable,typeOf,cast)

@@ -65,11 +65,7 @@ -- The Get monad is an instance of binary-strict's BinaryParser: -- import qualified Data.Binary.Strict.Class as P(BinaryParser(..)) -- The Get monad is an instance of all of these library classes:-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative(Applicative(pure,(<*>)),Alternative(empty,(<|>)))-#else import Control.Applicative(Alternative(empty,(<|>)))-#endif import Control.Monad(MonadPlus(mzero,mplus),when) import Control.Monad.Error.Class(MonadError(throwError,catchError),Error(strMsg)) -- It can be a MonadCont, but the semantics are too broken without a ton of work.@@ -87,12 +83,7 @@ import qualified Data.ByteString.Lazy.Internal as L(ByteString(..),chunk) import qualified Data.Foldable as F(foldr,foldr1)    -- used with Seq import Data.Int(Int32,Int64)                         -- index type for L.ByteString-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid(Monoid(mempty,mappend))           -- Writer has a Monoid contraint-import Data.Word(Word,Word8,Word16,Word32,Word64)-#else import Data.Word(Word8,Word16,Word32,Word64)-#endif import Data.Sequence(Seq,null,(|>))                  -- used for future queue in handler state import Foreign.ForeignPtr(withForeignPtr) import Foreign.Ptr(Ptr,castPtr,plusPtr,minusPtr,nullPtr)@@ -870,12 +861,6 @@  #if WORD_SIZE_IN_BITS < 64 shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i)--#if __GLASGOW_HASKELL__ <= 606--- Exported by GHC.Word in GHC 6.8 and higher-foreign import ccall unsafe "stg_uncheckedShiftL64"-    uncheckedShiftL64#     :: Word64# -> Int# -> Word64#-#endif  #else shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i)

@@ -4,9 +4,14 @@ module Text.ProtocolBuffers.Header     ( append, emptyBS     , pack, fromMaybe, ap+    , msum     , fromDistinctAscList, member     , throwError,catchError     , choice, sepEndBy, spaces, try+    , (<=<)+    , FromJSON(..), ToJSON(..)+    , Value(..)+    , explicitParseField, explicitParseFieldMaybe, withObject, withText     , module Data.Generics     , module Text.ProtocolBuffers.Basic     , module Text.ProtocolBuffers.Extensions@@ -15,10 +20,13 @@     , module Text.ProtocolBuffers.TextMessage     , module Text.ProtocolBuffers.Unknown     , module Text.ProtocolBuffers.WireMessage+    , module Text.ProtocolBuffers.ProtoJSON     ) where -import Control.Monad(ap)+import Control.Monad(ap, (<=<), msum) import Control.Monad.Error.Class(throwError,catchError)+import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))+import Data.Aeson.Types (explicitParseField, explicitParseFieldMaybe, withObject, withText) import Data.ByteString.Lazy(empty) import Data.ByteString.Lazy.Char8(pack) import Data.Generics(Data(..))@@ -39,7 +47,16 @@   , GetMessageInfo(GetMessageInfo),DescriptorInfo(extRanges),makePNF ) import Text.ProtocolBuffers.TextMessage -- all import Text.ProtocolBuffers.Unknown-  ( UnknownField,UnknownMessage(..),wireSizeUnknownField,wirePutUnknownField,wirePutUnknownFieldWithSize,catch'Unknown )+  ( UnknownField+  , UnknownMessage(..)+  , wireSizeUnknownField+  , wirePutUnknownField+  , wirePutUnknownFieldWithSize+  , catch'Unknown+  , catch'Unknown'+  , loadUnknown+  , discardUnknown+  ) import Text.ProtocolBuffers.WireMessage   ( Wire(..)   , prependMessageSize,putSize,splitWireTag@@ -53,6 +70,7 @@   , wireSizeErr,wirePutErr,wireGetErr,size'WireSize   , unknown,unknownField   , fieldIdOf)+import Text.ProtocolBuffers.ProtoJSON  {-# INLINE append #-} append :: Seq a -> a -> Seq a

@@ -30,12 +30,7 @@ import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString.Lazy.UTF8 as U import Data.Char-#if __GLASGOW_HASKELL__ < 710-import Data.List-import Data.Monoid-#else import Data.List hiding (uncons)-#endif import Data.Generics(Data) import Data.Typeable(Typeable) import Data.Set(Set)

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Werror #-}+module Text.ProtocolBuffers.ProtoJSON where++import Data.Aeson+import Data.Aeson.Types+import qualified Data.Vector as V+import Text.ProtocolBuffers.Basic+import Text.Read (readEither)++import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Base16 as B16+import qualified Data.Text.Encoding as T++objectNoEmpty :: [Pair] -> Value+objectNoEmpty = object . filter (hasContent . snd)+    where+      hasContent Null = False+      hasContent (Array xs) | V.null xs = False+      hasContent _ = True++toJSONShowWithPayload :: Show a => a -> Value+toJSONShowWithPayload x = object [("payload", toJSON . show $ x)]++parseJSONReadWithPayload :: Read a => String -> Value -> Parser a+parseJSONReadWithPayload tyName = withObject tyName $ \o -> do+    t <- o .: "payload"+    case readEither t of+      Left e -> fail e+      Right res -> return res++parseJSONBool :: Value -> Parser Bool+parseJSONBool (Bool b) = return b+parseJSONBool (Number sci) = return (sci >= 1)+parseJSONBool _ = fail "Expected Bool"++toJSONByteString :: ByteString -> Value+toJSONByteString bs = object [("payload", String . T.decodeUtf8 . B16.encode . BL.toStrict $ bs)]++parseJSONByteString :: Value -> Parser ByteString+parseJSONByteString = withObject "bytes" $ \o -> do+    t <- o .: "payload"+    case B16.decode (T.encodeUtf8 t) of+      (bs, "") -> return (BL.fromStrict bs)+      _ -> fail "Failed to parse base16."

@@ -82,6 +82,7 @@                                      , storeUnknown :: Bool                                      , lazyFields :: Bool                                      , makeLenses :: Bool+                                     , jsonInstances :: Bool                                      }   deriving (Show,Read,Eq,Ord,Data,Typeable) @@ -160,6 +161,7 @@ data EnumInfo = EnumInfo { enumName :: ProtoName                          , enumFilePath :: [FilePath]                          , enumValues :: [(EnumCode,String)] -- ^ The String is the Haskell name to write into the generated source files+                         , enumJsonInstances :: Bool                          }   deriving (Show,Read,Eq,Ord,Data,Typeable) 

@@ -13,9 +13,6 @@         getSubMessage,     ) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative ((<$>), (<*), (*>))-#endif import Control.Monad.Identity (Identity) import Control.Monad (void) import Control.Monad.Writer (Writer, execWriter, tell, censor)

@@ -4,15 +4,13 @@ -- notice.  Importer beware. module Text.ProtocolBuffers.Unknown   ( UnknownField(..),UnknownMessage(..),UnknownFieldValue(..)-  , wireSizeUnknownField,wirePutUnknownField, wirePutUnknownFieldWithSize,catch'Unknown+  , wireSizeUnknownField,wirePutUnknownField, wirePutUnknownFieldWithSize+  , catch'Unknown, catch'Unknown', loadUnknown, discardUnknown   ) where  import qualified Data.ByteString.Lazy as L import qualified Data.Foldable as F import Data.Generics-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid(mempty,mappend)-#endif import Data.Sequence((|>)) import Data.Typeable() import Control.Monad.Error.Class(catchError)@@ -59,14 +57,30 @@   wirePutUnknownField m >> return (wireSizeUnknownField m)  {-# INLINE catch'Unknown #-}+-- | This is used by the generated code. Here for backwards compatibility.+catch'Unknown :: (UnknownMessage a) => (WireTag -> a -> Get a) -> WireTag -> a -> Get a+catch'Unknown = catch'Unknown' loadUnknown++{-# INLINE catch'Unknown' #-}+catch'Unknown' :: (WireTag -> a -> Get a) -> (WireTag -> a -> Get a) -> WireTag -> a -> Get a+catch'Unknown' handleUnknown update'Self wire'Tag old'Self =+    catchError (update'Self wire'Tag old'Self) (\_ -> handleUnknown wire'Tag old'Self)++{-# INLINE loadUnknown #-} -- | This is used by the generated code-catch'Unknown :: (Typeable a, UnknownMessage a) => (WireTag -> a -> Get a) -> (WireTag -> a -> Get a)-catch'Unknown update'Self = \wire'Tag old'Self -> catchError (update'Self wire'Tag old'Self) (\_ -> loadUnknown wire'Tag old'Self)-  where loadUnknown :: (Typeable a, UnknownMessage a) => WireTag -> a -> Get a-        loadUnknown tag msg = do-          let (fieldId,wireType) = splitWireTag tag-              (UnknownField uf) = getUnknownField msg-          bs <- wireGetFromWire fieldId wireType-          let v' = seq bs $ UFV tag bs-              uf' = seq v' $ uf |> v'-          seq uf' $ return $ putUnknownField (UnknownField uf') msg+loadUnknown :: (UnknownMessage a) => WireTag -> a -> Get a+loadUnknown tag msg = do+  let (fieldId,wireType) = splitWireTag tag+      (UnknownField uf) = getUnknownField msg+  bs <- wireGetFromWire fieldId wireType+  let v' = seq bs $ UFV tag bs+      uf' = seq v' $ uf |> v'+  seq uf' $ return $ putUnknownField (UnknownField uf') msg++{-# INLINE discardUnknown #-}+-- | This is used by the generated code+discardUnknown :: WireTag -> a -> Get a+discardUnknown tag msg = do+  let (fieldId,wireType) = splitWireTag tag+  _bs <- wireGetFromWire fieldId wireType+  return msg

@@ -1,5 +1,5 @@ name:           protocol-buffers-version:        2.4.11+version:        2.4.12 cabal-version:  >= 1.6 build-type:     Simple license:        BSD3@@ -14,6 +14,7 @@ category:       Text extra-source-files: TODO                     README.md+Tested-With: GHC == 8.0.2, GHC == 8.2.1, GHC == 8.4.2, GHC == 8.6.2 source-repository head   type: git   location: git://github.com/k-bx/protocol-buffers.git@@ -32,21 +33,23 @@                    Text.ProtocolBuffers.TextMessage                    Text.ProtocolBuffers.Unknown                    Text.ProtocolBuffers.WireMessage+                   Text.ProtocolBuffers.ProtoJSON -  build-depends: base >= 4.7.0 && < 5,+  build-depends: base >= 4.9.0 && < 5,+                 aeson >= 1.1.0.0,                  array,+                 base16-bytestring,+                 text,                  binary,                  bytestring,                  containers,                  directory,                  filepath,                  mtl,+                 vector,                  parsec,                  utf8-string,                  syb-  if !impl(ghc >= 8.0)-    build-depends:-      semigroups >= 0.11 && < 0.19  -- Most of these are needed for protocol-buffers (Get and WireMessage.hs) -- Nothing especially hazardous in this list