{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}
{-| This module provides a less verbose API for accessing the options
    of the various descriptor messages types.  There are seven
    different option types.  The EnumValueOptions are not currently
    settable in the proto file.  To access extension keys the
    descendKey functions are provided as the descend functions ignore
    them.  The 'toDP', 'toEP', 'toSP' are type-specific descents that
    are demonstrated in the the tests below.  They are useful in that
    they provide more information for the type-checker.  The 'toFP',
    'toEVP', and 'toMP' are fully type-specific descents but are
    needed to make the tests below type-check, though they could have
    been used in 'test4', test5', and 'test7'.

> import Text.DescriptorProtos.Options
> import Text.DescriptorProtos(fileDescriptorProto)
> 
> test1 :: D.FileOptions
> test1 = options fileDescriptorProto
> 
> test2 :: Maybe D.MessageOptions
> test2 = return fileDescriptorProto >>= descend "FieldDescriptorProto" >>= return . options
> 
> test3 :: Maybe D.EnumOptions
> test3 = return fileDescriptorProto >>= toDP "FieldDescriptorProto" >>= descend "Type" >>= return . options
> 
> test4 :: Maybe D.EnumValueOptions
> test4 = return fileDescriptorProto >>= toDP "FieldDescriptorProto" >>= toEP "Type" >>= descend "TYPE_DOUBLE" >>= return . options
> 
> test5 :: Maybe D.FieldOptions
> test5 = return fileDescriptorProto >>= toDP "DescriptorProto" >>= toDP "ExtensionRange" >>= descend "start" >>= return . options
> 
> test6 :: Maybe D.ServiceOptions
> test6 = return fileDescriptorProto >>= descend "ImaginaryService" >>= return . options
> 
> test7 :: Maybe D.MethodOptions
> test7 = return fileDescriptorProto >>= toSP "ImaginaryService" >>= descend "ImaginaryMethod" >>= return . options
-}
module Text.DescriptorProtos.Options(descend,descendKey
                                    ,toDP,toEP,toSP,toFP,toEVP,toMP
                                    ,NameAndOptions(name,options),DescendClass(descend'),DescendKey(descendKey')
                                    ,D.FileDescriptorProto,D.DescriptorProto,D.EnumDescriptorProto
                                    ,D.EnumValueDescriptorProto,D.FieldDescriptorProto
                                    ,D.ServiceDescriptorProto,D.MethodDescriptorProto
                                    ,D.EnumOptions,D.EnumValueOptions,D.FieldOptions
                                    ,D.FileOptions,D.MessageOptions,D.MethodOptions,D.ServiceOptions) 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(ExtensionRange(ExtensionRange))
import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.ExtensionRange(ExtensionRange(..))
import qualified Text.DescriptorProtos.EnumDescriptorProto            as D(EnumDescriptorProto(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 qualified Text.DescriptorProtos.FieldDescriptorProto.Type      as D(Type)
import           Text.DescriptorProtos.FieldDescriptorProto.Type      as D.Type(Type(..))
import qualified Text.DescriptorProtos.FileDescriptorProto            as D(FileDescriptorProto)
import qualified Text.DescriptorProtos.FileDescriptorProto            as D.FileDescriptorProto(FileDescriptorProto(..))
import qualified Text.DescriptorProtos.MethodDescriptorProto          as D(MethodDescriptorProto)
import qualified Text.DescriptorProtos.MethodDescriptorProto          as D.MethodDescriptorProto(MethodDescriptorProto(..))
import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D(ServiceDescriptorProto)
import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D.ServiceDescriptorProto(ServiceDescriptorProto(..))
import qualified Text.DescriptorProtos.UninterpretedOption            as D(UninterpretedOption)
import qualified Text.DescriptorProtos.UninterpretedOption            as D.UninterpretedOption(UninterpretedOption(..))
import qualified Text.DescriptorProtos.UninterpretedOption.NamePart   as D(NamePart(NamePart))
import qualified Text.DescriptorProtos.UninterpretedOption.NamePart   as D.NamePart(NamePart(..))
import qualified Text.DescriptorProtos.EnumOptions      as D(EnumOptions)
import qualified Text.DescriptorProtos.EnumOptions      as D.EnumOptions(EnumOptions(..))
import qualified Text.DescriptorProtos.EnumValueOptions as D(EnumValueOptions)
import qualified Text.DescriptorProtos.EnumValueOptions as D.EnumValueOptions(EnumValueOptions(..))
import qualified Text.DescriptorProtos.FieldOptions     as D(FieldOptions)
import qualified Text.DescriptorProtos.FieldOptions     as D.FieldOptions(FieldOptions(..))
import qualified Text.DescriptorProtos.FileOptions      as D(FileOptions)
import qualified Text.DescriptorProtos.FileOptions      as D.FileOptions(FileOptions(..))
import qualified Text.DescriptorProtos.MessageOptions   as D(MessageOptions)
import qualified Text.DescriptorProtos.MessageOptions   as D.MessageOptions(MessageOptions(..))
import qualified Text.DescriptorProtos.MethodOptions    as D(MethodOptions)
import qualified Text.DescriptorProtos.MethodOptions    as D.MethodOptions(MethodOptions(..))
import qualified Text.DescriptorProtos.ServiceOptions   as D(ServiceOptions)
import qualified Text.DescriptorProtos.ServiceOptions   as D.ServiceOptions(ServiceOptions(..))

import Text.DescriptorProtos(fileDescriptorProto) -- for testing

import Data.Maybe(listToMaybe)
import Text.ProtocolBuffers(fromString,Utf8,getVal,Seq)
import qualified Data.Foldable as F(toList)

class DescendClass a c where
  descend' :: a -> Utf8 -> (Maybe c)

descend :: DescendClass a c => String -> a -> Maybe c
descend :: String -> a -> Maybe c
descend = (a -> Utf8 -> Maybe c) -> Utf8 -> a -> Maybe c
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Utf8 -> Maybe c
forall a c. DescendClass a c => a -> Utf8 -> Maybe c
descend' (Utf8 -> a -> Maybe c)
-> (String -> Utf8) -> String -> a -> Maybe c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8
fromString

class DescendKey a where
  descendKey' :: a -> Utf8 -> Maybe D.FieldDescriptorProto

descendKey :: DescendKey a => String -> a -> Maybe D.FieldDescriptorProto
descendKey :: String -> a -> Maybe FieldDescriptorProto
descendKey = (a -> Utf8 -> Maybe FieldDescriptorProto)
-> Utf8 -> a -> Maybe FieldDescriptorProto
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Utf8 -> Maybe FieldDescriptorProto
forall a. DescendKey a => a -> Utf8 -> Maybe FieldDescriptorProto
descendKey' (Utf8 -> a -> Maybe FieldDescriptorProto)
-> (String -> Utf8) -> String -> a -> Maybe FieldDescriptorProto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8
fromString

class NameAndOptions a opt | a -> opt, opt -> a where
  name :: a -> Utf8
  options :: a -> opt

-- helper
search :: (NameAndOptions a b) => Seq a -> Utf8 -> Maybe a
search :: Seq a -> Utf8 -> Maybe a
search Seq a
s Utf8
n = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [ a
m | a
m <- Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq a
s, Utf8
n Utf8 -> Utf8 -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Utf8
forall a opt. NameAndOptions a opt => a -> Utf8
name a
m ]

instance DescendClass D.DescriptorProto D.DescriptorProto where
  descend' :: DescriptorProto -> Utf8 -> Maybe DescriptorProto
descend' DescriptorProto
dp = Seq DescriptorProto -> Utf8 -> Maybe DescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (DescriptorProto -> Seq DescriptorProto
D.DescriptorProto.nested_type DescriptorProto
dp)

instance DescendClass D.DescriptorProto D.EnumDescriptorProto where
  descend' :: DescriptorProto -> Utf8 -> Maybe EnumDescriptorProto
descend' DescriptorProto
dp = Seq EnumDescriptorProto -> Utf8 -> Maybe EnumDescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (DescriptorProto -> Seq EnumDescriptorProto
D.DescriptorProto.enum_type DescriptorProto
dp)

instance DescendClass D.DescriptorProto D.FieldDescriptorProto where
  descend' :: DescriptorProto -> Utf8 -> Maybe FieldDescriptorProto
descend' DescriptorProto
dp = Seq FieldDescriptorProto -> Utf8 -> Maybe FieldDescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.field DescriptorProto
dp)

instance DescendClass D.FileDescriptorProto D.DescriptorProto where
  descend' :: FileDescriptorProto -> Utf8 -> Maybe DescriptorProto
descend' FileDescriptorProto
dp = Seq DescriptorProto -> Utf8 -> Maybe DescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (FileDescriptorProto -> Seq DescriptorProto
D.FileDescriptorProto.message_type FileDescriptorProto
dp)

instance DescendClass D.FileDescriptorProto D.EnumDescriptorProto where
  descend' :: FileDescriptorProto -> Utf8 -> Maybe EnumDescriptorProto
descend' FileDescriptorProto
dp = Seq EnumDescriptorProto -> Utf8 -> Maybe EnumDescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (FileDescriptorProto -> Seq EnumDescriptorProto
D.FileDescriptorProto.enum_type FileDescriptorProto
dp)

instance DescendClass D.FileDescriptorProto D.ServiceDescriptorProto where
  descend' :: FileDescriptorProto -> Utf8 -> Maybe ServiceDescriptorProto
descend' FileDescriptorProto
dp = Seq ServiceDescriptorProto -> Utf8 -> Maybe ServiceDescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (FileDescriptorProto -> Seq ServiceDescriptorProto
D.FileDescriptorProto.service FileDescriptorProto
dp)

instance DescendClass D.EnumDescriptorProto D.EnumValueDescriptorProto where
  descend' :: EnumDescriptorProto -> Utf8 -> Maybe EnumValueDescriptorProto
descend' EnumDescriptorProto
dp = Seq EnumValueDescriptorProto
-> Utf8 -> Maybe EnumValueDescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (EnumDescriptorProto -> Seq EnumValueDescriptorProto
D.EnumDescriptorProto.value EnumDescriptorProto
dp)

instance DescendClass D.ServiceDescriptorProto D.MethodDescriptorProto where
  descend' :: ServiceDescriptorProto -> Utf8 -> Maybe MethodDescriptorProto
descend' ServiceDescriptorProto
dp = Seq MethodDescriptorProto -> Utf8 -> Maybe MethodDescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (ServiceDescriptorProto -> Seq MethodDescriptorProto
D.ServiceDescriptorProto.method ServiceDescriptorProto
dp)

instance DescendKey D.FileDescriptorProto where
  descendKey' :: FileDescriptorProto -> Utf8 -> Maybe FieldDescriptorProto
descendKey' FileDescriptorProto
dp = Seq FieldDescriptorProto -> Utf8 -> Maybe FieldDescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (FileDescriptorProto -> Seq FieldDescriptorProto
D.FileDescriptorProto.extension FileDescriptorProto
dp)

instance DescendKey D.DescriptorProto where
  descendKey' :: DescriptorProto -> Utf8 -> Maybe FieldDescriptorProto
descendKey' DescriptorProto
dp = Seq FieldDescriptorProto -> Utf8 -> Maybe FieldDescriptorProto
forall a b. NameAndOptions a b => Seq a -> Utf8 -> Maybe a
search (DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.extension DescriptorProto
dp)

instance NameAndOptions D.FileDescriptorProto D.FileOptions where
  name :: FileDescriptorProto -> Utf8
name = (FileDescriptorProto
 -> (FileDescriptorProto -> Maybe Utf8) -> Utf8)
-> (FileDescriptorProto -> Maybe Utf8)
-> FileDescriptorProto
-> Utf8
forall a b c. (a -> b -> c) -> b -> a -> c
flip FileDescriptorProto -> (FileDescriptorProto -> Maybe Utf8) -> Utf8
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal FileDescriptorProto -> Maybe Utf8
D.FileDescriptorProto.name
  options :: FileDescriptorProto -> FileOptions
options = (FileDescriptorProto
 -> (FileDescriptorProto -> Maybe FileOptions) -> FileOptions)
-> (FileDescriptorProto -> Maybe FileOptions)
-> FileDescriptorProto
-> FileOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip FileDescriptorProto
-> (FileDescriptorProto -> Maybe FileOptions) -> FileOptions
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal FileDescriptorProto -> Maybe FileOptions
D.FileDescriptorProto.options

instance NameAndOptions D.DescriptorProto D.MessageOptions where
  name :: DescriptorProto -> Utf8
name = (DescriptorProto -> (DescriptorProto -> Maybe Utf8) -> Utf8)
-> (DescriptorProto -> Maybe Utf8) -> DescriptorProto -> Utf8
forall a b c. (a -> b -> c) -> b -> a -> c
flip DescriptorProto -> (DescriptorProto -> Maybe Utf8) -> Utf8
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal DescriptorProto -> Maybe Utf8
D.DescriptorProto.name
  options :: DescriptorProto -> MessageOptions
options = (DescriptorProto
 -> (DescriptorProto -> Maybe MessageOptions) -> MessageOptions)
-> (DescriptorProto -> Maybe MessageOptions)
-> DescriptorProto
-> MessageOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip DescriptorProto
-> (DescriptorProto -> Maybe MessageOptions) -> MessageOptions
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal DescriptorProto -> Maybe MessageOptions
D.DescriptorProto.options

instance NameAndOptions D.FieldDescriptorProto D.FieldOptions where
  name :: FieldDescriptorProto -> Utf8
name = (FieldDescriptorProto
 -> (FieldDescriptorProto -> Maybe Utf8) -> Utf8)
-> (FieldDescriptorProto -> Maybe Utf8)
-> FieldDescriptorProto
-> Utf8
forall a b c. (a -> b -> c) -> b -> a -> c
flip FieldDescriptorProto
-> (FieldDescriptorProto -> Maybe Utf8) -> Utf8
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal FieldDescriptorProto -> Maybe Utf8
D.FieldDescriptorProto.name
  options :: FieldDescriptorProto -> FieldOptions
options = (FieldDescriptorProto
 -> (FieldDescriptorProto -> Maybe FieldOptions) -> FieldOptions)
-> (FieldDescriptorProto -> Maybe FieldOptions)
-> FieldDescriptorProto
-> FieldOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip FieldDescriptorProto
-> (FieldDescriptorProto -> Maybe FieldOptions) -> FieldOptions
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal FieldDescriptorProto -> Maybe FieldOptions
D.FieldDescriptorProto.options

instance NameAndOptions D.ServiceDescriptorProto D.ServiceOptions where
  name :: ServiceDescriptorProto -> Utf8
name = (ServiceDescriptorProto
 -> (ServiceDescriptorProto -> Maybe Utf8) -> Utf8)
-> (ServiceDescriptorProto -> Maybe Utf8)
-> ServiceDescriptorProto
-> Utf8
forall a b c. (a -> b -> c) -> b -> a -> c
flip ServiceDescriptorProto
-> (ServiceDescriptorProto -> Maybe Utf8) -> Utf8
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal ServiceDescriptorProto -> Maybe Utf8
D.ServiceDescriptorProto.name
  options :: ServiceDescriptorProto -> ServiceOptions
options = (ServiceDescriptorProto
 -> (ServiceDescriptorProto -> Maybe ServiceOptions)
 -> ServiceOptions)
-> (ServiceDescriptorProto -> Maybe ServiceOptions)
-> ServiceDescriptorProto
-> ServiceOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip ServiceDescriptorProto
-> (ServiceDescriptorProto -> Maybe ServiceOptions)
-> ServiceOptions
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal ServiceDescriptorProto -> Maybe ServiceOptions
D.ServiceDescriptorProto.options

instance NameAndOptions D.MethodDescriptorProto D.MethodOptions where
  name :: MethodDescriptorProto -> Utf8
name = (MethodDescriptorProto
 -> (MethodDescriptorProto -> Maybe Utf8) -> Utf8)
-> (MethodDescriptorProto -> Maybe Utf8)
-> MethodDescriptorProto
-> Utf8
forall a b c. (a -> b -> c) -> b -> a -> c
flip MethodDescriptorProto
-> (MethodDescriptorProto -> Maybe Utf8) -> Utf8
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal MethodDescriptorProto -> Maybe Utf8
D.MethodDescriptorProto.name
  options :: MethodDescriptorProto -> MethodOptions
options = (MethodDescriptorProto
 -> (MethodDescriptorProto -> Maybe MethodOptions) -> MethodOptions)
-> (MethodDescriptorProto -> Maybe MethodOptions)
-> MethodDescriptorProto
-> MethodOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip MethodDescriptorProto
-> (MethodDescriptorProto -> Maybe MethodOptions) -> MethodOptions
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal MethodDescriptorProto -> Maybe MethodOptions
D.MethodDescriptorProto.options

instance NameAndOptions D.EnumValueDescriptorProto D.EnumValueOptions where
  name :: EnumValueDescriptorProto -> Utf8
name = (EnumValueDescriptorProto
 -> (EnumValueDescriptorProto -> Maybe Utf8) -> Utf8)
-> (EnumValueDescriptorProto -> Maybe Utf8)
-> EnumValueDescriptorProto
-> Utf8
forall a b c. (a -> b -> c) -> b -> a -> c
flip EnumValueDescriptorProto
-> (EnumValueDescriptorProto -> Maybe Utf8) -> Utf8
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal EnumValueDescriptorProto -> Maybe Utf8
D.EnumValueDescriptorProto.name
  options :: EnumValueDescriptorProto -> EnumValueOptions
options = (EnumValueDescriptorProto
 -> (EnumValueDescriptorProto -> Maybe EnumValueOptions)
 -> EnumValueOptions)
-> (EnumValueDescriptorProto -> Maybe EnumValueOptions)
-> EnumValueDescriptorProto
-> EnumValueOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip EnumValueDescriptorProto
-> (EnumValueDescriptorProto -> Maybe EnumValueOptions)
-> EnumValueOptions
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal EnumValueDescriptorProto -> Maybe EnumValueOptions
D.EnumValueDescriptorProto.options

instance NameAndOptions D.EnumDescriptorProto D.EnumOptions where
  name :: EnumDescriptorProto -> Utf8
name = (EnumDescriptorProto
 -> (EnumDescriptorProto -> Maybe Utf8) -> Utf8)
-> (EnumDescriptorProto -> Maybe Utf8)
-> EnumDescriptorProto
-> Utf8
forall a b c. (a -> b -> c) -> b -> a -> c
flip EnumDescriptorProto -> (EnumDescriptorProto -> Maybe Utf8) -> Utf8
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal EnumDescriptorProto -> Maybe Utf8
D.EnumDescriptorProto.name
  options :: EnumDescriptorProto -> EnumOptions
options = (EnumDescriptorProto
 -> (EnumDescriptorProto -> Maybe EnumOptions) -> EnumOptions)
-> (EnumDescriptorProto -> Maybe EnumOptions)
-> EnumDescriptorProto
-> EnumOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip EnumDescriptorProto
-> (EnumDescriptorProto -> Maybe EnumOptions) -> EnumOptions
forall msg a b. MessageAPI msg a b => msg -> a -> b
getVal EnumDescriptorProto -> Maybe EnumOptions
D.EnumDescriptorProto.options

toDP :: DescendClass a D.DescriptorProto => String -> a -> Maybe D.DescriptorProto
toDP :: String -> a -> Maybe DescriptorProto
toDP String
s a
a = a -> Utf8 -> Maybe DescriptorProto
forall a c. DescendClass a c => a -> Utf8 -> Maybe c
descend' a
a (String -> Utf8
fromString String
s)

toEP :: DescendClass a D.EnumDescriptorProto => String -> a -> Maybe D.EnumDescriptorProto
toEP :: String -> a -> Maybe EnumDescriptorProto
toEP String
s a
a = a -> Utf8 -> Maybe EnumDescriptorProto
forall a c. DescendClass a c => a -> Utf8 -> Maybe c
descend' a
a (String -> Utf8
fromString String
s)

toSP :: String -> D.FileDescriptorProto -> Maybe D.ServiceDescriptorProto
toSP :: String -> FileDescriptorProto -> Maybe ServiceDescriptorProto
toSP String
s FileDescriptorProto
a = FileDescriptorProto -> Utf8 -> Maybe ServiceDescriptorProto
forall a c. DescendClass a c => a -> Utf8 -> Maybe c
descend' FileDescriptorProto
a (String -> Utf8
fromString String
s)

toFP :: String -> D.DescriptorProto -> Maybe D.FieldDescriptorProto
toFP :: String -> DescriptorProto -> Maybe FieldDescriptorProto
toFP String
s DescriptorProto
a = DescriptorProto -> Utf8 -> Maybe FieldDescriptorProto
forall a c. DescendClass a c => a -> Utf8 -> Maybe c
descend' DescriptorProto
a (String -> Utf8
fromString String
s)

toEVP :: String -> D.EnumDescriptorProto -> Maybe D.EnumValueDescriptorProto
toEVP :: String -> EnumDescriptorProto -> Maybe EnumValueDescriptorProto
toEVP String
s EnumDescriptorProto
a = EnumDescriptorProto -> Utf8 -> Maybe EnumValueDescriptorProto
forall a c. DescendClass a c => a -> Utf8 -> Maybe c
descend' EnumDescriptorProto
a (String -> Utf8
fromString String
s)

toMP :: String -> D.ServiceDescriptorProto -> Maybe D.MethodDescriptorProto
toMP :: String -> ServiceDescriptorProto -> Maybe MethodDescriptorProto
toMP String
s ServiceDescriptorProto
a = ServiceDescriptorProto -> Utf8 -> Maybe MethodDescriptorProto
forall a c. DescendClass a c => a -> Utf8 -> Maybe c
descend' ServiceDescriptorProto
a (String -> Utf8
fromString String
s)

test1 :: D.FileOptions
test1 :: FileOptions
test1 = FileDescriptorProto -> FileOptions
forall a opt. NameAndOptions a opt => a -> opt
options FileDescriptorProto
fileDescriptorProto

test2 :: Maybe D.MessageOptions
test2 :: Maybe MessageOptions
test2 = FileDescriptorProto -> Maybe FileDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FileDescriptorProto
fileDescriptorProto Maybe FileDescriptorProto
-> (FileDescriptorProto -> Maybe DescriptorProto)
-> Maybe DescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> FileDescriptorProto -> Maybe DescriptorProto
forall a c. DescendClass a c => String -> a -> Maybe c
descend String
"FieldDescriptorProto" Maybe DescriptorProto
-> (DescriptorProto -> Maybe MessageOptions)
-> Maybe MessageOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MessageOptions -> Maybe MessageOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (MessageOptions -> Maybe MessageOptions)
-> (DescriptorProto -> MessageOptions)
-> DescriptorProto
-> Maybe MessageOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorProto -> MessageOptions
forall a opt. NameAndOptions a opt => a -> opt
options

test3 :: Maybe D.EnumOptions
test3 :: Maybe EnumOptions
test3 = FileDescriptorProto -> Maybe FileDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FileDescriptorProto
fileDescriptorProto Maybe FileDescriptorProto
-> (FileDescriptorProto -> Maybe DescriptorProto)
-> Maybe DescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> FileDescriptorProto -> Maybe DescriptorProto
forall a.
DescendClass a DescriptorProto =>
String -> a -> Maybe DescriptorProto
toDP String
"FieldDescriptorProto" Maybe DescriptorProto
-> (DescriptorProto -> Maybe EnumDescriptorProto)
-> Maybe EnumDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> DescriptorProto -> Maybe EnumDescriptorProto
forall a c. DescendClass a c => String -> a -> Maybe c
descend String
"Type" Maybe EnumDescriptorProto
-> (EnumDescriptorProto -> Maybe EnumOptions) -> Maybe EnumOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EnumOptions -> Maybe EnumOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumOptions -> Maybe EnumOptions)
-> (EnumDescriptorProto -> EnumOptions)
-> EnumDescriptorProto
-> Maybe EnumOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumDescriptorProto -> EnumOptions
forall a opt. NameAndOptions a opt => a -> opt
options

test4 :: Maybe D.EnumValueOptions
test4 :: Maybe EnumValueOptions
test4 = FileDescriptorProto -> Maybe FileDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FileDescriptorProto
fileDescriptorProto Maybe FileDescriptorProto
-> (FileDescriptorProto -> Maybe DescriptorProto)
-> Maybe DescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> FileDescriptorProto -> Maybe DescriptorProto
forall a.
DescendClass a DescriptorProto =>
String -> a -> Maybe DescriptorProto
toDP String
"FieldDescriptorProto" Maybe DescriptorProto
-> (DescriptorProto -> Maybe EnumDescriptorProto)
-> Maybe EnumDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> DescriptorProto -> Maybe EnumDescriptorProto
forall a.
DescendClass a EnumDescriptorProto =>
String -> a -> Maybe EnumDescriptorProto
toEP String
"Type" Maybe EnumDescriptorProto
-> (EnumDescriptorProto -> Maybe EnumValueDescriptorProto)
-> Maybe EnumValueDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> EnumDescriptorProto -> Maybe EnumValueDescriptorProto
forall a c. DescendClass a c => String -> a -> Maybe c
descend String
"TYPE_DOUBLE" Maybe EnumValueDescriptorProto
-> (EnumValueDescriptorProto -> Maybe EnumValueOptions)
-> Maybe EnumValueOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EnumValueOptions -> Maybe EnumValueOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumValueOptions -> Maybe EnumValueOptions)
-> (EnumValueDescriptorProto -> EnumValueOptions)
-> EnumValueDescriptorProto
-> Maybe EnumValueOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumValueDescriptorProto -> EnumValueOptions
forall a opt. NameAndOptions a opt => a -> opt
options

test5 :: Maybe D.FieldOptions
test5 :: Maybe FieldOptions
test5 = FileDescriptorProto -> Maybe FileDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FileDescriptorProto
fileDescriptorProto Maybe FileDescriptorProto
-> (FileDescriptorProto -> Maybe DescriptorProto)
-> Maybe DescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> FileDescriptorProto -> Maybe DescriptorProto
forall a.
DescendClass a DescriptorProto =>
String -> a -> Maybe DescriptorProto
toDP String
"DescriptorProto" Maybe DescriptorProto
-> (DescriptorProto -> Maybe DescriptorProto)
-> Maybe DescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> DescriptorProto -> Maybe DescriptorProto
forall a.
DescendClass a DescriptorProto =>
String -> a -> Maybe DescriptorProto
toDP String
"ExtensionRange" Maybe DescriptorProto
-> (DescriptorProto -> Maybe FieldDescriptorProto)
-> Maybe FieldDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> DescriptorProto -> Maybe FieldDescriptorProto
forall a c. DescendClass a c => String -> a -> Maybe c
descend String
"start" Maybe FieldDescriptorProto
-> (FieldDescriptorProto -> Maybe FieldOptions)
-> Maybe FieldOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldOptions -> Maybe FieldOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldOptions -> Maybe FieldOptions)
-> (FieldDescriptorProto -> FieldOptions)
-> FieldDescriptorProto
-> Maybe FieldOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescriptorProto -> FieldOptions
forall a opt. NameAndOptions a opt => a -> opt
options

test6 :: Maybe D.ServiceOptions
test6 :: Maybe ServiceOptions
test6 = FileDescriptorProto -> Maybe FileDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FileDescriptorProto
fileDescriptorProto Maybe FileDescriptorProto
-> (FileDescriptorProto -> Maybe ServiceDescriptorProto)
-> Maybe ServiceDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> FileDescriptorProto -> Maybe ServiceDescriptorProto
forall a c. DescendClass a c => String -> a -> Maybe c
descend String
"ImaginaryService" Maybe ServiceDescriptorProto
-> (ServiceDescriptorProto -> Maybe ServiceOptions)
-> Maybe ServiceOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ServiceOptions -> Maybe ServiceOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (ServiceOptions -> Maybe ServiceOptions)
-> (ServiceDescriptorProto -> ServiceOptions)
-> ServiceDescriptorProto
-> Maybe ServiceOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceDescriptorProto -> ServiceOptions
forall a opt. NameAndOptions a opt => a -> opt
options

test7 :: Maybe D.MethodOptions
test7 :: Maybe MethodOptions
test7 = FileDescriptorProto -> Maybe FileDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FileDescriptorProto
fileDescriptorProto Maybe FileDescriptorProto
-> (FileDescriptorProto -> Maybe ServiceDescriptorProto)
-> Maybe ServiceDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> FileDescriptorProto -> Maybe ServiceDescriptorProto
toSP String
"ImaginaryService" Maybe ServiceDescriptorProto
-> (ServiceDescriptorProto -> Maybe MethodDescriptorProto)
-> Maybe MethodDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ServiceDescriptorProto -> Maybe MethodDescriptorProto
forall a c. DescendClass a c => String -> a -> Maybe c
descend String
"ImaginaryMethod" Maybe MethodDescriptorProto
-> (MethodDescriptorProto -> Maybe MethodOptions)
-> Maybe MethodOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MethodOptions -> Maybe MethodOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (MethodOptions -> Maybe MethodOptions)
-> (MethodDescriptorProto -> MethodOptions)
-> MethodDescriptorProto
-> Maybe MethodOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodDescriptorProto -> MethodOptions
forall a opt. NameAndOptions a opt => a -> opt
options