module Hydra.Langs.Protobuf.Coder (moduleToProtobuf) where

import Hydra.Kernel
import Hydra.Langs.Protobuf.Language
import qualified Hydra.Langs.Protobuf.Proto3 as P3
import qualified Hydra.Lib.Strings as Strings
import Hydra.Langs.Protobuf.Language
import Hydra.Langs.Protobuf.Serde
import Hydra.Tools.Serialization
import qualified Hydra.Dsl.Types as Types
import Hydra.Dsl.Annotations

import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Text.Read as TR
import qualified Data.Maybe as Y

-- | Note: follows the Protobuf Style Guide (https://protobuf.dev/programming-guides/style)
moduleToProtobuf :: Module -> Flow (Graph) (M.Map FilePath String)
moduleToProtobuf :: Module -> Flow Graph (Map String String)
moduleToProtobuf Module
mod = do
    Map String ProtoFile
files <- Language
-> (Term -> Flow Graph ())
-> (Module
    -> Map Type (Coder Graph Graph Term ())
    -> [(Element, TypedTerm)]
    -> Flow Graph (Map String ProtoFile))
-> Module
-> Flow Graph (Map String ProtoFile)
forall e d.
Language
-> (Term -> Flow Graph e)
-> (Module
    -> Map Type (Coder Graph Graph Term e)
    -> [(Element, TypedTerm)]
    -> Flow Graph d)
-> Module
-> Flow Graph d
transformModule Language
protobufLanguage Term -> Flow Graph ()
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
encodeTerm Module
-> Map Type (Coder Graph Graph Term ())
-> [(Element, TypedTerm)]
-> Flow Graph (Map String ProtoFile)
constructModule Module
mod
    Map String String -> Flow Graph (Map String String)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String String -> Flow Graph (Map String String))
-> Map String String -> Flow Graph (Map String String)
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((String, ProtoFile) -> (String, String)
forall {a}. (a, ProtoFile) -> (a, String)
mapPair ((String, ProtoFile) -> (String, String))
-> [(String, ProtoFile)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String ProtoFile -> [(String, ProtoFile)]
forall k a. Map k a -> [(k, a)]
M.toList Map String ProtoFile
files)
  where
    mapPair :: (a, ProtoFile) -> (a, String)
mapPair (a
path, ProtoFile
sf) = (a
path, Expr -> String
printExpr (Expr -> String) -> Expr -> String
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
parenthesize (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ ProtoFile -> Expr
writeProtoFile ProtoFile
sf)
    encodeTerm :: p -> m a
encodeTerm p
_ = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"term-level encoding is not yet supported"

--

javaMultipleFilesOptionName :: String
javaMultipleFilesOptionName = String
"java_multiple_files"
javaPackageOptionName :: String
javaPackageOptionName = String
"java_package"

checkIsStringType :: Type -> Flow (Graph) ()
checkIsStringType :: Type -> Flow Graph ()
checkIsStringType Type
typ = case Type -> Type
simplifyType Type
typ of
  TypeLiteral LiteralType
lt -> case LiteralType
lt of
    LiteralType
LiteralTypeString -> () -> Flow Graph ()
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    LiteralType
_ -> String -> String -> Flow Graph ()
forall s x. String -> String -> Flow s x
unexpected String
"string type" (String -> Flow Graph ()) -> String -> Flow Graph ()
forall a b. (a -> b) -> a -> b
$ LiteralType -> String
forall a. Show a => a -> String
show LiteralType
lt
  TypeVariable Name
name -> Name -> Flow Graph Type
requireType Name
name Flow Graph Type -> (Type -> Flow Graph ()) -> Flow Graph ()
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Flow Graph ()
checkIsStringType
  Type
_ -> String -> String -> Flow Graph ()
forall s x. String -> String -> Flow s x
unexpected String
"literal (string) type" (String -> Flow Graph ()) -> String -> Flow Graph ()
forall a b. (a -> b) -> a -> b
$ Type -> String
forall a. Show a => a -> String
show Type
typ

constructModule :: Module
  -> M.Map (Type) (Coder (Graph) (Graph) (Term) ())
  -> [(Element, TypedTerm)]
  -> Flow (Graph) (M.Map FilePath P3.ProtoFile)
constructModule :: Module
-> Map Type (Coder Graph Graph Term ())
-> [(Element, TypedTerm)]
-> Flow Graph (Map String ProtoFile)
constructModule mod :: Module
mod@(Module Namespace
ns [Element]
els [Module]
_ [Module]
_ Maybe String
desc) Map Type (Coder Graph Graph Term ())
_ [(Element, TypedTerm)]
pairs = do
    [FileReference]
schemaImports <- ((Namespace -> FileReference) -> [Namespace] -> [FileReference]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Namespace -> FileReference
namespaceToFileReference ([Namespace] -> [FileReference])
-> (Set Namespace -> [Namespace])
-> Set Namespace
-> [FileReference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Namespace -> [Namespace]
forall a. Set a -> [a]
S.toList) (Set Namespace -> [FileReference])
-> Flow Graph (Set Namespace) -> Flow Graph [FileReference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Bool -> Bool -> Bool -> Module -> Flow Graph (Set Namespace)
moduleDependencyNamespaces Bool
True Bool
False Bool
False Bool
False Module
mod
    [(Element, Type)]
types <- ((Element, TypedTerm) -> Flow Graph (Element, Type))
-> [(Element, TypedTerm)] -> Flow Graph [(Element, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Element, TypedTerm) -> Flow Graph (Element, Type)
toType [(Element, TypedTerm)]
pairs
    [Definition]
definitions <- ((Element, Type) -> Flow Graph Definition)
-> [(Element, Type)] -> Flow Graph [Definition]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Element, Type) -> Flow Graph Definition
toDef [(Element, Type)]
types
    let pfile :: ProtoFile
pfile = P3.ProtoFile {
      protoFilePackage :: PackageName
P3.protoFilePackage = Namespace -> PackageName
namespaceToPackageName Namespace
ns,
      protoFileImports :: [FileReference]
P3.protoFileImports = [FileReference]
schemaImports [FileReference] -> [FileReference] -> [FileReference]
forall a. [a] -> [a] -> [a]
++ ([Type] -> [FileReference]
forall {t :: * -> *}.
(Foldable t, Functor t) =>
t Type -> [FileReference]
wrapperImport ([Type] -> [FileReference]) -> [Type] -> [FileReference]
forall a b. (a -> b) -> a -> b
$ (Element, Type) -> Type
forall a b. (a, b) -> b
snd ((Element, Type) -> Type) -> [(Element, Type)] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Element, Type)]
types) [FileReference] -> [FileReference] -> [FileReference]
forall a. [a] -> [a] -> [a]
++ ([Type] -> [FileReference]
forall {t :: * -> *}.
(Foldable t, Functor t) =>
t Type -> [FileReference]
emptyImport ([Type] -> [FileReference]) -> [Type] -> [FileReference]
forall a b. (a -> b) -> a -> b
$ (Element, Type) -> Type
forall a b. (a, b) -> b
snd ((Element, Type) -> Type) -> [(Element, Type)] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Element, Type)]
types),
      protoFileTypes :: [Definition]
P3.protoFileTypes = [Definition]
definitions,
      protoFileOptions :: [Option]
P3.protoFileOptions = Option
descOptionOption -> [Option] -> [Option]
forall a. a -> [a] -> [a]
:[Option]
javaOptions}
    Map String ProtoFile -> Flow Graph (Map String ProtoFile)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String ProtoFile -> Flow Graph (Map String ProtoFile))
-> Map String ProtoFile -> Flow Graph (Map String ProtoFile)
forall a b. (a -> b) -> a -> b
$ String -> ProtoFile -> Map String ProtoFile
forall k a. k -> a -> Map k a
M.singleton String
path ProtoFile
pfile
  where
    javaOptions :: [Option]
javaOptions = [
      String -> Value -> Option
P3.Option String
javaMultipleFilesOptionName (Value -> Option) -> Value -> Option
forall a b. (a -> b) -> a -> b
$ Bool -> Value
P3.ValueBoolean Bool
True,
      String -> Value -> Option
P3.Option String
javaPackageOptionName (Value -> Option) -> Value -> Option
forall a b. (a -> b) -> a -> b
$ String -> Value
P3.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ PackageName -> String
P3.unPackageName (PackageName -> String) -> PackageName -> String
forall a b. (a -> b) -> a -> b
$ Namespace -> PackageName
namespaceToPackageName Namespace
ns]
    descOption :: Option
descOption = String -> Value -> Option
P3.Option String
descriptionOptionName (Value -> Option) -> Value -> Option
forall a b. (a -> b) -> a -> b
$ String -> Value
P3.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$
      (String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe String
"" (\String
d -> String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n") Maybe String
desc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
warningAutoGeneratedFile
    path :: String
path = FileReference -> String
P3.unFileReference (FileReference -> String) -> FileReference -> String
forall a b. (a -> b) -> a -> b
$ Namespace -> FileReference
namespaceToFileReference Namespace
ns
    toType :: (Element, TypedTerm) -> Flow Graph (Element, Type)
toType (Element
el, (TypedTerm Term
term Type
typ)) = do
      if Type -> Bool
isType Type
typ
        then do
          Type
t <- Term -> Flow Graph Type
coreDecodeType Term
term
          (Element, Type) -> Flow Graph (Element, Type)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
el, Type
t)
        else String -> Flow Graph (Element, Type)
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow Graph (Element, Type))
-> String -> Flow Graph (Element, Type)
forall a b. (a -> b) -> a -> b
$ String
"mapping of non-type elements to PDL is not yet supported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName (Element -> Name
elementName Element
el)
    toDef :: (Element, Type) -> Flow Graph Definition
toDef (Element
el, Type
typ) = Language
-> (Type -> Flow Graph Definition) -> Type -> Flow Graph Definition
forall t.
Language -> (Type -> Flow Graph t) -> Type -> Flow Graph t
adaptAndEncodeType Language
protobufLanguage (Namespace -> Name -> Type -> Flow Graph Definition
encodeDefinition Namespace
ns (Element -> Name
elementName Element
el)) (Type -> Flow Graph Definition) -> Type -> Flow Graph Definition
forall a b. (a -> b) -> a -> b
$ Type -> Type
flattenType Type
typ
    checkFields :: (Type -> Maybe Bool) -> (Type -> Bool) -> t Type -> Bool
checkFields Type -> Maybe Bool
checkType Type -> Bool
checkFieldType t Type
types = (Bool -> Bool -> Bool) -> Bool -> t Bool -> Bool
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl Bool -> Bool -> Bool
(||) Bool
False (Type -> Bool
hasMatches (Type -> Bool) -> t Type -> t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Type
types)
      where
        hasMatches :: Type -> Bool
hasMatches = TraversalOrder -> (Bool -> Type -> Bool) -> Bool -> Type -> Bool
forall x. TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
foldOverType TraversalOrder
TraversalOrderPre (\Bool
b Type
t -> Bool
b Bool -> Bool -> Bool
|| Type -> Bool
hasMatch Type
t) Bool
False
        hasMatch :: Type -> Bool
hasMatch Type
typ = case Type -> Maybe Bool
checkType Type
typ of
          Just Bool
b -> Bool
b
          Maybe Bool
Nothing -> case Type
typ of
            TypeRecord RowType
rt -> RowType -> Bool
checkRowType RowType
rt
            TypeUnion RowType
rt -> RowType -> Bool
checkRowType RowType
rt
            Type
_ -> Bool
False
        checkRowType :: RowType -> Bool
checkRowType (RowType Name
_ Maybe Name
_ [FieldType]
fields) = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl Bool -> Bool -> Bool
(||) Bool
False (FieldType -> Bool
checkField (FieldType -> Bool) -> [FieldType] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType]
fields)
        checkField :: FieldType -> Bool
checkField (FieldType Name
_ Type
typ) = Type -> Bool
checkFieldType (Type -> Bool) -> Type -> Bool
forall a b. (a -> b) -> a -> b
$ Type -> Type
stripType Type
typ
    wrapperImport :: t Type -> [FileReference]
wrapperImport t Type
types = if (Type -> Maybe Bool) -> (Type -> Bool) -> t Type -> Bool
forall {t :: * -> *}.
(Foldable t, Functor t) =>
(Type -> Maybe Bool) -> (Type -> Bool) -> t Type -> Bool
checkFields (Maybe Bool -> Type -> Maybe Bool
forall a b. a -> b -> a
const Maybe Bool
forall a. Maybe a
Nothing) Type -> Bool
isOptionalScalarField t Type
types
        then [String -> FileReference
P3.FileReference String
"google/protobuf/wrappers.proto"]
        else []
      where
        isOptionalScalarField :: Type -> Bool
isOptionalScalarField Type
typ = case Type
typ of
          TypeOptional Type
ot -> case Type -> Type
stripType Type
ot of
            TypeLiteral LiteralType
_ -> Bool
True
            Type
_ -> Bool
False
          Type
_ -> Bool
False
    emptyImport :: t Type -> [FileReference]
emptyImport t Type
types = if (Type -> Maybe Bool) -> (Type -> Bool) -> t Type -> Bool
forall {t :: * -> *}.
(Foldable t, Functor t) =>
(Type -> Maybe Bool) -> (Type -> Bool) -> t Type -> Bool
checkFields Type -> Maybe Bool
checkType Type -> Bool
isUnitField t Type
types
        then [String -> FileReference
P3.FileReference String
"google/protobuf/empty.proto"]
        else []
      where
        checkType :: Type -> Maybe Bool
checkType Type
typ = if Type -> Bool
isEnumDefinition Type
typ
          then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
          else Maybe Bool
forall a. Maybe a
Nothing
        isUnitField :: Type -> Bool
isUnitField Type
typ = case Type
typ of
          TypeRecord (RowType Name
name Maybe Name
_ [FieldType]
_) -> Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
_Unit
          Type
_ -> Bool
False

encodeDefinition :: Namespace -> Name -> Type -> Flow (Graph) P3.Definition
encodeDefinition :: Namespace -> Name -> Type -> Flow Graph Definition
encodeDefinition Namespace
localNs Name
name Type
typ = String -> Flow Graph Definition -> Flow Graph Definition
forall s a. String -> Flow s a -> Flow s a
withTrace (String
"encoding " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name) (Flow Graph Definition -> Flow Graph Definition)
-> Flow Graph Definition -> Flow Graph Definition
forall a b. (a -> b) -> a -> b
$ do
    String -> Flow Graph ()
forall s. String -> Flow s ()
resetCount String
"proto_field_index"
    Flow Graph Int
forall s. Flow s Int
nextIndex
    [Option]
options <- Type -> Flow Graph [Option]
findOptions Type
typ
    [Option] -> Type -> Flow Graph Definition
encode [Option]
options Type
typ
  where
    wrapAsRecordType :: Type -> Type
wrapAsRecordType Type
t = RowType -> Type
TypeRecord (RowType -> Type) -> RowType -> Type
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name -> [FieldType] -> RowType
RowType Name
name Maybe Name
forall a. Maybe a
Nothing [Name -> Type -> FieldType
FieldType (String -> Name
Name String
"value") Type
t]
    encode :: [Option] -> Type -> Flow Graph Definition
encode [Option]
options Type
typ = case Type -> Type
simplifyType Type
typ of
      TypeRecord RowType
rt -> MessageDefinition -> Definition
P3.DefinitionMessage (MessageDefinition -> Definition)
-> Flow Graph MessageDefinition -> Flow Graph Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> [Option] -> RowType -> Flow Graph MessageDefinition
encodeRecordType Namespace
localNs [Option]
options RowType
rt
      TypeUnion RowType
rt -> if Type -> Bool
isEnumDefinition Type
typ
        then EnumDefinition -> Definition
P3.DefinitionEnum (EnumDefinition -> Definition)
-> Flow Graph EnumDefinition -> Flow Graph Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Option] -> RowType -> Flow Graph EnumDefinition
encodeEnumDefinition [Option]
options RowType
rt
        else [Option] -> Type -> Flow Graph Definition
encode [Option]
options (Type -> Flow Graph Definition) -> Type -> Flow Graph Definition
forall a b. (a -> b) -> a -> b
$ Type -> Type
wrapAsRecordType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ RowType -> Type
TypeUnion RowType
rt
      Type
t -> [Option] -> Type -> Flow Graph Definition
encode [Option]
options (Type -> Flow Graph Definition) -> Type -> Flow Graph Definition
forall a b. (a -> b) -> a -> b
$ Type -> Type
wrapAsRecordType Type
t

encodeEnumDefinition :: [P3.Option] -> RowType -> Flow (Graph) P3.EnumDefinition
encodeEnumDefinition :: [Option] -> RowType -> Flow Graph EnumDefinition
encodeEnumDefinition [Option]
options (RowType Name
tname Maybe Name
_ [FieldType]
fields) = do
    [EnumValue]
values <- (FieldType -> Int -> Flow Graph EnumValue)
-> [FieldType] -> [Int] -> Flow Graph [EnumValue]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
CM.zipWithM FieldType -> Int -> Flow Graph EnumValue
encodeEnumField [FieldType]
fields [Int
1..]
    EnumDefinition -> Flow Graph EnumDefinition
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumDefinition -> Flow Graph EnumDefinition)
-> EnumDefinition -> Flow Graph EnumDefinition
forall a b. (a -> b) -> a -> b
$ P3.EnumDefinition {
      enumDefinitionName :: TypeName
P3.enumDefinitionName = Name -> TypeName
encodeTypeName Name
tname,
      enumDefinitionValues :: [EnumValue]
P3.enumDefinitionValues = EnumValue
unspecifiedFieldEnumValue -> [EnumValue] -> [EnumValue]
forall a. a -> [a] -> [a]
:[EnumValue]
values,
      enumDefinitionOptions :: [Option]
P3.enumDefinitionOptions = [Option]
options}
  where
    unspecifiedField :: EnumValue
unspecifiedField = P3.EnumValue {
      enumValueName :: EnumValueName
P3.enumValueName = Name -> Name -> EnumValueName
encodeEnumValueName Name
tname (Name -> EnumValueName) -> Name -> EnumValueName
forall a b. (a -> b) -> a -> b
$ String -> Name
Name String
"unspecified",
      enumValueNumber :: Int
P3.enumValueNumber = Int
0,
      enumValueOptions :: [Option]
P3.enumValueOptions = []}
    encodeEnumField :: FieldType -> Int -> Flow Graph EnumValue
encodeEnumField (FieldType Name
fname Type
ftype) Int
idx = do
      [Option]
opts <- Type -> Flow Graph [Option]
findOptions Type
ftype
      EnumValue -> Flow Graph EnumValue
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumValue -> Flow Graph EnumValue)
-> EnumValue -> Flow Graph EnumValue
forall a b. (a -> b) -> a -> b
$ P3.EnumValue {
        enumValueName :: EnumValueName
P3.enumValueName = Name -> Name -> EnumValueName
encodeEnumValueName Name
tname Name
fname,
        enumValueNumber :: Int
P3.enumValueNumber = Int
idx,
        enumValueOptions :: [Option]
P3.enumValueOptions = [Option]
opts}

encodeEnumValueName :: Name -> Name -> P3.EnumValueName
encodeEnumValueName :: Name -> Name -> EnumValueName
encodeEnumValueName Name
tname Name
fname = String -> EnumValueName
P3.EnumValueName (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix)
  where
    prefix :: String
prefix = String -> String
convertCaseCamelToUpperSnake (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Name -> String
localNameOfEager Name
tname
    suffix :: String
suffix = String -> String
convertCaseCamelToUpperSnake (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Name -> String
unName Name
fname

encodeFieldName :: Bool -> Name -> P3.FieldName
encodeFieldName :: Bool -> Name -> FieldName
encodeFieldName Bool
preserve = String -> FieldName
P3.FieldName (String -> FieldName) -> (Name -> String) -> Name -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
toPname (String -> String) -> (Name -> String) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
unName
  where
    toPname :: String -> String
toPname = if Bool
preserve
      then String -> String
forall a. a -> a
id
      else String -> String
convertCaseCamelToLowerSnake

encodeFieldType :: Namespace -> FieldType -> Flow (Graph) P3.Field
encodeFieldType :: Namespace -> FieldType -> Flow Graph Field
encodeFieldType Namespace
localNs (FieldType Name
fname Type
ftype) = String -> Flow Graph Field -> Flow Graph Field
forall s a. String -> Flow s a -> Flow s a
withTrace (String
"encode field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (Name -> String
unName Name
fname)) (Flow Graph Field -> Flow Graph Field)
-> Flow Graph Field -> Flow Graph Field
forall a b. (a -> b) -> a -> b
$ do
    [Option]
options <- Type -> Flow Graph [Option]
findOptions Type
ftype
    FieldType
ft <- Type -> Flow Graph FieldType
encodeType Type
ftype
    Int
idx <- Flow Graph Int
forall s. Flow s Int
nextIndex
    Bool
preserve <- String -> Type -> Flow Graph Bool
readBooleanAnnotation String
key_preserveFieldName Type
ftype
    Field -> Flow Graph Field
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Flow Graph Field) -> Field -> Flow Graph Field
forall a b. (a -> b) -> a -> b
$ P3.Field {
      fieldName :: FieldName
P3.fieldName = Bool -> Name -> FieldName
encodeFieldName Bool
preserve Name
fname,
      fieldJsonName :: Maybe String
P3.fieldJsonName = Maybe String
forall a. Maybe a
Nothing,
      fieldType :: FieldType
P3.fieldType = FieldType
ft,
      fieldNumber :: Int
P3.fieldNumber = Int
idx,
      fieldOptions :: [Option]
P3.fieldOptions = [Option]
options}
  where
    encodeType :: Type -> Flow Graph FieldType
encodeType Type
typ = case Type -> Type
simplifyType Type
typ of
      TypeList Type
lt -> do
        SimpleType -> FieldType
P3.FieldTypeRepeated (SimpleType -> FieldType)
-> Flow Graph SimpleType -> Flow Graph FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Flow Graph SimpleType
forall {s}. Type -> Flow s SimpleType
encodeSimpleType Type
lt
      TypeMap (MapType Type
kt Type
vt) -> do
--        checkIsStringType kt
        SimpleType -> FieldType
P3.FieldTypeMap (SimpleType -> FieldType)
-> Flow Graph SimpleType -> Flow Graph FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Flow Graph SimpleType
forall {s}. Type -> Flow s SimpleType
encodeSimpleType Type
vt
      TypeOptional Type
ot -> case Type -> Type
stripType Type
ot of
        TypeLiteral LiteralType
lt -> SimpleType -> FieldType
P3.FieldTypeSimple (SimpleType -> FieldType)
-> Flow Graph SimpleType -> Flow Graph FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LiteralType -> Flow Graph SimpleType
forall s. LiteralType -> Flow s SimpleType
encodeScalarTypeWrapped LiteralType
lt
        Type
_ -> Type -> Flow Graph FieldType
encodeType Type
ot -- TODO
      TypeUnion (RowType Name
_ Maybe Name
_ [FieldType]
fields) -> do
        [Field]
pfields <- (FieldType -> Flow Graph Field)
-> [FieldType] -> Flow Graph [Field]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Namespace -> FieldType -> Flow Graph Field
encodeFieldType Namespace
localNs) [FieldType]
fields
        FieldType -> Flow Graph FieldType
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldType -> Flow Graph FieldType)
-> FieldType -> Flow Graph FieldType
forall a b. (a -> b) -> a -> b
$ [Field] -> FieldType
P3.FieldTypeOneof [Field]
pfields
      Type
_ -> do
        SimpleType -> FieldType
P3.FieldTypeSimple (SimpleType -> FieldType)
-> Flow Graph SimpleType -> Flow Graph FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Flow Graph SimpleType
forall {s}. Type -> Flow s SimpleType
encodeSimpleType Type
typ
    encodeSimpleType :: Type -> Flow s SimpleType
encodeSimpleType Type
typ = case Type -> Type
simplifyType Type
typ of
      TypeLiteral LiteralType
lt -> ScalarType -> SimpleType
P3.SimpleTypeScalar (ScalarType -> SimpleType)
-> Flow s ScalarType -> Flow s SimpleType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LiteralType -> Flow s ScalarType
forall s. LiteralType -> Flow s ScalarType
encodeScalarType LiteralType
lt
      TypeRecord (RowType Name
name Maybe Name
_ [FieldType]
_) -> if Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
_Unit
        then SimpleType -> Flow s SimpleType
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleType -> Flow s SimpleType)
-> SimpleType -> Flow s SimpleType
forall a b. (a -> b) -> a -> b
$ TypeName -> SimpleType
P3.SimpleTypeReference (TypeName -> SimpleType) -> TypeName -> SimpleType
forall a b. (a -> b) -> a -> b
$ String -> TypeName
P3.TypeName (String -> TypeName) -> String -> TypeName
forall a b. (a -> b) -> a -> b
$ String
"google.protobuf.Empty"
        else Name -> Flow s SimpleType
forall {f :: * -> *}. Applicative f => Name -> f SimpleType
forNominal Name
name
      TypeUnion (RowType Name
name Maybe Name
_ [FieldType]
_) -> Name -> Flow s SimpleType
forall {f :: * -> *}. Applicative f => Name -> f SimpleType
forNominal Name
name
      TypeVariable Name
name -> Name -> Flow s SimpleType
forall {f :: * -> *}. Applicative f => Name -> f SimpleType
forNominal Name
name
      Type
t -> String -> String -> Flow s SimpleType
forall s x. String -> String -> Flow s x
unexpected String
"simple type" (String -> Flow s SimpleType) -> String -> Flow s SimpleType
forall a b. (a -> b) -> a -> b
$ Type -> String
forall a. Show a => a -> String
show (Type -> String) -> Type -> String
forall a b. (a -> b) -> a -> b
$ Type -> Type
removeTypeAnnotations Type
t
      where
        forNominal :: Name -> f SimpleType
forNominal Name
name = SimpleType -> f SimpleType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleType -> f SimpleType) -> SimpleType -> f SimpleType
forall a b. (a -> b) -> a -> b
$ TypeName -> SimpleType
P3.SimpleTypeReference (TypeName -> SimpleType) -> TypeName -> SimpleType
forall a b. (a -> b) -> a -> b
$ Namespace -> Name -> TypeName
encodeTypeReference Namespace
localNs Name
name

encodeRecordType :: Namespace -> [P3.Option] -> RowType -> Flow (Graph) P3.MessageDefinition
encodeRecordType :: Namespace -> [Option] -> RowType -> Flow Graph MessageDefinition
encodeRecordType Namespace
localNs [Option]
options (RowType Name
tname Maybe Name
_ [FieldType]
fields) = do
    [Field]
pfields <- (FieldType -> Flow Graph Field)
-> [FieldType] -> Flow Graph [Field]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Namespace -> FieldType -> Flow Graph Field
encodeFieldType Namespace
localNs) [FieldType]
fields
    MessageDefinition -> Flow Graph MessageDefinition
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return P3.MessageDefinition {
      messageDefinitionName :: TypeName
P3.messageDefinitionName = Name -> TypeName
encodeTypeName Name
tname,
      messageDefinitionFields :: [Field]
P3.messageDefinitionFields = [Field]
pfields,
      messageDefinitionOptions :: [Option]
P3.messageDefinitionOptions = [Option]
options}

encodeScalarType :: LiteralType -> Flow s P3.ScalarType
encodeScalarType :: forall s. LiteralType -> Flow s ScalarType
encodeScalarType LiteralType
lt = case LiteralType
lt of
  LiteralType
LiteralTypeBinary -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeBytes
  LiteralType
LiteralTypeBoolean -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeBool
  LiteralTypeFloat FloatType
ft -> case FloatType
ft of
    FloatType
FloatTypeFloat32 -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeFloat
    FloatType
FloatTypeFloat64 -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeDouble
    FloatType
_ -> String -> String -> Flow s ScalarType
forall s x. String -> String -> Flow s x
unexpected String
"32-bit or 64-bit floating-point type" (String -> Flow s ScalarType) -> String -> Flow s ScalarType
forall a b. (a -> b) -> a -> b
$ FloatType -> String
forall a. Show a => a -> String
show FloatType
ft
  LiteralTypeInteger IntegerType
it -> case IntegerType
it of
    IntegerType
IntegerTypeInt32 -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeInt32
    IntegerType
IntegerTypeInt64 -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeInt64
    IntegerType
IntegerTypeUint32 -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeUint32
    IntegerType
IntegerTypeUint64 -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeUint64
    IntegerType
_ -> String -> String -> Flow s ScalarType
forall s x. String -> String -> Flow s x
unexpected String
"32-bit or 64-bit integer type" (String -> Flow s ScalarType) -> String -> Flow s ScalarType
forall a b. (a -> b) -> a -> b
$ IntegerType -> String
forall a. Show a => a -> String
show IntegerType
it
  LiteralType
LiteralTypeString -> ScalarType -> Flow s ScalarType
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarType
P3.ScalarTypeString

encodeScalarTypeWrapped :: LiteralType -> Flow s P3.SimpleType
encodeScalarTypeWrapped :: forall s. LiteralType -> Flow s SimpleType
encodeScalarTypeWrapped LiteralType
lt = String -> SimpleType
toType (String -> SimpleType) -> Flow s String -> Flow s SimpleType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case LiteralType
lt of
    LiteralType
LiteralTypeBinary -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Bytes"
    LiteralType
LiteralTypeBoolean -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Bool"
    LiteralTypeFloat FloatType
ft -> case FloatType
ft of
      FloatType
FloatTypeFloat32 -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Float"
      FloatType
FloatTypeFloat64 -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Double"
      FloatType
_ -> String -> String -> Flow s String
forall s x. String -> String -> Flow s x
unexpected String
"32-bit or 64-bit floating-point type" (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ FloatType -> String
forall a. Show a => a -> String
show FloatType
ft
    LiteralTypeInteger IntegerType
it -> case IntegerType
it of
      IntegerType
IntegerTypeInt32 -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Int32"
      IntegerType
IntegerTypeInt64 -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Int64"
      IntegerType
IntegerTypeUint32 -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"UInt32"
      IntegerType
IntegerTypeUint64 -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"UInt64"
      IntegerType
_ -> String -> String -> Flow s String
forall s x. String -> String -> Flow s x
unexpected String
"32-bit or 64-bit integer type" (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ IntegerType -> String
forall a. Show a => a -> String
show IntegerType
it
    LiteralType
LiteralTypeString -> String -> Flow s String
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"String"
  where
    toType :: String -> SimpleType
toType String
label = TypeName -> SimpleType
P3.SimpleTypeReference (TypeName -> SimpleType) -> TypeName -> SimpleType
forall a b. (a -> b) -> a -> b
$ String -> TypeName
P3.TypeName (String -> TypeName) -> String -> TypeName
forall a b. (a -> b) -> a -> b
$ String
"google.protobuf." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Value"

encodeTypeName :: Name -> P3.TypeName
encodeTypeName :: Name -> TypeName
encodeTypeName = String -> TypeName
P3.TypeName (String -> TypeName) -> (Name -> String) -> Name -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
localNameOfEager

encodeTypeReference :: Namespace -> Name -> P3.TypeName
encodeTypeReference :: Namespace -> Name -> TypeName
encodeTypeReference Namespace
localNs Name
name = String -> TypeName
P3.TypeName (String -> TypeName) -> String -> TypeName
forall a b. (a -> b) -> a -> b
$ if Maybe [String]
nsParts Maybe [String] -> Maybe [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
localNsParts
    then String
local
    else case Maybe [String]
nsParts of
      Maybe [String]
Nothing -> String
local
      Just [String]
parts -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." ([String]
parts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
local])
  where
    QualifiedName Maybe Namespace
ns String
local = Name -> QualifiedName
qualifyNameEager Name
name
    nsParts :: Maybe [String]
nsParts = (Namespace -> [String]) -> Maybe Namespace -> Maybe [String]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Namespace
n -> [String] -> [String]
forall a. HasCallStack => [a] -> [a]
L.init ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
Strings.splitOn String
"/" (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Namespace -> String
unNamespace Namespace
n) Maybe Namespace
ns
    localNsParts :: [String]
localNsParts = [String] -> [String]
forall a. HasCallStack => [a] -> [a]
L.init ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
Strings.splitOn String
"/" (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Namespace -> String
unNamespace Namespace
localNs

-- Eliminate type lambdas and type applications, simply replacing type variables with the string type
flattenType :: Type -> Type
flattenType :: Type -> Type
flattenType = ((Type -> Type) -> Type -> Type)
-> (Map String Term -> Map String Term) -> Type -> Type
rewriteType (Type -> Type) -> Type -> Type
forall {b}. (Type -> b) -> Type -> b
f Map String Term -> Map String Term
forall a. a -> a
id
  where
   f :: (Type -> b) -> Type -> b
f Type -> b
recurse Type
typ = case Type
typ of
     TypeLambda (LambdaType Name
v Type
body) -> Type -> b
recurse (Type -> b) -> Type -> b
forall a b. (a -> b) -> a -> b
$ Name -> Type -> Type -> Type
replaceFreeName Name
v Type
Types.string Type
body
     TypeApplication (ApplicationType Type
lhs Type
_) -> Type -> b
recurse Type
lhs
     Type
_ -> Type -> b
recurse Type
typ

findOptions :: Type -> Flow (Graph) [P3.Option]
findOptions :: Type -> Flow Graph [Option]
findOptions Type
typ = do
  Maybe String
mdesc <- Type -> Flow Graph (Maybe String)
getTypeDescription Type
typ
  Bool
bdep <- String -> Type -> Flow Graph Bool
readBooleanAnnotation String
key_deprecated Type
typ
  let mdescAnn :: Maybe Option
mdescAnn = (String -> Option) -> Maybe String -> Maybe Option
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
desc -> String -> Value -> Option
P3.Option String
descriptionOptionName (Value -> Option) -> Value -> Option
forall a b. (a -> b) -> a -> b
$ String -> Value
P3.ValueString String
desc) Maybe String
mdesc
  let mdepAnn :: Maybe Option
mdepAnn = if Bool
bdep then Option -> Maybe Option
forall a. a -> Maybe a
Just (String -> Value -> Option
P3.Option String
deprecatedOptionName (Value -> Option) -> Value -> Option
forall a b. (a -> b) -> a -> b
$ Bool -> Value
P3.ValueBoolean Bool
True) else Maybe Option
forall a. Maybe a
Nothing
  [Option] -> Flow Graph [Option]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> Flow Graph [Option])
-> [Option] -> Flow Graph [Option]
forall a b. (a -> b) -> a -> b
$ [Maybe Option] -> [Option]
forall a. [Maybe a] -> [a]
Y.catMaybes [Maybe Option
mdescAnn, Maybe Option
mdepAnn]

isEnumFields :: [FieldType] -> Bool
isEnumFields :: [FieldType] -> Bool
isEnumFields [FieldType]
fields = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl Bool -> Bool -> Bool
(&&) Bool
True ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (FieldType -> Bool) -> [FieldType] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldType -> Bool
isEnumField [FieldType]
fields
  where
    isEnumField :: FieldType -> Bool
isEnumField = Type -> Bool
isUnitType (Type -> Bool) -> (FieldType -> Type) -> FieldType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
simplifyType (Type -> Type) -> (FieldType -> Type) -> FieldType -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldType -> Type
fieldTypeType

isEnumDefinition :: Type -> Bool
isEnumDefinition :: Type -> Bool
isEnumDefinition Type
typ = case Type -> Type
simplifyType Type
typ of
  TypeUnion (RowType Name
_ Maybe Name
_ [FieldType]
fields) -> [FieldType] -> Bool
isEnumFields [FieldType]
fields
  Type
_ -> Bool
False

isEnumDefinitionReference :: Name -> Flow (Graph) Bool
isEnumDefinitionReference :: Name -> Flow Graph Bool
isEnumDefinitionReference Name
name = Type -> Bool
isEnumDefinition (Type -> Bool) -> Flow Graph Type -> Flow Graph Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Element -> Term
elementData (Element -> Term) -> Flow Graph Element -> Flow Graph Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Flow Graph Element
requireElement Name
name) Flow Graph Term -> (Term -> Flow Graph Type) -> Flow Graph Type
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Term -> Flow Graph Type
coreDecodeType)

namespaceToFileReference :: Namespace -> P3.FileReference
namespaceToFileReference :: Namespace -> FileReference
namespaceToFileReference (Namespace String
ns) = String -> FileReference
P3.FileReference (String -> FileReference) -> String -> FileReference
forall a b. (a -> b) -> a -> b
$ String
pns String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".proto"
  where
    pns :: String
pns = String -> [String] -> String
Strings.intercalate String
"/" (String -> String
convertCaseCamelToLowerSnake (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> [String]
Strings.splitOn String
"/" String
ns))

namespaceToPackageName :: Namespace -> P3.PackageName
namespaceToPackageName :: Namespace -> PackageName
namespaceToPackageName (Namespace String
ns) = String -> PackageName
P3.PackageName (String -> PackageName) -> String -> PackageName
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
Strings.intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
  String -> String
convertCaseCamelToLowerSnake (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
L.init ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
Strings.splitOn String
"/" String
ns)

nextIndex :: Flow s Int
nextIndex :: forall s. Flow s Int
nextIndex = String -> Flow s Int
forall s. String -> Flow s Int
nextCount String
"proto_field_index"

readBooleanAnnotation :: String -> Type -> Flow (Graph) Bool
readBooleanAnnotation :: String -> Type -> Flow Graph Bool
readBooleanAnnotation String
key Type
typ = do
  let ann :: Map String Term
ann = Type -> Map String Term
typeAnnotationInternal Type
typ
  case String -> Maybe (Map String Term)
forall a. Read a => String -> Maybe a
TR.readMaybe (String -> Maybe (Map String Term))
-> String -> Maybe (Map String Term)
forall a b. (a -> b) -> a -> b
$ Map String Term -> String
forall a. Show a => a -> String
show Map String Term
ann of
    Just Map String Term
kv -> case String -> Map String Term -> Maybe Term
getAnnotation String
key Map String Term
kv of
      Just Term
_ -> Bool -> Flow Graph Bool
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      Maybe Term
Nothing -> Bool -> Flow Graph Bool
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Maybe (Map String Term)
Nothing -> Bool -> Flow Graph Bool
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- Note: this should probably be done in the term adapters
simplifyType :: Type -> Type
simplifyType :: Type -> Type
simplifyType Type
typ = case Type -> Type
stripType Type
typ of
  TypeWrap (WrappedType Name
_ Type
t) -> Type -> Type
simplifyType Type
t
  Type
t -> Type
t