{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Data.ProtocolBuffers.Decode
  ( Decode(..)
  , decodeMessage
  , decodeLengthPrefixedMessage
  , GDecode(..)
  , fieldDecode
  ) where

import Control.Applicative
import Control.Monad
import Data.Foldable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Int (Int32, Int64)
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Proxy
import Data.Binary.Get
import Data.Traversable (traverse)

import GHC.Generics
import GHC.TypeLits

import Data.ProtocolBuffers.Types
import Data.ProtocolBuffers.Wire
import qualified Data.ByteString.Lazy as LBS

-- |
-- Decode a Protocol Buffers message.
decodeMessage :: Decode a => Get a
{-# INLINE decodeMessage #-}
decodeMessage :: Get a
decodeMessage = HashMap Tag [WireField] -> Get a
forall a. Decode a => HashMap Tag [WireField] -> Get a
decode (HashMap Tag [WireField] -> Get a)
-> Get (HashMap Tag [WireField]) -> Get a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([WireField] -> [WireField])
-> HashMap Tag [WireField] -> HashMap Tag [WireField]
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map [WireField] -> [WireField]
forall a. [a] -> [a]
reverse (HashMap Tag [WireField] -> HashMap Tag [WireField])
-> Get (HashMap Tag [WireField]) -> Get (HashMap Tag [WireField])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Tag [WireField] -> Get (HashMap Tag [WireField])
go HashMap Tag [WireField]
forall k v. HashMap k v
HashMap.empty where
  go :: HashMap Tag [WireField] -> Get (HashMap Tag [WireField])
  go :: HashMap Tag [WireField] -> Get (HashMap Tag [WireField])
go HashMap Tag [WireField]
msg = do
    Maybe WireField
mfield <- WireField -> Maybe WireField
forall a. a -> Maybe a
Just (WireField -> Maybe WireField)
-> Get WireField -> Get (Maybe WireField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get WireField
getWireField Get (Maybe WireField)
-> Get (Maybe WireField) -> Get (Maybe WireField)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe WireField -> Get (Maybe WireField)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WireField
forall a. Maybe a
Nothing
    case Maybe WireField
mfield of
      Just WireField
v  -> HashMap Tag [WireField] -> Get (HashMap Tag [WireField])
go (HashMap Tag [WireField] -> Get (HashMap Tag [WireField]))
-> HashMap Tag [WireField] -> Get (HashMap Tag [WireField])
forall a b. (a -> b) -> a -> b
$! ([WireField] -> [WireField] -> [WireField])
-> Tag
-> [WireField]
-> HashMap Tag [WireField]
-> HashMap Tag [WireField]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith (\(WireField
x:[]) [WireField]
xs -> WireField
xWireField -> [WireField] -> [WireField]
forall a. a -> [a] -> [a]
:[WireField]
xs) (WireField -> Tag
wireFieldTag WireField
v) [WireField
v] HashMap Tag [WireField]
msg
      Maybe WireField
Nothing -> HashMap Tag [WireField] -> Get (HashMap Tag [WireField])
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Tag [WireField]
msg

-- |
-- Decode a Protocol Buffers message prefixed with a varint encoded 32-bit integer describing its length.
decodeLengthPrefixedMessage :: Decode a => Get a
{-# INLINE decodeLengthPrefixedMessage #-}
decodeLengthPrefixedMessage :: Get a
decodeLengthPrefixedMessage = do
  Int64
len :: Int64 <- Get Int64
forall a. (Integral a, Bits a) => Get a
getVarInt
  ByteString
bs <- Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len
  case Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get a
forall a. Decode a => Get a
decodeMessage (ByteString -> ByteString
LBS.fromStrict ByteString
bs) of
   Right (ByteString
bs', Int64
_, a
val)
      | ByteString -> Bool
LBS.null ByteString
bs' -> a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
      | Bool
otherwise  -> 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
"Unparsed bytes leftover in decodeLengthPrefixedMessage: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show (ByteString -> Int64
LBS.length ByteString
bs')
   Left (ByteString
_, Int64
_, String
err) -> String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err

class Decode (a :: *) where
  decode :: HashMap Tag [WireField] -> Get a
  default decode :: (Generic a, GDecode (Rep a)) => HashMap Tag [WireField] -> Get a
  decode = (Rep a Any -> a) -> Get (Rep a Any) -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Get (Rep a Any) -> Get a)
-> (HashMap Tag [WireField] -> Get (Rep a Any))
-> HashMap Tag [WireField]
-> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Tag [WireField] -> Get (Rep a Any)
forall (f :: * -> *) a.
GDecode f =>
HashMap Tag [WireField] -> Get (f a)
gdecode

-- | Untyped message decoding, @ 'decode' = 'id' @
instance Decode (HashMap Tag [WireField]) where
  decode :: HashMap Tag [WireField] -> Get (HashMap Tag [WireField])
decode = HashMap Tag [WireField] -> Get (HashMap Tag [WireField])
forall (f :: * -> *) a. Applicative f => a -> f a
pure

class GDecode (f :: * -> *) where
  gdecode :: HashMap Tag [WireField] -> Get (f a)

instance GDecode a => GDecode (M1 i c a) where
  gdecode :: HashMap Tag [WireField] -> Get (M1 i c a a)
gdecode = (a a -> M1 i c a a) -> Get (a a) -> Get (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Get (a a) -> Get (M1 i c a a))
-> (HashMap Tag [WireField] -> Get (a a))
-> HashMap Tag [WireField]
-> Get (M1 i c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Tag [WireField] -> Get (a a)
forall (f :: * -> *) a.
GDecode f =>
HashMap Tag [WireField] -> Get (f a)
gdecode

instance (GDecode a, GDecode b) => GDecode (a :*: b) where
  gdecode :: HashMap Tag [WireField] -> Get ((:*:) a b a)
gdecode HashMap Tag [WireField]
msg = (a a -> b a -> (:*:) a b a)
-> Get (a a) -> Get (b a) -> Get ((:*:) a b a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (HashMap Tag [WireField] -> Get (a a)
forall (f :: * -> *) a.
GDecode f =>
HashMap Tag [WireField] -> Get (f a)
gdecode HashMap Tag [WireField]
msg) (HashMap Tag [WireField] -> Get (b a)
forall (f :: * -> *) a.
GDecode f =>
HashMap Tag [WireField] -> Get (f a)
gdecode HashMap Tag [WireField]
msg)

instance (GDecode x, GDecode y) => GDecode (x :+: y) where
  gdecode :: HashMap Tag [WireField] -> Get ((:+:) x y a)
gdecode HashMap Tag [WireField]
msg = x a -> (:+:) x y a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (x a -> (:+:) x y a) -> Get (x a) -> Get ((:+:) x y a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Tag [WireField] -> Get (x a)
forall (f :: * -> *) a.
GDecode f =>
HashMap Tag [WireField] -> Get (f a)
gdecode HashMap Tag [WireField]
msg Get ((:+:) x y a) -> Get ((:+:) x y a) -> Get ((:+:) x y a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> y a -> (:+:) x y a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (y a -> (:+:) x y a) -> Get (y a) -> Get ((:+:) x y a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Tag [WireField] -> Get (y a)
forall (f :: * -> *) a.
GDecode f =>
HashMap Tag [WireField] -> Get (f a)
gdecode HashMap Tag [WireField]
msg

fieldDecode
  :: forall a b i n p . (DecodeWire a, Monoid a, KnownNat n)
  => (a -> b)
  -> HashMap Tag [WireField]
  -> Get (K1 i (Field n b) p)
{-# INLINE fieldDecode #-}
fieldDecode :: (a -> b) -> HashMap Tag [WireField] -> Get (K1 i (Field n b) p)
fieldDecode a -> b
c HashMap Tag [WireField]
msg =
  let tag :: Tag
tag = Integer -> Tag
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Tag) -> Integer -> Tag
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
  in case Tag -> HashMap Tag [WireField] -> Maybe [WireField]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Tag
tag HashMap Tag [WireField]
msg of
    Just [WireField]
val -> Field n b -> K1 i (Field n b) p
forall k i c (p :: k). c -> K1 i c p
K1 (Field n b -> K1 i (Field n b) p)
-> (a -> Field n b) -> a -> K1 i (Field n b) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Field n b
forall (n :: Nat) a. a -> Field n a
Field (b -> Field n b) -> (a -> b) -> a -> Field n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
c (a -> K1 i (Field n b) p) -> Get a -> Get (K1 i (Field n b) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WireField -> Get a) -> [WireField] -> Get a
forall (m :: * -> *) (t :: * -> *) b a.
(Monad m, Foldable t, Monoid b) =>
(a -> m b) -> t a -> m b
foldMapM WireField -> Get a
forall a. DecodeWire a => WireField -> Get a
decodeWire [WireField]
val
    Maybe [WireField]
Nothing  -> Get (K1 i (Field n b) p)
forall (f :: * -> *) a. Alternative f => f a
empty

instance (DecodeWire a, KnownNat n) => GDecode (K1 i (Field n (OptionalField (Last (Value a))))) where
  gdecode :: HashMap Tag [WireField]
-> Get (K1 i (Field n (OptionalField (Last (Value a)))) a)
gdecode HashMap Tag [WireField]
msg = (Last (Value a) -> OptionalField (Last (Value a)))
-> HashMap Tag [WireField]
-> Get (K1 i (Field n (OptionalField (Last (Value a)))) a)
forall a b i (n :: Nat) p.
(DecodeWire a, Monoid a, KnownNat n) =>
(a -> b) -> HashMap Tag [WireField] -> Get (K1 i (Field n b) p)
fieldDecode Last (Value a) -> OptionalField (Last (Value a))
forall a. a -> OptionalField a
Optional HashMap Tag [WireField]
msg Get (K1 i (Field n (OptionalField (Last (Value a)))) a)
-> Get (K1 i (Field n (OptionalField (Last (Value a)))) a)
-> Get (K1 i (Field n (OptionalField (Last (Value a)))) a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> K1 i (Field n (OptionalField (Last (Value a)))) a
-> Get (K1 i (Field n (OptionalField (Last (Value a)))) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field n (OptionalField (Last (Value a)))
-> K1 i (Field n (OptionalField (Last (Value a)))) a
forall k i c (p :: k). c -> K1 i c p
K1 Field n (OptionalField (Last (Value a)))
forall a. Monoid a => a
mempty)

instance (Enum a, KnownNat n) => GDecode (K1 i (Field n (RequiredField (Always (Enumeration a))))) where
  gdecode :: HashMap Tag [WireField]
-> Get (K1 i (Field n (RequiredField (Always (Enumeration a)))) a)
gdecode HashMap Tag [WireField]
msg = do
    K1 Field n (RequiredField (Always (Value Int32)))
mx <- (Always (Value Int32) -> RequiredField (Always (Value Int32)))
-> HashMap Tag [WireField]
-> Get
     (K1 Any (Field n (RequiredField (Always (Value Int32)))) Any)
forall a b i (n :: Nat) p.
(DecodeWire a, Monoid a, KnownNat n) =>
(a -> b) -> HashMap Tag [WireField] -> Get (K1 i (Field n b) p)
fieldDecode Always (Value Int32) -> RequiredField (Always (Value Int32))
forall a. a -> RequiredField a
Required HashMap Tag [WireField]
msg
    case Field n (RequiredField (Always (Value Int32)))
mx :: Field n (RequiredField (Always (Value Int32))) of
      Field (Required (Always (Value Int32
x))) ->
        K1 i (Field n (RequiredField (Always (Enumeration a)))) a
-> Get (K1 i (Field n (RequiredField (Always (Enumeration a)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (K1 i (Field n (RequiredField (Always (Enumeration a)))) a
 -> Get (K1 i (Field n (RequiredField (Always (Enumeration a)))) a))
-> (Int
    -> K1 i (Field n (RequiredField (Always (Enumeration a)))) a)
-> Int
-> Get (K1 i (Field n (RequiredField (Always (Enumeration a)))) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field n (RequiredField (Always (Enumeration a)))
-> K1 i (Field n (RequiredField (Always (Enumeration a)))) a
forall k i c (p :: k). c -> K1 i c p
K1 (Field n (RequiredField (Always (Enumeration a)))
 -> K1 i (Field n (RequiredField (Always (Enumeration a)))) a)
-> (Int -> Field n (RequiredField (Always (Enumeration a))))
-> Int
-> K1 i (Field n (RequiredField (Always (Enumeration a)))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequiredField (Always (Enumeration a))
-> Field n (RequiredField (Always (Enumeration a)))
forall (n :: Nat) a. a -> Field n a
Field (RequiredField (Always (Enumeration a))
 -> Field n (RequiredField (Always (Enumeration a))))
-> (Int -> RequiredField (Always (Enumeration a)))
-> Int
-> Field n (RequiredField (Always (Enumeration a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Always (Enumeration a) -> RequiredField (Always (Enumeration a))
forall a. a -> RequiredField a
Required (Always (Enumeration a) -> RequiredField (Always (Enumeration a)))
-> (Int -> Always (Enumeration a))
-> Int
-> RequiredField (Always (Enumeration a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumeration a -> Always (Enumeration a)
forall a. a -> Always a
Always (Enumeration a -> Always (Enumeration a))
-> (Int -> Enumeration a) -> Int -> Always (Enumeration a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Enumeration a
forall a. a -> Enumeration a
Enumeration (a -> Enumeration a) -> (Int -> a) -> Int -> Enumeration a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Enum a => Int -> a
toEnum (Int
 -> Get (K1 i (Field n (RequiredField (Always (Enumeration a)))) a))
-> Int
-> Get (K1 i (Field n (RequiredField (Always (Enumeration a)))) a)
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x

instance (Enum a, KnownNat n) => GDecode (K1 i (Field n (OptionalField (Last (Enumeration a))))) where
  gdecode :: HashMap Tag [WireField]
-> Get (K1 i (Field n (OptionalField (Last (Enumeration a)))) a)
gdecode HashMap Tag [WireField]
msg = do
    K1 Field n (OptionalField (Last (Value Int32)))
mx <- (Last (Value Int32) -> OptionalField (Last (Value Int32)))
-> HashMap Tag [WireField]
-> Get (K1 Any (Field n (OptionalField (Last (Value Int32)))) Any)
forall a b i (n :: Nat) p.
(DecodeWire a, Monoid a, KnownNat n) =>
(a -> b) -> HashMap Tag [WireField] -> Get (K1 i (Field n b) p)
fieldDecode Last (Value Int32) -> OptionalField (Last (Value Int32))
forall a. a -> OptionalField a
Optional HashMap Tag [WireField]
msg Get (K1 Any (Field n (OptionalField (Last (Value Int32)))) Any)
-> Get (K1 Any (Field n (OptionalField (Last (Value Int32)))) Any)
-> Get (K1 Any (Field n (OptionalField (Last (Value Int32)))) Any)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> K1 Any (Field n (OptionalField (Last (Value Int32)))) Any
-> Get (K1 Any (Field n (OptionalField (Last (Value Int32)))) Any)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field n (OptionalField (Last (Value Int32)))
-> K1 Any (Field n (OptionalField (Last (Value Int32)))) Any
forall k i c (p :: k). c -> K1 i c p
K1 Field n (OptionalField (Last (Value Int32)))
forall a. Monoid a => a
mempty)
    case Field n (OptionalField (Last (Value Int32)))
mx :: Field n (OptionalField (Last (Value Int32))) of
      Field (Optional (Last (Just (Value Int32
x)))) ->
        K1 i (Field n (OptionalField (Last (Enumeration a)))) a
-> Get (K1 i (Field n (OptionalField (Last (Enumeration a)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (K1 i (Field n (OptionalField (Last (Enumeration a)))) a
 -> Get (K1 i (Field n (OptionalField (Last (Enumeration a)))) a))
-> (Int -> K1 i (Field n (OptionalField (Last (Enumeration a)))) a)
-> Int
-> Get (K1 i (Field n (OptionalField (Last (Enumeration a)))) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field n (OptionalField (Last (Enumeration a)))
-> K1 i (Field n (OptionalField (Last (Enumeration a)))) a
forall k i c (p :: k). c -> K1 i c p
K1 (Field n (OptionalField (Last (Enumeration a)))
 -> K1 i (Field n (OptionalField (Last (Enumeration a)))) a)
-> (Int -> Field n (OptionalField (Last (Enumeration a))))
-> Int
-> K1 i (Field n (OptionalField (Last (Enumeration a)))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionalField (Last (Enumeration a))
-> Field n (OptionalField (Last (Enumeration a)))
forall (n :: Nat) a. a -> Field n a
Field (OptionalField (Last (Enumeration a))
 -> Field n (OptionalField (Last (Enumeration a))))
-> (Int -> OptionalField (Last (Enumeration a)))
-> Int
-> Field n (OptionalField (Last (Enumeration a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last (Enumeration a) -> OptionalField (Last (Enumeration a))
forall a. a -> OptionalField a
Optional (Last (Enumeration a) -> OptionalField (Last (Enumeration a)))
-> (Int -> Last (Enumeration a))
-> Int
-> OptionalField (Last (Enumeration a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Enumeration a) -> Last (Enumeration a)
forall a. Maybe a -> Last a
Last (Maybe (Enumeration a) -> Last (Enumeration a))
-> (Int -> Maybe (Enumeration a)) -> Int -> Last (Enumeration a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumeration a -> Maybe (Enumeration a)
forall a. a -> Maybe a
Just (Enumeration a -> Maybe (Enumeration a))
-> (Int -> Enumeration a) -> Int -> Maybe (Enumeration a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Enumeration a
forall a. a -> Enumeration a
Enumeration (a -> Enumeration a) -> (Int -> a) -> Int -> Enumeration a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Enum a => Int -> a
toEnum (Int
 -> Get (K1 i (Field n (OptionalField (Last (Enumeration a)))) a))
-> Int
-> Get (K1 i (Field n (OptionalField (Last (Enumeration a)))) a)
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x
      Field n (OptionalField (Last (Value Int32)))
_ -> K1 i (Field n (OptionalField (Last (Enumeration a)))) a
-> Get (K1 i (Field n (OptionalField (Last (Enumeration a)))) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field n (OptionalField (Last (Enumeration a)))
-> K1 i (Field n (OptionalField (Last (Enumeration a)))) a
forall k i c (p :: k). c -> K1 i c p
K1 Field n (OptionalField (Last (Enumeration a)))
forall a. Monoid a => a
mempty)

instance (DecodeWire a, KnownNat n) => GDecode (K1 i (Repeated n a)) where
  gdecode :: HashMap Tag [WireField] -> Get (K1 i (Repeated n a) a)
gdecode HashMap Tag [WireField]
msg =
    let tag :: Tag
tag = Integer -> Tag
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Tag) -> Integer -> Tag
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
    in case Tag -> HashMap Tag [WireField] -> Maybe [WireField]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Tag
tag HashMap Tag [WireField]
msg of
      Just [WireField]
val -> Repeated n a -> K1 i (Repeated n a) a
forall k i c (p :: k). c -> K1 i c p
K1 (Repeated n a -> K1 i (Repeated n a) a)
-> ([a] -> Repeated n a) -> [a] -> K1 i (Repeated n a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepeatedField [a] -> Repeated n a
forall (n :: Nat) a. a -> Field n a
Field (RepeatedField [a] -> Repeated n a)
-> ([a] -> RepeatedField [a]) -> [a] -> Repeated n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> RepeatedField [a]
forall a. a -> RepeatedField a
Repeated ([a] -> K1 i (Repeated n a) a)
-> Get [a] -> Get (K1 i (Repeated n a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WireField -> Get a) -> [WireField] -> Get [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse WireField -> Get a
forall a. DecodeWire a => WireField -> Get a
decodeWire [WireField]
val
      Maybe [WireField]
Nothing  -> K1 i (Repeated n a) a -> Get (K1 i (Repeated n a) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (K1 i (Repeated n a) a -> Get (K1 i (Repeated n a) a))
-> K1 i (Repeated n a) a -> Get (K1 i (Repeated n a) a)
forall a b. (a -> b) -> a -> b
$ Repeated n a -> K1 i (Repeated n a) a
forall k i c (p :: k). c -> K1 i c p
K1 Repeated n a
forall a. Monoid a => a
mempty

instance (DecodeWire a, KnownNat n) => GDecode (K1 i (Field n (RequiredField (Always (Value a))))) where
  gdecode :: HashMap Tag [WireField]
-> Get (K1 i (Field n (RequiredField (Always (Value a)))) a)
gdecode HashMap Tag [WireField]
msg = (Always (Value a) -> RequiredField (Always (Value a)))
-> HashMap Tag [WireField]
-> Get (K1 i (Field n (RequiredField (Always (Value a)))) a)
forall a b i (n :: Nat) p.
(DecodeWire a, Monoid a, KnownNat n) =>
(a -> b) -> HashMap Tag [WireField] -> Get (K1 i (Field n b) p)
fieldDecode Always (Value a) -> RequiredField (Always (Value a))
forall a. a -> RequiredField a
Required HashMap Tag [WireField]
msg

instance (DecodeWire (PackedList a), KnownNat n) => GDecode (K1 i (Packed n a)) where
  gdecode :: HashMap Tag [WireField] -> Get (K1 i (Packed n a) a)
gdecode HashMap Tag [WireField]
msg = (PackedList a -> PackedField (PackedList a))
-> HashMap Tag [WireField] -> Get (K1 i (Packed n a) a)
forall a b i (n :: Nat) p.
(DecodeWire a, Monoid a, KnownNat n) =>
(a -> b) -> HashMap Tag [WireField] -> Get (K1 i (Field n b) p)
fieldDecode PackedList a -> PackedField (PackedList a)
forall a. a -> PackedField a
PackedField HashMap Tag [WireField]
msg Get (K1 i (Packed n a) a)
-> Get (K1 i (Packed n a) a) -> Get (K1 i (Packed n a) a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> K1 i (Packed n a) a -> Get (K1 i (Packed n a) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Packed n a -> K1 i (Packed n a) a
forall k i c (p :: k). c -> K1 i c p
K1 Packed n a
forall a. Monoid a => a
mempty)

instance GDecode U1 where
  gdecode :: HashMap Tag [WireField] -> Get (U1 a)
gdecode HashMap Tag [WireField]
_ = U1 a -> Get (U1 a)
forall (m :: * -> *) a. Monad m => a -> m a
return U1 a
forall k (p :: k). U1 p
U1

-- |
-- foldMapM implemented in a way that defers using (mempty :: b) unless the
-- Foldable is empty, this allows the gross hack of pretending Always is
-- a Monoid while strictly evaluating the accumulator
foldMapM :: (Monad m, Foldable t, Monoid b) => (a -> m b) -> t a -> m b
foldMapM :: (a -> m b) -> t a -> m b
foldMapM a -> m b
f = (Maybe b -> b) -> m (Maybe b) -> m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
forall a. Monoid a => a
mempty) (m (Maybe b) -> m b) -> (t a -> m (Maybe b)) -> t a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe b -> a -> m (Maybe b)) -> Maybe b -> t a -> m (Maybe b)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Maybe b -> a -> m (Maybe b)
go Maybe b
forall a. Maybe a
Nothing where
  go :: Maybe b -> a -> m (Maybe b)
go (Just !b
acc) = (b -> Maybe b) -> m b -> m (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (b -> b) -> b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> b
forall a. Monoid a => a -> a -> a
mappend b
acc) (m b -> m (Maybe b)) -> (a -> m b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f
  go Maybe b
Nothing     = (b -> Maybe b) -> m b -> m (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Maybe b
forall a. a -> Maybe a
Just (m b -> m (Maybe b)) -> (a -> m b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f