module Text.ProtocolBuffers.ProtoCompile.MakeReflections(makeProtoInfo,serializeFDP) where
import qualified Text.DescriptorProtos.DescriptorProto as D(DescriptorProto)
import qualified Text.DescriptorProtos.DescriptorProto as D.DescriptorProto(DescriptorProto(..))
import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.DescriptorProto(ExtensionRange(ExtensionRange))
import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.DescriptorProto.ExtensionRange(ExtensionRange(..))
import qualified Text.DescriptorProtos.EnumDescriptorProto as D(EnumDescriptorProto)
import qualified Text.DescriptorProtos.EnumDescriptorProto as D.EnumDescriptorProto(EnumDescriptorProto(..))
import qualified Text.DescriptorProtos.EnumValueDescriptorProto as D(EnumValueDescriptorProto)
import qualified Text.DescriptorProtos.EnumValueDescriptorProto as D.EnumValueDescriptorProto(EnumValueDescriptorProto(..))
import qualified Text.DescriptorProtos.FieldDescriptorProto as D(FieldDescriptorProto)
import qualified Text.DescriptorProtos.FieldDescriptorProto as D.FieldDescriptorProto(FieldDescriptorProto(..))
import Text.DescriptorProtos.FieldDescriptorProto.Label as D.FieldDescriptorProto.Label(Label(..))
import Text.DescriptorProtos.FieldDescriptorProto.Type as D.FieldDescriptorProto.Type(Type(..))
import qualified Text.DescriptorProtos.FieldOptions as D(FieldOptions(FieldOptions))
import qualified Text.DescriptorProtos.FieldOptions as D.FieldOptions(FieldOptions(..))
import qualified Text.DescriptorProtos.FileDescriptorProto as D(FileDescriptorProto(FileDescriptorProto))
import qualified Text.DescriptorProtos.FileDescriptorProto as D.FileDescriptorProto(FileDescriptorProto(..))
import qualified Text.DescriptorProtos.OneofDescriptorProto as D(OneofDescriptorProto)
import qualified Text.DescriptorProtos.OneofDescriptorProto as D.OneofDescriptorProto(OneofDescriptorProto(..))
import Text.ProtocolBuffers.Basic
import Text.ProtocolBuffers.Identifiers
import Text.ProtocolBuffers.Reflections
import Text.ProtocolBuffers.WireMessage(size'WireTag,toWireTag,toPackedWireTag,runPut,Wire(..))
import Text.ProtocolBuffers.ProtoCompile.Resolve(ReMap,NameMap(..),getPackageID)
import qualified Data.Foldable as F(foldr,toList)
import Data.Sequence ((<|))
import qualified Data.Sequence as Seq(fromList,empty,singleton,null,filter)
import Numeric(readHex,readOct,readDec)
import Data.Monoid(mconcat,mappend)
import qualified Data.Map as M(fromListWith,lookup,keys)
import Data.Maybe(fromMaybe,catMaybes,fromJust)
import System.FilePath
imp :: String -> a
imp :: String -> a
imp String
msg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Text.ProtocolBuffers.ProtoCompile.MakeReflections: Impossible?\n "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
msg
pnPath :: ProtoName -> [FilePath]
pnPath :: ProtoName -> [String]
pnPath (ProtoName FIName Utf8
_ [MName String]
a [MName String]
b MName String
c) = String -> [String]
splitDirectories (String -> [String])
-> ([MName String] -> String) -> [MName String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String -> String -> String) -> String -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> String
addExtension String
"hs" (String -> String)
-> ([MName String] -> String) -> [MName String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
joinPath ([String] -> String)
-> ([MName String] -> [String]) -> [MName String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MName String -> String) -> [MName String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MName String -> String
forall a. MName a -> a
mName ([MName String] -> [String]) -> [MName String] -> [String]
forall a b. (a -> b) -> a -> b
$ [MName String]
a[MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++[MName String]
b[MName String] -> [MName String] -> [MName String]
forall a. [a] -> [a] -> [a]
++[MName String
c]
serializeFDP :: D.FileDescriptorProto -> ByteString
serializeFDP :: FileDescriptorProto -> ByteString
serializeFDP FileDescriptorProto
fdp = Put -> ByteString
runPut (FieldType -> FileDescriptorProto -> Put
forall b. Wire b => FieldType -> b -> Put
wirePut FieldType
11 FileDescriptorProto
fdp)
toHaskell :: ReMap -> FIName Utf8 -> ProtoName
toHaskell :: ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap FIName Utf8
k = case FIName Utf8 -> ReMap -> Maybe ProtoName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FIName Utf8
k ReMap
reMap of
Maybe ProtoName
Nothing -> String -> ProtoName
forall a. String -> a
imp (String -> ProtoName) -> String -> ProtoName
forall a b. (a -> b) -> a -> b
$ String
"toHaskell failed to find "String -> String -> String
forall a. [a] -> [a] -> [a]
++FIName Utf8 -> String
forall a. Show a => a -> String
show FIName Utf8
kString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" among "String -> String -> String
forall a. [a] -> [a] -> [a]
++[FIName Utf8] -> String
forall a. Show a => a -> String
show (ReMap -> [FIName Utf8]
forall k a. Map k a -> [k]
M.keys ReMap
reMap)
Just ProtoName
pn -> ProtoName
pn
makeProtoInfo :: (Bool,Bool,Bool,Bool)
-> NameMap
-> D.FileDescriptorProto
-> ProtoInfo
makeProtoInfo :: (Bool, Bool, Bool, Bool)
-> NameMap -> FileDescriptorProto -> ProtoInfo
makeProtoInfo (Bool
unknownField,Bool
lazyFieldsOpt,Bool
lenses,Bool
json) (NameMap (PackageID (FIName Utf8)
packageID,[MName String]
hPrefix,[MName String]
hParent) ReMap
reMap)
fdp :: FileDescriptorProto
fdp@(D.FileDescriptorProto { name :: FileDescriptorProto -> Maybe Utf8
D.FileDescriptorProto.name = Just Utf8
rawName })
= ProtoName
-> [String]
-> String
-> Seq KeyInfo
-> [DescriptorInfo]
-> [EnumInfo]
-> [OneofInfo]
-> Map ProtoName (Seq FieldInfo)
-> ProtoInfo
ProtoInfo ProtoName
protoName (ProtoName -> [String]
pnPath ProtoName
protoName) (Utf8 -> String
toString Utf8
rawName) Seq KeyInfo
keyInfos [DescriptorInfo]
allMessages [EnumInfo]
allEnums [OneofInfo]
allOneofs Map ProtoName (Seq FieldInfo)
allKeys where
packageName :: FIName Utf8
packageName = PackageID (FIName Utf8) -> FIName Utf8
forall a. PackageID a -> a
getPackageID PackageID (FIName Utf8)
packageID :: FIName (Utf8)
protoName :: ProtoName
protoName = case [MName String]
hParent of
[] -> case [MName String]
hPrefix of
[] -> String -> ProtoName
forall a. String -> a
imp (String -> ProtoName) -> String -> ProtoName
forall a b. (a -> b) -> a -> b
$ String
"makeProtoInfo: no hPrefix or hParent in NameMap for: "String -> String -> String
forall a. [a] -> [a] -> [a]
++FileDescriptorProto -> String
forall a. Show a => a -> String
show FileDescriptorProto
fdp
[MName String]
_ -> FIName Utf8
-> [MName String] -> [MName String] -> MName String -> ProtoName
ProtoName FIName Utf8
packageName ([MName String] -> [MName String]
forall a. [a] -> [a]
init [MName String]
hPrefix) [] ([MName String] -> MName String
forall a. [a] -> a
last [MName String]
hPrefix)
[MName String]
_ -> FIName Utf8
-> [MName String] -> [MName String] -> MName String -> ProtoName
ProtoName FIName Utf8
packageName [MName String]
hPrefix ([MName String] -> [MName String]
forall a. [a] -> [a]
init [MName String]
hParent) ([MName String] -> MName String
forall a. [a] -> a
last [MName String]
hParent)
keyInfos :: Seq KeyInfo
keyInfos = [KeyInfo] -> Seq KeyInfo
forall a. [a] -> Seq a
Seq.fromList ([KeyInfo] -> Seq KeyInfo)
-> (FileDescriptorProto -> [KeyInfo])
-> FileDescriptorProto
-> Seq KeyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldDescriptorProto -> KeyInfo)
-> [FieldDescriptorProto] -> [KeyInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldDescriptorProto
f -> (ReMap -> FieldDescriptorProto -> ProtoName
keyExtendee' ReMap
reMap FieldDescriptorProto
f,ReMap -> FIName Utf8 -> Bool -> FieldDescriptorProto -> FieldInfo
toFieldInfo' ReMap
reMap FIName Utf8
packageName Bool
lenses FieldDescriptorProto
f))
([FieldDescriptorProto] -> [KeyInfo])
-> (FileDescriptorProto -> [FieldDescriptorProto])
-> FileDescriptorProto
-> [KeyInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq FieldDescriptorProto -> [FieldDescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq FieldDescriptorProto -> [FieldDescriptorProto])
-> (FileDescriptorProto -> Seq FieldDescriptorProto)
-> FileDescriptorProto
-> [FieldDescriptorProto]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileDescriptorProto -> Seq FieldDescriptorProto
D.FileDescriptorProto.extension (FileDescriptorProto -> Seq KeyInfo)
-> FileDescriptorProto -> Seq KeyInfo
forall a b. (a -> b) -> a -> b
$ FileDescriptorProto
fdp
allMessages :: [DescriptorInfo]
allMessages = (DescriptorProto -> [DescriptorInfo])
-> [DescriptorProto] -> [DescriptorInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FIName Utf8 -> Bool -> DescriptorProto -> [DescriptorInfo]
processMSG FIName Utf8
packageName Bool
False) (Seq DescriptorProto -> [DescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq DescriptorProto -> [DescriptorProto])
-> Seq DescriptorProto -> [DescriptorProto]
forall a b. (a -> b) -> a -> b
$ FileDescriptorProto -> Seq DescriptorProto
D.FileDescriptorProto.message_type FileDescriptorProto
fdp)
allEnums :: [EnumInfo]
allEnums = (EnumDescriptorProto -> EnumInfo)
-> [EnumDescriptorProto] -> [EnumInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ReMap -> FIName Utf8 -> Bool -> EnumDescriptorProto -> EnumInfo
makeEnumInfo' ReMap
reMap FIName Utf8
packageName Bool
json) (Seq EnumDescriptorProto -> [EnumDescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq EnumDescriptorProto -> [EnumDescriptorProto])
-> Seq EnumDescriptorProto -> [EnumDescriptorProto]
forall a b. (a -> b) -> a -> b
$ FileDescriptorProto -> Seq EnumDescriptorProto
D.FileDescriptorProto.enum_type FileDescriptorProto
fdp)
[EnumInfo] -> [EnumInfo] -> [EnumInfo]
forall a. [a] -> [a] -> [a]
++ (DescriptorProto -> [EnumInfo]) -> [DescriptorProto] -> [EnumInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FIName Utf8 -> DescriptorProto -> [EnumInfo]
processENM FIName Utf8
packageName) (Seq DescriptorProto -> [DescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq DescriptorProto -> [DescriptorProto])
-> Seq DescriptorProto -> [DescriptorProto]
forall a b. (a -> b) -> a -> b
$ FileDescriptorProto -> Seq DescriptorProto
D.FileDescriptorProto.message_type FileDescriptorProto
fdp)
allOneofs :: [OneofInfo]
allOneofs = (DescriptorProto -> [OneofInfo])
-> [DescriptorProto] -> [OneofInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FIName Utf8 -> DescriptorProto -> [OneofInfo]
processONO FIName Utf8
packageName) (Seq DescriptorProto -> [DescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq DescriptorProto -> [DescriptorProto])
-> Seq DescriptorProto -> [DescriptorProto]
forall a b. (a -> b) -> a -> b
$ FileDescriptorProto -> Seq DescriptorProto
D.FileDescriptorProto.message_type FileDescriptorProto
fdp)
allKeys :: Map ProtoName (Seq FieldInfo)
allKeys = (Seq FieldInfo -> Seq FieldInfo -> Seq FieldInfo)
-> [(ProtoName, Seq FieldInfo)] -> Map ProtoName (Seq FieldInfo)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Seq FieldInfo -> Seq FieldInfo -> Seq FieldInfo
forall a. Monoid a => a -> a -> a
mappend ([(ProtoName, Seq FieldInfo)] -> Map ProtoName (Seq FieldInfo))
-> ([Seq KeyInfo] -> [(ProtoName, Seq FieldInfo)])
-> [Seq KeyInfo]
-> Map ProtoName (Seq FieldInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyInfo -> (ProtoName, Seq FieldInfo))
-> [KeyInfo] -> [(ProtoName, Seq FieldInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ProtoName
k,FieldInfo
a) -> (ProtoName
k,FieldInfo -> Seq FieldInfo
forall a. a -> Seq a
Seq.singleton FieldInfo
a))
([KeyInfo] -> [(ProtoName, Seq FieldInfo)])
-> ([Seq KeyInfo] -> [KeyInfo])
-> [Seq KeyInfo]
-> [(ProtoName, Seq FieldInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq KeyInfo -> [KeyInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq KeyInfo -> [KeyInfo])
-> ([Seq KeyInfo] -> Seq KeyInfo) -> [Seq KeyInfo] -> [KeyInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Seq KeyInfo] -> Seq KeyInfo
forall a. Monoid a => [a] -> a
mconcat ([Seq KeyInfo] -> Map ProtoName (Seq FieldInfo))
-> [Seq KeyInfo] -> Map ProtoName (Seq FieldInfo)
forall a b. (a -> b) -> a -> b
$ Seq KeyInfo
keyInfos Seq KeyInfo -> [Seq KeyInfo] -> [Seq KeyInfo]
forall a. a -> [a] -> [a]
: (DescriptorInfo -> Seq KeyInfo)
-> [DescriptorInfo] -> [Seq KeyInfo]
forall a b. (a -> b) -> [a] -> [b]
map DescriptorInfo -> Seq KeyInfo
keys [DescriptorInfo]
allMessages
processMSG :: FIName Utf8 -> Bool -> DescriptorProto -> [DescriptorInfo]
processMSG FIName Utf8
parent Bool
msgIsGroup DescriptorProto
msg =
let getKnownKeys :: ProtoName -> Seq FieldInfo
getKnownKeys ProtoName
protoName' = Seq FieldInfo -> Maybe (Seq FieldInfo) -> Seq FieldInfo
forall a. a -> Maybe a -> a
fromMaybe Seq FieldInfo
forall a. Seq a
Seq.empty (ProtoName -> Map ProtoName (Seq FieldInfo) -> Maybe (Seq FieldInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProtoName
protoName' Map ProtoName (Seq FieldInfo)
allKeys)
groups :: [Utf8]
groups = DescriptorProto -> [Utf8]
collectedGroups DescriptorProto
msg
checkGroup :: DescriptorProto -> Bool
checkGroup DescriptorProto
x = Utf8 -> [Utf8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Utf8 -> Maybe Utf8 -> Utf8
forall a. a -> Maybe a -> a
fromMaybe (String -> Utf8
forall a. String -> a
imp (String -> Utf8) -> String -> Utf8
forall a b. (a -> b) -> a -> b
$ String
"no message name in makeProtoInfo.processMSG.checkGroup:\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++DescriptorProto -> String
forall a. Show a => a -> String
show DescriptorProto
msg)
(DescriptorProto -> Maybe Utf8
D.DescriptorProto.name DescriptorProto
x))
[Utf8]
groups
parent' :: FIName Utf8
parent' = FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend FIName Utf8
parent [Utf8 -> IName Utf8
forall a. a -> IName a
IName (Maybe Utf8 -> Utf8
forall a. HasCallStack => Maybe a -> a
fromJust (DescriptorProto -> Maybe Utf8
D.DescriptorProto.name DescriptorProto
msg))]
in ReMap
-> FIName Utf8
-> (ProtoName -> Seq FieldInfo)
-> Bool
-> (Bool, Bool, Bool, Bool)
-> DescriptorProto
-> DescriptorInfo
makeDescriptorInfo' ReMap
reMap FIName Utf8
parent ProtoName -> Seq FieldInfo
getKnownKeys Bool
msgIsGroup (Bool
unknownField,Bool
lazyFieldsOpt,Bool
lenses,Bool
json) DescriptorProto
msg
DescriptorInfo -> [DescriptorInfo] -> [DescriptorInfo]
forall a. a -> [a] -> [a]
: (DescriptorProto -> [DescriptorInfo])
-> [DescriptorProto] -> [DescriptorInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\DescriptorProto
x -> FIName Utf8 -> Bool -> DescriptorProto -> [DescriptorInfo]
processMSG FIName Utf8
parent' (DescriptorProto -> Bool
checkGroup DescriptorProto
x) DescriptorProto
x)
(Seq DescriptorProto -> [DescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorProto -> Seq DescriptorProto
D.DescriptorProto.nested_type DescriptorProto
msg))
processENM :: FIName Utf8 -> DescriptorProto -> [EnumInfo]
processENM FIName Utf8
parent DescriptorProto
msg = (EnumDescriptorProto -> [EnumInfo] -> [EnumInfo])
-> [EnumInfo] -> [EnumDescriptorProto] -> [EnumInfo]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (EnumInfo -> [EnumInfo] -> [EnumInfo])
-> (EnumDescriptorProto -> EnumInfo)
-> EnumDescriptorProto
-> [EnumInfo]
-> [EnumInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReMap -> FIName Utf8 -> Bool -> EnumDescriptorProto -> EnumInfo
makeEnumInfo' ReMap
reMap FIName Utf8
parent' Bool
json) [EnumInfo]
nested
(Seq EnumDescriptorProto -> [EnumDescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorProto -> Seq EnumDescriptorProto
D.DescriptorProto.enum_type DescriptorProto
msg))
where parent' :: FIName Utf8
parent' = FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend FIName Utf8
parent [Utf8 -> IName Utf8
forall a. a -> IName a
IName (Maybe Utf8 -> Utf8
forall a. HasCallStack => Maybe a -> a
fromJust (DescriptorProto -> Maybe Utf8
D.DescriptorProto.name DescriptorProto
msg))]
nested :: [EnumInfo]
nested = (DescriptorProto -> [EnumInfo]) -> [DescriptorProto] -> [EnumInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FIName Utf8 -> DescriptorProto -> [EnumInfo]
processENM FIName Utf8
parent') (Seq DescriptorProto -> [DescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorProto -> Seq DescriptorProto
D.DescriptorProto.nested_type DescriptorProto
msg))
processONO :: FIName Utf8 -> DescriptorProto -> [OneofInfo]
processONO FIName Utf8
parent DescriptorProto
msg = ((Int32, OneofDescriptorProto) -> [OneofInfo] -> [OneofInfo])
-> [OneofInfo] -> [(Int32, OneofDescriptorProto)] -> [OneofInfo]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (OneofInfo -> [OneofInfo] -> [OneofInfo])
-> ((Int32, OneofDescriptorProto) -> OneofInfo)
-> (Int32, OneofDescriptorProto)
-> [OneofInfo]
-> [OneofInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReMap
-> FIName Utf8
-> Bool
-> DescriptorProto
-> (Int32, OneofDescriptorProto)
-> OneofInfo
makeOneofInfo' ReMap
reMap FIName Utf8
parent' Bool
lenses DescriptorProto
msg) [OneofInfo]
nested
([Int32]
-> [OneofDescriptorProto] -> [(Int32, OneofDescriptorProto)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int32
0..] (Seq OneofDescriptorProto -> [OneofDescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorProto -> Seq OneofDescriptorProto
D.DescriptorProto.oneof_decl DescriptorProto
msg)))
where parent' :: FIName Utf8
parent' = FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend FIName Utf8
parent [Utf8 -> IName Utf8
forall a. a -> IName a
IName (Maybe Utf8 -> Utf8
forall a. HasCallStack => Maybe a -> a
fromJust (DescriptorProto -> Maybe Utf8
D.DescriptorProto.name DescriptorProto
msg))]
nested :: [OneofInfo]
nested = (DescriptorProto -> [OneofInfo])
-> [DescriptorProto] -> [OneofInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FIName Utf8 -> DescriptorProto -> [OneofInfo]
processONO FIName Utf8
parent') (Seq DescriptorProto -> [DescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (DescriptorProto -> Seq DescriptorProto
D.DescriptorProto.nested_type DescriptorProto
msg))
makeProtoInfo (Bool, Bool, Bool, Bool)
_ NameMap
_ FileDescriptorProto
_ = String -> ProtoInfo
forall a. String -> a
imp (String -> ProtoInfo) -> String -> ProtoInfo
forall a b. (a -> b) -> a -> b
$ String
"makeProtoInfo: missing name or package"
makeEnumInfo' :: ReMap -> FIName Utf8 -> Bool -> D.EnumDescriptorProto -> EnumInfo
makeEnumInfo' :: ReMap -> FIName Utf8 -> Bool -> EnumDescriptorProto -> EnumInfo
makeEnumInfo' ReMap
reMap FIName Utf8
parent Bool
json
e :: EnumDescriptorProto
e@(D.EnumDescriptorProto.EnumDescriptorProto
{ name :: EnumDescriptorProto -> Maybe Utf8
D.EnumDescriptorProto.name = Just Utf8
rawName
, value :: EnumDescriptorProto -> Seq EnumValueDescriptorProto
D.EnumDescriptorProto.value = Seq EnumValueDescriptorProto
value })
= if Seq EnumValueDescriptorProto -> Bool
forall a. Seq a -> Bool
Seq.null Seq EnumValueDescriptorProto
value then String -> EnumInfo
forall a. String -> a
imp (String -> EnumInfo) -> String -> EnumInfo
forall a b. (a -> b) -> a -> b
$ String
"enum has no values: "String -> String -> String
forall a. [a] -> [a] -> [a]
++EnumDescriptorProto -> String
forall a. Show a => a -> String
show EnumDescriptorProto
e
else ProtoName -> [String] -> [(EnumCode, String)] -> Bool -> EnumInfo
EnumInfo ProtoName
protoName (ProtoName -> [String]
pnPath ProtoName
protoName) [(EnumCode, String)]
enumVals Bool
json
where protoName :: ProtoName
protoName = ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap (FIName Utf8 -> ProtoName) -> FIName Utf8 -> ProtoName
forall a b. (a -> b) -> a -> b
$ FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend FIName Utf8
parent [Utf8 -> IName Utf8
forall a. a -> IName a
IName Utf8
rawName]
enumVals ::[(EnumCode,String)]
enumVals :: [(EnumCode, String)]
enumVals = (EnumValueDescriptorProto
-> [(EnumCode, String)] -> [(EnumCode, String)])
-> [(EnumCode, String)]
-> Seq EnumValueDescriptorProto
-> [(EnumCode, String)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((:) ((EnumCode, String)
-> [(EnumCode, String)] -> [(EnumCode, String)])
-> (EnumValueDescriptorProto -> (EnumCode, String))
-> EnumValueDescriptorProto
-> [(EnumCode, String)]
-> [(EnumCode, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumValueDescriptorProto -> (EnumCode, String)
oneValue) [] Seq EnumValueDescriptorProto
value
where oneValue :: D.EnumValueDescriptorProto -> (EnumCode,String)
oneValue :: EnumValueDescriptorProto -> (EnumCode, String)
oneValue (D.EnumValueDescriptorProto.EnumValueDescriptorProto
{ name :: EnumValueDescriptorProto -> Maybe Utf8
D.EnumValueDescriptorProto.name = Just Utf8
name
, number :: EnumValueDescriptorProto -> Maybe Int32
D.EnumValueDescriptorProto.number = Just Int32
number })
= (Int32 -> EnumCode
EnumCode Int32
number,MName String -> String
forall a. MName a -> a
mName (MName String -> String)
-> (FIName Utf8 -> MName String) -> FIName Utf8 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoName -> MName String
baseName (ProtoName -> MName String)
-> (FIName Utf8 -> ProtoName) -> FIName Utf8 -> MName String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap (FIName Utf8 -> String) -> FIName Utf8 -> String
forall a b. (a -> b) -> a -> b
$ FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend (ProtoName -> FIName Utf8
protobufName ProtoName
protoName) [Utf8 -> IName Utf8
forall a. a -> IName a
IName Utf8
name])
oneValue EnumValueDescriptorProto
evdp = String -> (EnumCode, String)
forall a. String -> a
imp (String -> (EnumCode, String)) -> String -> (EnumCode, String)
forall a b. (a -> b) -> a -> b
$ String
"no name or number for evdp passed to makeEnumInfo.oneValue: "String -> String -> String
forall a. [a] -> [a] -> [a]
++EnumValueDescriptorProto -> String
forall a. Show a => a -> String
show EnumValueDescriptorProto
evdp
makeEnumInfo' ReMap
_ FIName Utf8
_ Bool
_ EnumDescriptorProto
_ = String -> EnumInfo
forall a. String -> a
imp String
"makeEnumInfo: missing name"
makeOneofInfo' :: ReMap -> FIName Utf8
-> Bool
-> D.DescriptorProto -> (Int32,D.OneofDescriptorProto) -> OneofInfo
makeOneofInfo' :: ReMap
-> FIName Utf8
-> Bool
-> DescriptorProto
-> (Int32, OneofDescriptorProto)
-> OneofInfo
makeOneofInfo' ReMap
reMap FIName Utf8
parent Bool
lenses DescriptorProto
parentProto
(Int32
n, e :: OneofDescriptorProto
e@(D.OneofDescriptorProto.OneofDescriptorProto
{ name :: OneofDescriptorProto -> Maybe Utf8
D.OneofDescriptorProto.name = Just Utf8
rawName }))
= ProtoName
-> ProtoFName -> [String] -> Seq KeyInfo -> Bool -> OneofInfo
OneofInfo ProtoName
protoName ProtoFName
protoFName (ProtoName -> [String]
pnPath ProtoName
protoName) Seq KeyInfo
fieldInfos Bool
lenses
where protoName :: ProtoName
protoName@(ProtoName FIName Utf8
x [MName String]
a [MName String]
b MName String
c) = ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap (FIName Utf8 -> ProtoName) -> FIName Utf8 -> ProtoName
forall a b. (a -> b) -> a -> b
$ FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend FIName Utf8
parent [Utf8 -> IName Utf8
forall a. a -> IName a
IName Utf8
rawName]
protoFName :: ProtoFName
protoFName = FIName Utf8
-> [MName String]
-> [MName String]
-> FName String
-> String
-> ProtoFName
ProtoFName FIName Utf8
x [MName String]
a [MName String]
b (MName String -> FName String
forall a b. Mangle a b => a -> b
mangle MName String
c) (if Bool
lenses then String
"_" else String
"")
rawFields :: Seq FieldDescriptorProto
rawFields = DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.field DescriptorProto
parentProto
rawFieldsOneof :: Seq FieldDescriptorProto
rawFieldsOneof = (FieldDescriptorProto -> Bool)
-> Seq FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter ((Maybe Int32 -> Maybe Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
n) (Maybe Int32 -> Bool)
-> (FieldDescriptorProto -> Maybe Int32)
-> FieldDescriptorProto
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescriptorProto -> Maybe Int32
D.FieldDescriptorProto.oneof_index) Seq FieldDescriptorProto
rawFields
getFieldProtoName :: FieldDescriptorProto -> ProtoName
getFieldProtoName FieldDescriptorProto
fdp
= case FieldDescriptorProto -> Maybe Utf8
D.FieldDescriptorProto.name FieldDescriptorProto
fdp of
Just Utf8
name -> ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap (FIName Utf8 -> ProtoName) -> FIName Utf8 -> ProtoName
forall a b. (a -> b) -> a -> b
$ FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend (ProtoName -> FIName Utf8
protobufName ProtoName
protoName) [Utf8 -> IName Utf8
forall a. a -> IName a
IName Utf8
name]
Maybe Utf8
Nothing -> String -> ProtoName
forall a. String -> a
imp (String -> ProtoName) -> String -> ProtoName
forall a b. (a -> b) -> a -> b
$ String
"getFieldProtoName: missing info in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FieldDescriptorProto -> String
forall a. Show a => a -> String
show FieldDescriptorProto
fdp
getFieldInfo :: FieldDescriptorProto -> FieldInfo
getFieldInfo = ReMap -> FIName Utf8 -> Bool -> FieldDescriptorProto -> FieldInfo
toFieldInfo' ReMap
reMap (ProtoName -> FIName Utf8
protobufName ProtoName
protoName) Bool
lenses
fieldInfos :: Seq KeyInfo
fieldInfos = (FieldDescriptorProto -> KeyInfo)
-> Seq FieldDescriptorProto -> Seq KeyInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FieldDescriptorProto
x->(FieldDescriptorProto -> ProtoName
getFieldProtoName FieldDescriptorProto
x,FieldDescriptorProto -> FieldInfo
getFieldInfo FieldDescriptorProto
x)) Seq FieldDescriptorProto
rawFieldsOneof
makeOneofInfo' ReMap
_ FIName Utf8
_ Bool
_ DescriptorProto
_ (Int32, OneofDescriptorProto)
_ = String -> OneofInfo
forall a. String -> a
imp String
"makeOneofInfo: missing name"
keyExtendee' :: ReMap -> D.FieldDescriptorProto.FieldDescriptorProto -> ProtoName
keyExtendee' :: ReMap -> FieldDescriptorProto -> ProtoName
keyExtendee' ReMap
reMap FieldDescriptorProto
f = case FieldDescriptorProto -> Maybe Utf8
D.FieldDescriptorProto.extendee FieldDescriptorProto
f of
Maybe Utf8
Nothing -> String -> ProtoName
forall a. String -> a
imp (String -> ProtoName) -> String -> ProtoName
forall a b. (a -> b) -> a -> b
$ String
"keyExtendee expected Just but found Nothing: "String -> String -> String
forall a. [a] -> [a] -> [a]
++FieldDescriptorProto -> String
forall a. Show a => a -> String
show FieldDescriptorProto
f
Just Utf8
extName -> ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap (Utf8 -> FIName Utf8
forall a. a -> FIName a
FIName Utf8
extName)
makeDescriptorInfo' :: ReMap -> FIName Utf8
-> (ProtoName -> Seq FieldInfo)
-> Bool
-> (Bool,Bool,Bool,Bool)
-> D.DescriptorProto -> DescriptorInfo
makeDescriptorInfo' :: ReMap
-> FIName Utf8
-> (ProtoName -> Seq FieldInfo)
-> Bool
-> (Bool, Bool, Bool, Bool)
-> DescriptorProto
-> DescriptorInfo
makeDescriptorInfo' ReMap
reMap FIName Utf8
parent ProtoName -> Seq FieldInfo
getKnownKeys Bool
msgIsGroup (Bool
unknownField,Bool
lazyFieldsOpt,Bool
lenses,Bool
json)
msg :: DescriptorProto
msg@(D.DescriptorProto.DescriptorProto
{ name :: DescriptorProto -> Maybe Utf8
D.DescriptorProto.name = Just Utf8
rawName
, field :: DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.field = Seq FieldDescriptorProto
rawFields
, oneof_decl :: DescriptorProto -> Seq OneofDescriptorProto
D.DescriptorProto.oneof_decl = Seq OneofDescriptorProto
rawOneofs
, extension :: DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.extension = Seq FieldDescriptorProto
rawKeys
, extension_range :: DescriptorProto -> Seq ExtensionRange
D.DescriptorProto.extension_range = Seq ExtensionRange
extension_range })
= let di :: DescriptorInfo
di = ProtoName
-> [String]
-> Bool
-> Seq FieldInfo
-> Seq OneofInfo
-> Seq KeyInfo
-> [(FieldId, FieldId)]
-> Seq FieldInfo
-> Bool
-> Bool
-> Bool
-> Bool
-> DescriptorInfo
DescriptorInfo ProtoName
protoName (ProtoName -> [String]
pnPath ProtoName
protoName) Bool
msgIsGroup
Seq FieldInfo
fieldInfos Seq OneofInfo
oneofInfos Seq KeyInfo
keyInfos [(FieldId, FieldId)]
extRangeList
(ProtoName -> Seq FieldInfo
getKnownKeys ProtoName
protoName)
Bool
unknownField Bool
lazyFieldsOpt Bool
lenses Bool
json
in DescriptorInfo
di
where protoName :: ProtoName
protoName = ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap (FIName Utf8 -> ProtoName) -> FIName Utf8 -> ProtoName
forall a b. (a -> b) -> a -> b
$ FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend FIName Utf8
parent [Utf8 -> IName Utf8
forall a. a -> IName a
IName Utf8
rawName]
rawFieldsNotOneof :: Seq FieldDescriptorProto
rawFieldsNotOneof = (FieldDescriptorProto -> Bool)
-> Seq FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\FieldDescriptorProto
x -> FieldDescriptorProto -> Maybe Int32
D.FieldDescriptorProto.oneof_index FieldDescriptorProto
x Maybe Int32 -> Maybe Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int32
forall a. Maybe a
Nothing) Seq FieldDescriptorProto
rawFields
fieldInfos :: Seq FieldInfo
fieldInfos = (FieldDescriptorProto -> FieldInfo)
-> Seq FieldDescriptorProto -> Seq FieldInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReMap -> FIName Utf8 -> Bool -> FieldDescriptorProto -> FieldInfo
toFieldInfo' ReMap
reMap (ProtoName -> FIName Utf8
protobufName ProtoName
protoName) Bool
lenses) Seq FieldDescriptorProto
rawFieldsNotOneof
oneofInfos :: Seq OneofInfo
oneofInfos = ((Int32, OneofDescriptorProto) -> Seq OneofInfo -> Seq OneofInfo)
-> Seq OneofInfo
-> [(Int32, OneofDescriptorProto)]
-> Seq OneofInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (OneofInfo -> Seq OneofInfo -> Seq OneofInfo
forall a. a -> Seq a -> Seq a
(<|) (OneofInfo -> Seq OneofInfo -> Seq OneofInfo)
-> ((Int32, OneofDescriptorProto) -> OneofInfo)
-> (Int32, OneofDescriptorProto)
-> Seq OneofInfo
-> Seq OneofInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReMap
-> FIName Utf8
-> Bool
-> DescriptorProto
-> (Int32, OneofDescriptorProto)
-> OneofInfo
makeOneofInfo' ReMap
reMap (ProtoName -> FIName Utf8
protobufName ProtoName
protoName) Bool
lenses DescriptorProto
msg) Seq OneofInfo
forall a. Seq a
Seq.empty
([Int32]
-> [OneofDescriptorProto] -> [(Int32, OneofDescriptorProto)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int32
0..] (Seq OneofDescriptorProto -> [OneofDescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq OneofDescriptorProto
rawOneofs))
keyInfos :: Seq KeyInfo
keyInfos = (FieldDescriptorProto -> KeyInfo)
-> Seq FieldDescriptorProto -> Seq KeyInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FieldDescriptorProto
f -> (ReMap -> FieldDescriptorProto -> ProtoName
keyExtendee' ReMap
reMap FieldDescriptorProto
f,ReMap -> FIName Utf8 -> Bool -> FieldDescriptorProto -> FieldInfo
toFieldInfo' ReMap
reMap (ProtoName -> FIName Utf8
protobufName ProtoName
protoName) Bool
lenses FieldDescriptorProto
f)) Seq FieldDescriptorProto
rawKeys
extRangeList :: [(FieldId, FieldId)]
extRangeList = ((FieldId, FieldId) -> [(FieldId, FieldId)])
-> [(FieldId, FieldId)] -> [(FieldId, FieldId)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FieldId, FieldId) -> [(FieldId, FieldId)]
forall b. (Ord b, Num b) => (b, b) -> [(b, b)]
check [(FieldId, FieldId)]
unchecked
where check :: (b, b) -> [(b, b)]
check x :: (b, b)
x@(b
lo,b
hi) | b
hi b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
lo = []
| b
hib -> b -> Bool
forall a. Ord a => a -> a -> Bool
<b
19000 Bool -> Bool -> Bool
|| b
19999b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<b
lo = [(b, b)
x]
| Bool
otherwise = ((b, b) -> [(b, b)]) -> [(b, b)] -> [(b, b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (b, b) -> [(b, b)]
check [(b
lo,b
18999),(b
20000,b
hi)]
unchecked :: [(FieldId, FieldId)]
unchecked = (ExtensionRange -> [(FieldId, FieldId)] -> [(FieldId, FieldId)])
-> [(FieldId, FieldId)]
-> Seq ExtensionRange
-> [(FieldId, FieldId)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((:) ((FieldId, FieldId)
-> [(FieldId, FieldId)] -> [(FieldId, FieldId)])
-> (ExtensionRange -> (FieldId, FieldId))
-> ExtensionRange
-> [(FieldId, FieldId)]
-> [(FieldId, FieldId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtensionRange -> (FieldId, FieldId)
extToPair) [] Seq ExtensionRange
extension_range
extToPair :: ExtensionRange -> (FieldId, FieldId)
extToPair (D.DescriptorProto.ExtensionRange
{ start :: ExtensionRange -> Maybe Int32
D.DescriptorProto.ExtensionRange.start = Maybe Int32
mStart
, end :: ExtensionRange -> Maybe Int32
D.DescriptorProto.ExtensionRange.end = Maybe Int32
mEnd }) =
(FieldId -> (Int32 -> FieldId) -> Maybe Int32 -> FieldId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FieldId
forall a. Bounded a => a
minBound Int32 -> FieldId
FieldId Maybe Int32
mStart, FieldId -> (Int32 -> FieldId) -> Maybe Int32 -> FieldId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FieldId
forall a. Bounded a => a
maxBound (Int32 -> FieldId
FieldId (Int32 -> FieldId) -> (Int32 -> Int32) -> Int32 -> FieldId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
forall a. Enum a => a -> a
pred) Maybe Int32
mEnd)
makeDescriptorInfo' ReMap
_ FIName Utf8
_ ProtoName -> Seq FieldInfo
_ Bool
_ (Bool, Bool, Bool, Bool)
_ DescriptorProto
_ = String -> DescriptorInfo
forall a. String -> a
imp (String -> DescriptorInfo) -> String -> DescriptorInfo
forall a b. (a -> b) -> a -> b
$ String
"makeDescriptorInfo: missing name"
toFieldInfo'
:: ReMap
-> FIName Utf8
-> Bool
-> D.FieldDescriptorProto
-> FieldInfo
toFieldInfo' :: ReMap -> FIName Utf8 -> Bool -> FieldDescriptorProto -> FieldInfo
toFieldInfo' ReMap
reMap FIName Utf8
parent Bool
lenses
f :: FieldDescriptorProto
f@(D.FieldDescriptorProto.FieldDescriptorProto
{ name :: FieldDescriptorProto -> Maybe Utf8
D.FieldDescriptorProto.name = Just Utf8
name
, number :: FieldDescriptorProto -> Maybe Int32
D.FieldDescriptorProto.number = Just Int32
number
, label :: FieldDescriptorProto -> Maybe Label
D.FieldDescriptorProto.label = Just Label
label
, type' :: FieldDescriptorProto -> Maybe Type
D.FieldDescriptorProto.type' = Just Type
type'
, type_name :: FieldDescriptorProto -> Maybe Utf8
D.FieldDescriptorProto.type_name = Maybe Utf8
mayTypeName
, default_value :: FieldDescriptorProto -> Maybe Utf8
D.FieldDescriptorProto.default_value = Maybe Utf8
mayRawDef
, options :: FieldDescriptorProto -> Maybe FieldOptions
D.FieldDescriptorProto.options = Maybe FieldOptions
mayOpt })
= FieldInfo
fieldInfo
where mayDef :: Maybe HsDefault
mayDef = FieldDescriptorProto -> Maybe HsDefault
parseDefaultValue FieldDescriptorProto
f
fieldInfo :: FieldInfo
fieldInfo = let (ProtoName FIName Utf8
x [MName String]
a [MName String]
b MName String
c) = ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap (FIName Utf8 -> ProtoName) -> FIName Utf8 -> ProtoName
forall a b. (a -> b) -> a -> b
$ FIName Utf8 -> [IName Utf8] -> FIName Utf8
forall a. Dotted a => FIName a -> [IName a] -> FIName a
fqAppend FIName Utf8
parent [Utf8 -> IName Utf8
forall a. a -> IName a
IName Utf8
name]
protoFName :: ProtoFName
protoFName = FIName Utf8
-> [MName String]
-> [MName String]
-> FName String
-> String
-> ProtoFName
ProtoFName FIName Utf8
x [MName String]
a [MName String]
b (MName String -> FName String
forall a b. Mangle a b => a -> b
mangle MName String
c) (if Bool
lenses then String
"_" else String
"")
fieldId :: FieldId
fieldId = (Int32 -> FieldId
FieldId (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
number))
fieldType :: FieldType
fieldType = (Int -> FieldType
FieldType (Type -> Int
forall a. Enum a => a -> Int
fromEnum Type
type'))
wt :: WireTag
wt | Bool
packedOption = FieldId -> WireTag
toPackedWireTag FieldId
fieldId
| Bool
otherwise = FieldId -> FieldType -> WireTag
toWireTag FieldId
fieldId FieldType
fieldType
wt2 :: Maybe (WireTag, WireTag)
wt2 | Bool
validPacked = (WireTag, WireTag) -> Maybe (WireTag, WireTag)
forall a. a -> Maybe a
Just (FieldId -> FieldType -> WireTag
toWireTag FieldId
fieldId FieldType
fieldType
,FieldId -> WireTag
toPackedWireTag FieldId
fieldId)
| Bool
otherwise = Maybe (WireTag, WireTag)
forall a. Maybe a
Nothing
wtLength :: Int64
wtLength = WireTag -> Int64
size'WireTag WireTag
wt
packedOption :: Bool
packedOption = case Maybe FieldOptions
mayOpt of
Just (D.FieldOptions { packed :: FieldOptions -> Maybe Bool
D.FieldOptions.packed = Just Bool
True }) -> Bool
True
Maybe FieldOptions
_ -> Bool
False
validPacked :: Bool
validPacked = Label -> FieldType -> Bool
isValidPacked Label
label FieldType
fieldType
in ProtoFName
-> FieldId
-> WireTag
-> Maybe (WireTag, WireTag)
-> Int64
-> Bool
-> Bool
-> Bool
-> Bool
-> FieldType
-> Maybe ProtoName
-> Maybe ByteString
-> Maybe HsDefault
-> FieldInfo
FieldInfo ProtoFName
protoFName
FieldId
fieldId
WireTag
wt
Maybe (WireTag, WireTag)
wt2
Int64
wtLength
Bool
packedOption
(Label
label Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
LABEL_REQUIRED)
(Label
label Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
LABEL_REPEATED)
Bool
validPacked
FieldType
fieldType
((Utf8 -> ProtoName) -> Maybe Utf8 -> Maybe ProtoName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReMap -> FIName Utf8 -> ProtoName
toHaskell ReMap
reMap (FIName Utf8 -> ProtoName)
-> (Utf8 -> FIName Utf8) -> Utf8 -> ProtoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8 -> FIName Utf8
forall a. a -> FIName a
FIName) Maybe Utf8
mayTypeName)
((Utf8 -> ByteString) -> Maybe Utf8 -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Utf8 -> ByteString
utf8 Maybe Utf8
mayRawDef)
Maybe HsDefault
mayDef
toFieldInfo' ReMap
_ FIName Utf8
_ Bool
_ FieldDescriptorProto
f = String -> FieldInfo
forall a. String -> a
imp (String -> FieldInfo) -> String -> FieldInfo
forall a b. (a -> b) -> a -> b
$ String
"toFieldInfo: missing info in "String -> String -> String
forall a. [a] -> [a] -> [a]
++FieldDescriptorProto -> String
forall a. Show a => a -> String
show FieldDescriptorProto
f
collectedGroups :: D.DescriptorProto -> [Utf8]
collectedGroups :: DescriptorProto -> [Utf8]
collectedGroups = [Maybe Utf8] -> [Utf8]
forall a. [Maybe a] -> [a]
catMaybes
([Maybe Utf8] -> [Utf8])
-> (DescriptorProto -> [Maybe Utf8]) -> DescriptorProto -> [Utf8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldDescriptorProto -> Maybe Utf8)
-> [FieldDescriptorProto] -> [Maybe Utf8]
forall a b. (a -> b) -> [a] -> [b]
map FieldDescriptorProto -> Maybe Utf8
D.FieldDescriptorProto.type_name
([FieldDescriptorProto] -> [Maybe Utf8])
-> (DescriptorProto -> [FieldDescriptorProto])
-> DescriptorProto
-> [Maybe Utf8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldDescriptorProto -> Bool)
-> [FieldDescriptorProto] -> [FieldDescriptorProto]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FieldDescriptorProto
f -> FieldDescriptorProto -> Maybe Type
D.FieldDescriptorProto.type' FieldDescriptorProto
f Maybe Type -> Maybe Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type -> Maybe Type
forall a. a -> Maybe a
Just Type
TYPE_GROUP)
([FieldDescriptorProto] -> [FieldDescriptorProto])
-> (DescriptorProto -> [FieldDescriptorProto])
-> DescriptorProto
-> [FieldDescriptorProto]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq FieldDescriptorProto -> [FieldDescriptorProto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
(Seq FieldDescriptorProto -> [FieldDescriptorProto])
-> (DescriptorProto -> Seq FieldDescriptorProto)
-> DescriptorProto
-> [FieldDescriptorProto]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.field
parseDefaultValue :: D.FieldDescriptorProto -> Maybe HsDefault
parseDefaultValue :: FieldDescriptorProto -> Maybe HsDefault
parseDefaultValue f :: FieldDescriptorProto
f@(D.FieldDescriptorProto.FieldDescriptorProto
{ type' :: FieldDescriptorProto -> Maybe Type
D.FieldDescriptorProto.type' = Maybe Type
type'
, default_value :: FieldDescriptorProto -> Maybe Utf8
D.FieldDescriptorProto.default_value = Maybe Utf8
mayRawDef })
= do Utf8
bs <- Maybe Utf8
mayRawDef
Type
t <- Maybe Type
type'
Utf8 -> Maybe HsDefault
todo <- case Type
t of
Type
TYPE_MESSAGE -> Maybe (Utf8 -> Maybe HsDefault)
forall a. Maybe a
Nothing
Type
TYPE_GROUP -> Maybe (Utf8 -> Maybe HsDefault)
forall a. Maybe a
Nothing
Type
TYPE_ENUM -> (Utf8 -> Maybe HsDefault) -> Maybe (Utf8 -> Maybe HsDefault)
forall a. a -> Maybe a
Just Utf8 -> Maybe HsDefault
parseDefEnum
Type
TYPE_BOOL -> (Utf8 -> Maybe HsDefault) -> Maybe (Utf8 -> Maybe HsDefault)
forall a. a -> Maybe a
Just Utf8 -> Maybe HsDefault
parseDefBool
Type
TYPE_BYTES -> (Utf8 -> Maybe HsDefault) -> Maybe (Utf8 -> Maybe HsDefault)
forall a. a -> Maybe a
Just Utf8 -> Maybe HsDefault
parseDefBytes
Type
TYPE_DOUBLE -> (Utf8 -> Maybe HsDefault) -> Maybe (Utf8 -> Maybe HsDefault)
forall a. a -> Maybe a
Just Utf8 -> Maybe HsDefault
parseDefDouble
Type
TYPE_FLOAT -> (Utf8 -> Maybe HsDefault) -> Maybe (Utf8 -> Maybe HsDefault)
forall a. a -> Maybe a
Just Utf8 -> Maybe HsDefault
parseDefFloat
Type
TYPE_STRING -> (Utf8 -> Maybe HsDefault) -> Maybe (Utf8 -> Maybe HsDefault)
forall a. a -> Maybe a
Just Utf8 -> Maybe HsDefault
parseDefString
Type
_ -> (Utf8 -> Maybe HsDefault) -> Maybe (Utf8 -> Maybe HsDefault)
forall a. a -> Maybe a
Just Utf8 -> Maybe HsDefault
parseDefInteger
case Utf8 -> Maybe HsDefault
todo Utf8
bs of
Maybe HsDefault
Nothing -> String -> Maybe HsDefault
forall a. HasCallStack => String -> a
error (String -> Maybe HsDefault) -> String -> Maybe HsDefault
forall a b. (a -> b) -> a -> b
$ String
"Could not parse as type "String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" the default value (raw) is "String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Utf8 -> String
forall a. Show a => a -> String
show Maybe Utf8
mayRawDef String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" for field "String -> String -> String
forall a. [a] -> [a] -> [a]
++FieldDescriptorProto -> String
forall a. Show a => a -> String
show FieldDescriptorProto
f
Just HsDefault
value -> HsDefault -> Maybe HsDefault
forall (m :: * -> *) a. Monad m => a -> m a
return HsDefault
value
parseDefEnum :: Utf8 -> Maybe HsDefault
parseDefEnum :: Utf8 -> Maybe HsDefault
parseDefEnum = HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (HsDefault -> Maybe HsDefault)
-> (Utf8 -> HsDefault) -> Utf8 -> Maybe HsDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDefault
HsDef'Enum (String -> HsDefault) -> (Utf8 -> String) -> Utf8 -> HsDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MName String -> String
forall a. MName a -> a
mName (MName String -> String)
-> (Utf8 -> MName String) -> Utf8 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IName String -> MName String
forall a b. Mangle a b => a -> b
mangle (IName String -> MName String)
-> (Utf8 -> IName String) -> Utf8 -> MName String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IName String
forall a. a -> IName a
IName (String -> IName String)
-> (Utf8 -> String) -> Utf8 -> IName String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8 -> String
uToString
{-# INLINE mayRead #-}
mayRead :: ReadS a -> String -> Maybe a
mayRead :: ReadS a -> String -> Maybe a
mayRead ReadS a
f String
s = case ReadS a
f String
s of [(a
a,String
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
a; [(a, String)]
_ -> Maybe a
forall a. Maybe a
Nothing
parseDefDouble :: Utf8 -> Maybe HsDefault
parseDefDouble :: Utf8 -> Maybe HsDefault
parseDefDouble Utf8
bs = case (Utf8 -> String
uToString Utf8
bs) of
String
"nan" -> HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (SomeRealFloat -> HsDefault
HsDef'RealFloat SomeRealFloat
SRF'nan)
String
"-inf" -> HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (SomeRealFloat -> HsDefault
HsDef'RealFloat SomeRealFloat
SRF'ninf)
String
"inf" -> HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (SomeRealFloat -> HsDefault
HsDef'RealFloat SomeRealFloat
SRF'inf)
String
s -> (Double -> HsDefault) -> Maybe Double -> Maybe HsDefault
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SomeRealFloat -> HsDefault
HsDef'RealFloat (SomeRealFloat -> HsDefault)
-> (Double -> SomeRealFloat) -> Double -> HsDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> SomeRealFloat
SRF'Rational (Rational -> SomeRealFloat)
-> (Double -> Rational) -> Double -> SomeRealFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) (Maybe Double -> Maybe HsDefault)
-> (String -> Maybe Double) -> String -> Maybe HsDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadS Double -> String -> Maybe Double
forall a. ReadS a -> String -> Maybe a
mayRead ReadS Double
reads'(String -> Maybe HsDefault) -> String -> Maybe HsDefault
forall a b. (a -> b) -> a -> b
$ String
s
where reads' :: ReadS Double
reads' :: ReadS Double
reads' = ReadS Double -> ReadS Double
forall a t. Num a => (String -> [(a, t)]) -> String -> [(a, t)]
readSigned' ReadS Double
forall a. Read a => ReadS a
reads
parseDefFloat :: Utf8 -> Maybe HsDefault
parseDefFloat :: Utf8 -> Maybe HsDefault
parseDefFloat Utf8
bs = case (Utf8 -> String
uToString Utf8
bs) of
String
"nan" -> HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (SomeRealFloat -> HsDefault
HsDef'RealFloat SomeRealFloat
SRF'nan)
String
"-inf" -> HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (SomeRealFloat -> HsDefault
HsDef'RealFloat SomeRealFloat
SRF'ninf)
String
"inf" -> HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (SomeRealFloat -> HsDefault
HsDef'RealFloat SomeRealFloat
SRF'inf)
String
s -> (Float -> HsDefault) -> Maybe Float -> Maybe HsDefault
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SomeRealFloat -> HsDefault
HsDef'RealFloat (SomeRealFloat -> HsDefault)
-> (Float -> SomeRealFloat) -> Float -> HsDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> SomeRealFloat
SRF'Rational (Rational -> SomeRealFloat)
-> (Float -> Rational) -> Float -> SomeRealFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational) (Maybe Float -> Maybe HsDefault)
-> (String -> Maybe Float) -> String -> Maybe HsDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadS Float -> String -> Maybe Float
forall a. ReadS a -> String -> Maybe a
mayRead ReadS Float
reads'(String -> Maybe HsDefault) -> String -> Maybe HsDefault
forall a b. (a -> b) -> a -> b
$ String
s
where reads' :: ReadS Float
reads' :: ReadS Float
reads' = ReadS Float -> ReadS Float
forall a t. Num a => (String -> [(a, t)]) -> String -> [(a, t)]
readSigned' ReadS Float
forall a. Read a => ReadS a
reads
parseDefString :: Utf8 -> Maybe HsDefault
parseDefString :: Utf8 -> Maybe HsDefault
parseDefString Utf8
bs = HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (ByteString -> HsDefault
HsDef'ByteString (Utf8 -> ByteString
utf8 Utf8
bs))
parseDefBytes :: Utf8 -> Maybe HsDefault
parseDefBytes :: Utf8 -> Maybe HsDefault
parseDefBytes Utf8
bs = HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (ByteString -> HsDefault
HsDef'ByteString (Utf8 -> ByteString
utf8 Utf8
bs))
parseDefInteger :: Utf8 -> Maybe HsDefault
parseDefInteger :: Utf8 -> Maybe HsDefault
parseDefInteger Utf8
bs = (Integer -> HsDefault) -> Maybe Integer -> Maybe HsDefault
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> HsDefault
HsDef'Integer (Maybe Integer -> Maybe HsDefault)
-> (Utf8 -> Maybe Integer) -> Utf8 -> Maybe HsDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadS Integer -> String -> Maybe Integer
forall a. ReadS a -> String -> Maybe a
mayRead ReadS Integer
checkSign (String -> Maybe Integer)
-> (Utf8 -> String) -> Utf8 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8 -> String
uToString (Utf8 -> Maybe HsDefault) -> Utf8 -> Maybe HsDefault
forall a b. (a -> b) -> a -> b
$ Utf8
bs
where checkSign :: ReadS Integer
checkSign = ReadS Integer -> ReadS Integer
forall a t. Num a => (String -> [(a, t)]) -> String -> [(a, t)]
readSigned' ReadS Integer
forall a. (Eq a, Num a) => String -> [(a, String)]
checkBase
checkBase :: String -> [(a, String)]
checkBase (Char
'0':Char
'x':xs :: String
xs@(Char
_:String
_)) = String -> [(a, String)]
forall a. (Eq a, Num a) => String -> [(a, String)]
readHex String
xs
checkBase (Char
'0':xs :: String
xs@(Char
_:String
_)) = String -> [(a, String)]
forall a. (Eq a, Num a) => String -> [(a, String)]
readOct String
xs
checkBase String
xs = String -> [(a, String)]
forall a. (Eq a, Num a) => String -> [(a, String)]
readDec String
xs
parseDefBool :: Utf8 -> Maybe HsDefault
parseDefBool :: Utf8 -> Maybe HsDefault
parseDefBool Utf8
bs | Utf8
bs Utf8 -> Utf8 -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Utf8
uFromString String
"true" = HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (Bool -> HsDefault
HsDef'Bool Bool
True)
| Utf8
bs Utf8 -> Utf8 -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Utf8
uFromString String
"false" = HsDefault -> Maybe HsDefault
forall a. a -> Maybe a
Just (Bool -> HsDefault
HsDef'Bool Bool
False)
| Bool
otherwise = Maybe HsDefault
forall a. Maybe a
Nothing
readSigned' :: (Num a) => ([Char] -> [(a, t)]) -> [Char] -> [(a, t)]
readSigned' :: (String -> [(a, t)]) -> String -> [(a, t)]
readSigned' String -> [(a, t)]
f (Char
'-':String
xs) = ((a, t) -> (a, t)) -> [(a, t)] -> [(a, t)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
v,t
s) -> (-a
v,t
s)) ([(a, t)] -> [(a, t)])
-> (String -> [(a, t)]) -> String -> [(a, t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(a, t)]
f (String -> [(a, t)]) -> String -> [(a, t)]
forall a b. (a -> b) -> a -> b
$ String
xs
readSigned' String -> [(a, t)]
f (Char
'+':String
xs) = String -> [(a, t)]
f String
xs
readSigned' String -> [(a, t)]
f String
xs = String -> [(a, t)]
f String
xs
isValidPacked :: Label -> FieldType -> Bool
isValidPacked :: Label -> FieldType -> Bool
isValidPacked Label
LABEL_REPEATED FieldType
fieldType =
case FieldType
fieldType of
FieldType
9 -> Bool
False
FieldType
10 -> Bool
False
FieldType
11 -> Bool
False
FieldType
12 -> Bool
False
FieldType
_ -> Bool
True
isValidPacked Label
_ FieldType
_ = Bool
False